diff --git a/CONTRIBUTORS.md b/CONTRIBUTORS.md index 24b412e65..5c277da0b 100644 --- a/CONTRIBUTORS.md +++ b/CONTRIBUTORS.md @@ -2,6 +2,7 @@ | GitHub user | Real Name | Affiliation | Date | | --------------- | ----------------- | ----------- | ---------- | | 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 | | mike-hobson | Mike Hobson | Met Office | 2025-12-17 | | mo-marqh | mark Hedley | Met Office | 2025-12-11 | @@ -11,4 +12,4 @@ | DrTVockerodtMO | Terence Vockerodt | Met Office | 2026-01-08 | | MetBenjaminWent | Benjamin Went | Met Office | 2026-01-15 | | timgraham-Met | Tim Graham | Met Office | 2026-01-15 | -| mo-alistairp | Alistair Pirrie | Met Office | 2026-01-19 | \ No newline at end of file +| mo-alistairp | Alistair Pirrie | Met Office | 2026-01-19 | diff --git a/applications/adjoint_tests/source/adjoint_tests.f90 b/applications/adjoint_tests/source/adjoint_tests.f90 index 5fa5b2232..b24cf8800 100644 --- a/applications/adjoint_tests/source/adjoint_tests.f90 +++ b/applications/adjoint_tests/source/adjoint_tests.f90 @@ -24,17 +24,23 @@ program adjoint_tests use log_mod, only : log_event, & log_level_trace, & log_scratch_space + use timing_mod, only: init_timing, final_timing + use io_config_mod, only: timer_output_path + use namelist_mod, only: namelist_type implicit none ! Model run working data set type (modeldb_type) :: modeldb - character(*), parameter :: application_name = "adjoint_tests" - character(:), allocatable :: filename + character(*), parameter :: application_name = "adjoint_tests" + character(:), allocatable :: filename - call parse_command_line( filename ) + type(namelist_type), pointer :: io_nml + + logical :: lsubroutine_timers + call parse_command_line( filename ) modeldb%mpi => global_mpi call modeldb%configuration%initialise( application_name, table_len=10 ) @@ -61,6 +67,13 @@ program adjoint_tests call init_config( filename, gungho_required_namelists, & modeldb%configuration ) call init_logger( modeldb%mpi%get_comm(), application_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, & + application_name, timer_output_path ) + nullify( io_nml ) + call init_collections() call init_time( modeldb ) deallocate( filename ) @@ -77,6 +90,7 @@ program adjoint_tests call final_time( modeldb ) call final_collections() + call final_timing( application_name ) call final_logger( application_name ) call final_config() call final_comm( modeldb ) diff --git a/applications/adjoint_tests/source/algorithm/solver/adjt_mixed_operator_alg_mod.x90 b/applications/adjoint_tests/source/algorithm/solver/adjt_mixed_operator_alg_mod.x90 index 1ec40ca09..36906bb77 100644 --- a/applications/adjoint_tests/source/algorithm/solver/adjt_mixed_operator_alg_mod.x90 +++ b/applications/adjoint_tests/source/algorithm/solver/adjt_mixed_operator_alg_mod.x90 @@ -27,8 +27,8 @@ module adjt_mixed_operator_alg_mod use mixed_operator_alg_mod, only: mixed_operator_type use adj_mixed_operator_alg_mod, only: adj_mixed_operator_type use adj_semi_implicit_solver_alg_mod, only: construct_solver_state - use io_config_mod, only: subroutine_timers - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF use finite_element_config_mod, only: element_order_h, element_order_v use function_space_collection_mod, only: function_space_collection use moist_dyn_mod, only: num_moist_factors @@ -84,8 +84,10 @@ contains real(kind=r_def) :: relative_diff, relative_diff_r_solver real(kind=r_def), parameter :: overall_tolerance = 1000.0_r_def real(kind=r_def), parameter :: eps = 1e-30_r_def + integer(kind=tik) :: id + + if ( LPROF ) call start_timing( id, 'adjt_mixed_operator_alg' ) - if (subroutine_timers) call timer('adjt_mixed_operator_alg') ! -------------------------------------------------------------------------- ! Setup @@ -216,7 +218,7 @@ contains call log_event( log_scratch_space, LOG_LEVEL_ERROR ) end if - if (subroutine_timers) call timer('adjt_mixed_operator_alg') + if ( LPROF ) call stop_timing(id, 'adjt_mixed_operator_alg' ) end subroutine adjt_mixed_operator_alg diff --git a/applications/adjoint_tests/source/algorithm/solver/adjt_mixed_schur_preconditioner_alg_mod.x90 b/applications/adjoint_tests/source/algorithm/solver/adjt_mixed_schur_preconditioner_alg_mod.x90 index 7a4560938..3c214bdd1 100644 --- a/applications/adjoint_tests/source/algorithm/solver/adjt_mixed_schur_preconditioner_alg_mod.x90 +++ b/applications/adjoint_tests/source/algorithm/solver/adjt_mixed_schur_preconditioner_alg_mod.x90 @@ -22,8 +22,8 @@ module adjt_mixed_schur_preconditioner_alg_mod igh_p, igh_t, igh_d, igh_u use sci_iterative_solver_mod, only: abstract_iterative_solver_type, & bicgstab_type - use io_config_mod, only: subroutine_timers - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF use finite_element_config_mod, only: element_order_h, element_order_v use function_space_collection_mod, only: function_space_collection use copy_field_alg_mod, only: copy_field @@ -126,8 +126,9 @@ contains real(kind=r_def) :: machine_tol, machine_tol_r_solver real(kind=r_def) :: relative_diff, relative_diff_r_solver real(kind=r_def), parameter :: eps = 1e-30_r_def + integer(kind=tik) :: id - if (subroutine_timers) call timer('adjt_mixed_schur_preconditioner_alg') + if ( LPROF ) call start_timing( id, 'adjt_mixed_schur_preconditioner_alg' ) ! -------------------------------------------------------------------------- ! Setup @@ -305,7 +306,7 @@ contains deallocate( pressure_preconditioner, pressure_solver, mixed_preconditioner, & adj_pressure_preconditioner, adj_pressure_solver, adj_mixed_preconditioner ) - if (subroutine_timers) call timer('adjt_mixed_schur_preconditioner_alg') + if ( LPROF ) call stop_timing( id, 'adjt_mixed_schur_preconditioner_alg' ) end subroutine adjt_mixed_schur_preconditioner_alg diff --git a/applications/adjoint_tests/source/algorithm/solver/adjt_mixed_solver_alg_mod.x90 b/applications/adjoint_tests/source/algorithm/solver/adjt_mixed_solver_alg_mod.x90 index 67317630f..df216b670 100644 --- a/applications/adjoint_tests/source/algorithm/solver/adjt_mixed_solver_alg_mod.x90 +++ b/applications/adjoint_tests/source/algorithm/solver/adjt_mixed_solver_alg_mod.x90 @@ -26,8 +26,8 @@ module adjt_mixed_solver_alg_mod igh_p, igh_t, igh_d, igh_u use mixed_operator_alg_mod, only: mixed_operator_type use adj_mixed_operator_alg_mod, only: adj_mixed_operator_type - use io_config_mod, only: subroutine_timers - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF use finite_element_config_mod, only: element_order_h, element_order_v use function_space_collection_mod, only: function_space_collection use copy_field_alg_mod, only: copy_field @@ -143,8 +143,9 @@ contains real(kind=r_def) :: machine_tol, machine_tol_r_solver real(kind=r_def) :: relative_diff, relative_diff_r_solver real(kind=r_def), parameter :: eps = 1e-30_r_def + integer(tik) :: id - if (subroutine_timers) call timer('adjt_mixed_solver_alg') + if ( LPROF ) call start_timing( id, 'adjt_mixed_solver_alg' ) ! -------------------------------------------------------------------------- ! Setup @@ -336,7 +337,7 @@ contains deallocate( pressure_preconditioner, pressure_solver, mixed_preconditioner, mixed_solver, & adj_pressure_preconditioner, adj_pressure_solver, adj_mixed_preconditioner, adj_mixed_solver ) - if (subroutine_timers) call timer('adjt_mixed_solver_alg') + if ( LPROF ) call stop_timing( id, 'adjt_mixed_solver_alg' ) end subroutine adjt_mixed_solver_alg diff --git a/applications/adjoint_tests/source/algorithm/solver/adjt_pressure_precon_alg_mod.x90 b/applications/adjoint_tests/source/algorithm/solver/adjt_pressure_precon_alg_mod.x90 index 225e7610b..308b1f180 100644 --- a/applications/adjoint_tests/source/algorithm/solver/adjt_pressure_precon_alg_mod.x90 +++ b/applications/adjoint_tests/source/algorithm/solver/adjt_pressure_precon_alg_mod.x90 @@ -20,8 +20,8 @@ module adjt_pressure_precon_alg_mod use derived_config_mod, only: bundle_size use field_indices_mod, only: isol_p, isol_u, isol_w, isol_uv, & igh_p, igh_t, igh_d, igh_u - use io_config_mod, only: subroutine_timers - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF use finite_element_config_mod, only: element_order_h, element_order_v use function_space_collection_mod, only: function_space_collection use copy_field_alg_mod, only: copy_field @@ -115,8 +115,9 @@ contains real(kind=r_def) :: machine_tol, machine_tol_r_solver real(kind=r_def) :: relative_diff, relative_diff_r_solver real(kind=r_def), parameter :: eps = 1e-30_r_def + integer(tik) :: id - if (subroutine_timers) call timer('adjt_pressure_precon_alg') + if ( LPROF ) call start_timing( id, 'adjt_pressure_precon_alg' ) ! -------------------------------------------------------------------------- ! Setup @@ -276,7 +277,7 @@ contains deallocate( pressure_preconditioner, adj_pressure_preconditioner ) - if (subroutine_timers) call timer('adjt_pressure_preconditioner_alg') + if ( LPROF ) call stop_timing( id, 'adjt_pressure_precon_alg' ) end subroutine adjt_pressure_precon_alg diff --git a/applications/adjoint_tests/source/algorithm/solver/adjt_semi_implicit_solver_step_alg_mod.x90 b/applications/adjoint_tests/source/algorithm/solver/adjt_semi_implicit_solver_step_alg_mod.x90 index 6672c772c..efb6ffc53 100644 --- a/applications/adjoint_tests/source/algorithm/solver/adjt_semi_implicit_solver_step_alg_mod.x90 +++ b/applications/adjoint_tests/source/algorithm/solver/adjt_semi_implicit_solver_step_alg_mod.x90 @@ -18,8 +18,8 @@ module adjt_semi_implicit_solver_step_alg_mod use derived_config_mod, only: bundle_size use field_indices_mod, only: isol_p, isol_u, isol_w, isol_uv, & igh_p, igh_t, igh_d, igh_u - use io_config_mod, only: subroutine_timers - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF use finite_element_config_mod, only: element_order_h, element_order_v use adj_semi_implicit_solver_alg_mod, only: adj_semi_implicit_solver_type use semi_implicit_solver_alg_mod, only: semi_implicit_solver_alg_step @@ -100,8 +100,9 @@ contains type(field_type), pointer :: panel_id real(kind=r_def) :: initial_time integer(kind=i_def) :: i + integer(kind=tik) :: id - if (subroutine_timers) call timer('adjt_semi_implicit_solver_step_alg') + if ( LPROF ) call start_timing( id, 'adjt_semi_implicit_solver_step_alg' ) ! -------------------------------------------------------------------------- ! Setup @@ -258,7 +259,7 @@ contains call adj_semi_implicit_solver%finalise() - if (subroutine_timers) call timer('adjt_semi_implicit_solver_step_alg') + if ( LPROF ) call stop_timing( id, 'adjt_semi_implicit_solver_step_alg' ) end subroutine adjt_semi_implicit_solver_step_alg diff --git a/applications/adjoint_tests/source/algorithm/timestepping/atlt_si_timestep_alg_mod.x90 b/applications/adjoint_tests/source/algorithm/timestepping/atlt_si_timestep_alg_mod.x90 index d7e6cfe04..a95de6ba9 100644 --- a/applications/adjoint_tests/source/algorithm/timestepping/atlt_si_timestep_alg_mod.x90 +++ b/applications/adjoint_tests/source/algorithm/timestepping/atlt_si_timestep_alg_mod.x90 @@ -20,7 +20,6 @@ module atlt_si_timestep_alg_mod use reference_element_mod, only: T use formulation_config_mod, only: moisture_formulation, & moisture_formulation_dry - use io_config_mod, only: subroutine_timers use derived_config_mod, only: bundle_size use fs_continuity_mod, only: Wtheta, W2, W3 use moist_dyn_factors_alg_mod, only: moist_dyn_factors_alg @@ -30,7 +29,8 @@ module atlt_si_timestep_alg_mod use mr_indices_mod, only: nummr use moist_dyn_mod, only: num_moist_factors, gas_law use field_indices_mod, only: igh_u, igh_t, igh_d, igh_p - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF use tl_si_timestep_alg_mod, only: tl_semi_implicit_alg_init, & tl_semi_implicit_alg_step, & tl_semi_implicit_alg_final @@ -115,8 +115,9 @@ contains real(kind=r_def) :: machine_tol, machine_tol_r_solver real(kind=r_def) :: relative_diff, relative_diff_r_solver real(kind=r_def), parameter :: eps = 1e-30_r_def + integer(kind=tik) :: id - if (subroutine_timers) call timer('atlt_si_timestep_alg') + if ( LPROF ) call start_timing( id, 'atlt_si_timestep_alg' ) ! -------------------------------------------------------------------------- ! Setup @@ -370,7 +371,7 @@ contains call tl_semi_implicit_alg_final() call atl_si_timestep%finalise() - if (subroutine_timers) call timer('atlt_si_timestep_alg') + if ( LPROF ) call stop_timing( id, 'atlt_si_timestep_alg' ) end subroutine atlt_si_timestep_alg diff --git a/applications/gravity_wave/source/algorithm/gravity_wave_alg_mod.x90 b/applications/gravity_wave/source/algorithm/gravity_wave_alg_mod.x90 index f5a9bbd93..59b1a432d 100644 --- a/applications/gravity_wave/source/algorithm/gravity_wave_alg_mod.x90 +++ b/applications/gravity_wave/source/algorithm/gravity_wave_alg_mod.x90 @@ -66,7 +66,8 @@ module gravity_wave_alg_mod use field_indices_mod, only: igw_u, igw_p, igw_b use copy_field_alg_mod, only: copy_field - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF implicit none @@ -525,12 +526,12 @@ contains real(kind=r_second) :: dt real(kind=r_def) :: bvf_square integer(kind=i_def) :: b_space - logical(kind=l_def) :: subroutine_timers ! Auxiliary constants to group invokes real(kind=r_def) :: const1, const2 + integer(tik) :: id - if ( subroutine_timers ) call timer('gravity_wave_alg') + if ( LPROF ) call start_timing( id, 'gravity_wave_alg' ) ! Pointers to namelists timestepping_nml => modeldb%configuration%get_namelist('timestepping') @@ -540,7 +541,6 @@ contains ! Obtain namelist parameters call timestepping_nml%get_value( 'dt', dt ) call initial_temperature_nml%get_value( 'bvf_square', bvf_square ) - call io_nml%get_value( 'subroutine_timers', subroutine_timers ) !=== Do a single timestep ==============================================! mesh => wind%get_mesh() @@ -638,7 +638,7 @@ contains nullify( mesh ) - if ( subroutine_timers ) call timer('gravity_wave_alg') + if ( LPROF ) call stop_timing( id, 'gravity_wave_alg' ) end subroutine gravity_wave_alg_step diff --git a/applications/gravity_wave/source/algorithm/gw_mixed_diag_precon_alg_mod.x90 b/applications/gravity_wave/source/algorithm/gw_mixed_diag_precon_alg_mod.x90 index 228c8ff52..054ab7fec 100644 --- a/applications/gravity_wave/source/algorithm/gw_mixed_diag_precon_alg_mod.x90 +++ b/applications/gravity_wave/source/algorithm/gw_mixed_diag_precon_alg_mod.x90 @@ -16,7 +16,6 @@ module gw_mixed_diag_precon_alg_mod use constants_mod, only: i_def - use io_config_mod, only: subroutine_timers use log_mod, only: log_event, & LOG_LEVEL_ERROR, & LOG_LEVEL_INFO, & @@ -26,7 +25,8 @@ module gw_mixed_diag_precon_alg_mod use copy_field_alg_mod, only: copy_field use sci_preconditioner_mod, only: abstract_preconditioner_type use sci_r_solver_field_vector_mod, only: r_solver_field_vector_type - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF use vector_mod, only: abstract_vector_type implicit none @@ -174,8 +174,9 @@ contains y_vec_u => null(), & y_vec_p => null(), & y_vec_b => null() + integer(tik) :: id - if ( subroutine_timers ) call timer('gw_mixed_diag_precon_alg') + if ( LPROF ) call start_timing( id, 'gw_mixed_diag_precon_alg' ) select type(x) type is(r_solver_field_vector_type) @@ -212,7 +213,7 @@ contains nullify( x_vec_u, x_vec_p, x_vec_b, y_vec_u, y_vec_p, y_vec_b ) - if ( subroutine_timers ) call timer('gw_mixed_diag_precon_alg') + if ( LPROF ) call stop_timing( id, 'gw_mixed_diag_precon_alg' ) end subroutine apply_gw_mixed_diag_preconditioner diff --git a/applications/gravity_wave/source/algorithm/gw_mixed_schur_precon_alg_mod.x90 b/applications/gravity_wave/source/algorithm/gw_mixed_schur_precon_alg_mod.x90 index 79ff8630b..d109d6c6e 100644 --- a/applications/gravity_wave/source/algorithm/gw_mixed_schur_precon_alg_mod.x90 +++ b/applications/gravity_wave/source/algorithm/gw_mixed_schur_precon_alg_mod.x90 @@ -89,8 +89,8 @@ module gw_mixed_schur_precon_alg_mod use sci_preconditioner_mod, only: abstract_preconditioner_type use sci_r_solver_field_vector_mod, only: r_solver_field_vector_type use field_indices_mod, only: igw_u, igw_p, igw_b - use io_config_mod, only: subroutine_timers - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF use log_mod, only: log_event, & LOG_LEVEL_ERROR, & LOG_LEVEL_INFO, & @@ -350,9 +350,10 @@ contains type(r_solver_field_type), pointer :: y_vec_u => null(), & y_vec_p => null(), & y_vec_b => null() + integer(tik) :: id - if ( subroutine_timers ) call timer('gw_mixed_schur_precon_alg') + if ( LPROF ) call start_timing( id, 'gw_mixed_schur_precon_alg' ) select type(x) type is(r_solver_field_vector_type) @@ -399,7 +400,7 @@ contains nullify( y_vec_u, y_vec_p, y_vec_b ) - if ( subroutine_timers ) call timer('gw_mixed_schur_precon_alg') + if ( LPROF ) call stop_timing( id, 'gw_mixed_schur_precon_alg' ) end subroutine apply_gw_mixed_schur_preconditioner diff --git a/applications/gravity_wave/source/gravity_wave.f90 b/applications/gravity_wave/source/gravity_wave.f90 index e1a988dd0..e7eb7ffe6 100644 --- a/applications/gravity_wave/source/gravity_wave.f90 +++ b/applications/gravity_wave/source/gravity_wave.f90 @@ -18,19 +18,23 @@ program gravity_wave use driver_config_mod, only: init_config, final_config use driver_log_mod, only: init_logger, final_logger use driver_time_mod, only: init_time, final_time - use driver_timer_mod, only: init_timers, final_timers use gravity_wave_mod, only: gravity_wave_required_namelists use gravity_wave_driver_mod, only: initialise, step, finalise use lfric_mpi_mod, only: global_mpi use log_mod, only: log_event, & log_level_trace, & log_scratch_space + use namelist_mod, only: namelist_type + use timing_mod, only: init_timing, final_timing + use io_config_mod, only: timer_output_path implicit none - type(modeldb_type) :: modeldb - character(*), parameter :: program_name = "gravity_wave" - character(:), allocatable :: filename + type(modeldb_type) :: modeldb + character(*), parameter :: program_name = "gravity_wave" + character(:), allocatable :: filename + type(namelist_type), pointer :: io_nml + logical :: lsubroutine_timers call parse_command_line( filename ) @@ -43,8 +47,11 @@ program gravity_wave 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_timers( program_name ) call init_time( modeldb ) ! Create the depository field collection and place it in modeldb @@ -64,8 +71,8 @@ program gravity_wave call finalise( program_name, modeldb ) call final_time( modeldb ) - call final_timers( program_name ) call final_collections() + call final_timing( program_name ) call final_logger( program_name ) call final_config() call final_comm( modeldb ) diff --git a/applications/gungho_model/source/gungho_model.f90 b/applications/gungho_model/source/gungho_model.f90 index da2050f69..ee8699e43 100644 --- a/applications/gungho_model/source/gungho_model.f90 +++ b/applications/gungho_model/source/gungho_model.f90 @@ -23,7 +23,6 @@ program gungho_model use driver_counter_mod, only: init_counters, final_counters use driver_log_mod, only: init_logger, final_logger use driver_time_mod, only: init_time, final_time - use driver_timer_mod, only: init_timers, final_timers use gungho_mod, only: gungho_required_namelists use gungho_driver_mod, only: initialise, step, finalise use driver_modeldb_mod, only: modeldb_type @@ -32,14 +31,20 @@ program gungho_model log_level_info, & log_level_trace, & log_scratch_space + use namelist_mod, only: namelist_type + use timing_mod, only: init_timing, final_timing + use io_config_mod, only: timer_output_path + implicit none ! Model run working data set type(modeldb_type) :: modeldb - character(*), parameter :: application_name = "gungho_model" - character(:), allocatable :: filename + character(*), parameter :: application_name = "gungho_model" + character(:), allocatable :: filename + type(namelist_type), pointer :: io_nml + logical :: lsubroutine_timers call parse_command_line( filename ) @@ -72,7 +77,10 @@ program gungho_model call init_config( filename, gungho_required_namelists, & modeldb%configuration ) call init_logger( modeldb%mpi%get_comm(), application_name ) - call init_timers( application_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, application_name, timer_output_path ) + nullify( io_nml ) call init_collections() call init_time( modeldb ) call init_counters( application_name ) @@ -101,7 +109,7 @@ program gungho_model call final_counters( application_name ) call final_time( modeldb ) call final_collections() - call final_timers( application_name ) + call final_timing( application_name ) call final_logger( application_name ) call final_config() call final_comm( modeldb ) diff --git a/applications/jedi_lfric_tests/source/jedi-interface/jedi_run_mod.f90 b/applications/jedi_lfric_tests/source/jedi-interface/jedi_run_mod.f90 index 8e981a2e9..b1597fc4a 100644 --- a/applications/jedi_lfric_tests/source/jedi-interface/jedi_run_mod.f90 +++ b/applications/jedi_lfric_tests/source/jedi-interface/jedi_run_mod.f90 @@ -90,7 +90,9 @@ subroutine initialise_infrastructure( self, filename, model_communicator ) use driver_collections_mod, only: init_collections use driver_config_mod, only: init_config use driver_log_mod, only: init_logger - use driver_timer_mod, only: init_timers + use namelist_mod, only: namelist_type + use timing_mod, only: init_timing + use io_config_mod, only: timer_output_path use jedi_lfric_tests_mod, only: jedi_lfric_tests_required_namelists use lfric_mpi_mod, only: lfric_comm_type @@ -101,6 +103,9 @@ subroutine initialise_infrastructure( self, filename, model_communicator ) integer(i_def), intent(in) :: model_communicator type(lfric_comm_type) :: lfric_comm + type(namelist_type), pointer :: io_nml + logical :: lsubroutine_timers + ! Initialise the configuration call self%configuration%initialise( self%jedi_run_name, table_len=10 ) @@ -116,8 +121,10 @@ subroutine initialise_infrastructure( self, filename, model_communicator ) call lfric_comm%set_comm_mpi_val(model_communicator) call init_logger( lfric_comm, self%jedi_run_name ) - ! Initialise subroutine timers - call init_timers( self%jedi_run_name ) + ! Initialise timing wrapper + io_nml => self%configuration%get_namelist('io') + call io_nml%get_value('subroutine_timers', lsubroutine_timers) + call init_timing( lfric_comm, lsubroutine_timers, trim(self%jedi_run_name), timer_output_path ) self%timers_finalised = .false. ! Initialise collections @@ -141,13 +148,13 @@ end function get_configuration !> subroutine finalise_timers(self) - use driver_timer_mod, only: final_timers + use timing_mod, only: final_timing implicit none class(jedi_run_type), intent(inout) :: self - call final_timers( self%jedi_run_name ) + call final_timing( self%jedi_run_name ) self%timers_finalised = .true. end subroutine finalise_timers @@ -159,7 +166,7 @@ subroutine finalise(self) use driver_collections_mod, only: final_collections use driver_config_mod, only: final_config use driver_log_mod, only: final_logger - use driver_timer_mod, only: final_timers + use timing_mod, only: final_timing use jedi_lfric_comm_mod, only: final_external_comm, & final_internal_comm use lfric_mpi_mod, only: destroy_comm @@ -172,7 +179,7 @@ subroutine finalise(self) call final_collections() ! Finalise subroutine timers - if (.not. self%timers_finalised) call final_timers( self%jedi_run_name ) + if (.not. self%timers_finalised) call final_timing( self%jedi_run_name ) ! Finalise logger call final_logger(self%jedi_run_name) diff --git a/applications/jedi_lfric_tests/source/jedi_lfric_tests.f90 b/applications/jedi_lfric_tests/source/jedi_lfric_tests.f90 index 2937a18de..7bef53fbc 100644 --- a/applications/jedi_lfric_tests/source/jedi_lfric_tests.f90 +++ b/applications/jedi_lfric_tests/source/jedi_lfric_tests.f90 @@ -21,22 +21,26 @@ program jedi_lfric_tests use driver_config_mod, only : init_config, final_config use driver_log_mod, only : init_logger, final_logger use driver_time_mod, only : init_time, final_time - use driver_timer_mod, only : init_timers, final_timers use gungho_mod, only : gungho_required_namelists use driver_modeldb_mod, only : modeldb_type use lfric_mpi_mod, only : global_mpi use linear_driver_mod, only : initialise, step, finalise use log_mod, only : log_event, & log_level_trace, & - log_scratch_space + log_scratch_space, LOG_LEVEL_WARNING + use namelist_mod, only: namelist_type + use timing_mod, only: init_timing, final_timing + use io_config_mod, only: timer_output_path implicit none ! Model run working data set type (modeldb_type) :: modeldb - character(*), parameter :: application_name = "jedi_lfric_tests" - character(:), allocatable :: filename + character(*), parameter :: application_name = "jedi_lfric_tests" + character(:), allocatable :: filename + type(namelist_type), pointer :: io_nml + logical :: lsubroutine_timers call parse_command_line( filename ) @@ -66,7 +70,10 @@ program jedi_lfric_tests call init_config( filename, gungho_required_namelists, & modeldb%configuration ) call init_logger( modeldb%mpi%get_comm(), application_name ) - call init_timers( application_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, application_name, timer_output_path ) + nullify( io_nml ) call init_collections() call init_time( modeldb ) deallocate( filename ) @@ -84,7 +91,7 @@ program jedi_lfric_tests call final_time( modeldb ) call final_collections() - call final_timers( application_name ) + call final_timing( application_name ) call final_logger( application_name ) call final_config() call final_comm( modeldb ) diff --git a/applications/jules/source/jules.f90 b/applications/jules/source/jules.f90 index 5b2ca853a..457e85cc3 100644 --- a/applications/jules/source/jules.f90 +++ b/applications/jules/source/jules.f90 @@ -23,20 +23,23 @@ program jules use driver_counter_mod, only: init_counters, final_counters use driver_log_mod, only: init_logger, final_logger use driver_time_mod, only: init_time, final_time - use driver_timer_mod, only: init_timers, final_timers use gungho_mod, only: gungho_required_namelists use driver_modeldb_mod, only: modeldb_type use gungho_driver_mod, only: initialise, step, finalise use lfric_mpi_mod, only: global_mpi + use namelist_mod, only: namelist_type + use timing_mod, only: init_timing, final_timing + use io_config_mod, only: timer_output_path implicit none ! Model run working data set type(modeldb_type) :: modeldb - character(*), parameter :: application_name = "jules" - - character(:), allocatable :: filename + character(*), parameter :: application_name = "jules" + character(:), allocatable :: filename + type(namelist_type), pointer :: io_nml + logical :: lsubroutine_timers call parse_command_line( filename ) @@ -68,7 +71,10 @@ program jules call init_config( filename, gungho_required_namelists, & modeldb%configuration ) call init_logger( modeldb%mpi%get_comm(), application_name ) - call init_timers( application_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, application_name, timer_output_path ) + nullify( io_nml ) call init_collections() call init_time( modeldb ) call init_counters( application_name ) @@ -85,7 +91,7 @@ program jules call final_counters( application_name ) call final_time( modeldb ) call final_collections() - call final_timers( application_name ) + call final_timing( application_name ) call final_logger( application_name ) call final_config() call final_comm( modeldb ) diff --git a/applications/lfric_atm/source/lfric_atm.f90 b/applications/lfric_atm/source/lfric_atm.f90 index 8f314f64d..e77c16ddb 100644 --- a/applications/lfric_atm/source/lfric_atm.f90 +++ b/applications/lfric_atm/source/lfric_atm.f90 @@ -23,24 +23,26 @@ program lfric_atm use driver_counter_mod, only: init_counters, final_counters use driver_log_mod, only: init_logger, final_logger use driver_time_mod, only: init_time, final_time - use driver_timer_mod, only: init_timers, final_timers use gungho_mod, only: gungho_required_namelists use driver_modeldb_mod, only: modeldb_type use gungho_driver_mod, only: initialise, step, finalise use lfric_mpi_mod, only: global_mpi use namelist_mod, only: namelist_type - - use timing_mod, only: init_timing, start_timing, stop_timing, final_timing, tik, LPROF + use timing_mod, only: init_timing, final_timing, & + start_timing, stop_timing, & + tik, LPROF + use io_config_mod, only: timer_output_path implicit none ! Model run working data set type(modeldb_type) :: modeldb - character(*), parameter :: application_name = "lfric_atm" - character(:), allocatable :: filename - integer(tik) :: timing_handle_global + character(*), parameter :: application_name = "lfric_atm" + character(:), allocatable :: filename + integer(tik) :: id_setup type(namelist_type), pointer :: io_nml + logical :: lsubroutine_timers call parse_command_line( filename ) @@ -74,13 +76,13 @@ program lfric_atm call init_config( filename, gungho_required_namelists, & modeldb%configuration ) call init_logger( modeldb%mpi%get_comm(), application_name ) - call init_timers( application_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 ) + call init_timing( modeldb%mpi%get_comm(), lsubroutine_timers, application_name, timer_output_path ) nullify( io_nml ) - if ( LPROF ) call start_timing( timing_handle_global, '__lfric_atm__ ') + if ( LPROF ) call start_timing( id_setup, '__setup__' ) + call init_collections() call init_time( modeldb ) @@ -88,6 +90,7 @@ program lfric_atm deallocate( filename ) call initialise( application_name, modeldb ) + if ( LPROF ) call stop_timing( id_setup, '__setup__' ) do while (modeldb%clock%tick()) call step( modeldb ) end do @@ -96,11 +99,7 @@ program lfric_atm call final_counters( application_name ) call final_time( modeldb ) call final_collections() - - if ( LPROF ) call stop_timing( timing_handle_global ) - call final_timing() - - call final_timers( application_name ) + call final_timing( application_name ) call final_logger( application_name ) call final_config() call final_comm( modeldb ) diff --git a/applications/lfric_coupled/build/fortran/crayftn.mk b/applications/lfric_coupled/build/fortran/crayftn.mk index 3f3205685..794ea2c32 100644 --- a/applications/lfric_coupled/build/fortran/crayftn.mk +++ b/applications/lfric_coupled/build/fortran/crayftn.mk @@ -54,8 +54,6 @@ ifeq ($(shell expr ${CRAYFTN_VERSION} \>= 015000000), 1) %driver_modeldb_mod.o %driver_modeldb_mod.mod: private FFLAGS_DEBUG = -G0 %driver_time_mod.o %driver_time_mod.mod: private FFLAGS_SAFE_OPTIMISATION = -O0 %driver_time_mod.o %driver_time_mod.mod: private FFLAGS_DEBUG = -G0 - %driver_timer_mod.o %driver_timer_mod.mod: private FFLAGS_SAFE_OPTIMISATION = -O0 - %driver_timer_mod.o %driver_timer_mod.mod: private FFLAGS_DEBUG = -G0 %io_context_collection_mod.o %io_context_collection_mod.mod: private FFLAGS_SAFE_OPTIMISATION = -O0 %io_context_collection_mod.o %io_context_collection_mod.mod: private FFLAGS_DEBUG = -G0 %variable_fields_mod.o %variable_fields_mod.mod: private FFLAGS_SAFE_OPTIMISATION = -O0 diff --git a/applications/lfric_coupled/source/lfric_coupled.f90 b/applications/lfric_coupled/source/lfric_coupled.f90 index 16b5d7375..2f22b8bc0 100644 --- a/applications/lfric_coupled/source/lfric_coupled.f90 +++ b/applications/lfric_coupled/source/lfric_coupled.f90 @@ -27,16 +27,20 @@ program lfric_coupled use gungho_driver_mod, only : initialise, step, finalise use driver_modeldb_mod, only : modeldb_type use lfric_mpi_mod, only : global_mpi + use namelist_mod, only: namelist_type + use timing_mod, only: init_timing, final_timing + use io_config_mod, only: timer_output_path implicit none ! Model run working data set type(modeldb_type) :: modeldb - character(*), parameter :: application_name = "lfric_coupled" - character(*), parameter :: cpl_component_name = "lfric" - - character(:), allocatable :: filename + character(*), parameter :: application_name = "lfric_coupled" + character(*), parameter :: cpl_component_name = "lfric" + character(:), allocatable :: filename + type(namelist_type), pointer :: io_nml + logical :: lsubroutine_timers call parse_command_line( filename ) @@ -69,6 +73,10 @@ program lfric_coupled call init_config( filename, gungho_required_namelists, & modeldb%configuration ) call init_logger( modeldb%mpi%get_comm(), application_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, application_name, timer_output_path ) + nullify( io_nml ) call init_collections() call init_time( modeldb ) deallocate(filename) @@ -81,6 +89,7 @@ program lfric_coupled call final_time( modeldb ) call final_collections() + call final_timing( application_name ) call final_logger( application_name ) call final_config() call final_comm( modeldb ) diff --git a/applications/linear_model/source/linear_model.f90 b/applications/linear_model/source/linear_model.f90 index e58099d46..8ba21132b 100644 --- a/applications/linear_model/source/linear_model.f90 +++ b/applications/linear_model/source/linear_model.f90 @@ -20,7 +20,6 @@ program linear_model use driver_config_mod, only : init_config, final_config use driver_log_mod, only : init_logger, final_logger use driver_time_mod, only : init_time, final_time - use driver_timer_mod, only : init_timers, final_timers use gungho_mod, only : gungho_required_namelists use driver_modeldb_mod, only : modeldb_type use lfric_mpi_mod, only : global_mpi @@ -28,14 +27,19 @@ program linear_model use log_mod, only : log_event, & log_level_trace, & log_scratch_space + use namelist_mod, only: namelist_type + use timing_mod, only: init_timing, final_timing + use io_config_mod, only: timer_output_path implicit none ! Model run working data set type (modeldb_type) :: modeldb - character(*), parameter :: application_name = "linear_model" - character(:), allocatable :: filename + character(*), parameter :: application_name = "linear_model" + character(:), allocatable :: filename + type(namelist_type), pointer :: io_nml + logical :: lsubroutine_timers call parse_command_line( filename ) @@ -65,7 +69,10 @@ program linear_model call init_config( filename, gungho_required_namelists, & modeldb%configuration ) call init_logger( modeldb%mpi%get_comm(), application_name ) - call init_timers( application_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, application_name, timer_output_path ) + nullify( io_nml ) call init_collections() call init_time( modeldb ) deallocate( filename ) @@ -83,7 +90,7 @@ program linear_model call final_time( modeldb ) call final_collections() - call final_timers( application_name ) + call final_timing( application_name ) call final_logger( application_name ) call final_config() call final_comm( modeldb ) diff --git a/applications/name_transport/source/driver/name_transport_driver_mod.f90 b/applications/name_transport/source/driver/name_transport_driver_mod.f90 index 94e8365c0..60d5ae6ce 100644 --- a/applications/name_transport/source/driver/name_transport_driver_mod.f90 +++ b/applications/name_transport/source/driver/name_transport_driver_mod.f90 @@ -45,7 +45,8 @@ module name_transport_driver_mod use sci_geometric_constants_mod, only: get_chi_inventory, & get_panel_id_inventory, & get_height_fe - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF ! Transport algorithms use name_transport_init_fields_alg_mod, only: name_transport_init_fields_alg @@ -367,7 +368,6 @@ subroutine step_name_transport( model_clock ) use base_mesh_config_mod, only: prime_mesh_name use io_config_mod, only: diagnostic_frequency, & nodal_output_on_w3, & - subroutine_timers, & write_diag use sci_field_minmax_alg_mod, only: log_field_minmax @@ -376,6 +376,7 @@ subroutine step_name_transport( model_clock ) class(model_clock_type), intent(in) :: model_clock type(mesh_type), pointer :: mesh + integer(tik) :: id ! Get mesh mesh => mesh_collection%get_mesh(prime_mesh_name) @@ -392,13 +393,13 @@ subroutine step_name_transport( model_clock ) 'Start of timestep ', model_clock%get_step() call log_event( log_scratch_space, LOG_LEVEL_INFO ) - if ( subroutine_timers ) call timer( 'name transport step' ) + if ( LPROF ) call start_timing( id, 'name_transport_step' ) ! Transport field call name_transport_step( model_clock, wind, tracer_con, & density, transport_density ) - if ( subroutine_timers ) call timer( 'name transport step' ) + if ( LPROF ) call stop_timing( id, 'name_transport_step' ) ! Print min/max of fields after transport step if (transport_density) then diff --git a/applications/name_transport/source/name_transport.f90 b/applications/name_transport/source/name_transport.f90 index 7f8faab1d..c7e5343e4 100644 --- a/applications/name_transport/source/name_transport.f90 +++ b/applications/name_transport/source/name_transport.f90 @@ -17,7 +17,6 @@ program name_transport use driver_log_mod, only: init_logger, final_logger use driver_modeldb_mod, only: modeldb_type use driver_time_mod, only: init_time, final_time - use driver_timer_mod, only: init_timers, final_timers use lfric_mpi_mod, only: global_mpi use log_mod, only: log_event, & log_level_debug, & @@ -30,12 +29,16 @@ program name_transport use name_transport_driver_mod, only: initialise_name_transport, & step_name_transport, & finalise_name_transport - + use namelist_mod, only: namelist_type + use timing_mod, only: init_timing, final_timing + use io_config_mod, only: timer_output_path implicit none type(modeldb_type) :: modeldb character(*), parameter :: program_name = "name_transport" character(:), allocatable :: filename + type(namelist_type), pointer :: io_nml + logical :: lsubroutine_timers call parse_command_line( filename ) @@ -53,7 +56,10 @@ program name_transport write(log_scratch_space, '(" i_def kind = ", I0)') kind(1_i_def) call log_event( log_scratch_space , log_level_info ) - call init_timers( 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 ) deallocate( filename ) @@ -75,7 +81,7 @@ program name_transport call final_time( modeldb ) call final_collections() - call final_timers( program_name ) + call final_timing( program_name ) call final_logger( program_name ) call final_config() call final_comm( modeldb ) diff --git a/applications/ngarch/source/ngarch.f90 b/applications/ngarch/source/ngarch.f90 index 919eec564..29a1c7614 100644 --- a/applications/ngarch/source/ngarch.f90 +++ b/applications/ngarch/source/ngarch.f90 @@ -20,6 +20,9 @@ program ngarch use log_mod, only : log_event, & log_level_trace, & log_scratch_space + use namelist_mod, only : namelist_type + use timing_mod, only : init_timing, final_timing + use io_config_mod, only : timer_output_path use ngarch_mod, only : ngarch_required_namelists use gungho_driver_mod, only : initialise, finalise, step @@ -28,9 +31,11 @@ program ngarch implicit none ! The technical and scientific state - type( modeldb_type ) :: modeldb - character(*), parameter :: application_name = "ngarch" - character(:), allocatable :: filename + type( modeldb_type ) :: modeldb + character(*), parameter :: application_name = "ngarch" + character(:), allocatable :: filename + type(namelist_type), pointer :: io_nml + logical :: lsubroutine_timers call parse_command_line( filename ) @@ -64,6 +69,10 @@ program ngarch deallocate( filename ) call init_logger( modeldb%mpi%get_comm(), application_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, application_name, timer_output_path ) + nullify( io_nml ) call init_collections() call init_time( modeldb ) @@ -80,6 +89,7 @@ program ngarch call finalise( application_name, modeldb ) call final_time( modeldb ) call final_collections() + call final_timing( application_name ) call final_logger( application_name ) call final_config() call final_comm( modeldb ) diff --git a/applications/shallow_water/source/algorithm/swe_mixed_diag_precon_alg_mod.x90 b/applications/shallow_water/source/algorithm/swe_mixed_diag_precon_alg_mod.x90 index d59789449..d511cbfb4 100644 --- a/applications/shallow_water/source/algorithm/swe_mixed_diag_precon_alg_mod.x90 +++ b/applications/shallow_water/source/algorithm/swe_mixed_diag_precon_alg_mod.x90 @@ -18,7 +18,6 @@ module swe_mixed_diag_precon_alg_mod use field_mod, only: field_type use field_indices_mod, only: isw_u, isw_g, isw_b use fs_continuity_mod, only: W1, W2, W3 - use io_config_mod, only: subroutine_timers use log_mod, only: log_event, & LOG_LEVEL_ERROR, & LOG_LEVEL_INFO, & @@ -28,7 +27,8 @@ module swe_mixed_diag_precon_alg_mod use sci_field_vector_mod, only: field_vector_type use sci_preconditioner_mod, only: abstract_preconditioner_type use shallow_water_settings_config_mod, only: thermal_swe - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF use vector_mod, only: abstract_vector_type implicit none @@ -119,8 +119,9 @@ contains y_vec_u => null(), & y_vec_g => null(), & y_vec_b => null() + integer(tik) :: id - if ( subroutine_timers ) call timer('swe_mixed_diag_preconditioner_alg') + if ( LPROF ) call start_timing( id, 'swe_mixed_diag_preconditioner_alg' ) select type(x) type is(field_vector_type) @@ -161,7 +162,7 @@ contains nullify( x_vec_u, x_vec_g, x_vec_b ) nullify( y_vec_u, y_vec_g, y_vec_b ) - if ( subroutine_timers ) call timer('swe_mixed_diag_preconditioner_alg') + if ( LPROF ) call stop_timing( id, 'swe_mixed_diag_preconditioner_alg' ) end subroutine apply_swe_mixed_diag_preconditioner diff --git a/applications/shallow_water/source/algorithm/swe_mixed_schur_precon_alg_mod.x90 b/applications/shallow_water/source/algorithm/swe_mixed_schur_precon_alg_mod.x90 index e426f6275..7b497585e 100644 --- a/applications/shallow_water/source/algorithm/swe_mixed_schur_precon_alg_mod.x90 +++ b/applications/shallow_water/source/algorithm/swe_mixed_schur_precon_alg_mod.x90 @@ -76,7 +76,6 @@ module swe_mixed_schur_precon_alg_mod use field_mod, only: field_type use field_indices_mod, only: isw_u, isw_g, isw_b use fs_continuity_mod, only: W1, W2, W3 - use io_config_mod, only: subroutine_timers use log_mod, only: log_event, & LOG_LEVEL_ERROR, & LOG_LEVEL_INFO, & @@ -89,7 +88,8 @@ module swe_mixed_schur_precon_alg_mod use shallow_water_settings_config_mod, only: ref_gp, & thermal_swe use timestepping_config_mod, only: dt - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF use vector_mod, only: abstract_vector_type use sci_field_minmax_alg_mod, only: log_field_minmax @@ -268,8 +268,9 @@ contains type(field_type), pointer :: y_vec_u => null(), & y_vec_g => null(), & y_vec_b => null() + integer(tik) :: id - if ( subroutine_timers ) call timer('swe_mixed_schur_preconditioner_alg') + if ( LPROF ) call start_timing( id, 'swe_mixed_schur_preconditioner_alg' ) select type(x) type is(field_vector_type) @@ -316,7 +317,7 @@ contains nullify( y_vec_u, y_vec_g, y_vec_b ) - if ( subroutine_timers ) call timer('swe_mixed_schur_preconditioner_alg') + if ( LPROF ) call stop_timing( id, 'swe_mixed_schur_preconditioner_alg' ) end subroutine apply_swe_mixed_schur_preconditioner diff --git a/applications/shallow_water/source/algorithm/swe_timestep_alg_mod.x90 b/applications/shallow_water/source/algorithm/swe_timestep_alg_mod.x90 index c66673e57..d509b19b4 100644 --- a/applications/shallow_water/source/algorithm/swe_timestep_alg_mod.x90 +++ b/applications/shallow_water/source/algorithm/swe_timestep_alg_mod.x90 @@ -27,13 +27,13 @@ module swe_timestep_alg_mod use model_clock_mod, only: model_clock_type ! Configuration options - use io_config_mod, only: subroutine_timers use shallow_water_settings_config_mod, & only: ref_gp, & thermal_swe, & time_scheme, & time_scheme_semi_implicit - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF use timestepping_config_mod, only: alpha, & outer_iterations, & inner_iterations @@ -433,8 +433,9 @@ contains real(kind=r_def) :: alpha_dt real(kind=r_def) :: beta_dt type(field_type) :: wind_prev + integer(tik) :: id_sw_alg - if ( subroutine_timers ) call timer('shallow_water_alg_si') + if ( LPROF ) call start_timing( id_sw_alg, 'shallow_water_alg_si' ) !--- Do a single timestep -------------------------------------------------- ! set up state variable @@ -584,7 +585,7 @@ contains end if call state%export_field(q, isw_q) - if ( subroutine_timers ) call timer('shallow_water_alg_si') + if ( LPROF ) call stop_timing( id_sw_alg, 'shallow_water_alg_si' ) end subroutine swe_timestep_alg_si @@ -742,8 +743,9 @@ contains ! Variables after forward Euler step type( field_type ) :: wind_fe1, geopot_fe1, buoyancy_fe1, q_fe1 type( field_type ) :: wind_fe2, geopot_fe2, buoyancy_fe2, q_fe2 + integer(tik) :: id_swe_ssprk3 - if ( subroutine_timers ) call timer('swe_timestep_alg_ssprk3') + if ( LPROF ) call start_timing( id_swe_ssprk3, 'swe_timestep_alg_ssprk3' ) !--- Do a single timestep -------------------------------------------------- ! Initialise variables @@ -830,7 +832,7 @@ contains aX_plus_bY( buoyancy, onethird, buoyancy_n, twothird, buoyancy_fe2 ) ) call swe_init_vorticity_alg(wind, geopot, q) - if ( subroutine_timers ) call timer('swe_timestep_alg_ssprk3') + if ( LPROF ) call stop_timing( id_swe_ssprk3, 'swe_timestep_alg_ssprk3' ) end subroutine swe_timestep_alg_ssprk3 @@ -892,8 +894,9 @@ contains real(kind=r_def), parameter :: one_sixth = 1.0_r_def/6.0_r_def real(kind=r_def), parameter :: one_twenty_fourth = 1.0_r_def/24.0_r_def real(kind=r_def), parameter :: three_eighths = 3.0_r_def/8.0_r_def + integer(kind=tik) :: id_swe_rk4 - if ( subroutine_timers ) call timer('swe_timestep_alg_rk4') + if ( LPROF ) call start_timing( id_swe_rk4, 'swe_timestep_alg_rk4' ) !--- Do a single timestep -------------------------------------------------- ! Initialise all the variables @@ -1036,7 +1039,7 @@ contains inc_X_plus_bY( buoyancy, one_sixth, buoyancy_fe3 ) ) call swe_init_vorticity_alg(wind, geopot, q) - if ( subroutine_timers ) call timer('swe_timestep_alg_rk4') + if ( LPROF ) call stop_timing( id_swe_rk4, 'swe_timestep_alg_rk4' ) end subroutine swe_timestep_alg_rk4 diff --git a/applications/shallow_water/source/algorithm/swe_transport_control_alg_mod.x90 b/applications/shallow_water/source/algorithm/swe_transport_control_alg_mod.x90 index 996729ec7..ce4364156 100644 --- a/applications/shallow_water/source/algorithm/swe_transport_control_alg_mod.x90 +++ b/applications/shallow_water/source/algorithm/swe_transport_control_alg_mod.x90 @@ -40,6 +40,8 @@ module swe_transport_control_alg_mod momentum_form, & momentum_form_momentum, & momentum_form_vector_invariant + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF use transport_config_mod, only: cheap_update use transport_controller_mod, only: transport_controller_type use transport_metadata_mod, only: transport_metadata_type @@ -147,8 +149,6 @@ contains use operator_mod, only: operator_type use transport_field_mod, only: transport_field use wind_transport_alg_mod, only: wind_transport_alg - use io_config_mod, only: subroutine_timers - use timer_mod, only: timer implicit none @@ -200,8 +200,9 @@ contains ! Quadrature type(quadrature_xyoz_type) :: qr type(quadrature_rule_gaussian_type) :: quadrature_rule + integer(tik) :: id_cont - if ( subroutine_timers ) call timer('swe_transport_control_alg_step') + if ( LPROF ) call start_timing( id_cont, 'swe_transport_control_alg_step' ) ! ------------------------------------------------------------------------ ! ! Pre-transport initialisation tasks @@ -365,7 +366,7 @@ contains call transport_controller%finalise() - if ( subroutine_timers ) call timer('swe_transport_control_alg_step') + if ( LPROF ) call stop_timing( id_cont, 'swe_transport_control_alg_step' ) end subroutine swe_transport_control_alg_step @@ -391,8 +392,6 @@ contains model_clock ) use transport_field_mod, only: transport_field - use io_config_mod, only: subroutine_timers - use timer_mod, only: timer use transport_enumerated_types_mod, only: equation_form_conservative, & equation_form_advective, & equation_form_consistent @@ -420,8 +419,9 @@ contains ! Parameters for transport runtime integer(i_def), parameter :: outer = 1 logical(l_def), parameter :: cheap_update_flag = .false. + integer(tik) :: id_swe_tracer - if ( subroutine_timers ) call timer('swe_transport_control_alg_step') + if ( LPROF ) call start_timing( id_swe_tracer, 'swe_tracer_transport_alg' ) ! Initialise the main transport controller --------------------------------- call transport_controller%initialise(model_clock, mass_n, wind_n, wind_np1) @@ -513,7 +513,7 @@ contains call transport_controller%finalise() - if ( subroutine_timers ) call timer('swe_tracer_transport_alg') + if ( LPROF ) call stop_timing( id_swe_tracer, 'swe_tracer_transport_alg' ) end subroutine swe_tracer_transport_alg diff --git a/applications/shallow_water/source/shallow_water.f90 b/applications/shallow_water/source/shallow_water.f90 index c74a664b5..05f686f7a 100644 --- a/applications/shallow_water/source/shallow_water.f90 +++ b/applications/shallow_water/source/shallow_water.f90 @@ -22,7 +22,6 @@ program shallow_water use driver_log_mod, only: init_logger, final_logger use driver_modeldb_mod, only: modeldb_type use driver_time_mod, only: init_time, final_time - use driver_timer_mod, only: init_timers, final_timers use lfric_mpi_mod, only: global_mpi use log_mod, only: log_event, & log_level_trace, & @@ -31,6 +30,9 @@ program shallow_water use shallow_water_driver_mod, only: initialise, & step, & finalise + use namelist_mod, only: namelist_type + use timing_mod, only: init_timing, final_timing + use io_config_mod, only: timer_output_path implicit none @@ -40,6 +42,9 @@ program shallow_water type(modeldb_type) :: modeldb character(:), allocatable :: filename + type(namelist_type), pointer :: io_nml + logical :: lsubroutine_timers + call parse_command_line( filename ) modeldb%mpi => global_mpi @@ -61,7 +66,10 @@ program shallow_water call init_config( filename, shallow_water_required_namelists, & modeldb%configuration ) call init_logger( global_mpi%get_comm(), program_name ) - call init_timers( 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_counters( program_name ) call init_collections() call init_time( modeldb ) @@ -81,7 +89,7 @@ program shallow_water call final_time( modeldb ) call final_collections() call final_counters( program_name ) - call final_timers( program_name ) + call final_timing( program_name ) call final_logger( program_name ) call final_config() call final_comm( modeldb ) diff --git a/applications/transport/source/algorithm/mass_conservation_alg_mod.x90 b/applications/transport/source/algorithm/mass_conservation_alg_mod.x90 index 9a023bc3a..288ab8f05 100644 --- a/applications/transport/source/algorithm/mass_conservation_alg_mod.x90 +++ b/applications/transport/source/algorithm/mass_conservation_alg_mod.x90 @@ -26,8 +26,8 @@ module mass_conservation_alg_mod use mesh_collection_mod, only: mesh_collection use mesh_mod, only: mesh_type use mr_indices_mod, only: nummr - use io_config_mod, only: subroutine_timers - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF implicit none @@ -62,9 +62,10 @@ contains type(field_type) :: coarse_rho_d, rho_X, aerosol_shifted real(kind=r_def) :: total_dry_mass, total_water_mass real(kind=r_def) :: total_w3_aerosol_mass, total_wt_aerosol_mass + integer(tik) :: id - if ( subroutine_timers ) call timer( 'mass_conservation' ) + if ( LPROF ) call start_timing( id, 'mass_conservation' ) mesh => rho_d%get_mesh() @@ -126,7 +127,7 @@ contains nullify( coarse_mesh, w3_sh_fs, shifted_mesh ) end if - if ( subroutine_timers ) call timer( 'mass_conservation' ) + if ( LPROF ) call stop_timing( id, 'mass_conservation' ) end subroutine mass_conservation diff --git a/applications/transport/source/driver/transport_driver_mod.f90 b/applications/transport/source/driver/transport_driver_mod.f90 index 2f9d4361d..c21bb94bd 100644 --- a/applications/transport/source/driver/transport_driver_mod.f90 +++ b/applications/transport/source/driver/transport_driver_mod.f90 @@ -51,7 +51,8 @@ module transport_driver_mod use mr_indices_mod, only: nummr use namelist_mod, only: namelist_type use runtime_constants_mod, only: create_runtime_constants - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF use transport_init_fields_alg_mod, only: transport_init_fields_alg use transport_control_alg_mod, only: transport_prerun_setup, & transport_init, transport_step, & @@ -464,7 +465,6 @@ subroutine step_transport( model_clock ) use formulation_config_mod, only: use_multires_coupling use io_config_mod, only: diagnostic_frequency, & nodal_output_on_w3, & - subroutine_timers, & write_diag use multires_coupling_config_mod, only: aerosol_mesh_name use sci_field_minmax_alg_mod, only: log_field_minmax @@ -475,6 +475,7 @@ subroutine step_transport( model_clock ) type(mesh_type), pointer :: mesh type(mesh_type), pointer :: aerosol_mesh + integer(tik) :: id call log_event( 'Miniapp will run with default precision set as:', LOG_LEVEL_INFO ) write(log_scratch_space, '(I1)') kind(1.0_r_def) @@ -504,7 +505,7 @@ subroutine step_transport( model_clock ) 'Start of timestep ', model_clock%get_step() call log_event( log_scratch_space, LOG_LEVEL_INFO ) - if ( subroutine_timers ) call timer( 'transport step' ) + if ( LPROF ) call start_timing( id, 'transport_step' ) call transport_step( model_clock, & wind, density, theta, tracer_con, & @@ -512,7 +513,7 @@ subroutine step_transport( model_clock ) w3_aerosol, wt_aerosol, aerosol_wind, & nummr_to_transport ) - if ( subroutine_timers ) call timer( 'transport step' ) + if ( LPROF ) call stop_timing( id, 'transport_step' ) ! Write out conservation diagnostics call mass_conservation( model_clock%get_step(), density, mr, & diff --git a/applications/transport/source/transport.f90 b/applications/transport/source/transport.f90 index a4ea8347a..54369eee1 100644 --- a/applications/transport/source/transport.f90 +++ b/applications/transport/source/transport.f90 @@ -16,13 +16,14 @@ program transport use driver_log_mod, only: init_logger, final_logger use driver_modeldb_mod, only: modeldb_type use driver_time_mod, only: init_time, final_time - use driver_timer_mod, only: init_timers, final_timers use lfric_mpi_mod, only: global_mpi use log_mod, only: log_event, & log_level_trace, & log_scratch_space use namelist_collection_mod, only: namelist_collection_type - + use namelist_mod, only: namelist_type + use timing_mod, only: init_timing, final_timing + use io_config_mod, only: timer_output_path use transport_mod, only: transport_required_namelists use transport_driver_mod, only: initialise_transport, & step_transport, & @@ -33,6 +34,8 @@ program transport type(modeldb_type) :: modeldb character(*), parameter :: program_name = "transport" character(:), allocatable :: filename + type(namelist_type), pointer :: io_nml + logical :: lsubroutine_timers call parse_command_line( filename ) @@ -50,7 +53,10 @@ program transport write(log_scratch_space, '(" i_def kind = ", I0)') kind(1_i_def) call log_event( log_scratch_space , log_level_trace ) - call init_timers( 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 ) deallocate( filename ) @@ -68,7 +74,7 @@ program transport call final_time( modeldb ) call final_collections() - call final_timers( program_name ) + call final_timing( program_name ) call final_logger( program_name ) call final_config() call final_comm( modeldb ) diff --git a/dependencies.yaml b/dependencies.yaml index 473a2c6ee..6bf41fd78 100644 --- a/dependencies.yaml +++ b/dependencies.yaml @@ -31,7 +31,7 @@ lfric_apps: lfric_core: source: git@github.com:MetOffice/lfric_core.git - ref: 5d4d72f0e35f00e71b1757df6beadec21ece97f0 + ref: aa328242675491338ddb888d4d747b5e02d3754c moci: source: git@github.com:MetOffice/moci.git diff --git a/interfaces/jules_interface/source/algorithm/jules_exp_alg_mod.x90 b/interfaces/jules_interface/source/algorithm/jules_exp_alg_mod.x90 index 18e785d09..db9c66665 100644 --- a/interfaces/jules_interface/source/algorithm/jules_exp_alg_mod.x90 +++ b/interfaces/jules_interface/source/algorithm/jules_exp_alg_mod.x90 @@ -22,8 +22,8 @@ module jules_exp_alg_mod use microphysics_config_mod, only: microphysics_casim use um_sizes_init_mod, only: um_sizes_init - use io_config_mod, only: subroutine_timers - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF use log_mod, only: log_event, LOG_LEVEL_DEBUG use mesh_mod, only: mesh_type @@ -228,9 +228,10 @@ contains type(xios_date) :: datetime integer(i_def), save :: day_of_year, second_of_day + integer(tik) :: id - if ( subroutine_timers ) call timer('jules_exp_alg') - + if ( LPROF ) call start_timing( id, 'jules_exp_alg' ) + call log_event( 'slow_physics: Running explicit JULES layer', LOG_LEVEL_DEBUG ) ! Cannot pass null pointers to invoke calls. Therefore non-pointer variables @@ -455,7 +456,7 @@ contains ! Switch UM back to columns call um_sizes_init(1_i_def) - if ( subroutine_timers ) call timer('jules_exp_alg') + if ( LPROF ) call stop_timing( id, 'jules_exp_alg' ) ! output JULES diagnostics if (write_diag .and. use_xios_io) then diff --git a/interfaces/jules_interface/source/algorithm/jules_extra_alg_mod.x90 b/interfaces/jules_interface/source/algorithm/jules_extra_alg_mod.x90 index 3ee3d7829..157a4a577 100644 --- a/interfaces/jules_interface/source/algorithm/jules_extra_alg_mod.x90 +++ b/interfaces/jules_interface/source/algorithm/jules_extra_alg_mod.x90 @@ -13,9 +13,9 @@ module jules_extra_alg_mod use field_collection_mod, only: field_collection_type use mesh_mod, only: mesh_type - use io_config_mod, only: subroutine_timers - use timer_mod, only: timer - use surface_config_mod, only: lake_water_conservation + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF + use surface_config_mod, only: lake_water_conservation ! xios output use io_config_mod, only: write_diag, use_xios_io @@ -148,8 +148,9 @@ contains type(mesh_type), pointer :: mesh => null() integer( kind=i_def ) :: ncells + integer( tik ) :: id - if ( subroutine_timers ) call timer('jules_extra_alg') + if ( LPROF ) call start_timing( id, 'jules_extra_alg' ) ! Unpack precipitation fields call microphysics_fields%get_field('ls_rain', ls_rain) @@ -268,7 +269,7 @@ contains call um_sizes_init(1_i_def) - if ( subroutine_timers ) call timer('jules_extra_alg') + if ( LPROF ) call stop_timing( id, 'jules_extra_alg' ) if (use_xios_io .and. write_diag) then diff --git a/interfaces/jules_interface/source/algorithm/jules_imp_alg_mod.x90 b/interfaces/jules_interface/source/algorithm/jules_imp_alg_mod.x90 index c3cbb3ca4..0c12170a0 100644 --- a/interfaces/jules_interface/source/algorithm/jules_imp_alg_mod.x90 +++ b/interfaces/jules_interface/source/algorithm/jules_imp_alg_mod.x90 @@ -18,8 +18,8 @@ module jules_imp_alg_mod use mr_indices_mod, only: imr_ci, nummr use timestepping_config_mod, only: outer_iterations - use io_config_mod, only: subroutine_timers - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF ! xios output use io_config_mod, only: write_diag, use_xios_io, diagnostic_frequency use jules_imp_diags_mod, only: initialise_diags_for_jules_imp, & @@ -166,8 +166,9 @@ contains type( mesh_type ), pointer :: mesh => null() integer(i_def) :: loop, ncells + integer(tik) :: id - if ( subroutine_timers ) call timer("jules_imp_alg") + if ( LPROF ) call start_timing( id, 'jules_imp_alg' ) call log_event( 'Running implicit Jules', LOG_LEVEL_DEBUG ) @@ -304,8 +305,7 @@ contains surf_radnet, surf_lw_up, surf_lw_down,& ocn_cpl_point) ) - - if ( subroutine_timers ) call timer("jules_imp_alg") + if ( LPROF ) call stop_timing( id, 'jules_imp_alg' ) ! Output the BL diagnostics if (use_xios_io .and. write_diag .and. outer == outer_iterations) then diff --git a/interfaces/jules_interface/source/algorithm/rad_tile_alg_mod.x90 b/interfaces/jules_interface/source/algorithm/rad_tile_alg_mod.x90 index 63bb8386e..be7f6b856 100644 --- a/interfaces/jules_interface/source/algorithm/rad_tile_alg_mod.x90 +++ b/interfaces/jules_interface/source/algorithm/rad_tile_alg_mod.x90 @@ -14,11 +14,11 @@ use function_space_mod, only: function_space_type use mesh_mod, only: mesh_type use constants_mod, only: r_def, i_def use empty_data_mod, only: empty_real_data -use io_config_mod, only: subroutine_timers use log_mod, only: log_event, & log_scratch_space, & LOG_LEVEL_ERROR -use timer_mod, only: timer +use timing_mod, only: start_timing, stop_timing, & + tik, LPROF use jules_control_init_mod, only: n_surf_tile use sci_geometric_constants_mod, only: get_dz_at_wtheta use fs_continuity_mod, only: W3, Wtheta @@ -135,9 +135,9 @@ subroutine rad_tile_alg(tile_sw_direct_albedo, tile_sw_diffuse_albedo, & ! Grey LW surface albedo real( kind=r_def ) :: planet_lw_albedo + integer( tik ) :: id - - if ( subroutine_timers ) call timer('rad_tile_alg') + if ( LPROF ) call start_timing( id, 'rad_tile_alg' ) vector_space => function_space_collection%get_fs( & twod_mesh, 0, 0, W3, n_sw_band * n_surf_tile ) @@ -306,7 +306,7 @@ subroutine rad_tile_alg(tile_sw_direct_albedo, tile_sw_diffuse_albedo, & call log_event( log_scratch_space, LOG_LEVEL_ERROR ) end if - if ( subroutine_timers ) call timer('rad_tile_alg') + if ( LPROF ) call stop_timing( id, 'rad_tile_alg' ) end subroutine rad_tile_alg end module rad_tile_alg_mod diff --git a/interfaces/jules_interface/source/diagnostics/jules_exp_diags_mod.f90 b/interfaces/jules_interface/source/diagnostics/jules_exp_diags_mod.f90 index 28c952446..41c52e0c3 100644 --- a/interfaces/jules_interface/source/diagnostics/jules_exp_diags_mod.f90 +++ b/interfaces/jules_interface/source/diagnostics/jules_exp_diags_mod.f90 @@ -10,8 +10,8 @@ module jules_exp_diags_mod use constants_mod, only: l_def use field_mod, only: field_type use integer_field_mod, only: integer_field_type - use io_config_mod, only: subroutine_timers - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF use initialise_diagnostics_mod, only : init_diag => init_diagnostic_field implicit none @@ -39,14 +39,15 @@ subroutine initialise_diags_for_jules_exp(z0h_eff, gross_prim_prod, & type( field_type ), intent(inout) :: z0h_eff type( field_type ), intent(inout) :: gross_prim_prod type( field_type ), intent(inout) :: soil_respiration + integer( tik ) :: id - if ( subroutine_timers ) call timer("jules_exp_diags") + if ( LPROF ) call start_timing( id, 'jules_exp_diags' ) z0h_eff_flag = init_diag(z0h_eff, 'surface__z0h_eff') gross_prim_prod_flag = init_diag(gross_prim_prod, 'surface__gross_prim_prod') soil_respiration_flag = init_diag(soil_respiration, 'surface__soil_respiration') - if ( subroutine_timers ) call timer("jules_exp_diags") + if ( LPROF ) call stop_timing( id, 'jules_exp_diags' ) end subroutine initialise_diags_for_jules_exp @@ -79,9 +80,9 @@ subroutine output_diags_for_jules_exp(z0h_eff, tile_fraction, z0m_tile, z0m, & gc_tile, soil_respiration, ustar, & z0m_eff, canopy_height, leaf_area_index type( field_type ), intent(in) :: dust_flux + integer( tik ) :: id - - if ( subroutine_timers ) call timer("jules_exp_diags") + if ( LPROF ) call start_timing( id, 'jules_exp_diags' ) ! Prognostic fields from surface collection call tile_fraction%write_field('surface__tile_fraction') @@ -101,7 +102,7 @@ subroutine output_diags_for_jules_exp(z0h_eff, tile_fraction, z0m_tile, z0m, & if (gross_prim_prod_flag) call gross_prim_prod%write_field() if (soil_respiration_flag) call soil_respiration%write_field() - if ( subroutine_timers ) call timer("jules_exp_diags") + if ( LPROF ) call stop_timing( id, 'jules_exp_diags' ) end subroutine output_diags_for_jules_exp end module jules_exp_diags_mod diff --git a/interfaces/jules_interface/source/diagnostics/jules_imp_diags_mod.x90 b/interfaces/jules_interface/source/diagnostics/jules_imp_diags_mod.x90 index 5dc8ae284..5e72f0301 100644 --- a/interfaces/jules_interface/source/diagnostics/jules_imp_diags_mod.x90 +++ b/interfaces/jules_interface/source/diagnostics/jules_imp_diags_mod.x90 @@ -7,14 +7,14 @@ module jules_imp_diags_mod - use constants_mod, only: l_def - use field_mod, only: field_type - use jules_control_init_mod, only: n_surf_tile, n_land_tile + use constants_mod, only: l_def + use field_mod, only: field_type + use jules_control_init_mod, only: n_surf_tile, n_land_tile use sci_weighted_ave_kernel_mod, only: weighted_ave_kernel_type - use io_config_mod, only: subroutine_timers - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF - use initialise_diagnostics_mod, only : init_diag => init_diagnostic_field, & + use initialise_diagnostics_mod, only: init_diag => init_diagnostic_field, & samp_diag => diagnostic_to_be_sampled implicit none @@ -260,8 +260,9 @@ contains ! Local variables type( field_type ) :: land_surface_temperature, grid_canopy_evap, & grid_surface_temperature, grid_latent_heat, grid_sublimation + integer( tik ) :: id - if ( subroutine_timers ) call timer("jules_imp_diags") + if ( LPROF ) call start_timing( id, 'jules_imp_diags' ) ! Output prognostic fields - always output these on 2nd loop if (loop == 2) then @@ -341,7 +342,7 @@ contains end if - if ( subroutine_timers ) call timer("jules_imp_diags") + if ( LPROF ) call stop_timing( id, 'jules_imp_diags' ) end subroutine output_diags_for_jules_imp end module jules_imp_diags_mod diff --git a/interfaces/jules_interface/source/diagnostics/jules_seaice_diags_mod.x90 b/interfaces/jules_interface/source/diagnostics/jules_seaice_diags_mod.x90 index b7b796462..bc4b21839 100644 --- a/interfaces/jules_interface/source/diagnostics/jules_seaice_diags_mod.x90 +++ b/interfaces/jules_interface/source/diagnostics/jules_seaice_diags_mod.x90 @@ -8,8 +8,7 @@ module jules_seaice_diags_mod use field_mod, only: field_type - use io_config_mod, only: subroutine_timers - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, tik, LPROF use jules_control_init_mod, only: first_sea_ice_tile, & n_sea_ice_tile @@ -48,8 +47,9 @@ contains ! Diagnostics locally computed here from other fields type( field_type ) :: sea_ice_fraction + integer( tik ) :: id - if ( subroutine_timers ) call timer("jules_seaice_diags") + if ( LPROF ) call start_timing( id, 'jules_seaice_diags' ) ! Prognostic fields call sea_ice_thickness%write_field('seaice__sea_ice_thickness') @@ -65,7 +65,7 @@ contains first_sea_ice_tile, n_sea_ice_tile)) call sea_ice_fraction%write_field('seaice__sea_ice_fraction') - if ( subroutine_timers ) call timer("jules_seaice_diags") + if ( LPROF ) call stop_timing( id, 'jules_seaice_diags' ) end subroutine output_diags_for_jules_seaice end module jules_seaice_diags_mod diff --git a/interfaces/jules_interface/source/diagnostics/jules_snow_diags_mod.x90 b/interfaces/jules_interface/source/diagnostics/jules_snow_diags_mod.x90 index cc40f42a4..54674b006 100644 --- a/interfaces/jules_interface/source/diagnostics/jules_snow_diags_mod.x90 +++ b/interfaces/jules_interface/source/diagnostics/jules_snow_diags_mod.x90 @@ -7,13 +7,12 @@ module jules_snow_diags_mod - use constants_mod, only: l_def - use field_mod, only: field_type - use io_config_mod, only: subroutine_timers - use timer_mod, only: timer + use constants_mod, only: l_def + use field_mod, only: field_type + use timing_mod, only: start_timing, stop_timing, tik, LPROF use sci_weighted_ave_kernel_mod, only: weighted_ave_kernel_type - use initialise_diagnostics_mod, only : init_diag => init_diagnostic_field + use initialise_diagnostics_mod, only : init_diag => init_diagnostic_field implicit none @@ -44,15 +43,16 @@ contains ! Diagnostic fields to initialise type( field_type ), intent(inout) :: grid_snow_mass type( field_type ), intent(inout) :: grid_snowmelt + integer( tik ) :: id - if ( subroutine_timers ) call timer("jules_snow_diags") + if ( LPROF ) call start_timing( id, 'jules_snow_diags' ) ! 2D fields grid_snow_mass_flag = init_diag(grid_snow_mass, 'snow__grid_snow_mass') if (grid_snow_mass_flag) call invoke( setval_c(grid_snow_mass, 0.0_r_def) ) grid_snowmelt_flag = init_diag(grid_snowmelt, 'snow__grid_snowmelt') - if ( subroutine_timers ) call timer("jules_snow_diags") + if ( LPROF ) call stop_timing( id, 'jules_snow_diags' ) end subroutine initialise_diags_for_jules_snow @@ -98,9 +98,9 @@ contains ! Diagnostics locally computed here from other fields type( field_type ), intent(inout) :: grid_snowmelt + integer( tik ) :: id - - if ( subroutine_timers ) call timer("jules_snow_diags") + if ( LPROF ) call start_timing( id, 'jules_snow_diags' ) ! Prognostic fields call tile_snow_mass%write_field('snow__snow_mass') @@ -126,7 +126,7 @@ contains call grid_snow_mass%write_field() end if - if ( subroutine_timers ) call timer("jules_snow_diags") + if ( LPROF ) call stop_timing( id, 'jules_snow_diags' ) end subroutine output_diags_for_jules_snow end module jules_snow_diags_mod diff --git a/interfaces/jules_interface/source/diagnostics/jules_soil_diags_mod.x90 b/interfaces/jules_interface/source/diagnostics/jules_soil_diags_mod.x90 index 47a01a7a2..f949df59b 100644 --- a/interfaces/jules_interface/source/diagnostics/jules_soil_diags_mod.x90 +++ b/interfaces/jules_interface/source/diagnostics/jules_soil_diags_mod.x90 @@ -7,12 +7,11 @@ module jules_soil_diags_mod - use constants_mod, only: l_def - use field_mod, only: field_type - use io_config_mod, only: subroutine_timers - use timer_mod, only: timer + use constants_mod, only: l_def + use field_mod, only: field_type + use timing_mod, only: start_timing, stop_timing, tik, LPROF use sci_weighted_ave_kernel_mod, only: weighted_ave_kernel_type - use initialise_diagnostics_mod, only: init_diag => init_diagnostic_field + use initialise_diagnostics_mod, only: init_diag => init_diagnostic_field implicit none @@ -55,8 +54,9 @@ contains type( field_type ), intent(inout) :: grid_canopy_water type( field_type ), intent(inout) :: throughfall type( field_type ), intent(inout) :: grid_throughfall + integer( tik ) :: id - if ( subroutine_timers ) call timer("jules_soil_diags") + if ( LPROF ) call start_timing( id, 'jules_soil_diags' ) ! 2D fields soil_moisture_content_flag = init_diag(soil_moisture_content, 'soil__soil_moisture_content') @@ -72,7 +72,7 @@ contains ! Initialise field to that sea and sea-ice tiles have zero values if (throughfall_flag) call invoke(setval_c(throughfall, 0.0_r_def)) - if ( subroutine_timers ) call timer("jules_soil_diags") + if ( LPROF ) call stop_timing( id, 'jules_soil_diags' ) end subroutine initialise_diags_for_jules_soil @@ -126,8 +126,9 @@ contains ! Diagnostics locally computed here from other fields type( field_type ), intent(inout) :: grid_canopy_water type( field_type ), intent(inout) :: grid_throughfall + integer( tik ) :: id - if ( subroutine_timers ) call timer("jules_soil_diags") + if ( LPROF ) call start_timing( id, 'jules_soil_diags' ) ! Prognostic fields call canopy_water%write_field('surface__canopy_water') @@ -160,7 +161,7 @@ contains call surface_runoff%write_field('soil__surface_runoff') call sub_surface_runoff%write_field('soil__sub_surface_runoff') - if ( subroutine_timers ) call timer("jules_soil_diags") + if ( LPROF ) call stop_timing( id, 'jules_soil_diags' ) end subroutine output_diags_for_jules_soil end module jules_soil_diags_mod diff --git a/interfaces/physics_schemes_interface/source/algorithm/aerosol_ukca_alg_mod.x90 b/interfaces/physics_schemes_interface/source/algorithm/aerosol_ukca_alg_mod.x90 index a1a52f0e5..814dbb16d 100644 --- a/interfaces/physics_schemes_interface/source/algorithm/aerosol_ukca_alg_mod.x90 +++ b/interfaces/physics_schemes_interface/source/algorithm/aerosol_ukca_alg_mod.x90 @@ -69,12 +69,11 @@ contains get_detj_at_w3_fv use physics_constants_mod, only: get_rdz_w3 use aerosol_ukca_kernel_mod, only: aerosol_ukca_kernel_type - - use io_config_mod, only: subroutine_timers, use_xios_io, & - write_diag + use io_config_mod, only: use_xios_io, write_diag use xios, only: xios_date, xios_get_current_date, & xios_date_get_day_of_year - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF use log_mod, only: log_event, LOG_LEVEL_DEBUG use chemistry_config_mod, only: chem_scheme, & @@ -466,8 +465,9 @@ contains integer( kind=i_def) :: jp1, jp2 ! Indices for photolysis fields type( field_type ) :: mr_ice + integer( tik ) :: id, id_photo, id_chem - if ( subroutine_timers ) call timer('aerosol_ukca_alg') + if ( LPROF ) call start_timing( id, 'aerosol_ukca_alg' ) call log_event( 'Running UKCA aerosol', LOG_LEVEL_DEBUG ) @@ -1030,7 +1030,7 @@ contains if (mod( model_clock%get_step(), & chem_timestep/int(model_clock%get_seconds_per_step()) ) == 0) then - if ( subroutine_timers ) call timer('ukca_photolysis_alg') + if ( LPROF ) call start_timing( id_photo, 'ukca_photolysis_alg' ) ! FastJX scheme if (photol_scheme == photol_scheme_fastjx ) then @@ -1150,7 +1150,7 @@ contains end if ! photol_scheme = fastjx/ prescribed - if ( subroutine_timers ) call timer('ukca_photolysis_alg') + if ( LPROF ) call stop_timing( id_photo, 'ukca_photolysis_alg' ) end if ! Chem timestep @@ -1158,7 +1158,7 @@ contains ! Do UKCA time step - if ( subroutine_timers ) call timer('ukca_chemistry_alg') + if ( LPROF ) call start_timing( id_chem, 'ukca_chemistry_alg' ) call invoke(aerosol_ukca_kernel_type( o3p, & o1d, & o3, & @@ -1440,7 +1440,7 @@ contains emiss_so2_nat, & photol_rates )) - if ( subroutine_timers ) call timer('ukca_chemistry_alg') + if ( LPROF ) call stop_timing( id_chem, 'ukca_chemistry_alg' ) call um_sizes_init(1_i_def) ! Save time for reference at next step @@ -1656,7 +1656,7 @@ contains nullify( mesh ) - if ( subroutine_timers ) call timer('aerosol_ukca_alg') + if ( LPROF ) call stop_timing( id, 'aerosol_ukca_alg' ) end subroutine aerosol_ukca_alg diff --git a/interfaces/physics_schemes_interface/source/algorithm/bl_exp_alg_mod.x90 b/interfaces/physics_schemes_interface/source/algorithm/bl_exp_alg_mod.x90 index a514beb49..a788c9b00 100644 --- a/interfaces/physics_schemes_interface/source/algorithm/bl_exp_alg_mod.x90 +++ b/interfaces/physics_schemes_interface/source/algorithm/bl_exp_alg_mod.x90 @@ -29,8 +29,7 @@ module bl_exp_alg_mod use bl_option_mod, only: l_noice_in_turb use um_sizes_init_mod, only: um_sizes_init - use io_config_mod, only: subroutine_timers - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, tik, LPROF use log_mod, only: log_event, LOG_LEVEL_DEBUG use mesh_mod, only: mesh_type use model_clock_mod, only: model_clock_type @@ -217,8 +216,9 @@ contains type( field_type ) :: mr_ice integer(i_def) :: ncells + integer(tik) :: id - if ( subroutine_timers ) call timer('bl_exp_alg') + if ( LPROF ) call start_timing( id, 'bl_exp_alg' ) call log_event( 'slow_physics: Running explicit Boundary layer', LOG_LEVEL_DEBUG ) @@ -415,13 +415,13 @@ contains call um_sizes_init(1_i_def) if (formdrag == formdrag_dist_drag) then - if ( subroutine_timers ) call timer('bl_exp_alg') + if ( LPROF ) call stop_timing( id, 'bl_exp_alg' ) call theta%copy_field_properties(fd_tauz) call invoke(setval_c(fd_tauz, 0.0_r_def)) ! Calculate form drag stress in w2 call set_wind(fd_tau_w2,fd_taux,fd_tauy,fd_tauz) call invoke(inc_X_divideby_Y(fd_tau_w2, dA)) - if ( subroutine_timers ) call timer('bl_exp_alg') + if ( LPROF ) call start_timing( id, 'bl_exp_alg' ) end if ! Calculate explicit momentum diffusion on cell faces @@ -453,7 +453,7 @@ contains sea_v_current_ptr) ) end if - if ( subroutine_timers ) call timer('bl_exp_alg') + if ( LPROF ) call stop_timing( id, 'bl_exp_alg' ) ! output BL diagnostics if (write_diag .and. use_xios_io) then diff --git a/interfaces/physics_schemes_interface/source/algorithm/bl_imp_alg_mod.x90 b/interfaces/physics_schemes_interface/source/algorithm/bl_imp_alg_mod.x90 index db83e0d3d..295e919c2 100644 --- a/interfaces/physics_schemes_interface/source/algorithm/bl_imp_alg_mod.x90 +++ b/interfaces/physics_schemes_interface/source/algorithm/bl_imp_alg_mod.x90 @@ -21,8 +21,7 @@ module bl_imp_alg_mod use timestepping_config_mod, only: outer_iterations use um_sizes_init_mod, only: um_sizes_init - use io_config_mod, only: subroutine_timers - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, tik, LPROF ! xios output use io_config_mod, only: write_diag, use_xios_io, diagnostic_frequency use bl_imp_diags_mod, only: initialise_diags_for_bl_imp, & @@ -220,8 +219,10 @@ contains type( mesh_type ), pointer :: mesh => null() integer(i_def) :: loop, ncells logical(l_def) :: diag_step, flag_blpert + integer(tik) :: id - if ( subroutine_timers ) call timer("bl_imp_alg") + + if ( LPROF ) call start_timing( id, 'bl_imp_alg' ) call log_event( 'Running implicit Boundary layer', LOG_LEVEL_DEBUG ) @@ -330,7 +331,7 @@ contains call u_physics%copy_field_properties(du_conv_w2) if ( cv_scheme == cv_scheme_gregory_rowntree .or. & cv_scheme == cv_scheme_comorph ) then - if ( subroutine_timers ) call timer("bl_imp_alg") + if ( LPROF ) call stop_timing( id, 'bl_imp_alg' ) call theta%copy_field_properties(dw_conv) call invoke(setval_c(dw_conv, 0.0_r_def) ) call set_wind(du_conv_w2, du_conv, dv_conv, dw_conv) @@ -338,7 +339,7 @@ contains ! Set wind provides output in dynamics quantites, need to remove ! dA scaling for physics call invoke(inc_X_divideby_Y(du_conv_w2, dA) ) - if ( subroutine_timers ) call timer("bl_imp_alg") + if ( LPROF ) call start_timing( id, 'bl_imp_alg' ) else call invoke(setval_c(du_conv_w2, 0.0_r_def) ) end if @@ -476,7 +477,7 @@ contains setval_X(moist_flux_bl,fqw) ) end if - if ( subroutine_timers ) call timer("bl_imp_alg") + if ( LPROF ) call stop_timing( id, 'bl_imp_alg' ) ! Calculate and output fields on last iteration only if (use_xios_io .and. outer == outer_iterations) then diff --git a/interfaces/physics_schemes_interface/source/algorithm/blpert_main_alg_mod.x90 b/interfaces/physics_schemes_interface/source/algorithm/blpert_main_alg_mod.x90 index 2159f6c56..6456ea923 100644 --- a/interfaces/physics_schemes_interface/source/algorithm/blpert_main_alg_mod.x90 +++ b/interfaces/physics_schemes_interface/source/algorithm/blpert_main_alg_mod.x90 @@ -13,8 +13,7 @@ module blpert_main_alg_mod use field_mod, only: field_type, field_proxy_type use integer_field_mod, only: integer_field_type use clock_mod, only: clock_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 @@ -114,8 +113,9 @@ contains integer(i_def), parameter :: stencil_depth_edge = 1 integer(i_def), parameter :: stencil_depth_buff = 1 real(r_def) :: dt, auto_corr_coeff, tfac + integer(tik) :: id - if ( subroutine_timers ) call timer("blpert_main_alg") + if ( LPROF ) call start_timing( id, 'blpert_main_alg' ) nullify(vector_space, coarse_vector_space, mesh, coarse_mesh, & twod_mesh, coarse_twod_mesh, local_mesh, mesh_map, & @@ -316,7 +316,7 @@ contains call dmv_base%write_field('stochastic__dmv_base_blpert') end if - if ( subroutine_timers ) call timer("blpert_main_alg") + if ( LPROF ) call stop_timing( id, 'blpert_main_alg' ) end subroutine blpert_main_alg end module blpert_main_alg_mod diff --git a/interfaces/physics_schemes_interface/source/algorithm/bm_tau_alg_mod.x90 b/interfaces/physics_schemes_interface/source/algorithm/bm_tau_alg_mod.x90 index eaaaa2814..9ce300ac1 100644 --- a/interfaces/physics_schemes_interface/source/algorithm/bm_tau_alg_mod.x90 +++ b/interfaces/physics_schemes_interface/source/algorithm/bm_tau_alg_mod.x90 @@ -11,8 +11,8 @@ module bm_tau_alg_mod use field_mod, only: field_type use field_collection_mod, only: field_collection_type use mr_indices_mod, only: nummr, imr_v, imr_cl, imr_ci, imr_s - use io_config_mod, only: subroutine_timers - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF use mesh_mod, only: mesh_type use um_sizes_init_mod, only: um_sizes_init @@ -69,9 +69,10 @@ contains type( field_type ), pointer :: ni_mphys => null() type( mesh_type ), pointer :: mesh => null() - integer( kind=i_def ) :: ncells + integer( kind=i_def ) :: ncells + integer ( tik ) :: id - if ( subroutine_timers ) call timer('bm_tau_alg') + if ( LPROF ) call start_timing( id, 'bm_tau_alg' ) call cloud_fields%get_field('frozen_fraction', cf_fro) call cloud_fields%get_field('tau_dec_bm', tau_dec_bm) @@ -102,7 +103,7 @@ contains call um_sizes_init(1_i_def) - if ( subroutine_timers ) call timer('bm_tau_alg') + if ( LPROF ) call stop_timing( id, 'bm_tau_alg' ) end subroutine bm_tau_alg diff --git a/interfaces/physics_schemes_interface/source/algorithm/casim_activate_alg_mod.x90 b/interfaces/physics_schemes_interface/source/algorithm/casim_activate_alg_mod.x90 index 743350347..2c6c21d92 100644 --- a/interfaces/physics_schemes_interface/source/algorithm/casim_activate_alg_mod.x90 +++ b/interfaces/physics_schemes_interface/source/algorithm/casim_activate_alg_mod.x90 @@ -11,9 +11,9 @@ module casim_activate_alg_mod use field_mod, only: field_type use field_collection_mod, only: field_collection_type use mr_indices_mod, only: nummr, imr_cl, imr_ci - use io_config_mod, only: subroutine_timers, write_diag, & - use_xios_io - use timer_mod, only: timer + use io_config_mod, only: write_diag, use_xios_io + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF use log_mod, only: log_event, LOG_LEVEL_INFO use mesh_mod, only: mesh_type use sci_geometric_constants_mod, only: get_height_fv @@ -69,8 +69,9 @@ contains type( field_type ), pointer :: mci_init type( mesh_type ), pointer :: mesh + integer( tik ) :: id - if ( subroutine_timers ) call timer('casim_activate_alg') + if ( LPROF ) call start_timing( id, 'casim_activate_alg' ) ! For fixed CDNC or if we want to initialise the CDNC if (casim_cdnc_opt == casim_cdnc_opt_fixed .or. initialise) then @@ -119,7 +120,7 @@ contains end if - if ( subroutine_timers ) call timer('casim_activate_alg') + if ( LPROF ) call stop_timing( id, 'casim_activate_alg' ) end subroutine casim_activate_alg diff --git a/interfaces/physics_schemes_interface/source/algorithm/casim_alg_mod.x90 b/interfaces/physics_schemes_interface/source/algorithm/casim_alg_mod.x90 index 8ad8ae789..ee175055c 100644 --- a/interfaces/physics_schemes_interface/source/algorithm/casim_alg_mod.x90 +++ b/interfaces/physics_schemes_interface/source/algorithm/casim_alg_mod.x90 @@ -60,8 +60,7 @@ contains use microphysics_config_mod, only: turb_gen_mixph use um_sizes_init_mod, only: um_sizes_init - use io_config_mod, only: subroutine_timers - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, tik, LPROF use log_mod, only: log_event, LOG_LEVEL_INFO implicit none @@ -122,8 +121,9 @@ contains type( field_type ) :: ls_graup_3d integer(kind=i_def) :: mesh_id, ncells + integer(tik) :: id_alg, id_xios - if ( subroutine_timers ) call timer("casim_alg") + if ( LPROF ) call start_timing( id_alg, 'casim_alg' ) call log_event( 'slow_physics: Running Microphysics', LOG_LEVEL_INFO ) @@ -216,11 +216,11 @@ contains call microphysics_fields%get_field('dmv_mphys', dmv_mphys) call invoke(setval_X(dmv_mphys, dmr_mphys(imr_v))) - if ( subroutine_timers ) call timer("casim_alg") + if ( LPROF ) call stop_timing( id_alg, 'casim_alg' ) ! Output microphysics diagnostics if (write_diag .and. use_xios_io) then - if ( subroutine_timers ) call timer("casim_xios") + if ( LPROF ) call start_timing( id_xios, 'casim_xios' ) call output_diags_for_casim(ls_rain, ls_snow, ls_graup, & lsca_2d, refl_tot, refl_1km, & @@ -232,7 +232,7 @@ contains dmr_mphys(imr_g), dmr_mphys(imr_s), & superc_liq, superc_rain ) - if ( subroutine_timers ) call timer("casim_xios") + if ( LPROF ) call stop_timing( id_xios, 'casim_xios' ) end if end subroutine casim_alg diff --git a/interfaces/physics_schemes_interface/source/algorithm/cld_alg_mod.x90 b/interfaces/physics_schemes_interface/source/algorithm/cld_alg_mod.x90 index 33071d015..3580b9f1e 100644 --- a/interfaces/physics_schemes_interface/source/algorithm/cld_alg_mod.x90 +++ b/interfaces/physics_schemes_interface/source/algorithm/cld_alg_mod.x90 @@ -14,11 +14,11 @@ module cld_alg_mod use mr_indices_mod, only: nummr, imr_v, imr_cl, imr_ci, & imr_r, imr_s use sci_enforce_lower_bound_kernel_mod, only: enforce_lower_bound_kernel_type - use io_config_mod, only: subroutine_timers, & - write_conservation_diag, & + use io_config_mod, only: write_conservation_diag, & write_diag, use_xios_io, & diagnostic_frequency - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF use microphysics_config_mod, only: microphysics_casim use cloud_config_mod, only: scheme, & scheme_smith, & @@ -127,8 +127,9 @@ contains type( mesh_type ), pointer :: mesh => null() integer(i_def) :: i_mr, ncells character(str_def) :: name_ext + integer(tik) :: id - if ( subroutine_timers ) call timer('cld_alg') + if ( LPROF ) call start_timing( id, 'cld_alg' ) call log_event( 'End-of-timestep cloud update', LOG_LEVEL_DEBUG ) @@ -263,7 +264,7 @@ contains end if end if - if ( subroutine_timers ) call timer('cld_alg') + if ( LPROF ) call stop_timing( id, 'cld_alg' ) if ( write_diag .and. use_xios_io .and. & mod(step,diagnostic_frequency) == 0 .and. & diff --git a/interfaces/physics_schemes_interface/source/algorithm/conv_comorph_alg_mod.x90 b/interfaces/physics_schemes_interface/source/algorithm/conv_comorph_alg_mod.x90 index 8fc190807..0c1be2dff 100644 --- a/interfaces/physics_schemes_interface/source/algorithm/conv_comorph_alg_mod.x90 +++ b/interfaces/physics_schemes_interface/source/algorithm/conv_comorph_alg_mod.x90 @@ -18,8 +18,7 @@ module conv_comorph_alg_mod use sci_geometric_constants_mod, only: get_height_fv, get_delta_at_wtheta use fs_continuity_mod, only: W3, Wtheta - use io_config_mod, only: subroutine_timers - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, tik, LPROF ! xios output use io_config_mod, only: write_diag, use_xios_io use comorph_diags_mod, only: initialise_diags_for_comorph, & @@ -266,8 +265,9 @@ contains type( mesh_type ), pointer :: mesh integer(i_def) :: ncells + integer(tik) :: id - if ( subroutine_timers ) call timer("conv_comorph_alg") + if ( LPROF ) call start_timing( id, 'conv_comorph_alg' ) call log_event( 'Running Comorph convection scheme', LOG_LEVEL_DEBUG ) @@ -630,7 +630,7 @@ contains call um_sizes_init(1_i_def) - if ( subroutine_timers ) call timer("conv_comorph_alg") + if ( LPROF ) call stop_timing( id, 'conv_comorph_alg' ) ! output diagnostics on last iteration only if (write_diag .and. use_xios_io .and. outer == outer_iterations) then diff --git a/interfaces/physics_schemes_interface/source/algorithm/conv_gr_alg_mod.x90 b/interfaces/physics_schemes_interface/source/algorithm/conv_gr_alg_mod.x90 index fbb5a8969..489742c65 100644 --- a/interfaces/physics_schemes_interface/source/algorithm/conv_gr_alg_mod.x90 +++ b/interfaces/physics_schemes_interface/source/algorithm/conv_gr_alg_mod.x90 @@ -18,8 +18,8 @@ module conv_gr_alg_mod use sci_geometric_constants_mod, only: get_height_fv, get_delta_at_wtheta use fs_continuity_mod, only: W3, Wtheta - use io_config_mod, only: subroutine_timers - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, tik, LPROF + ! xios output use io_config_mod, only: write_diag, use_xios_io use conv_diags_mod, only: initialise_diags_for_conv, & @@ -267,8 +267,9 @@ contains type( field_type ) :: mr_ice type( mesh_type ), pointer :: mesh => null() + integer( tik) :: id - if ( subroutine_timers ) call timer("conv_gr_alg") + if ( LPROF ) call start_timing( id, 'conv_gr_alg' ) call log_event( 'Running GR convection scheme', LOG_LEVEL_DEBUG ) @@ -700,7 +701,7 @@ contains cca_unadjusted, dth_conv_noshal, dmv_conv_noshal ) & ) ! end of invoke - if ( subroutine_timers ) call timer("conv_gr_alg") + if ( LPROF ) call stop_timing( id, 'conv_gr_alg' ) ! output diagnostics on last iteration only if (write_diag .and. use_xios_io .and. outer == outer_iterations) then diff --git a/interfaces/physics_schemes_interface/source/algorithm/conv_ll_alg_mod.x90 b/interfaces/physics_schemes_interface/source/algorithm/conv_ll_alg_mod.x90 index eee4bb96c..b930432cf 100644 --- a/interfaces/physics_schemes_interface/source/algorithm/conv_ll_alg_mod.x90 +++ b/interfaces/physics_schemes_interface/source/algorithm/conv_ll_alg_mod.x90 @@ -12,8 +12,7 @@ module conv_ll_alg_mod use field_collection_mod, only: field_collection_type use mr_indices_mod, only: nummr, imr_v, imr_cl use timestepping_config_mod, only: outer_iterations - use io_config_mod, only: subroutine_timers - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, tik, LPROF ! xios output use io_config_mod, only: write_diag, use_xios_io use log_mod, only: log_event, LOG_LEVEL_INFO @@ -59,8 +58,9 @@ contains type( field_type ), pointer :: dbcf_conv => null() type( field_type ), pointer :: conv_rain => null() type( field_type ), pointer :: conv_snow => null() + integer(tik) :: id - if ( subroutine_timers ) call timer("conv_ll_alg") + if ( LPROF ) call start_timing( id, 'conv_ll_alg' ) call log_event( 'Running LL convection scheme', LOG_LEVEL_INFO ) @@ -90,7 +90,7 @@ contains call conv_snow%write_field('convection__conv_snow') end if - if ( subroutine_timers ) call timer("conv_ll_alg") + if ( LPROF ) call stop_timing( id, 'conv_ll_alg' ) end subroutine conv_ll_alg diff --git a/interfaces/physics_schemes_interface/source/algorithm/electric_main_alg_mod.x90 b/interfaces/physics_schemes_interface/source/algorithm/electric_main_alg_mod.x90 index 12e4ffdbf..efe286381 100644 --- a/interfaces/physics_schemes_interface/source/algorithm/electric_main_alg_mod.x90 +++ b/interfaces/physics_schemes_interface/source/algorithm/electric_main_alg_mod.x90 @@ -35,8 +35,7 @@ contains use electric_main_kernel_mod, only: electric_main_kernel_type use mr_indices_mod, only: imr_ci, imr_s, imr_g, nummr - use io_config_mod, only: subroutine_timers - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, tik, LPROF use log_mod, only: log_event, LOG_LEVEL_INFO implicit none @@ -68,10 +67,12 @@ contains type(mesh_type), pointer :: mesh => null() + integer(tik) :: id + !-------------------------------------------------------------------------- ! End of declarations and start of the subroutine actually doing something !-------------------------------------------------------------------------- - if ( subroutine_timers ) call timer('electric_main_alg') + if ( LPROF ) call start_timing( id, 'electric_main_alg' ) call log_event( 'slow_physics: Running Lightning Scheme', LOG_LEVEL_INFO ) @@ -111,8 +112,7 @@ contains fr1_mc_2d, fr2_mc_2d, gwp_2d, & tiwp_2d ) ) - - if ( subroutine_timers ) call timer('electric_main_alg') + if ( LPROF ) call stop_timing( id, 'electric_main_alg' ) !--------------------------- ! Output Diagnostics diff --git a/interfaces/physics_schemes_interface/source/algorithm/flexchem_alg_mod.x90 b/interfaces/physics_schemes_interface/source/algorithm/flexchem_alg_mod.x90 index 2668353ed..ccaa1d1e4 100644 --- a/interfaces/physics_schemes_interface/source/algorithm/flexchem_alg_mod.x90 +++ b/interfaces/physics_schemes_interface/source/algorithm/flexchem_alg_mod.x90 @@ -10,9 +10,9 @@ module flexchem_alg_mod use chemistry_config_mod, only: flexchem_opt, flexchem_opt_bs1999 use field_mod, only: field_type use field_collection_mod, only: field_collection_type - use io_config_mod, only: subroutine_timers use log_mod, only: log_event, LOG_LEVEL_INFO - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF implicit none @@ -53,8 +53,9 @@ contains type( field_type ), pointer :: rb type( field_type ), pointer :: tio type( field_type ), pointer :: vo + integer( tik ) :: id - if ( subroutine_timers ) call timer('flexchem_alg') + if ( LPROF ) call start_timing( id, 'flexchem_alg' ) call log_event( 'Running flexible chemistry scheme', LOG_LEVEL_INFO ) @@ -96,7 +97,7 @@ contains call tio%write_field('chemistry__tio') call vo%write_field('chemistry__vo') - if ( subroutine_timers ) call timer('flexchem_alg') + if ( LPROF ) call stop_timing( id, 'flexchem_alg' ) end subroutine flexchem_alg diff --git a/interfaces/physics_schemes_interface/source/algorithm/fsd_condensate_alg_mod.x90 b/interfaces/physics_schemes_interface/source/algorithm/fsd_condensate_alg_mod.x90 index 48c93f5ed..bddb78c6b 100644 --- a/interfaces/physics_schemes_interface/source/algorithm/fsd_condensate_alg_mod.x90 +++ b/interfaces/physics_schemes_interface/source/algorithm/fsd_condensate_alg_mod.x90 @@ -33,8 +33,7 @@ contains subroutine fsd_condensate_alg( f_arr, cloud_fields, convection_fields ) use fsd_condensate_kernel_mod, only: fsd_condensate_kernel_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 @@ -51,9 +50,10 @@ contains type( field_type ), pointer :: sigma_mi type( field_type ), pointer :: cca - type( mesh_type), pointer :: mesh + type( mesh_type), pointer :: mesh + integer(tik) :: id - if ( subroutine_timers ) call timer("fsd_condensate_alg") + if ( LPROF ) call start_timing( id, 'fsd_condensate_alg' ) ! Unpack fields call cloud_fields%get_field('area_fraction', area_fraction) @@ -79,7 +79,7 @@ contains nullify( mesh ) - if ( subroutine_timers ) call timer("fsd_condensate_alg") + if ( LPROF ) call stop_timing( id, 'fsd_condensate_alg' ) end subroutine fsd_condensate_alg diff --git a/interfaces/physics_schemes_interface/source/algorithm/glomap_aerosol_alg_mod.x90 b/interfaces/physics_schemes_interface/source/algorithm/glomap_aerosol_alg_mod.x90 index e7ee279c9..b1f6b9507 100644 --- a/interfaces/physics_schemes_interface/source/algorithm/glomap_aerosol_alg_mod.x90 +++ b/interfaces/physics_schemes_interface/source/algorithm/glomap_aerosol_alg_mod.x90 @@ -13,11 +13,11 @@ module glomap_aerosol_alg_mod use field_collection_mod, only: field_collection_type use multires_coupling_config_mod, only: lowest_order_aero_flag, & coarse_rad_aerosol - use io_config_mod, only: subroutine_timers, & - use_xios_io, & + use io_config_mod, only: use_xios_io, & write_diag use mr_indices_mod, only: imr_ci, imr_v, nummr, imr_s - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF use radiation_config_mod, only: n_radstep use aerosol_config_mod, only: n_radaer_step use microphysics_config_mod, only: microphysics_casim @@ -142,9 +142,10 @@ contains type( field_type ), pointer :: rh_crit_aero => null() type( field_type ), pointer :: cloud_drop_no_conc_aero => null() type( field_type ), target :: cf_bulk_coarse, cf_liquid_coarse, rh_crit_coarse, cloud_drop_no_conc_coarse - type( field_type ) :: mr_ice + type( field_type ) :: mr_ice + integer(tik) :: id_alg, id_xios - if ( subroutine_timers ) call timer('glomap_aerosol_alg') + if ( LPROF ) call start_timing( id_alg, 'glomap_aerosol_alg' ) ! Unpack fields from aerosol_fields call aerosol_fields%get_field('n_nuc_sol', n_nuc_sol) @@ -320,10 +321,10 @@ contains if ( coarse_rad_aerosol ) then call map_scalar_intermesh(cloud_drop_no_conc, cloud_drop_no_conc_aero, lowest_order_flag=lowest_order_aero_flag) end if - if ( subroutine_timers ) call timer('glomap_aerosol_alg') + if ( LPROF ) call stop_timing( id_alg, 'glomap_aerosol_alg' ) if ( write_diag .and. use_xios_io ) then - if ( subroutine_timers ) call timer("glomap_aerosol_xios") + if ( LPROF ) call start_timing( id_xios, 'glomap_aerosol_xios' ) ! Diagnostic output call n_nuc_sol%write_field('aerosol__n_nuc_sol') @@ -377,7 +378,7 @@ contains call cloud_drop_no_conc_aero%write_field('aerosol__cloud_drop_no_conc') end if - if ( subroutine_timers ) call timer("glomap_aerosol_xios") + if ( LPROF ) call stop_timing( id_xios, 'glomap_aerosol_xios' ) end if end subroutine glomap_aerosol_alg diff --git a/interfaces/physics_schemes_interface/source/algorithm/locate_tropopause_alg_mod.x90 b/interfaces/physics_schemes_interface/source/algorithm/locate_tropopause_alg_mod.x90 index fa540d1c0..25b2f440e 100644 --- a/interfaces/physics_schemes_interface/source/algorithm/locate_tropopause_alg_mod.x90 +++ b/interfaces/physics_schemes_interface/source/algorithm/locate_tropopause_alg_mod.x90 @@ -19,8 +19,7 @@ use mesh_mod, only: mesh_type use field_parent_mod, only: write_interface use sci_geometric_constants_mod, only: get_height_fv use locate_tropopause_kernel_mod, only: locate_tropopause_kernel_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 private @@ -45,8 +44,9 @@ subroutine locate_tropopause_alg(trop_level, theta, exner_in_wth, twod_mesh) type( field_type ), pointer :: height_wth => null() type(function_space_type), pointer :: vector_space => null() procedure(write_interface), pointer :: write_diag_behaviour => null() + integer(tik) :: id_alg, id_xios - if ( subroutine_timers ) call timer("locate_tropopause_alg") + if ( LPROF ) call start_timing( id_alg, 'locate_tropopause_alg' ) height_wth => get_height_fv(Wtheta, theta%get_mesh_id()) @@ -55,15 +55,14 @@ subroutine locate_tropopause_alg(trop_level, theta, exner_in_wth, twod_mesh) call invoke( locate_tropopause_kernel_type( theta, exner_in_wth, & height_wth, trop_level ) ) - - if ( subroutine_timers ) call timer("locate_tropopause_alg") + if ( LPROF ) call stop_timing( id_alg, 'locate_tropopause_alg' ) if (write_diag .and. use_xios_io) then - if ( subroutine_timers ) call timer("locate_tropopause_xios") + if ( LPROF ) call start_timing( id_xios, 'locate_tropopause_xios' ) write_diag_behaviour => write_field_generic call trop_level%set_write_behaviour(write_diag_behaviour) call trop_level%write_field('processed__trop_level') - if ( subroutine_timers ) call timer("locate_tropopause_xios") + if ( LPROF ) call stop_timing( id_xios, 'locate_tropopause_xios' ) end if end subroutine locate_tropopause_alg diff --git a/interfaces/physics_schemes_interface/source/algorithm/methox_alg_mod.x90 b/interfaces/physics_schemes_interface/source/algorithm/methox_alg_mod.x90 index 07759e221..2d78f8231 100644 --- a/interfaces/physics_schemes_interface/source/algorithm/methox_alg_mod.x90 +++ b/interfaces/physics_schemes_interface/source/algorithm/methox_alg_mod.x90 @@ -10,9 +10,7 @@ module methox_alg_mod use field_mod, only: field_type use mr_indices_mod, only: nummr, imr_v use io_config_mod, only: write_diag, use_xios_io - use io_config_mod, only: subroutine_timers - use timer_mod, only: timer - + use timing_mod, only: start_timing, stop_timing, tik, LPROF use constants_mod, only: r_def, i_def, pi, l_def use extrusion_config_mod, only: domain_height, number_of_layers use level_heights_mod, only: eta_theta_levels @@ -83,8 +81,9 @@ contains !Internal variables integer(kind=i_def) :: k real(kind=r_def) :: pressure, dt + integer(tik) :: id - if ( subroutine_timers ) call timer('methox_alg') + if ( LPROF ) call start_timing( id, 'methox_alg' ) ! If required, calculate the rate coefficients ! (assumed to vary only with pressure) @@ -148,7 +147,7 @@ contains call dmv_methox%write_field('processed__dmv_methox') end if - if ( subroutine_timers ) call timer('methox_alg') + if ( LPROF ) call stop_timing( id, 'methox_alg' ) end subroutine methox_alg diff --git a/interfaces/physics_schemes_interface/source/algorithm/mphys_alg_mod.x90 b/interfaces/physics_schemes_interface/source/algorithm/mphys_alg_mod.x90 index 37f37f856..1aac86a89 100644 --- a/interfaces/physics_schemes_interface/source/algorithm/mphys_alg_mod.x90 +++ b/interfaces/physics_schemes_interface/source/algorithm/mphys_alg_mod.x90 @@ -65,8 +65,7 @@ contains use cloud_config_mod, only: mphys_erosion use microphysics_config_mod, only: turb_gen_mixph, prog_tnuc - use io_config_mod, only: subroutine_timers - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, tik, LPROF use log_mod, only: log_event, LOG_LEVEL_DEBUG implicit none @@ -139,8 +138,9 @@ contains type( field_type ) :: pressure_inc type(mesh_type), pointer :: mesh => null() + integer(tik) :: id - if ( subroutine_timers ) call timer("mphys_alg") + if ( LPROF ) call start_timing( id, 'mphys_alg' ) call log_event( 'slow_physics: Running Microphysics', LOG_LEVEL_DEBUG ) @@ -260,7 +260,7 @@ contains call microphysics_fields%get_field('dmv_mphys', dmv_mphys) call invoke(setval_X(dmv_mphys, dmr_mphys(imr_v))) - if ( subroutine_timers ) call timer("mphys_alg") + if ( LPROF ) call stop_timing( id, 'mphys_alg' ) ! Output microphysics diagnostics if (write_diag .and. use_xios_io) then diff --git a/interfaces/physics_schemes_interface/source/algorithm/orographic_drag_alg_mod.x90 b/interfaces/physics_schemes_interface/source/algorithm/orographic_drag_alg_mod.x90 index 1f45816fe..102fdcc15 100644 --- a/interfaces/physics_schemes_interface/source/algorithm/orographic_drag_alg_mod.x90 +++ b/interfaces/physics_schemes_interface/source/algorithm/orographic_drag_alg_mod.x90 @@ -12,8 +12,7 @@ module orographic_drag_alg_mod use mr_indices_mod, only: nummr, imr_v, imr_cl, imr_ci, imr_s use microphysics_config_mod, only: microphysics_casim use psykal_lite_phys_mod, only: invoke_orographic_drag_kernel - use io_config_mod, only: subroutine_timers - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, tik, LPROF use log_mod, only: log_event, LOG_LEVEL_DEBUG use mesh_mod, only: mesh_type @@ -95,9 +94,9 @@ contains type( field_type ) :: mr_ice type( mesh_type ), pointer :: mesh => null() + integer( tik ) :: id - - if ( subroutine_timers ) call timer("orographic_drag_alg") + if ( LPROF ) call start_timing( id, 'orographic_drag_alg' ) call log_event( 'slow_physics: Running Orographic drag', LOG_LEVEL_DEBUG ) @@ -177,7 +176,7 @@ contains X_divideby_Y (dtheta_orographic_drag, dtemp_orographic_drag, & exner_in_wth) ) - if ( subroutine_timers ) call timer("orographic_drag_alg") + if ( LPROF ) call stop_timing( id, 'orographic_drag_alg' ) if (write_diag .and. use_xios_io) then diff --git a/interfaces/physics_schemes_interface/source/algorithm/pc2_checks_alg_mod.x90 b/interfaces/physics_schemes_interface/source/algorithm/pc2_checks_alg_mod.x90 index 9f2472624..5b9cd225e 100644 --- a/interfaces/physics_schemes_interface/source/algorithm/pc2_checks_alg_mod.x90 +++ b/interfaces/physics_schemes_interface/source/algorithm/pc2_checks_alg_mod.x90 @@ -54,8 +54,7 @@ contains use pc2_checks_kernel_mod, only: pc2_checks_kernel_type use mr_indices_mod, only: imr_v, imr_cl, imr_ci, nummr, imr_s - use io_config_mod, only: subroutine_timers - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, tik, LPROF implicit none @@ -80,8 +79,9 @@ contains type( field_type ), pointer :: liquid_fraction => null() type( field_type ), pointer :: frozen_fraction => null() type( field_type ), pointer :: bulk_fraction => null() + integer( tik ) :: id_alg, id_xios - if ( subroutine_timers ) call timer("pc2_checks_alg") + if ( LPROF ) call start_timing( id_alg, 'pc2_checks_alg' ) ! Unpack fields call derived_fields%get_field('exner_in_wth', exner_in_wth) @@ -118,10 +118,10 @@ contains dcff_pc2_inc, & dbcf_pc2_inc ) ) - if ( subroutine_timers ) call timer("pc2_checks_alg") + if ( LPROF ) call stop_timing( id_alg, 'pc2_checks_alg' ) if ( write_diag .and. use_xios_io ) then - if ( subroutine_timers ) call timer("pc2_checks_xios") + if ( LPROF ) call start_timing( id_xios, 'pc2_checks_xios' ) call dtheta_pc2_inc%write_field('cloud__dtheta_pc2_checks') call dmv_pc2_inc%write_field('cloud__dmv_pc2_checks') call dmcl_pc2_inc%write_field('cloud__dmcl_pc2_checks') @@ -130,7 +130,7 @@ contains call dcfl_pc2_inc%write_field('cloud__dcfl_pc2_checks') call dcff_pc2_inc%write_field('cloud__dcff_pc2_checks') call dbcf_pc2_inc%write_field('cloud__dbcf_pc2_checks') - if ( subroutine_timers ) call timer("pc2_checks_xios") + if ( LPROF ) call stop_timing( id_xios, 'pc2_checks_xios' ) end if end subroutine pc2_checks_alg diff --git a/interfaces/physics_schemes_interface/source/algorithm/pc2_conv_coupling_alg_mod.x90 b/interfaces/physics_schemes_interface/source/algorithm/pc2_conv_coupling_alg_mod.x90 index d18891bdd..6183231d5 100644 --- a/interfaces/physics_schemes_interface/source/algorithm/pc2_conv_coupling_alg_mod.x90 +++ b/interfaces/physics_schemes_interface/source/algorithm/pc2_conv_coupling_alg_mod.x90 @@ -40,8 +40,8 @@ contains convection_fields, cloud_fields, dt ) use constants_mod, only: i_def - use io_config_mod, only: subroutine_timers - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF use pc2_conv_coupling_kernel_mod, only: pc2_conv_coupling_kernel_type use casim_conv_inc_kernel_mod, only: casim_conv_inc_kernel_type @@ -73,8 +73,9 @@ contains type(mesh_type), pointer :: mesh => null() integer(i_def) :: ncells + integer(tik) :: id_alg, id_xios - if ( subroutine_timers ) call timer ("pc2_conv_coupling_alg") + if ( LPROF ) call start_timing( id_alg, 'pc2_conv_coupling_alg' ) call derived_fields%get_field('exner_in_wth', exner_wth) call derived_fields%get_field('theta_star', theta_star) @@ -133,10 +134,10 @@ contains call invoke(inc_X_plus_Y(mr(imr_s), dms_conv)) end if - if ( subroutine_timers ) call timer ("pc2_conv_coupling_alg") + if ( LPROF ) call stop_timing( id_alg, 'pc2_conv_coupling_alg' ) if ( write_diag .and. use_xios_io ) then - if ( subroutine_timers ) call timer("pc2_conv_coupling_xios") + if ( LPROF ) call start_timing( id_xios, 'pc2_conv_coupling_xios' ) call dt_conv%write_field('cloud__dt_pc2_conv_coupling') call dmv_conv%write_field('cloud__dmv_pc2_conv_coupling') call dmcl_conv%write_field('cloud__dmcl_pc2_conv_coupling') @@ -144,7 +145,7 @@ contains call dcfl_conv%write_field('cloud__dcfl_pc2_conv_coupling') call dcff_conv%write_field('cloud__dcff_pc2_conv_coupling') call dbcf_conv%write_field('cloud__dbcf_pc2_conv_coupling') - if ( subroutine_timers ) call timer("pc2_conv_coupling_xios") + if ( LPROF ) call stop_timing( id_xios, 'pc2_conv_coupling_xios' ) end if end subroutine pc2_conv_coupling_alg diff --git a/interfaces/physics_schemes_interface/source/algorithm/pc2_initiation_alg_mod.x90 b/interfaces/physics_schemes_interface/source/algorithm/pc2_initiation_alg_mod.x90 index d6101365f..d4ab221df 100644 --- a/interfaces/physics_schemes_interface/source/algorithm/pc2_initiation_alg_mod.x90 +++ b/interfaces/physics_schemes_interface/source/algorithm/pc2_initiation_alg_mod.x90 @@ -60,8 +60,7 @@ contains use pc2_initiation_kernel_mod, only: pc2_initiation_kernel_type use mr_indices_mod, only: imr_v, imr_cl, imr_ci, imr_s, nummr - use io_config_mod, only: subroutine_timers - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, tik, LPROF implicit none @@ -116,8 +115,9 @@ contains type( mesh_type ), pointer :: mesh => null() integer( kind=i_def ) :: ncells + integer( tik ) :: id_alg, id_xios - if ( subroutine_timers ) call timer("pc2_initiation_alg") + if ( LPROF ) call start_timing( id_alg, 'pc2_initiation_alg' ) ! Unpack fields call derived_fields%get_field('exner_wth_n', exner_wth_n) @@ -218,10 +218,10 @@ contains call um_sizes_init(1_i_def) - if ( subroutine_timers ) call timer("pc2_initiation_alg") + if ( LPROF ) call stop_timing( id_alg, 'pc2_initiation_alg' ) if ( write_diag .and. use_xios_io ) then - if ( subroutine_timers ) call timer("pc2_initiation_xios") + if ( LPROF ) call start_timing( id_xios, 'pc2_initiation_xios' ) call dtheta_pc2_inc%write_field('cloud__dtheta_pc2_initiation'//trim(name_ext)) call dmv_pc2_inc%write_field('cloud__dmv_pc2_initiation'//trim(name_ext)) call dmcl_pc2_inc%write_field('cloud__dmcl_pc2_initiation'//trim(name_ext)) @@ -230,7 +230,7 @@ contains call dcfl_pc2_inc%write_field('cloud__dcfl_pc2_initiation'//trim(name_ext)) call dcff_pc2_inc%write_field('cloud__dcff_pc2_initiation'//trim(name_ext)) call dbcf_pc2_inc%write_field('cloud__dbcf_pc2_initiation'//trim(name_ext)) - if ( subroutine_timers ) call timer("pc2_initiation_xios") + if ( LPROF ) call stop_timing( id_xios, 'pc2_initiation_xios' ) end if nullify( mesh ) diff --git a/interfaces/physics_schemes_interface/source/algorithm/pc2_pressure_forcing_alg_mod.x90 b/interfaces/physics_schemes_interface/source/algorithm/pc2_pressure_forcing_alg_mod.x90 index ffc3f8865..83ea10e65 100644 --- a/interfaces/physics_schemes_interface/source/algorithm/pc2_pressure_forcing_alg_mod.x90 +++ b/interfaces/physics_schemes_interface/source/algorithm/pc2_pressure_forcing_alg_mod.x90 @@ -39,8 +39,7 @@ contains use pc2_homogeneous_kernel_mod, only: pc2_homogeneous_kernel_type use mr_indices_mod, only: imr_v, imr_cl, nummr - use io_config_mod, only: subroutine_timers - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, tik, LPROF implicit none @@ -69,8 +68,9 @@ contains type( field_type ), pointer :: frozen_fraction => null() type( field_type ), pointer :: bulk_fraction => null() type( field_type ), pointer :: exner_after_slow_wth => null() + integer( tik) :: id_alg, id_xios - if ( subroutine_timers ) call timer("pc2_pressure_forcing_alg") + if ( LPROF ) call start_timing( id_alg, 'pc2_pressure_forcing_alg' ) ! Unpack fields call cloud_fields%get_field('liquid_fraction', liquid_fraction) @@ -126,16 +126,16 @@ contains inc_X_plus_Y(liquid_fraction, dcfl_pc2_inc), & inc_X_plus_Y(bulk_fraction, dbcf_pc2_inc) ) - if ( subroutine_timers ) call timer("pc2_pressure_forcing_alg") + if ( LPROF ) call stop_timing( id_alg, 'pc2_pressure_forcing_alg' ) if ( write_diag .and. use_xios_io ) then - if ( subroutine_timers ) call timer("pc2_pressure_forcing_xios") + if ( LPROF ) call start_timing( id_xios, 'pc2_pressure_forcing_xios' ) call dtheta_pc2_inc%write_field('cloud__dtheta_pc2_pressure_change'//trim(name_ext)) call dmv_pc2_inc%write_field('cloud__dmv_pc2_pressure_change'//trim(name_ext)) call dmcl_pc2_inc%write_field('cloud__dmcl_pc2_pressure_change'//trim(name_ext)) call dcfl_pc2_inc%write_field('cloud__dcfl_pc2_pressure_change'//trim(name_ext)) call dbcf_pc2_inc%write_field('cloud__dbcf_pc2_pressure_change'//trim(name_ext)) - if ( subroutine_timers ) call timer("pc2_pressure_forcing_xios") + if ( LPROF ) call stop_timing( id_xios, 'pc2_pressure_forcing_xios' ) end if end subroutine pc2_pressure_forcing_alg diff --git a/interfaces/physics_schemes_interface/source/algorithm/pc2_rad_response_alg_mod.x90 b/interfaces/physics_schemes_interface/source/algorithm/pc2_rad_response_alg_mod.x90 index d6f83e560..0344e987a 100644 --- a/interfaces/physics_schemes_interface/source/algorithm/pc2_rad_response_alg_mod.x90 +++ b/interfaces/physics_schemes_interface/source/algorithm/pc2_rad_response_alg_mod.x90 @@ -50,8 +50,7 @@ contains use pc2_homogeneous_kernel_mod, only: pc2_homogeneous_kernel_type use mr_indices_mod, only: imr_v, imr_cl, imr_ci, nummr - use io_config_mod, only: subroutine_timers - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, tik, LPROF implicit none @@ -80,8 +79,9 @@ contains type( field_type ), pointer :: liquid_fraction => null() type( field_type ), pointer :: frozen_fraction => null() type( field_type ), pointer :: bulk_fraction => null() + integer( tik ) :: id_alg, id_xios - if ( subroutine_timers ) call timer("pc2_rad_response_alg") + if ( LPROF ) call start_timing( id_alg, 'pc2_rad_response_alg' ) ! Unpack fields call cloud_fields%get_field('liquid_fraction', liquid_fraction) @@ -124,16 +124,16 @@ contains ! N.B. We are not updating the variables that came in, just ! providing increments that need to be added on later. - if ( subroutine_timers ) call timer("pc2_rad_response_alg") + if ( LPROF ) call stop_timing( id_alg, 'pc2_rad_response_alg' ) if ( write_diag .and. use_xios_io ) then - if ( subroutine_timers ) call timer("pc2_rad_response_xios") + if ( LPROF ) call start_timing( id_xios, 'pc2_rad_response_xios' ) call dtheta_pc2_inc%write_field('cloud__dtheta_pc2_rad') call dmv_pc2_inc%write_field('cloud__dmv_pc2_rad') call dmcl_pc2_inc%write_field('cloud__dmcl_pc2_rad') call dcfl_pc2_inc%write_field('cloud__dcfl_pc2_rad') call dbcf_pc2_inc%write_field('cloud__dbcf_pc2_rad') - if ( subroutine_timers ) call timer("pc2_rad_response_xios") + if ( LPROF ) call stop_timing( id_xios, 'pc2_rad_response_xios' ) end if end subroutine pc2_rad_response_alg diff --git a/interfaces/physics_schemes_interface/source/algorithm/pmsl_alg_mod.x90 b/interfaces/physics_schemes_interface/source/algorithm/pmsl_alg_mod.x90 index 27264d3ce..fd6dc39a7 100644 --- a/interfaces/physics_schemes_interface/source/algorithm/pmsl_alg_mod.x90 +++ b/interfaces/physics_schemes_interface/source/algorithm/pmsl_alg_mod.x90 @@ -9,8 +9,8 @@ module pmsl_alg_mod use field_mod, only: field_type use field_collection_mod, only: field_collection_type - use io_config_mod, only: write_diag, use_xios_io,subroutine_timers - use timer_mod, only: timer + use io_config_mod, only: write_diag, use_xios_io + use timing_mod, only: start_timing, stop_timing, tik, LPROF use extrusion_config_mod, only: number_of_layers, domain_height use constants_mod, only: r_def, i_def use level_heights_mod, only: eta_theta_levels @@ -80,8 +80,9 @@ contains real(kind=r_def), parameter :: upperheight=2000.0_r_def integer(kind=i_def), parameter :: sten_size = 1 + integer(tik) :: id - if ( subroutine_timers ) call timer('pmsl_alg') + if ( LPROF ) call start_timing( id, 'pmsl_alg' ) pmsl_flag = init_diag(pmsl, 'processed__pmsl') pmsl_unsmooth_flag = init_diag(pmsl_unsmooth, 'processed__pmsl_unsmooth', & @@ -151,7 +152,7 @@ contains end if - if ( subroutine_timers ) call timer('pmsl_alg') + if ( LPROF ) call stop_timing( id, 'pmsl_alg' ) end subroutine pmsl_alg diff --git a/interfaces/physics_schemes_interface/source/algorithm/pres_lev_diags_alg_mod.x90 b/interfaces/physics_schemes_interface/source/algorithm/pres_lev_diags_alg_mod.x90 index 41d0188eb..883293b37 100644 --- a/interfaces/physics_schemes_interface/source/algorithm/pres_lev_diags_alg_mod.x90 +++ b/interfaces/physics_schemes_interface/source/algorithm/pres_lev_diags_alg_mod.x90 @@ -9,8 +9,8 @@ module pres_lev_diags_alg_mod use field_mod, only: field_type use field_collection_mod, only: field_collection_type - use io_config_mod, only: write_diag, use_xios_io,subroutine_timers - use timer_mod, only: timer + use io_config_mod, only: write_diag, use_xios_io + use timing_mod, only: start_timing, stop_timing, tik, LPROF use constants_mod, only: r_def, i_def, l_def, str_def use initialise_diagnostics_mod, only: init_diag => init_diagnostic_field, & diag_samp => diagnostic_to_be_sampled @@ -82,8 +82,9 @@ contains plev_w_flag, plev_w_clim_flag, plev_omega_clim_flag, & plev_mv_clim_flag, plev_qv_clim_flag, & plev_geopot_flag, plev_geopot_clim_flag, plev_thetaw_flag + integer(tik) :: id - if ( subroutine_timers ) call timer('pres_lev_diags_alg') + if ( LPROF ) call start_timing( id, 'pres_lev_diags_alg' ) nplev = get_axis_dimension('pressure_levels') allocate(plevs(nplev)) @@ -279,7 +280,7 @@ contains deallocate(plevs) - if ( subroutine_timers ) call timer('pres_lev_diags_alg') + if ( LPROF ) call stop_timing( id, 'pres_lev_diags_alg' ) end subroutine pres_lev_diags_alg diff --git a/interfaces/physics_schemes_interface/source/algorithm/radaer_alg_mod.x90 b/interfaces/physics_schemes_interface/source/algorithm/radaer_alg_mod.x90 index d1bf92aa4..2b1cde145 100644 --- a/interfaces/physics_schemes_interface/source/algorithm/radaer_alg_mod.x90 +++ b/interfaces/physics_schemes_interface/source/algorithm/radaer_alg_mod.x90 @@ -16,10 +16,9 @@ module radaer_alg_mod use function_space_collection_mod, & only: function_space_collection use socrates_init_mod, only: n_sw_band, n_lw_band - use io_config_mod, only: subroutine_timers, & - use_xios_io, & + use io_config_mod, only: use_xios_io, & write_diag - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, tik, LPROF use constants_mod, only: i_def, l_def use radiation_config_mod, & only: n_radstep @@ -205,8 +204,9 @@ contains type( field_type ) :: aaod_ukca_acc_ins type( field_type ) :: aod_ukca_cor_ins type( field_type ) :: aaod_ukca_cor_ins + integer(tik) :: id - if ( subroutine_timers ) call timer('radaer_alg') + if ( LPROF ) call start_timing( id, 'radaer_alg' ) ! Call on radiation time steps only if (mod(timestep-1_i_def, n_radaer_step*n_radstep) == 0) then @@ -498,7 +498,7 @@ contains end if - if ( subroutine_timers ) call timer('radaer_alg') + if ( LPROF ) call stop_timing( id, 'radaer_alg' ) end subroutine radaer_alg diff --git a/interfaces/physics_schemes_interface/source/algorithm/skeb_main_alg_mod.x90 b/interfaces/physics_schemes_interface/source/algorithm/skeb_main_alg_mod.x90 index b49ad7f82..d431461b0 100644 --- a/interfaces/physics_schemes_interface/source/algorithm/skeb_main_alg_mod.x90 +++ b/interfaces/physics_schemes_interface/source/algorithm/skeb_main_alg_mod.x90 @@ -22,8 +22,8 @@ module skeb_main_alg_mod use function_space_collection_mod, only: function_space_collection use mesh_collection_mod, only: mesh_collection ! xios output and timers - use io_config_mod, only: write_diag, use_xios_io, subroutine_timers - use timer_mod, only: timer + use io_config_mod, only: write_diag, use_xios_io + use timing_mod, only: start_timing, stop_timing, tik, LPROF ! initialise diagnostics use initialise_diagnostics_mod, only: init_diag => init_diagnostic_field ! configs @@ -296,8 +296,11 @@ module skeb_main_alg_mod ! Iterators in for loops integer(i_def) :: m, n, n_row, stencil_extent + ! Timing handle + integer(tik) :: id + !!!!!!!!!! END OF VARIABLE DEFINITION, START OF CODE !!!!!!!!!! - if ( subroutine_timers ) call timer("skeb_main_alg") + if ( LPROF ) call start_timing( id, 'skeb_main_alg' ) ! create dissipation functions and psif_hat call rho%copy_field_properties(ndisp) @@ -688,7 +691,7 @@ module skeb_main_alg_mod end if ! end if write_diags and use_xios - if ( subroutine_timers ) call timer("skeb_main_alg") + if ( LPROF ) call stop_timing( id, 'skeb_main_alg' ) end subroutine skeb_main_alg end module skeb_main_alg_mod diff --git a/interfaces/physics_schemes_interface/source/algorithm/skeb_ndisp_alg_mod.x90 b/interfaces/physics_schemes_interface/source/algorithm/skeb_ndisp_alg_mod.x90 index 91a60f790..70477be04 100644 --- a/interfaces/physics_schemes_interface/source/algorithm/skeb_ndisp_alg_mod.x90 +++ b/interfaces/physics_schemes_interface/source/algorithm/skeb_ndisp_alg_mod.x90 @@ -20,9 +20,8 @@ module skeb_ndisp_alg_mod ! use collections use function_space_collection_mod, only: function_space_collection ! xios output and timers - use io_config_mod, only: subroutine_timers, write_diag, & - use_xios_io - use timer_mod, only: timer + use io_config_mod, only: write_diag, use_xios_io + use timing_mod, only: start_timing, stop_timing, tik, LPROF ! configs and loging use base_mesh_config_mod, only: geometry, & geometry_spherical @@ -124,10 +123,11 @@ module skeb_ndisp_alg_mod ! Integers integer(kind=i_def) :: i + integer(tik) :: id !!!!!!!!!! END OF VARIABLE DEFINITION, START OF CODE !!!!!!!!!! - if ( subroutine_timers ) call timer("skeb_ndisp_alg") + if ( LPROF ) call start_timing( id, 'skeb_ndisp_alg' ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! 1) Initialize feilds and operators !! @@ -254,7 +254,7 @@ module skeb_ndisp_alg_mod end if end if - if ( subroutine_timers ) call timer("skeb_ndisp_alg") + if ( LPROF ) call stop_timing( id, 'skeb_ndisp_alg' ) end subroutine skeb_ndisp_alg end module skeb_ndisp_alg_mod diff --git a/interfaces/physics_schemes_interface/source/algorithm/spectral_gwd_alg_mod.x90 b/interfaces/physics_schemes_interface/source/algorithm/spectral_gwd_alg_mod.x90 index a640c58a8..02b517317 100644 --- a/interfaces/physics_schemes_interface/source/algorithm/spectral_gwd_alg_mod.x90 +++ b/interfaces/physics_schemes_interface/source/algorithm/spectral_gwd_alg_mod.x90 @@ -9,8 +9,7 @@ module spectral_gwd_alg_mod use constants_mod, only: i_def use field_mod, only: field_type use field_collection_mod, only: field_collection_type - use io_config_mod, only: subroutine_timers - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, tik, LPROF use log_mod, only: log_event, LOG_LEVEL_DEBUG use mesh_mod, only: mesh_type use fs_continuity_mod, only: W3, Wtheta @@ -87,8 +86,9 @@ contains type( mesh_type ), pointer :: mesh => null() type( mesh_type ), pointer :: twod_mesh => null() integer( kind=i_def ) :: ncells + integer( tik ) :: id - if ( subroutine_timers ) call timer("spectral_gwd_alg") + if ( LPROF ) call start_timing( id, 'spectral_gwd_alg' ) call log_event( 'slow_physics: Running spectral gravity wave drag', LOG_LEVEL_DEBUG ) @@ -146,7 +146,7 @@ contains call um_sizes_init(1_i_def) - if ( subroutine_timers ) call timer("spectral_gwd_alg") + if ( LPROF ) call stop_timing( id, 'spectral_gwd_alg' ) if (write_diag .and. use_xios_io) then diff --git a/interfaces/physics_schemes_interface/source/algorithm/spt_main_alg_mod.x90 b/interfaces/physics_schemes_interface/source/algorithm/spt_main_alg_mod.x90 index 0f61d1267..580abf7e6 100644 --- a/interfaces/physics_schemes_interface/source/algorithm/spt_main_alg_mod.x90 +++ b/interfaces/physics_schemes_interface/source/algorithm/spt_main_alg_mod.x90 @@ -16,9 +16,8 @@ module spt_main_alg_mod use field_collection_mod, only: field_collection_type use mesh_mod, only: mesh_type ! for IO and timers - use io_config_mod, only: write_diag, use_xios_io, & - subroutine_timers - use timer_mod, only: timer + use io_config_mod, only: write_diag, use_xios_io + use timing_mod, only: start_timing, stop_timing, tik, LPROF ! load modules to set up the W0 space for 1-2-1 filtering ! wtheta -> w0 bottom DoF -> wtheta use function_space_collection_mod, only: function_space_collection @@ -222,8 +221,10 @@ module spt_main_alg_mod real(kind=r_def) :: mlcrcp ! iterators in for loops integer(i_def) :: n,n_row, m + ! Timing handle + integer(tik) :: id - if ( subroutine_timers ) call timer("spt_main_alg") + if ( LPROF ) call start_timing( id, 'spt_main_alg' ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! 1) Create Forcing pattern || @@ -490,7 +491,7 @@ module spt_main_alg_mod call dmv_spt%write_field('stochastic__dmv_spt') end if - if ( subroutine_timers ) call timer("spt_main_alg") + if ( LPROF ) call stop_timing( id, 'spt_main_alg' ) end subroutine spt_main_alg end module spt_main_alg_mod diff --git a/interfaces/physics_schemes_interface/source/algorithm/stph_fp_main_alg_mod.x90 b/interfaces/physics_schemes_interface/source/algorithm/stph_fp_main_alg_mod.x90 index c0a1f2ff1..f42861932 100644 --- a/interfaces/physics_schemes_interface/source/algorithm/stph_fp_main_alg_mod.x90 +++ b/interfaces/physics_schemes_interface/source/algorithm/stph_fp_main_alg_mod.x90 @@ -14,8 +14,7 @@ module stph_fp_main_alg_mod use fs_continuity_mod, only: W3 use mesh_mod, only: mesh_type use mesh_collection_mod, only: mesh_collection - use io_config_mod, only: subroutine_timers - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, tik, LPROF use level_heights_mod, only: eta_theta_levels use extrusion_config_mod, only: domain_height @@ -117,7 +116,10 @@ module stph_fp_main_alg_mod integer(i_def) :: fs_id ! iterators in for loops integer(kind=i_def) :: n, m, n_row, k - if ( subroutine_timers ) call timer("stph_fp_main_alg") + ! Timing handle + integer(tik) :: id + + if ( LPROF ) call start_timing( id, 'stph_fp_main_alg' ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !! 1) Apply the First Auto-regressive process (1AR) !! @@ -203,7 +205,7 @@ module stph_fp_main_alg_mod level_bottom, level_top, & wavenumber_min, wavenumber_max) - if ( subroutine_timers ) call timer("stph_fp_main_alg") + if ( LPROF ) call stop_timing( id, 'stph_fp_main_alg' ) end subroutine stph_fp_main_alg diff --git a/interfaces/physics_schemes_interface/source/algorithm/stph_main_alg_mod.x90 b/interfaces/physics_schemes_interface/source/algorithm/stph_main_alg_mod.x90 index 9d4cb3631..a111b7dbd 100644 --- a/interfaces/physics_schemes_interface/source/algorithm/stph_main_alg_mod.x90 +++ b/interfaces/physics_schemes_interface/source/algorithm/stph_main_alg_mod.x90 @@ -14,9 +14,8 @@ module stph_main_alg_mod use clock_mod, only: clock_type use field_collection_mod, only: field_collection_type ! xios output and timers - use io_config_mod, only: write_diag, use_xios_io, & - subroutine_timers - use timer_mod, only: timer + use io_config_mod, only: write_diag, use_xios_io + use timing_mod, only: start_timing, stop_timing, tik, LPROF implicit none @@ -78,7 +77,10 @@ module stph_main_alg_mod ! classes class(clock_type), intent(in) :: clock - if ( subroutine_timers ) call timer("stph_main_alg") + ! Timing handle + integer(tik) :: id + + if ( LPROF ) call start_timing( id, 'stph_main_alg' ) call invoke(setval_c(du_stph, 0.0_r_def), & setval_c(dtheta_stph, 0.0_r_def), & @@ -97,7 +99,7 @@ module stph_main_alg_mod call skeb_main_alg(du_stph, rho, u, convection_fields, derived_fields,clock) end if - if ( subroutine_timers ) call timer("stph_main_alg") + if ( LPROF ) call stop_timing( id, 'stph_main_alg' ) end subroutine stph_main_alg end module stph_main_alg_mod diff --git a/interfaces/physics_schemes_interface/source/algorithm/strat_aerosol_alg_mod.x90 b/interfaces/physics_schemes_interface/source/algorithm/strat_aerosol_alg_mod.x90 index 277d9b22e..b249a359c 100644 --- a/interfaces/physics_schemes_interface/source/algorithm/strat_aerosol_alg_mod.x90 +++ b/interfaces/physics_schemes_interface/source/algorithm/strat_aerosol_alg_mod.x90 @@ -12,8 +12,7 @@ use field_mod, only: field_type use integer_field_mod, only: integer_field_type use field_collection_mod, only: field_collection_type use strat_aerosol_kernel_mod, only: strat_aerosol_kernel_type -use io_config_mod, only: subroutine_timers -use timer_mod, only: timer +use timing_mod, only: start_timing, stop_timing, tik, LPROF use function_space_mod, only: function_space_type use function_space_collection_mod, & only: function_space_collection @@ -47,8 +46,9 @@ subroutine strat_aerosol_alg( aerosol_fields, trop_level, exner ) type( field_type ) :: sulphuric_aero type(function_space_type), pointer :: wth_aero => null() type(mesh_type), pointer :: aerosol_mesh => null() - - if ( subroutine_timers ) call timer("strat_aerosol_alg") + integer(tik) :: id + + if ( LPROF ) call start_timing( id, 'strat_aerosol_alg' ) if (coarse_rad_aerosol) then ! Initialise potentially coarse aerosol field @@ -63,7 +63,7 @@ subroutine strat_aerosol_alg( aerosol_fields, trop_level, exner ) call invoke( strat_aerosol_kernel_type( sulphuric, trop_level, exner ) ) end if - if ( subroutine_timers ) call timer("strat_aerosol_alg") + if ( LPROF ) call stop_timing( id, 'strat_aerosol_alg' ) end subroutine strat_aerosol_alg end module strat_aerosol_alg_mod diff --git a/interfaces/physics_schemes_interface/source/algorithm/surf_temp_forcing_alg_mod.x90 b/interfaces/physics_schemes_interface/source/algorithm/surf_temp_forcing_alg_mod.x90 index 7cdb2be82..c8f97bcb6 100644 --- a/interfaces/physics_schemes_interface/source/algorithm/surf_temp_forcing_alg_mod.x90 +++ b/interfaces/physics_schemes_interface/source/algorithm/surf_temp_forcing_alg_mod.x90 @@ -9,12 +9,11 @@ module surf_temp_forcing_alg_mod use field_mod, only: field_type use field_collection_mod, only: field_collection_type -use io_config_mod, only: subroutine_timers use log_mod, only: log_event, & LOG_LEVEL_DEBUG, & LOG_LEVEL_WARNING, & LOG_LEVEL_ERROR -use timer_mod, only: timer +use timing_mod, only: start_timing, stop_timing, tik, LPROF use specified_surface_config_mod, only: surf_temp_forcing, & surf_temp_forcing_none, & surf_temp_forcing_int_flux @@ -47,8 +46,9 @@ contains type( field_type ), pointer :: sw_up_tile type( field_type ), pointer :: internal_flux type( field_type ), pointer :: tile_temperature + integer( tik ) :: id - if ( subroutine_timers ) call timer('surf_temp_forcing_alg') + if ( LPROF ) call start_timing( id, 'surf_temp_forcing_alg' ) if (surf_temp_forcing /= surf_temp_forcing_none) then @@ -82,7 +82,7 @@ contains end select end if - if ( subroutine_timers ) call timer('surf_temp_forcing_alg') + if ( LPROF ) call stop_timing( id, 'surf_temp_forcing_alg' ) end subroutine surf_temp_forcing_alg end module surf_temp_forcing_alg_mod diff --git a/interfaces/physics_schemes_interface/source/diagnostics/bl_exp_diags_mod.f90 b/interfaces/physics_schemes_interface/source/diagnostics/bl_exp_diags_mod.f90 index 610bfd7c8..7e5d8467c 100644 --- a/interfaces/physics_schemes_interface/source/diagnostics/bl_exp_diags_mod.f90 +++ b/interfaces/physics_schemes_interface/source/diagnostics/bl_exp_diags_mod.f90 @@ -10,8 +10,7 @@ module bl_exp_diags_mod use constants_mod, only: l_def use field_mod, only: field_type use integer_field_mod, only: integer_field_type - use io_config_mod, only: subroutine_timers - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, tik, LPROF use initialise_diagnostics_mod, only : init_diag => init_diagnostic_field implicit none @@ -35,13 +34,14 @@ subroutine initialise_diags_for_bl_exp(zht, oblen) type( field_type ), intent(inout) :: zht type( field_type ), intent(inout) :: oblen + integer( tik ) :: id - if ( subroutine_timers ) call timer("bl_exp_diags") + if ( LPROF ) call start_timing( id, 'bl_exp_diags' ) zht_flag = init_diag(zht, 'turbulence__zht') oblen_flag = init_diag(oblen, 'turbulence__oblen') - if ( subroutine_timers ) call timer("bl_exp_diags") + if ( LPROF ) call stop_timing( id, 'bl_exp_diags' ) end subroutine initialise_diags_for_bl_exp @@ -90,9 +90,9 @@ subroutine output_diags_for_bl_exp(ntml, cumulus, bl_type_ind, & ent_zrzi_dsc, oblen, bl_weight_1dbl type(integer_field_type), intent(in) :: level_ent, level_ent_dsc, ntml, & cumulus, bl_type_ind + integer( tik ) :: id - - if ( subroutine_timers ) call timer("bl_exp_diags") + if ( LPROF ) call start_timing( id, 'bl_exp_diags' ) ! Prognostic fields from turbulence collection call ntml%write_field('turbulence__ntml') @@ -121,7 +121,7 @@ subroutine output_diags_for_bl_exp(ntml, cumulus, bl_type_ind, & if (zht_flag) call zht%write_field() if (oblen_flag) call oblen%write_field() - if ( subroutine_timers ) call timer("bl_exp_diags") + if ( LPROF ) call stop_timing( id, 'bl_exp_diags' ) end subroutine output_diags_for_bl_exp end module bl_exp_diags_mod diff --git a/interfaces/physics_schemes_interface/source/diagnostics/bl_imp_diags_mod.x90 b/interfaces/physics_schemes_interface/source/diagnostics/bl_imp_diags_mod.x90 index bc09f3632..cd88eeabe 100644 --- a/interfaces/physics_schemes_interface/source/diagnostics/bl_imp_diags_mod.x90 +++ b/interfaces/physics_schemes_interface/source/diagnostics/bl_imp_diags_mod.x90 @@ -11,8 +11,7 @@ module bl_imp_diags_mod use field_mod, only: field_type use bl_extra_diags_kernel_mod, only: bl_extra_diags_kernel_type use physics_mappings_alg_mod, only: map_physics_winds - use io_config_mod, only: subroutine_timers - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, tik, LPROF use initialise_diagnostics_mod, only : init_diag => init_diagnostic_field, & samp_diag => diagnostic_to_be_sampled @@ -110,8 +109,9 @@ contains ! are mapped from tau_w2 by map_physics_winds (to w3) in bl_imp_alg type( field_type ), intent(inout) :: taux, tauy type( field_type ), intent(inout) :: ustar_implicit + integer( tik ) :: id - if ( subroutine_timers ) call timer("bl_imp_diags") + if ( LPROF ) call start_timing( id, 'bl_imp_diags' ) ! Genuine turbulence diagnostics ! 3D fields in wtheta space @@ -147,7 +147,7 @@ contains tauy_flag = init_diag(tauy, 'turbulence__tauy', activate=.true.) ustar_implicit_flag = init_diag(ustar_implicit, 'surface__ustar_implicit', activate=.true.) - if ( subroutine_timers ) call timer("bl_imp_diags") + if ( LPROF ) call stop_timing( id, 'bl_imp_diags' ) end subroutine initialise_diags_for_bl_imp @@ -282,8 +282,9 @@ contains type( field_type ) :: pseudotaux, pseudotauy logical( l_def ) :: ignore + integer( tik ) :: id - if ( subroutine_timers ) call timer("bl_imp_diags") + if ( LPROF ) call start_timing( id, 'bl_imp_diags' ) ! Output prognostic fields if (samp_diag('aerosol__murk')) call murk%write_field('aerosol__murk') @@ -449,7 +450,7 @@ contains if (dew_point_land_flag) call dew_point_land%write_field() end if - if ( subroutine_timers ) call timer("bl_imp_diags") + if ( LPROF ) call stop_timing( id, 'bl_imp_diags' ) end subroutine output_diags_for_bl_imp end module bl_imp_diags_mod diff --git a/interfaces/physics_schemes_interface/source/diagnostics/casim_diagnostics_mod.x90 b/interfaces/physics_schemes_interface/source/diagnostics/casim_diagnostics_mod.x90 index 1ab0e890d..ddfb87577 100644 --- a/interfaces/physics_schemes_interface/source/diagnostics/casim_diagnostics_mod.x90 +++ b/interfaces/physics_schemes_interface/source/diagnostics/casim_diagnostics_mod.x90 @@ -9,8 +9,7 @@ module casim_diagnostics_mod use constants_mod, only: l_def use field_mod, only: field_type - use io_config_mod, only: subroutine_timers - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, tik, LPROF use initialise_diagnostics_mod, only: init_diag => init_diagnostic_field @@ -54,8 +53,9 @@ contains type( field_type ), intent(inout) :: superc_liq type( field_type ), intent(inout) :: superc_rain type( field_type ), intent(inout) :: ls_graup_3d + integer( tik ) :: id - if ( subroutine_timers ) call timer("casim_diagnostics") + if ( LPROF ) call start_timing( id, 'casim_diagnostics' ) refl_tot_flag = init_diag(refl_tot, 'microphysics__refl_tot') refl_1km_flag = init_diag(refl_1km, 'microphysics__refl_1km') @@ -63,7 +63,7 @@ contains superc_rain_flag = init_diag(superc_rain, 'microphysics__superc_rain') ls_graup_3d_flag = init_diag(ls_graup_3d, 'microphysics__ls_graup_3d') - if ( subroutine_timers ) call timer("casim_diagnostics") + if ( LPROF ) call stop_timing( id, 'casim_diagnostics' ) end subroutine initialise_diags_for_casim @@ -95,11 +95,11 @@ contains superc_liq, superc_rain type ( field_type ) :: dt_mphys - + integer(tik) :: id !-------------------------------------- ! End of declarations !-------------------------------------- - if ( subroutine_timers ) call timer ("casim_diagnostics") + if ( LPROF ) call start_timing( id, 'casim_diagnostics' ) !---------------------------------------------------- @@ -170,7 +170,7 @@ contains call ns_mphys%write_field('casim__ns_mphys') call ng_mphys%write_field('casim__ng_mphys') - if ( subroutine_timers ) call timer ("casim_diagnostics") + if ( LPROF ) call stop_timing( id, 'casim_diagnostics' ) end subroutine output_diags_for_casim diff --git a/interfaces/physics_schemes_interface/source/diagnostics/cld_diags_mod.x90 b/interfaces/physics_schemes_interface/source/diagnostics/cld_diags_mod.x90 index 295a1425d..d1f026abd 100644 --- a/interfaces/physics_schemes_interface/source/diagnostics/cld_diags_mod.x90 +++ b/interfaces/physics_schemes_interface/source/diagnostics/cld_diags_mod.x90 @@ -16,8 +16,7 @@ module cld_diags_mod use field_collection_mod, only: field_collection_type use field_collection_iterator_mod, & only: field_collection_iterator_type - use io_config_mod, only: subroutine_timers - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, tik, LPROF use sci_geometric_constants_mod, & only: get_height_fv use cloud_config_mod, only: filter_optical_depth, opt_depth_thresh @@ -64,8 +63,9 @@ contains ! Diagnostic fields to initialise type( field_type ), intent(inout) :: sskew_bm, svar_bm, svar_tb logical(l_def), intent(in) :: call_b4_conv + integer(tik) :: id - if ( subroutine_timers ) call timer("cld_diags") + if ( LPROF ) call start_timing( id, 'cld_diags' ) if (call_b4_conv) then ! No diagnostics output in mid-timestep call @@ -79,7 +79,7 @@ contains svar_tb_flag = init_diag(svar_tb, 'cloud__svar_tb') end if - if ( subroutine_timers ) call timer("cld_diags") + if ( LPROF ) call stop_timing( id, 'cld_diags' ) end subroutine initialise_diags_for_cld @@ -146,8 +146,9 @@ contains class( field_parent_type ), pointer :: field_ptr => null() character(str_def) :: name logical( l_def ) :: ignore + integer( tik ) :: id - if ( subroutine_timers ) call timer("cld_diags") + if ( LPROF ) call start_timing( id, 'cld_diags' ) ! 2D fields cld_amount_max_flag = init_diag(cld_amount_max, 'cloud__cloud_amount_max') @@ -366,7 +367,7 @@ contains if (cloud_fraction_below_1000feet_asl_flag) call & cloud_fraction_below_1000feet_asl%write_field() - if ( subroutine_timers ) call timer("cld_diags") + if ( LPROF ) call stop_timing( id, 'cld_diags' ) end subroutine output_diags_for_cld end module cld_diags_mod diff --git a/interfaces/physics_schemes_interface/source/diagnostics/comorph_diags_mod.x90 b/interfaces/physics_schemes_interface/source/diagnostics/comorph_diags_mod.x90 index 29a6a8af8..d6343f5b7 100644 --- a/interfaces/physics_schemes_interface/source/diagnostics/comorph_diags_mod.x90 +++ b/interfaces/physics_schemes_interface/source/diagnostics/comorph_diags_mod.x90 @@ -9,8 +9,7 @@ module comorph_diags_mod use constants_mod, only: l_def use field_mod, only: field_type - use io_config_mod, only: subroutine_timers - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, tik, LPROF use initialise_diagnostics_mod, only : init_diag & => init_diagnostic_field @@ -70,8 +69,9 @@ contains detrain_up, & detrain_down, & massflux_up_half + integer(tik) :: id - if ( subroutine_timers ) call timer("comorph_diags") + if ( LPROF ) call start_timing( id, 'comorph_diags' ) ! Convective diagnostics - 2d lowest_cv_base_flag = init_diag(lowest_cv_base, 'convection__lowest_cv_base') @@ -105,7 +105,7 @@ contains massflux_up_half_flag = init_diag(massflux_up_half, 'convection__massflux_up_half') - if ( subroutine_timers ) call timer("comorph_diags") + if ( LPROF ) call stop_timing( id, 'comorph_diags' ) end subroutine initialise_diags_for_comorph @@ -183,8 +183,9 @@ contains detrain_up, & detrain_down, & massflux_up_half + integer(tik) :: id - if ( subroutine_timers ) call timer("comorph_diags") + if ( LPROF ) call start_timing( id, 'comorph_diags' ) ! Prognostic fields call cca%write_field('convection__cca') @@ -230,7 +231,7 @@ contains if (detrain_down_flag) call detrain_down%write_field() if (massflux_up_half_flag) call massflux_up_half%write_field() - if ( subroutine_timers ) call timer("comorph_diags") + if ( LPROF ) call stop_timing( id, 'comorph_diags' ) end subroutine output_diags_for_comorph end module comorph_diags_mod diff --git a/interfaces/physics_schemes_interface/source/diagnostics/conv_diags_mod.x90 b/interfaces/physics_schemes_interface/source/diagnostics/conv_diags_mod.x90 index 28b637aa0..1d06d96e8 100644 --- a/interfaces/physics_schemes_interface/source/diagnostics/conv_diags_mod.x90 +++ b/interfaces/physics_schemes_interface/source/diagnostics/conv_diags_mod.x90 @@ -9,8 +9,7 @@ module conv_diags_mod use constants_mod, only: l_def use field_mod, only: field_type - use io_config_mod, only: subroutine_timers - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, tik, LPROF use initialise_diagnostics_mod, only : init_diag & => init_diagnostic_field @@ -159,8 +158,9 @@ contains dmv_conv_noshal logical(l_def) :: ignore + integer(tik) :: id - if ( subroutine_timers ) call timer("conv_diags") + if ( LPROF ) call start_timing( id, 'conv_diags' ) ! Convective diagnostics - 2d deep_in_col_flag = init_diag(deep_in_col, 'convection__deep_in_col') @@ -302,7 +302,7 @@ contains call invoke( setval_c(shallow_in_col, 0.0_r_def) ) end if - if ( subroutine_timers ) call timer("conv_diags") + if ( LPROF ) call stop_timing( id, 'conv_diags' ) end subroutine initialise_diags_for_conv @@ -434,8 +434,9 @@ contains cca_unadjusted, & dth_conv_noshal, & dmv_conv_noshal + integer( tik ) :: id - if ( subroutine_timers ) call timer("conv_diags") + if ( LPROF ) call start_timing( id, 'conv_diags' ) ! Prognostic fields call cca%write_field('convection__cca') @@ -507,7 +508,7 @@ contains if (dth_conv_noshal_flag) call dth_conv_noshal%write_field() if (dmv_conv_noshal_flag) call dmv_conv_noshal%write_field() - if ( subroutine_timers ) call timer("conv_diags") + if ( LPROF ) call stop_timing( id, 'conv_diags' ) end subroutine output_diags_for_conv end module conv_diags_mod diff --git a/interfaces/physics_schemes_interface/source/diagnostics/electric_main_diags_mod.x90 b/interfaces/physics_schemes_interface/source/diagnostics/electric_main_diags_mod.x90 index f40ea91a1..34513b63b 100644 --- a/interfaces/physics_schemes_interface/source/diagnostics/electric_main_diags_mod.x90 +++ b/interfaces/physics_schemes_interface/source/diagnostics/electric_main_diags_mod.x90 @@ -10,8 +10,7 @@ module electric_main_diags_mod use constants_mod, only: l_def use field_mod, only: field_type - use io_config_mod, only: subroutine_timers - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, tik, LPROF use initialise_diagnostics_mod, only: init_diag => init_diagnostic_field implicit none @@ -43,11 +42,12 @@ contains type( field_type ), intent(inout) :: fr1_mc type( field_type ), intent(inout) :: fr2_mc type( field_type ), intent(inout) :: storm_field + integer( tik ) :: id !---------------------------------------------------- ! End of declarations; start of subroutine execution !---------------------------------------------------- - if ( subroutine_timers ) call timer("electric_diags") + if ( LPROF ) call start_timing( id, 'electric_diags' ) gwp_flag = init_diag(gwp, 'electric__gwp') tiwp_flag = init_diag(tiwp, 'electric__tiwp') @@ -56,7 +56,7 @@ contains fr2_mc_flag = init_diag(fr2_mc, 'electric__total_column_ice_flash_rate') storm_field_flag = init_diag(storm_field, 'electric__storm_field_indicator') - if ( subroutine_timers ) call timer("electric_diags") + if ( LPROF ) call stop_timing( id, 'electric_diags' ) end subroutine initialise_main_diags_for_electric @@ -85,10 +85,12 @@ contains ! Prognostic field to be output type( field_type), intent(in) :: flash_potential + integer(tik) :: id + !---------------------------------------------------- ! End of declarations; start of subroutine execution !---------------------------------------------------- - if ( subroutine_timers ) call timer("electric_diags") + if ( LPROF ) call start_timing( id, 'electric_diags' ) call flash_potential%write_field('electric__flash_potential') call num_flashes%write_field('electric__num_lightning_flashes') @@ -100,6 +102,6 @@ contains if (fr2_mc_flag) call fr2_mc%write_field() if (storm_field_flag) call storm_field%write_field() - if ( subroutine_timers ) call timer("electric_diags") + if ( LPROF ) call stop_timing( id, 'electric_diags' ) end subroutine output_main_diags_for_electric end module electric_main_diags_mod diff --git a/interfaces/physics_schemes_interface/source/diagnostics/mphys_diagnostics_mod.x90 b/interfaces/physics_schemes_interface/source/diagnostics/mphys_diagnostics_mod.x90 index ef0c0386f..3be62c05e 100644 --- a/interfaces/physics_schemes_interface/source/diagnostics/mphys_diagnostics_mod.x90 +++ b/interfaces/physics_schemes_interface/source/diagnostics/mphys_diagnostics_mod.x90 @@ -9,8 +9,7 @@ module mphys_diagnostics_mod use constants_mod, only: l_def use field_mod, only: field_type - use io_config_mod, only: subroutine_timers - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, tik, LPROF use initialise_diagnostics_mod, only : init_diag => init_diagnostic_field @@ -60,8 +59,9 @@ contains type( field_type ), intent(inout) :: sfsnow type( field_type ), intent(inout) :: refl_tot type( field_type ), intent(inout) :: refl_1km + integer( tik ) :: id - if ( subroutine_timers ) call timer("mphys_diagnostics") + if ( LPROF ) call start_timing( id, 'mphys_diagnostics' ) superc_liq_flag = init_diag(superc_liq, 'microphysics__superc_liq') superc_rain_flag = init_diag(superc_rain, 'microphysics__superc_rain') @@ -71,7 +71,7 @@ contains refl_tot_flag = init_diag(refl_tot, 'microphysics__refl_tot') refl_1km_flag = init_diag(refl_1km, 'microphysics__refl_1km') - if ( subroutine_timers ) call timer("mphys_diagnostics") + if ( LPROF ) call stop_timing( id, 'mphys_diagnostics' ) end subroutine @@ -125,11 +125,12 @@ contains refl_1km type ( field_type ) :: dt_mphys + integer( tik ) :: id !-------------------------------------- ! End of declarations !-------------------------------------- - if ( subroutine_timers ) call timer ("mphys_diagnostics") + if ( LPROF ) call start_timing( id, 'mphys_diagnostics' ) !-------------------------------------- ! Output locally computed 3D diagnostics @@ -194,7 +195,7 @@ contains call tnuc%write_field('microphysics__tnuc') - if ( subroutine_timers ) call timer ("mphys_diagnostics") + if ( LPROF ) call stop_timing( id, 'mphys_diagnostics' ) end subroutine output_diags_for_mphys diff --git a/interfaces/physics_schemes_interface/source/diagnostics/orographic_drag_diags_mod.x90 b/interfaces/physics_schemes_interface/source/diagnostics/orographic_drag_diags_mod.x90 index 943e49d6f..a1d402979 100644 --- a/interfaces/physics_schemes_interface/source/diagnostics/orographic_drag_diags_mod.x90 +++ b/interfaces/physics_schemes_interface/source/diagnostics/orographic_drag_diags_mod.x90 @@ -9,8 +9,7 @@ module orographic_drag_diags_mod use constants_mod, only: l_def use field_mod, only: field_type - use io_config_mod, only: subroutine_timers - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, tik, LPROF use initialise_diagnostics_mod, only : init_diag => init_diagnostic_field @@ -48,8 +47,9 @@ contains type( field_type ), intent(inout) :: & taux_orog_blk, tauy_orog_blk, & taux_orog_gwd, tauy_orog_gwd + integer( tik ) :: id - if ( subroutine_timers ) call timer("orographic_drag_diags") + if ( LPROF ) call start_timing( id, 'orographic_drag_diags' ) ! 3D fields in wtheta space taux_orog_blk_flag = init_diag(taux_orog_blk, 'orographic_drag__taux_orog_blk') @@ -61,7 +61,7 @@ contains tauy_orog_gwd_flag = init_diag(tauy_orog_gwd, 'orographic_drag__tauy_orog_gwd') if (tauy_orog_gwd_flag) call invoke( setval_c(tauy_orog_gwd, 0.0_r_def) ) - if ( subroutine_timers ) call timer("orographic_drag_diags") + if ( LPROF ) call stop_timing( id, 'orographic_drag_diags' ) end subroutine initialise_diags_for_orographic_drag @@ -79,8 +79,9 @@ contains dtheta_orographic_drag, du_orog_blk, dv_orog_blk, dtemp_orog_blk, & du_orog_gwd, dv_orog_gwd, dtemp_orog_gwd, & taux_orog_blk, tauy_orog_blk, taux_orog_gwd, tauy_orog_gwd + integer( tik ) :: id - if ( subroutine_timers ) call timer("orographic_drag_diags") + if ( LPROF ) call start_timing( id, 'orographic_drag_diags' ) ! Prognostic fields call du_orographic_drag%write_field('orographic_drag__du_orographic_drag') @@ -100,7 +101,7 @@ contains if (taux_orog_gwd_flag) call taux_orog_gwd%write_field() if (tauy_orog_gwd_flag) call tauy_orog_gwd%write_field() - if ( subroutine_timers ) call timer("orographic_drag_diags") + if ( LPROF ) call stop_timing( id, 'orographic_drag_diags' ) end subroutine output_diags_for_orographic_drag end module orographic_drag_diags_mod diff --git a/interfaces/physics_schemes_interface/source/diagnostics/radaer_diags_mod.x90 b/interfaces/physics_schemes_interface/source/diagnostics/radaer_diags_mod.x90 index f1afe99a3..2076fd65f 100644 --- a/interfaces/physics_schemes_interface/source/diagnostics/radaer_diags_mod.x90 +++ b/interfaces/physics_schemes_interface/source/diagnostics/radaer_diags_mod.x90 @@ -11,8 +11,7 @@ module radaer_main_diags_mod use constants_mod, only: l_def use integer_field_mod, only: integer_field_type use field_mod, only: field_type - use io_config_mod, only: subroutine_timers - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, tik, LPROF use initialise_diagnostics_mod, only: init_diag => init_diagnostic_field use mesh_mod, only: mesh_type @@ -77,12 +76,13 @@ contains type( integer_field_type ), intent(in) :: trop_level type(mesh_type), pointer :: mesh => null() + integer( tik ) :: id !---------------------------------------------------- ! End of declarations; start of subroutine execution !---------------------------------------------------- - if ( subroutine_timers ) call timer("radaer_diags") + if ( LPROF ) call start_timing( id, 'radaer_diags' ) ! Get 2D mesh from trop level field mesh => trop_level%get_mesh() @@ -183,7 +183,7 @@ contains call invoke(setval_c( aaod_ukca_cor_ins, 0.0_r_def)) end if - if ( subroutine_timers ) call timer("radaer_diags") + if ( LPROF ) call stop_timing( id, 'radaer_diags' ) end subroutine initialise_main_diags_for_radaer @@ -222,11 +222,11 @@ contains aod_ukca_ait_ins, aaod_ukca_ait_ins, & aod_ukca_acc_ins, aaod_ukca_acc_ins, & aod_ukca_cor_ins, aaod_ukca_cor_ins - + integer( tik ) :: id !---------------------------------------------------- ! End of declarations; start of subroutine execution !---------------------------------------------------- - if ( subroutine_timers ) call timer("radaer_diags") + if ( LPROF ) call start_timing( id, 'radaer_diags' ) if (aod_ukca_ait_sol_flag) call aod_ukca_ait_sol%write_field() if (aaod_ukca_ait_sol_flag) call aaod_ukca_ait_sol%write_field() @@ -241,6 +241,6 @@ contains if (aod_ukca_cor_ins_flag) call aod_ukca_cor_ins%write_field() if (aaod_ukca_cor_ins_flag) call aaod_ukca_cor_ins%write_field() - if ( subroutine_timers ) call timer("radaer_diags") + if ( LPROF ) call stop_timing( id, 'radaer_diags' ) end subroutine output_main_diags_for_radaer end module radaer_main_diags_mod \ No newline at end of file diff --git a/interfaces/physics_schemes_interface/source/diagnostics/spectral_gwd_diags_mod.x90 b/interfaces/physics_schemes_interface/source/diagnostics/spectral_gwd_diags_mod.x90 index 4b44eb884..787867718 100644 --- a/interfaces/physics_schemes_interface/source/diagnostics/spectral_gwd_diags_mod.x90 +++ b/interfaces/physics_schemes_interface/source/diagnostics/spectral_gwd_diags_mod.x90 @@ -9,8 +9,7 @@ module spectral_gwd_diags_mod use constants_mod, only: l_def use field_mod, only: field_type - use io_config_mod, only: subroutine_timers - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, tik, LPROF use initialise_diagnostics_mod, only : init_diag => init_diagnostic_field @@ -47,8 +46,9 @@ contains type( field_type ), intent(inout) :: & tau_east_spectral_gwd, tau_south_spectral_gwd, & tau_west_spectral_gwd, tau_north_spectral_gwd + integer( tik ) :: id - if ( subroutine_timers ) call timer("spectral_gwd_diags") + if ( LPROF ) call start_timing( id, 'spectral_gwd_diags' ) ! 3D fields in wtheta space tau_east_spectral_gwd_flag = init_diag(tau_east_spectral_gwd, 'spectral_gwd__tau_east_spectral_gwd') @@ -56,7 +56,7 @@ contains tau_west_spectral_gwd_flag = init_diag(tau_west_spectral_gwd, 'spectral_gwd__tau_west_spectral_gwd') tau_north_spectral_gwd_flag = init_diag(tau_north_spectral_gwd, 'spectral_gwd__tau_north_spectral_gwd') - if ( subroutine_timers ) call timer("spectral_gwd_diags") + if ( LPROF ) call stop_timing( id, 'spectral_gwd_diags' ) end subroutine initialise_diags_for_spectral_gwd @@ -74,8 +74,9 @@ contains dtheta_spectral_gwd, tau_east_spectral_gwd, & tau_south_spectral_gwd, tau_west_spectral_gwd, & tau_north_spectral_gwd + integer( tik ) :: id - if ( subroutine_timers ) call timer("spectral_gwd_diags") + if ( LPROF ) call start_timing( id, 'spectral_gwd_diags' ) ! Prognostic fields call du_spectral_gwd%write_field('spectral_gwd__du_spectral_gwd') @@ -89,7 +90,7 @@ contains if (tau_west_spectral_gwd_flag) call tau_west_spectral_gwd%write_field() if (tau_north_spectral_gwd_flag) call tau_north_spectral_gwd%write_field() - if ( subroutine_timers ) call timer("spectral_gwd_diags") + if ( LPROF ) call stop_timing( id, 'spectral_gwd_diags' ) end subroutine output_diags_for_spectral_gwd end module spectral_gwd_diags_mod diff --git a/interfaces/socrates_interface/source/algorithm/cosp_alg_mod.x90 b/interfaces/socrates_interface/source/algorithm/cosp_alg_mod.x90 index 369cf04a5..b11f66429 100644 --- a/interfaces/socrates_interface/source/algorithm/cosp_alg_mod.x90 +++ b/interfaces/socrates_interface/source/algorithm/cosp_alg_mod.x90 @@ -14,14 +14,14 @@ use fs_continuity_mod, only: W3, Wtheta use sci_geometric_constants_mod, & only: get_height_fv use integer_field_mod, only: integer_field_type -use io_config_mod, only: write_diag, use_xios_io, subroutine_timers +use io_config_mod, only: write_diag, use_xios_io use mesh_mod, only: mesh_type use mphys_inputs_mod, only: x1r, x2r use mphys_psd_mod, only: x1g, x2g, x4g use microphysics_config_mod, only: microphysics_casim use mr_indices_mod, only: nummr, imr_v, imr_cl, imr_s, imr_ci use planet_config_mod, only: p_zero, kappa -use timer_mod, only: timer +use timing_mod, only: start_timing, stop_timing, tik, LPROF use log_mod, only: log_event, LOG_LEVEL_INFO use cosp_config_mod, only: n_subcol_gen @@ -89,6 +89,7 @@ subroutine cosp_alg(pressure_in_wth, temperature_in_wth, exner, mr, & type( field_type ) :: pressure_in_w3, mr_ice, n_ice real( r_def ) :: inv_kappa real( r_def ) :: cosp_x1r, cosp_x2r, cosp_x1g, cosp_x2g, cosp_x4g + integer( tik ) :: id ! Unpacked fields from collections type( field_type ), pointer :: rho_in_wth => null() @@ -189,7 +190,7 @@ subroutine cosp_alg(pressure_in_wth, temperature_in_wth, exner, mr, & cloud_thermal_absorptivity, cloud_solar_extinction) ! Run COSP - if ( subroutine_timers ) call timer("cosp") + if ( LPROF ) call start_timing( id, 'cosp' ) call invoke( cosp_kernel_type( & pressure_in_wth, temperature_in_wth, rho_in_wth, height_wth, & pressure_in_w3, height_w3, & @@ -216,7 +217,7 @@ subroutine cosp_alg(pressure_in_wth, temperature_in_wth, exner, mr, & calipso_total_backscatter, & calipso_cfad_sr_40_lvls, & cloud_thermal_absorptivity, cloud_solar_extinction ) ) - if ( subroutine_timers ) call timer("cosp") + if ( LPROF ) call stop_timing( id, 'cosp' ) ! Output diagnostics if (write_diag .and. use_xios_io) then diff --git a/interfaces/socrates_interface/source/algorithm/cosp_diags_mod.x90 b/interfaces/socrates_interface/source/algorithm/cosp_diags_mod.x90 index 59448ec4e..9980ecac1 100644 --- a/interfaces/socrates_interface/source/algorithm/cosp_diags_mod.x90 +++ b/interfaces/socrates_interface/source/algorithm/cosp_diags_mod.x90 @@ -10,9 +10,8 @@ module cosp_diags_mod use constants_mod, only: l_def use cosp_config_mod, only: l_cosp use field_mod, only: field_type - use io_config_mod, only: subroutine_timers use log_mod, only: log_event, LOG_LEVEL_INFO - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, tik, LPROF use initialise_diagnostics_mod, only: init_diag => init_diagnostic_field, & diagnostic_to_be_sampled @@ -144,8 +143,9 @@ subroutine initialise_diags_for_cosp( & calipso_cf_40_lvls_undet, & calipso_cf_40_lvls_mask, & cloud_thermal_absorptivity, cloud_solar_extinction + integer(tik) :: id - if ( subroutine_timers ) call timer("cosp_diags") + if ( LPROF ) call start_timing( id, 'cosp_diags' ) sunlit_mask_flag = init_diag( sunlit_mask, & 'cosp__sunlit_mask' ) @@ -180,7 +180,7 @@ subroutine initialise_diags_for_cosp( & cloud_solar_extinction_flag = init_diag( cloud_solar_extinction, & 'cosp__cloud_solar_extinction' ) - if ( subroutine_timers ) call timer("cosp_diags") + if ( LPROF ) call stop_timing( id, 'cosp_diags' ) end subroutine initialise_diags_for_cosp @@ -231,8 +231,9 @@ subroutine output_diags_for_cosp( & calipso_cf_40_lvls_undet, & calipso_cf_40_lvls_mask, & cloud_thermal_absorptivity, cloud_solar_extinction + integer(tik) :: id - if ( subroutine_timers ) call timer("cosp_diags") + if ( LPROF ) call start_timing( id, 'cosp_diags' ) ! Diagnostics computed within the kernels if (sunlit_mask_flag) call & @@ -284,7 +285,7 @@ subroutine output_diags_for_cosp( & cloud_solar_extinction%write_field( & cloud_solar_extinction%get_name() ) - if ( subroutine_timers ) call timer("cosp_diags") + if ( LPROF ) call stop_timing( id, 'cosp_diags' ) end subroutine output_diags_for_cosp end module cosp_diags_mod diff --git a/interfaces/socrates_interface/source/algorithm/illuminate_alg_mod.x90 b/interfaces/socrates_interface/source/algorithm/illuminate_alg_mod.x90 index f7f2dce8c..d887afc75 100644 --- a/interfaces/socrates_interface/source/algorithm/illuminate_alg_mod.x90 +++ b/interfaces/socrates_interface/source/algorithm/illuminate_alg_mod.x90 @@ -16,9 +16,7 @@ use io_config_mod, only: write_diag, use_xios_io use sci_geometric_constants_mod, & only: get_latitude_fv, get_longitude_fv use illuminate_kernel_mod, only: illuminate_kernel_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 private @@ -63,14 +61,15 @@ subroutine illuminate_alg(radiation_fields, timestep, dt) type( field_type ), pointer :: horizon_aspect => null() type( field_type ), pointer :: skyview => null() - type(xios_date) :: datetime + type(xios_date) :: datetime integer(i_def), save :: current_year, day_of_year - real(r_def), save :: second_of_day + real(r_def), save :: second_of_day logical(l_def), save :: first_call = .true. + integer(tik) :: id_alg, id_xios if (.not. first_call) then - if ( subroutine_timers ) call timer("illuminate_alg") + if ( LPROF ) call start_timing( id_alg, 'illuminate_alg' ) call radiation_fields%get_field('cos_zenith_angle',cos_zenith_angle) call radiation_fields%get_field('lit_fraction',lit_fraction) @@ -107,11 +106,11 @@ subroutine illuminate_alg(radiation_fields, timestep, dt) latitude, longitude, timestep, dt, & current_year, day_of_year, second_of_day) ) - if ( subroutine_timers ) call timer("illuminate_alg") + if ( LPROF ) call stop_timing( id_alg, 'illuminate_alg' ) ! Output diagnostics if (write_diag .and. use_xios_io) then - if ( subroutine_timers ) call timer("illuminate_xios") + if ( LPROF ) call start_timing( id_xios, 'illuminate_xios' ) call sin_stellar_declination_rts%write_field(& 'radiation__sin_stellar_declination_rts') @@ -123,7 +122,7 @@ subroutine illuminate_alg(radiation_fields, timestep, dt) call horizon_aspect%write_field('radiation__horizon_aspect') call skyview%write_field('radiation__skyview') - if ( subroutine_timers ) call timer("illuminate_xios") + if ( LPROF ) call stop_timing( id_xios, 'illuminate_xios' ) end if nullify( mesh ) diff --git a/interfaces/socrates_interface/source/algorithm/radiation_alg_mod.x90 b/interfaces/socrates_interface/source/algorithm/radiation_alg_mod.x90 index 3678847f0..5977bd76a 100644 --- a/interfaces/socrates_interface/source/algorithm/radiation_alg_mod.x90 +++ b/interfaces/socrates_interface/source/algorithm/radiation_alg_mod.x90 @@ -25,8 +25,7 @@ use sw_mts_kernel_mod, only: sw_mts_kernel_type use lw_kernel_mod, only: lw_kernel_type use lw_inc_kernel_mod, only: lw_inc_kernel_type use lw_mts_kernel_mod, only: lw_mts_kernel_type -use io_config_mod, only: subroutine_timers -use timer_mod, only: timer +use timing_mod, only: start_timing, stop_timing, tik, LPROF use log_mod, only: log_event, LOG_LEVEL_DEBUG, LOG_LEVEL_INFO use log_field_alg_mod, only: log_field_alg use lfric_xios_write_mod, only: write_field_generic @@ -278,6 +277,7 @@ subroutine radiation_alg(dtheta_rad, theta, exner, mr, moist_dyn, & sw_direct_uv_surf_rts, sw_direct_uv_clear_surf_rts, & sw_up_uv_surf_rts, sw_up_uv_clear_surf_rts, & photolysis_rates_rts + integer( tik ) :: id_sw, id_lw call log_event( 'slow_physics: Running Radiation', LOG_LEVEL_DEBUG ) @@ -498,8 +498,7 @@ subroutine radiation_alg(dtheta_rad, theta, exner, mr, moist_dyn, & end if - if ( subroutine_timers ) call timer("sw_radiation") - + if ( LPROF ) call start_timing( id_sw, 'sw_radiation' ) if (rad_this_tstep) then ! -------------------------------------------------- ! Radiation time-step: full calculation of SW fluxes @@ -603,8 +602,8 @@ subroutine radiation_alg(dtheta_rad, theta, exner, mr, moist_dyn, & call log_field_alg( sw_up_tile, LOG_LEVEL_DEBUG ) call log_field_alg( sw_up_blue_tile, LOG_LEVEL_DEBUG ) - if ( subroutine_timers ) call timer("sw_radiation") - if ( subroutine_timers ) call timer("lw_radiation") + if ( LPROF ) call stop_timing( id_sw, 'sw_radiation' ) + if ( LPROF ) call start_timing( id_lw, 'lw_radiation' ) if (rad_this_tstep) then ! -------------------------------------------------- @@ -686,7 +685,7 @@ subroutine radiation_alg(dtheta_rad, theta, exner, mr, moist_dyn, & call log_field_alg( lw_down_surf, LOG_LEVEL_DEBUG ) call log_field_alg( lw_up_tile, LOG_LEVEL_DEBUG ) - if ( subroutine_timers ) call timer("lw_radiation") + if ( LPROF ) call stop_timing( id_lw, 'lw_radiation' ) ! first calculate the total temperature increment dt_again=dt diff --git a/interfaces/socrates_interface/source/algorithm/radiation_diags_mod.x90 b/interfaces/socrates_interface/source/algorithm/radiation_diags_mod.x90 index 17b189e9f..041ebef0e 100644 --- a/interfaces/socrates_interface/source/algorithm/radiation_diags_mod.x90 +++ b/interfaces/socrates_interface/source/algorithm/radiation_diags_mod.x90 @@ -10,8 +10,7 @@ module radiation_diags_mod use constants_mod, only: i_def, l_def, r_def use field_mod, only: field_type use integer_field_mod, only: integer_field_type - use io_config_mod, only: subroutine_timers - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, tik, LPROF use initialise_diagnostics_mod, only: init_diag => init_diagnostic_field, & diagnostic_to_be_sampled @@ -172,8 +171,9 @@ subroutine initialise_diags_for_radiation( lw_down_surf, lw_heating_rate, & ! Local working variables logical( l_def ) :: ignore + integer( tik ) :: id - if ( subroutine_timers ) call timer("radiation_diags") + if ( LPROF ) call start_timing( id, 'radiation_diags' ) ! Diagnostic fields that are always required by the kernels lw_up_surf_flag = init_diag( lw_up_surf, & @@ -355,7 +355,7 @@ subroutine initialise_diags_for_radiation( lw_down_surf, lw_heating_rate, & ignore = init_diag( warm_cloud_top_re_rts, & 'radiation__warm_cloud_top_re_rts', activate=.true. ) - if ( subroutine_timers ) call timer("radiation_diags") + if ( LPROF ) call stop_timing( id, 'radiation_diags' ) end subroutine initialise_diags_for_radiation @@ -496,8 +496,9 @@ subroutine output_diags_for_radiation( dtheta_rad, & ! Local working variables logical( l_def ) :: ignore + integer( tik ) :: id - if ( subroutine_timers ) call timer("radiation_diags") + if ( LPROF ) call start_timing( id, 'radiation_diags' ) ! Prognostic fields call dtheta_rad%write_field('radiation__dtheta_rad') @@ -743,7 +744,7 @@ subroutine output_diags_for_radiation( dtheta_rad, & if ( photolysis_rates_rts_flag ) call photolysis_rates_rts%write_field() - if ( subroutine_timers ) call timer("radiation_diags") + if ( LPROF ) call stop_timing( id, 'radiation_diags' ) end subroutine output_diags_for_radiation end module radiation_diags_mod diff --git a/rose-stem/site/meto/common/suite_config_azspice.cylc b/rose-stem/site/meto/common/suite_config_azspice.cylc index d38604881..2a660e66d 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_LEGACY_TIMER=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 7106a8eb6..604eff7ad 100644 --- a/rose-stem/site/meto/common/suite_config_ex1a.cylc +++ b/rose-stem/site/meto/common/suite_config_ex1a.cylc @@ -49,8 +49,8 @@ [[[environment]]] TRANSMUTE_INCLUDE_METHOD = specify_include [[[environment]]] - USE_VERNIER=yes - USE_TIMING_WRAPPER=yes + USE_LEGACY_TIMER=true + USE_TIMING_WRAPPER=true [[[directives]]] -l tmpsize=12GB diff --git a/science/adjoint/source/algorithm/core_dynamics/atl_rhs_alg_mod.x90 b/science/adjoint/source/algorithm/core_dynamics/atl_rhs_alg_mod.x90 index 0f8148790..5578b26c5 100644 --- a/science/adjoint/source/algorithm/core_dynamics/atl_rhs_alg_mod.x90 +++ b/science/adjoint/source/algorithm/core_dynamics/atl_rhs_alg_mod.x90 @@ -42,8 +42,8 @@ module atl_rhs_alg_mod use quadrature_rule_gaussian_mod, only: quadrature_rule_gaussian_type use derived_config_mod, only: bundle_size use field_indices_mod, only: igh_u, igh_t, igh_d, igh_p - use io_config_mod, only: subroutine_timers - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF use atl_rhs_project_eos_kernel_mod, only: atl_rhs_project_eos_kernel_type use atl_rhs_sample_eos_kernel_mod, only: atl_rhs_sample_eos_kernel_type use moist_dyn_mod, only: num_moist_factors, gas_law @@ -128,8 +128,9 @@ subroutine atl_rhs_alg(rhs, alpha_dt, base_state, state, moist_dyn, & integer(kind=i_def), parameter :: exner_stencil_depth = 1 type(function_space_type), pointer :: vector_space_w3_ptr type(field_type) :: dummy_w3 + integer(tik) :: id - if ( subroutine_timers ) call timer('atl_rhs_alg') + if ( LPROF ) call start_timing( id, 'atl_rhs_alg' ) mesh => base_state(igh_u)%get_mesh() @@ -298,7 +299,7 @@ subroutine atl_rhs_alg(rhs, alpha_dt, base_state, state, moist_dyn, & setval_c( rhs(igh_t), 0.0_r_def ) ) ! End of adjoint - if ( subroutine_timers ) call timer('atl_rhs_alg') + if ( LPROF ) call stop_timing( id, 'atl_rhs_alg' ) end subroutine atl_rhs_alg diff --git a/science/adjoint/source/algorithm/solver/adj_mixed_operator_alg_mod.x90 b/science/adjoint/source/algorithm/solver/adj_mixed_operator_alg_mod.x90 index d4b2998e2..00831f6e0 100644 --- a/science/adjoint/source/algorithm/solver/adj_mixed_operator_alg_mod.x90 +++ b/science/adjoint/source/algorithm/solver/adj_mixed_operator_alg_mod.x90 @@ -30,7 +30,6 @@ module adj_mixed_operator_alg_mod use function_space_collection_mod, only: function_space_collection use function_space_mod, only: function_space_type use integer_field_mod, only: integer_field_type - use io_config_mod, only: subroutine_timers use limited_area_constants_mod, only: get_mask_r_solver use log_mod, only: log_event, & LOG_LEVEL_ERROR @@ -54,7 +53,9 @@ module adj_mixed_operator_alg_mod get_eliminated_q32 use solver_constants_mod, only: get_w2_mass_matrix_r_solver, & get_normalisation_r_solver - use timer_mod, only: timer + use timing_mod, only: start_timing, & + stop_timing, & + tik, LPROF use vector_mod, only: abstract_vector_type implicit none @@ -103,8 +104,9 @@ contains type(r_solver_field_vector_type) :: x_in integer(kind=i_def) :: state_size + integer(tik) :: id - if (subroutine_timers) call timer('adj_mixed_operator') + if ( LPROF ) call start_timing( id, 'adj_mixed_operator' ) ! Extract mesh ID select type (y) @@ -257,7 +259,7 @@ contains call log_event( "mixed_operator_alg_mod: incorrect vector_type argument x", LOG_LEVEL_ERROR ) end select - if (subroutine_timers) call timer('adj_mixed_operator') + if ( LPROF ) call stop_timing( id, 'adj_mixed_operator' ) end subroutine apply_adj_mixed_operator diff --git a/science/adjoint/source/algorithm/solver/adj_mixed_schur_preconditioner_alg_mod.x90 b/science/adjoint/source/algorithm/solver/adj_mixed_schur_preconditioner_alg_mod.x90 index fa8308975..49e8b5dbd 100644 --- a/science/adjoint/source/algorithm/solver/adj_mixed_schur_preconditioner_alg_mod.x90 +++ b/science/adjoint/source/algorithm/solver/adj_mixed_schur_preconditioner_alg_mod.x90 @@ -20,8 +20,8 @@ module adj_mixed_schur_preconditioner_alg_mod isol_uv, isol_w use function_space_mod, only: function_space_type use function_space_collection_mod, only: function_space_collection - use io_config_mod, only: subroutine_timers - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF use mixed_solver_config_mod, only: split_w use log_mod, only: log_event, & LOG_LEVEL_ERROR, & @@ -132,8 +132,10 @@ contains type(r_solver_field_type) :: exner_inc type(r_solver_field_type) :: pressure_b_field + integer(tik) :: id_precon, id_solve - if (subroutine_timers) call timer('adj_mixed_schur_preconditioner_alg') + if ( LPROF ) call start_timing( id_precon, & + 'adj_mixed_schur_preconditioner_alg' ) select type(x) type is(r_solver_field_vector_type) @@ -169,9 +171,9 @@ contains ! Solve pressure system call log_event( 'Schur preconditioner pressure solve:', LOG_LEVEL_DEBUG ) - if (subroutine_timers) call timer('adj mixed_schur solve') + if ( LPROF ) call start_timing( id_solve, 'adj_mixed_schur_solve' ) call self%adj_pressure_solver%apply( self%pressure_x, self%pressure_b ) - if (subroutine_timers) call timer('adj mixed_schur solve') + if ( LPROF ) call stop_timing( id_solve, 'adj_mixed_schur_solve' ) ! STEP 1: Build RHS for Helmholtz system @@ -193,7 +195,8 @@ contains call log_event( "mixed_schur_preconditioner_mod: incorrect vector_type argument x", LOG_LEVEL_ERROR ) end select - if (subroutine_timers) call timer('adj_mixed_schur_preconditioner_alg') + if ( LPROF ) call stop_timing( id_precon, & + 'adj_mixed_schur_preconditioner_alg' ) end subroutine apply_adj_mixed_schur_preconditioner @@ -216,8 +219,9 @@ contains type(integer_field_type), pointer :: face_selector_ew type(integer_field_type), pointer :: face_selector_ns + integer(tik) :: id - if (subroutine_timers) call timer('adj mixed_schur rhs') + if ( LPROF ) call start_timing( id, 'adj_mixed_schur_rhs' ) ! Options coded: ! element_order_h= 0 @@ -300,7 +304,7 @@ contains call log_event( "adj_build_pressure_rhs: .not. split_w not coded", LOG_LEVEL_ERROR ) end if - if (subroutine_timers) call timer('adj mixed_schur rhs') + if ( LPROF ) call stop_timing( id, 'adj_mixed_schur_rhs' ) end subroutine adj_build_pressure_rhs @@ -322,8 +326,9 @@ contains type(integer_field_type), pointer :: face_selector_ew type(integer_field_type), pointer :: face_selector_ns + integer(tik) :: id - if (subroutine_timers) call timer('adj Schur back substitute') + if ( LPROF ) call start_timing( id, 'adj_schur_back_substitute' ) exner_inc => self%pressure_x%get_field_from_position(1) @@ -370,7 +375,7 @@ contains Hb_lumped_inv ), & setval_c(u_inc, 0.0_r_solver) ) - if (subroutine_timers) call timer('adj Schur back substitute') + if ( LPROF ) call stop_timing( id, 'adj_schur_back_substitute' ) end subroutine adj_back_substitute diff --git a/science/adjoint/source/algorithm/solver/adj_pressure_operator_alg_mod.x90 b/science/adjoint/source/algorithm/solver/adj_pressure_operator_alg_mod.x90 index bc6116949..b0f487c21 100644 --- a/science/adjoint/source/algorithm/solver/adj_pressure_operator_alg_mod.x90 +++ b/science/adjoint/source/algorithm/solver/adj_pressure_operator_alg_mod.x90 @@ -24,8 +24,9 @@ module adj_pressure_operator_alg_mod use integer_field_mod, only: integer_field_type use finite_element_config_mod, only: element_order_h, element_order_v - use io_config_mod, only: subroutine_timers - use timer_mod, only: timer + use timing_mod, only: start_timing, & + stop_timing, & + tik, LPROF use si_operators_alg_mod, only: get_helmholtz_operator implicit none @@ -109,9 +110,11 @@ contains type(integer_field_type), pointer :: set_counts_field integer(kind=i_def) :: nindices + integer(tik) :: id + nullify( Helmholtz_operator, x_vec, y_vec, lookup_field, set_counts_field ) - if (subroutine_timers) call timer('adj helmholtz lhs') + if ( LPROF ) call start_timing( id, 'adj_helmholtz_lhs' ) select type (x) type is (r_solver_field_vector_type) @@ -155,7 +158,7 @@ contains call log_event( "apply_adj_pressure_operator: element_orders /= 0 not coded", LOG_LEVEL_ERROR ) end if - if (subroutine_timers) call timer('adj helmholtz lhs') + if ( LPROF ) call stop_timing( id, 'adj_helmholtz_lhs' ) class default call log_event( "adj_pressure_operator_alg_mod: incorrect vector_type argument y", LOG_LEVEL_ERROR ) diff --git a/science/adjoint/source/algorithm/solver/adj_semi_implicit_solver_alg_mod.x90 b/science/adjoint/source/algorithm/solver/adj_semi_implicit_solver_alg_mod.x90 index c5da78977..ca4436d38 100644 --- a/science/adjoint/source/algorithm/solver/adj_semi_implicit_solver_alg_mod.x90 +++ b/science/adjoint/source/algorithm/solver/adj_semi_implicit_solver_alg_mod.x90 @@ -31,8 +31,8 @@ module adj_semi_implicit_solver_alg_mod bicgstab_type, block_gcr_type use split_w2_field_kernel_mod, only: split_w2_field_kernel_type use combine_w2_field_kernel_mod, only: combine_w2_field_kernel_type - use io_config_mod, only: subroutine_timers - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF use finite_element_config_mod, only: element_order_h, element_order_v use copy_field_alg_mod, only: copy_field use function_space_collection_mod, only: function_space_collection @@ -318,8 +318,10 @@ contains type(integer_field_type), pointer :: face_selector_ew, face_selector_ns type(mesh_type), pointer :: mesh integer(kind=i_def) :: p_h, p_v + integer(tik) :: id_si, id_mix - if (subroutine_timers) call timer('adj_semi_implicit_solver_type%step') + if ( LPROF ) call start_timing( id_si, & + 'adj_semi_implicit_solver_type_step' ) ! Input fields are r_def fields so preliminary work uses field_types @@ -434,10 +436,10 @@ contains call vector_rhs%import_field( inc_exner_rsol, isol_p ) ! Solve the semi-implicit operator - if (subroutine_timers) call timer('adj_mixed_solver') + if ( LPROF ) call start_timing( id_mix, 'adj_mixed_solver' ) call vector_inc%set_scalar(0.0_r_def) call self%adj_mixed_solver%apply( vector_inc, vector_rhs ) - if (subroutine_timers) call timer('adj_mixed_solver') + if ( LPROF ) call stop_timing( id_mix, 'adj_mixed_solver' ) call deconstruct_solver_state( vector_inc, rhs_rsol ) ! vector_inc(uv,w,p) IN, rhs_rsol(u,p) OUT, rhs_rsol(d,t) unaffected @@ -489,7 +491,8 @@ contains call invoke(inc_X_times_Y( rhs(igh_u), u_normalisation )) - if (subroutine_timers) call timer( 'adj_semi_implicit_solver_type%step' ) + if ( LPROF ) call stop_timing( id_si, & + 'adj_semi_implicit_solver_type_step' ) end subroutine step diff --git a/science/adjoint/source/algorithm/timestepping/atl_si_timestep_alg_mod.x90 b/science/adjoint/source/algorithm/timestepping/atl_si_timestep_alg_mod.x90 index 04c466748..08f383971 100644 --- a/science/adjoint/source/algorithm/timestepping/atl_si_timestep_alg_mod.x90 +++ b/science/adjoint/source/algorithm/timestepping/atl_si_timestep_alg_mod.x90 @@ -17,7 +17,6 @@ module atl_si_timestep_alg_mod use formulation_config_mod, only: dlayer_on, exner_from_eos, si_momentum_equation, & moisture_formulation, moisture_formulation_dry, & use_physics, use_wavedynamics - use io_config_mod, only: subroutine_timers use mixed_solver_config_mod, only: guess_np1, reference_reset_time use timestepping_config_mod, only: alpha, spinup_alpha, & outer_iterations, inner_iterations @@ -57,7 +56,8 @@ module atl_si_timestep_alg_mod use field_indices_mod, only: igh_u, igh_t, igh_d, igh_p use mixing_config_mod, only: smagorinsky use sci_enforce_bc_kernel_mod, only: enforce_bc_kernel_type - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF use transport_enumerated_types_mod, only: direction_3d, direction_h, direction_v implicit none @@ -321,8 +321,9 @@ contains type(field_type) :: advected_u type(mesh_type), pointer :: mesh character(len=str_def) :: prime_mesh_name + integer(tik) :: id - if (subroutine_timers) call timer('atl_si_timestep_type::step') + if ( LPROF ) call start_timing( id, 'atl_si_timestep_type::step' ) cast_dt = real( modeldb%clock%get_seconds_per_step(), r_def ) @@ -737,7 +738,7 @@ contains setval_X( rho, self%state(igh_d) ), & setval_X( exner, self%state(igh_p) ) ) - if (subroutine_timers) call timer('atl_si_timestep_type::step') + if ( LPROF ) call stop_timing( id, 'atl_si_timestep_type::step' ) end subroutine step diff --git a/science/adjoint/source/algorithm/transport/common/adj_end_transport_step_alg_mod.x90 b/science/adjoint/source/algorithm/transport/common/adj_end_transport_step_alg_mod.x90 index eb4c4e7ba..59d196f93 100644 --- a/science/adjoint/source/algorithm/transport/common/adj_end_transport_step_alg_mod.x90 +++ b/science/adjoint/source/algorithm/transport/common/adj_end_transport_step_alg_mod.x90 @@ -15,11 +15,11 @@ module adj_end_transport_step_alg_mod use sci_geometric_constants_mod, only: get_face_selector_ew, & get_face_selector_ns use integer_field_mod, only: integer_field_type - use io_config_mod, only: subroutine_timers use log_mod, only: log_event, LOG_LEVEL_ERROR use mesh_mod, only: mesh_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 use transport_config_mod, only: dry_field_name use transport_enumerated_types_mod, only: direction_3d, & direction_h, & @@ -76,8 +76,9 @@ contains type(r_tran_field_type) :: combined_flux logical(kind=l_def) :: is_flux_3d logical(kind=l_def) :: is_flux_split + integer(tik) :: id - if ( subroutine_timers ) call timer('transport.adj_build_up_flux') + if ( LPROF ) call start_timing( id, 'transport.adj_build_up_flux' ) ! Don't know which function space the fluxes are in -- add up each mesh => sum_flux%get_mesh() @@ -173,7 +174,7 @@ contains end if - if ( subroutine_timers ) call timer('transport.adj_build_up_flux') + if ( LPROF ) call stop_timing( id, 'transport.adj_build_up_flux' ) end subroutine adj_build_up_flux diff --git a/science/adjoint/source/algorithm/transport/common/atl_end_transport_step_alg_mod.x90 b/science/adjoint/source/algorithm/transport/common/atl_end_transport_step_alg_mod.x90 index 6f0cf3a45..38ceb3f2c 100644 --- a/science/adjoint/source/algorithm/transport/common/atl_end_transport_step_alg_mod.x90 +++ b/science/adjoint/source/algorithm/transport/common/atl_end_transport_step_alg_mod.x90 @@ -17,7 +17,6 @@ module atl_end_transport_step_alg_mod use fs_continuity_mod, only: W2, W2H, W2V use function_space_mod, only: function_space_type use function_space_collection_mod, only: function_space_collection - use io_config_mod, only: subroutine_timers use log_mod, only: log_event, LOG_LEVEL_ERROR use mesh_mod, only: mesh_type use mesh_collection_mod, only: mesh_collection @@ -27,7 +26,6 @@ module atl_end_transport_step_alg_mod use r_tran_field_mod, only: r_tran_field_type use r_tran_operator_mod, only: r_tran_operator_type use split_transport_utils_mod, only: get_num_split_steps - use timer_mod, only: timer use transport_config_mod, only: cheap_update, & dry_field_name use transport_constants_mod, only: get_directional_im3_div_r_tran diff --git a/science/adjoint/source/algorithm/transport/control/atl_moist_mr_transport_alg_mod.x90 b/science/adjoint/source/algorithm/transport/control/atl_moist_mr_transport_alg_mod.x90 index 8c8c8824a..1f13aa011 100644 --- a/science/adjoint/source/algorithm/transport/control/atl_moist_mr_transport_alg_mod.x90 +++ b/science/adjoint/source/algorithm/transport/control/atl_moist_mr_transport_alg_mod.x90 @@ -9,11 +9,11 @@ module atl_moist_mr_transport_alg_mod use constants_mod, only: i_def, r_def use field_mod, only: field_type - use io_config_mod, only: subroutine_timers use log_mod, only: log_event, & LOG_LEVEL_ERROR use mr_indices_mod, only: nummr - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF use tl_transport_controller_mod, only: tl_transport_controller_type use transport_enumerated_types_mod, only: equation_form_advective, & equation_form_conservative @@ -56,8 +56,9 @@ contains ! Internal variables integer(kind=i_def) :: imr + integer(tik) :: id - if ( subroutine_timers ) call timer('atl moist mixing ratio transport') + if ( LPROF ) call start_timing( id, 'atl_mois_mixing_ratio_transport' ) ! ------------------------------------------------------------------------ ! ! Copy non-transported fields over @@ -98,8 +99,7 @@ contains end select - - if ( subroutine_timers ) call timer('atl moist mixing ratio transport') + if ( LPROF ) call stop_timing( id, 'atl_mois_mixing_ratio_transport' ) end subroutine atl_moist_mr_transport_alg diff --git a/science/adjoint/source/algorithm/transport/control/atl_transport_control_alg_mod.x90 b/science/adjoint/source/algorithm/transport/control/atl_transport_control_alg_mod.x90 index f87b4ca55..2ed3d82dc 100644 --- a/science/adjoint/source/algorithm/transport/control/atl_transport_control_alg_mod.x90 +++ b/science/adjoint/source/algorithm/transport/control/atl_transport_control_alg_mod.x90 @@ -74,8 +74,8 @@ contains use adj_flux_precomputations_mod, only: adj_flux_precomputations_initialiser use adj_wind_precomputations_alg_mod, only: adj_wind_precomputations_initialiser use atl_transport_controller_mod, only: atl_transport_controller_initialiser - use io_config_mod, only: subroutine_timers - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF implicit none @@ -110,8 +110,9 @@ contains type(transport_controller_type), pointer :: ls_wind_pert_rho_controller type(flux_precomputations_type), pointer :: ls_wind_pert_rho_flux_pc type(r_tran_field_type), pointer :: ref_field_rtran + integer(tik) :: id - if ( subroutine_timers ) call timer('atl_transport_control') + if ( LPROF ) call start_timing( id, 'atl_transport_control' ) ! ========================================================================= ! ! Pre-transport initialisation tasks @@ -271,7 +272,7 @@ contains call tl_transport_controller%finalise() - if ( subroutine_timers ) call timer('atl_transport_control') + if ( LPROF ) call stop_timing( id, 'atl_transport_control' ) end subroutine atl_transport_control_alg diff --git a/science/adjoint/source/algorithm/transport/control/atl_wind_transport_alg_mod.x90 b/science/adjoint/source/algorithm/transport/control/atl_wind_transport_alg_mod.x90 index 2e8ac21cd..5eb9f58c6 100644 --- a/science/adjoint/source/algorithm/transport/control/atl_wind_transport_alg_mod.x90 +++ b/science/adjoint/source/algorithm/transport/control/atl_wind_transport_alg_mod.x90 @@ -20,7 +20,6 @@ module atl_wind_transport_alg_mod use function_space_mod, only: function_space_type use function_space_collection_mod, only: function_space_collection use sci_geometric_constants_mod, only: get_coordinates, get_panel_id - use io_config_mod, only: subroutine_timers use log_mod, only: log_event, & LOG_LEVEL_ERROR, & LOG_LEVEL_INFO @@ -29,7 +28,8 @@ module atl_wind_transport_alg_mod get_project_zdot_to_w2 use mesh_mod, only: mesh_type use operator_mod, only: operator_type - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF use transport_enumerated_types_mod, only: equation_form_advective use transport_config_mod, only: broken_w2_projection use tl_transport_controller_mod, only: tl_transport_controller_type @@ -93,8 +93,9 @@ contains type(function_space_type), pointer :: w3_fs type(function_space_type), pointer :: w2_fs type(function_space_type), pointer :: w2b_fs + integer(tik) :: id - if ( subroutine_timers ) call timer('atl wind transport') + if ( LPROF ) call start_timing( id, 'atl_wind_transport' ) ! ------------------------------------------------------------------------ ! ! Semi-implicit formulation @@ -214,7 +215,7 @@ contains end if ! si_momentum_equation - if ( subroutine_timers ) call timer('atl wind transport') + if ( LPROF ) call stop_timing( id, 'atl_wind_transport' ) end subroutine atl_wind_transport_alg diff --git a/science/adjoint/source/algorithm/transport/mol/atl_mol_conservative_alg_mod.x90 b/science/adjoint/source/algorithm/transport/mol/atl_mol_conservative_alg_mod.x90 index b5ed18d7e..b68fd309a 100644 --- a/science/adjoint/source/algorithm/transport/mol/atl_mol_conservative_alg_mod.x90 +++ b/science/adjoint/source/algorithm/transport/mol/atl_mol_conservative_alg_mod.x90 @@ -15,7 +15,8 @@ module atl_mol_conservative_alg_mod LOG_LEVEL_INFO use mesh_mod, only: mesh_type use operator_mod, only: operator_type - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF ! Algorithms and transport code use advective_and_flux_alg_mod, only: advective_and_flux_alg @@ -40,7 +41,6 @@ module atl_mol_conservative_alg_mod ! Configuration use boundaries_config_mod, only: limited_area use base_mesh_config_mod, only: topology, topology_non_periodic - use io_config_mod, only: subroutine_timers use transport_config_mod, only: runge_kutta_method, & dry_field_name, & operators, & @@ -111,8 +111,9 @@ module atl_mol_conservative_alg_mod type(flux_precomputations_type), pointer :: flux_precomputations type(flux_precomputations_type), pointer :: ls_wind_flux_precomp type(flux_precomputations_type), pointer :: pert_wind_flux_precomp + integer(tik) :: id - if ( subroutine_timers ) call timer('atl_mol_conservative_alg') + if ( LPROF ) call start_timing( id, 'atl_mol_conservative_alg' ) ! ------------------------------------------------------------------------ ! ! Extract transport objects and initialise temporary fields @@ -417,7 +418,7 @@ module atl_mol_conservative_alg_mod if ( allocated(rk_weights) ) deallocate(rk_weights) if ( allocated(stored_ls_field) ) deallocate(stored_ls_field) - if ( subroutine_timers ) call timer('atl_mol_conservative_alg') + if ( LPROF ) call stop_timing( id, 'atl_mol_conservative_alg' ) end subroutine atl_mol_conservative_alg diff --git a/science/gungho/source/algorithm/core_dynamics/derive_exner_from_eos_alg_mod.x90 b/science/gungho/source/algorithm/core_dynamics/derive_exner_from_eos_alg_mod.x90 index 522066e02..446faded5 100644 --- a/science/gungho/source/algorithm/core_dynamics/derive_exner_from_eos_alg_mod.x90 +++ b/science/gungho/source/algorithm/core_dynamics/derive_exner_from_eos_alg_mod.x90 @@ -12,8 +12,8 @@ module derive_exner_from_eos_alg_mod use field_mod, only: field_type use derived_config_mod, only: bundle_size use field_indices_mod, only: igh_p, igh_d, igh_t - use io_config_mod, only: subroutine_timers - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF use log_mod, only: log_event, & LOG_LEVEL_ERROR @@ -56,8 +56,9 @@ contains type( quadrature_xyoz_type ), pointer :: qr => null() type( mesh_type ), pointer :: mesh => null() + integer( tik ) :: id - if ( subroutine_timers ) call timer('exner_from_eos') + if ( LPROF ) call start_timing( id, 'exner_from_eos' ) mesh => state(igh_p)%get_mesh() @@ -83,7 +84,7 @@ contains nullify( m3_inv, chi, mesh, & panel_id, qr ) - if ( subroutine_timers ) call timer('exner_from_eos') + if ( LPROF ) call stop_timing( id, 'exner_from_eos' ) end subroutine derive_exner_from_eos diff --git a/science/gungho/source/algorithm/core_dynamics/rhs_alg_mod.x90 b/science/gungho/source/algorithm/core_dynamics/rhs_alg_mod.x90 index f78729ba9..42d6e4792 100644 --- a/science/gungho/source/algorithm/core_dynamics/rhs_alg_mod.x90 +++ b/science/gungho/source/algorithm/core_dynamics/rhs_alg_mod.x90 @@ -43,8 +43,8 @@ module rhs_alg_mod use quadrature_rule_gaussian_mod, only: quadrature_rule_gaussian_type use derived_config_mod, only: bundle_size use field_indices_mod, only: igh_u, igh_t, igh_d, igh_p - use io_config_mod, only: subroutine_timers - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF use rhs_project_eos_kernel_mod, only: rhs_project_eos_kernel_type use rhs_sample_eos_kernel_mod, only: rhs_sample_eos_kernel_type use moist_dyn_mod, only: num_moist_factors, gas_law @@ -156,6 +156,8 @@ contains type(field_type) :: rhs_u integer(kind=i_def) :: mesh_id type(field_type) :: theta_v + integer(tik) :: id + ! For continuous fields the default looping depth is to the depth 1 halo ! and so for any fields that are accessed with a stencil the halo_depth @@ -163,7 +165,7 @@ contains integer(kind=i_def), parameter :: req_stencil_depth = 1 integer(kind=i_def), parameter :: req_halo_depth = req_stencil_depth + 1 - if ( subroutine_timers ) call timer('rhs_alg') + if ( LPROF ) call start_timing( id, 'rhs_alg' ) mesh_id = base_state(igh_u)%get_mesh_id() @@ -233,7 +235,7 @@ contains geopotential, u, theta, rho, exner, & u_base, theta_base, rho_base ) - if ( subroutine_timers ) call timer('rhs_alg') + if ( LPROF ) call stop_timing( id, 'rhs_alg' ) end subroutine rhs_default_alg @@ -283,6 +285,7 @@ contains integer(kind=i_def) :: element_order_v type(field_type) :: rhs_adv type(field_type) :: exner_big_halo + integer(tik) :: id ! For continuous fields the default looping depth is to the depth 1 halo ! and so for any fields that are accessed with a stencil the halo_depth @@ -290,7 +293,7 @@ contains integer(kind=i_def), parameter :: req_stencil_depth = 1 integer(kind=i_def), parameter :: req_halo_depth = req_stencil_depth + 1 - if ( subroutine_timers ) call timer('rhs_alg') + if ( LPROF ) call start_timing( id, 'rhs_alg' ) mesh_id = base_state(igh_u)%get_mesh_id() @@ -424,7 +427,7 @@ contains geopotential, u, theta, rho, exner, & mesh, reference_element ) - if ( subroutine_timers ) call timer('rhs_alg') + if ( LPROF ) call stop_timing( id, 'rhs_alg' ) end subroutine rhs_general_alg diff --git a/science/gungho/source/algorithm/diagnostics/ageofair_alg_mod.x90 b/science/gungho/source/algorithm/diagnostics/ageofair_alg_mod.x90 index 24dfcc57e..3777b4d99 100644 --- a/science/gungho/source/algorithm/diagnostics/ageofair_alg_mod.x90 +++ b/science/gungho/source/algorithm/diagnostics/ageofair_alg_mod.x90 @@ -10,8 +10,8 @@ module ageofair_alg_mod use clock_mod, only: clock_type use constants_mod, only: r_def use field_mod, only: field_type - use io_config_mod, only: subroutine_timers - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF use ageofair_kernel_mod, only: ageofair_kernel_type use transport_config_mod, only: ageofair_reset_level @@ -50,8 +50,9 @@ contains type(field_type) :: ones real(r_def) :: dt + integer(tik) :: id - if ( subroutine_timers ) call timer( 'ageofair_advection_alg' ) + if ( LPROF ) call start_timing( id, 'ageofair_advection_alg' ) dt = real(clock%get_seconds_per_step(), r_def) @@ -62,7 +63,7 @@ contains ! Set levels nearest the surface to be zero in ageofair field ageofair_kernel_type(ageofair,ageofair_reset_level) ) - if ( subroutine_timers ) call timer( 'ageofair_advection_alg' ) + if ( LPROF ) call stop_timing( id, 'ageofair_advection_alg' ) end subroutine ageofair_update diff --git a/science/gungho/source/algorithm/diagnostics/compute_total_energy_alg_mod.x90 b/science/gungho/source/algorithm/diagnostics/compute_total_energy_alg_mod.x90 index 4651e9a47..280284956 100644 --- a/science/gungho/source/algorithm/diagnostics/compute_total_energy_alg_mod.x90 +++ b/science/gungho/source/algorithm/diagnostics/compute_total_energy_alg_mod.x90 @@ -26,7 +26,6 @@ module compute_total_energy_alg_mod get_coordinates, & get_panel_id, & get_da_msl_proj - use io_config_mod, only: subroutine_timers use log_mod, only: log_event, & log_scratch_space, & LOG_LEVEL_DEBUG, & @@ -38,7 +37,7 @@ module compute_total_energy_alg_mod use planet_config_mod, only: cv, gravity 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 implicit none @@ -122,8 +121,9 @@ contains real( kind=r_def ) :: surface_geopotential integer(kind=i_def) :: nqp_h_exact, nqp_v_exact integer(kind=i_def) :: element_order_h, element_order_v + integer(tik) :: id - if ( subroutine_timers ) call timer( "compute_total_energy" ) + if ( LPROF ) call start_timing( id, 'compute_total_energy' ) geopotential => get_geopotential( mesh%get_id() ) surface_geopotential = planet_radius*gravity @@ -245,7 +245,7 @@ contains nullify( geopotential ) - if ( subroutine_timers ) call timer( "compute_total_energy" ) + if ( LPROF ) call stop_timing( id, 'compute_total_energy' ) end subroutine compute_total_energy_alg diff --git a/science/gungho/source/algorithm/diagnostics/conservation_algorithm_mod.x90 b/science/gungho/source/algorithm/diagnostics/conservation_algorithm_mod.x90 index e9ba657e6..e884be66f 100644 --- a/science/gungho/source/algorithm/diagnostics/conservation_algorithm_mod.x90 +++ b/science/gungho/source/algorithm/diagnostics/conservation_algorithm_mod.x90 @@ -31,11 +31,11 @@ module conservation_algorithm_mod use dycore_constants_mod, only: get_geopotential use sci_geometric_constants_mod, only: get_coordinates, & get_panel_id - use io_config_mod, only: subroutine_timers, use_xios_io + use io_config_mod, only: use_xios_io use planet_config_mod, only: scaled_omega, cv, gravity use mr_indices_mod, only: nummr - use timer_mod, only: timer - + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF use initialise_diagnostics_mod, only: diagnostic_to_be_sampled use extrusion_config_mod, only: planet_radius @@ -90,10 +90,11 @@ contains total_entropy_dyn_dry, & surface_geopotential type(mesh_type), pointer :: mesh => null() + integer(tik) :: id procedure(write_interface), pointer :: write_behaviour => null() - if ( subroutine_timers ) call timer('conservation_alg') + if ( LPROF ) call start_timing( id, 'conservation_alg' ) element_order_h = rho%get_element_order_h() element_order_v = rho%get_element_order_v() @@ -212,7 +213,7 @@ contains nullify( chi, panel_id, w3_fs, mesh ) nullify ( write_behaviour ) - if ( subroutine_timers ) call timer('conservation_alg') + if ( LPROF ) call stop_timing( id, 'conservation_alg' ) end subroutine conservation_algorithm diff --git a/science/gungho/source/algorithm/diagnostics/moisture_conservation_alg_mod.x90 b/science/gungho/source/algorithm/diagnostics/moisture_conservation_alg_mod.x90 index 31afc1291..ed27fd857 100644 --- a/science/gungho/source/algorithm/diagnostics/moisture_conservation_alg_mod.x90 +++ b/science/gungho/source/algorithm/diagnostics/moisture_conservation_alg_mod.x90 @@ -26,8 +26,8 @@ module moisture_conservation_alg_mod use quadrature_rule_gaussian_mod, only: quadrature_rule_gaussian_type use sci_geometric_constants_mod, only: get_coordinates, & get_panel_id - use io_config_mod, only: subroutine_timers - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF implicit none @@ -76,8 +76,9 @@ contains type(mesh_type), pointer :: mesh => null() type(mesh_type), pointer :: shifted_mesh => null() + integer(tik) :: id - if ( subroutine_timers ) call timer('moisture_conservation_alg') + if ( LPROF ) call start_timing( id, 'moisture_conservation_alg' ) element_order_h = rho_d%get_element_order_h() element_order_v = rho_d%get_element_order_v() @@ -126,7 +127,7 @@ contains nullify( chi, panel_id, w3_fs, w3_fs, mesh, shifted_mesh, chi_shifted ) - if ( subroutine_timers ) call timer('moisture_conservation_alg') + if ( LPROF ) call stop_timing( id, 'moisture_conservation_alg' ) end subroutine moisture_conservation_alg diff --git a/science/gungho/source/algorithm/diagnostics/moisture_fluxes_alg_mod.x90 b/science/gungho/source/algorithm/diagnostics/moisture_fluxes_alg_mod.x90 index 0a311f1dd..6f4341a28 100644 --- a/science/gungho/source/algorithm/diagnostics/moisture_fluxes_alg_mod.x90 +++ b/science/gungho/source/algorithm/diagnostics/moisture_fluxes_alg_mod.x90 @@ -19,8 +19,7 @@ module moisture_fluxes_alg_mod use log_mod, only: log_event, & log_scratch_space, & LOG_LEVEL_INFO - use io_config_mod, only: subroutine_timers - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, tik, LPROF use sci_multi_extract_kernel_mod, & only: multi_extract_kernel_type @@ -77,9 +76,9 @@ contains real(kind=r_def) :: ls_rain_mass, ls_snow_mass, ls_graup_mass real(kind=r_def) :: conv_rain_mass, conv_snow_mass integer(kind=i_def) :: mesh + integer(tik) :: id - - if ( subroutine_timers ) call timer('moisture_fluxes_alg') + if ( LPROF ) call start_timing( id, 'moisture_fluxes_alg' ) mesh = area%get_mesh_id() call microphysics_fields%get_field('ls_rain', ls_rain) @@ -164,7 +163,7 @@ contains nullify( fs_2d ) nullify( ls_rain, ls_snow, ls_graup, conv_rain, conv_snow, moist_flux_bl ) - if ( subroutine_timers ) call timer('moisture_fluxes_alg') + if ( LPROF ) call stop_timing( id, 'moisture_fluxes_alg' ) end subroutine moisture_fluxes_alg diff --git a/science/gungho/source/algorithm/diagnostics/si_diagnostics_mod.x90 b/science/gungho/source/algorithm/diagnostics/si_diagnostics_mod.x90 index a96fd0d99..68dff5189 100644 --- a/science/gungho/source/algorithm/diagnostics/si_diagnostics_mod.x90 +++ b/science/gungho/source/algorithm/diagnostics/si_diagnostics_mod.x90 @@ -22,8 +22,7 @@ module si_diagnostics_mod stochastic_physics_placement_fast use physics_mappings_alg_mod, only: map_physics_winds use mr_indices_mod, only: nummr, imr_v, imr_cl, imr_ci, imr_s - use io_config_mod, only: subroutine_timers - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, tik, LPROF use initialise_diagnostics_mod, only: init_diag => init_diagnostic_field @@ -78,8 +77,9 @@ contains type(field_type), pointer :: exner_wth_n logical(l_def) :: ignore + integer(tik) :: id - if ( subroutine_timers ) call timer ("si_diagnostics") + if ( LPROF ) call start_timing( id, 'si_diagnostics' ) ! Slow physics timestep theta increments ! Difference between state at time step n (X_n) and X_after_slow @@ -237,7 +237,7 @@ contains if (dw_solv_flag) call dw_solv%write_field() end if - if ( subroutine_timers ) call timer ("si_diagnostics") + if ( LPROF ) call stop_timing( id, 'si_diagnostics' ) end subroutine output_diags_for_si diff --git a/science/gungho/source/algorithm/diffusion/leonard_term_alg_mod.x90 b/science/gungho/source/algorithm/diffusion/leonard_term_alg_mod.x90 index c9174a68e..b6b37cfae 100644 --- a/science/gungho/source/algorithm/diffusion/leonard_term_alg_mod.x90 +++ b/science/gungho/source/algorithm/diffusion/leonard_term_alg_mod.x90 @@ -21,8 +21,7 @@ module leonard_term_alg_mod use mixing_config_mod, only: leonard_kl - use io_config_mod, only: subroutine_timers - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, tik, LPROF use log_mod, only: log_event, LOG_LEVEL_INFO use model_clock_mod, only: model_clock_type @@ -94,6 +93,8 @@ subroutine leonard_term_alg(mt_inc_leonard, thetal_inc_leonard, & ! local variables integer(kind=i_def) :: mesh_id integer(kind=i_def), parameter :: stencil_depth = 1 + integer(tik) :: id + ! Leonard term parameter type( field_type ) :: kl ! liquid + ice water potential temperature @@ -103,7 +104,7 @@ subroutine leonard_term_alg(mt_inc_leonard, thetal_inc_leonard, & ! w increment type( field_type ) :: vel_w2v_inc_leonard - if ( subroutine_timers ) call timer("leonard_term_alg") + if ( LPROF ) call start_timing( id, 'leonard_term_alg' ) mesh_id = theta%get_mesh_id() @@ -221,7 +222,7 @@ subroutine leonard_term_alg(mt_inc_leonard, thetal_inc_leonard, & nullify( height_w1, height_w2, height_w3, height_wth ) - if ( subroutine_timers ) call timer("leonard_term_alg") + if ( LPROF ) call stop_timing( id, 'leonard_term_alg' ) end subroutine leonard_term_alg diff --git a/science/gungho/source/algorithm/diffusion/smagorinsky_alg_mod.x90 b/science/gungho/source/algorithm/diffusion/smagorinsky_alg_mod.x90 index d40e14ab7..3672def2d 100644 --- a/science/gungho/source/algorithm/diffusion/smagorinsky_alg_mod.x90 +++ b/science/gungho/source/algorithm/diffusion/smagorinsky_alg_mod.x90 @@ -25,9 +25,8 @@ module smagorinsky_alg_mod use log_mod, only: log_event, & LOG_LEVEL_INFO use mesh_mod, only: mesh_type - use io_config_mod, only: subroutine_timers, & - write_conservation_diag - use timer_mod, only: timer + use io_config_mod, only: write_conservation_diag + use timing_mod, only: start_timing, stop_timing, tik, LPROF use moisture_conservation_alg_mod, & only: moisture_conservation_alg use sci_geometric_constants_mod, & @@ -91,8 +90,9 @@ subroutine smagorinsky_alg(dtheta_io, du_io, mr, theta, u, & logical :: use_moisture real( r_def ) :: one_third + integer(tik) :: id - if ( subroutine_timers ) call timer("smagorinsky_alg") + if ( LPROF ) call start_timing( id, 'smagorinsky_alg' ) call log_event( 'Applying Smagorinsky mixing', LOG_LEVEL_INFO ) @@ -231,7 +231,7 @@ subroutine smagorinsky_alg(dtheta_io, du_io, mr, theta, u, & nullify( height_w1, height_w2 ) - if ( subroutine_timers ) call timer("smagorinsky_alg") + if ( LPROF ) call stop_timing( id, 'smagorinsky_alg' ) end subroutine smagorinsky_alg diff --git a/science/gungho/source/algorithm/limited_area/init_gungho_lbcs_alg_mod.x90 b/science/gungho/source/algorithm/limited_area/init_gungho_lbcs_alg_mod.x90 index 24391689a..38ba51747 100644 --- a/science/gungho/source/algorithm/limited_area/init_gungho_lbcs_alg_mod.x90 +++ b/science/gungho/source/algorithm/limited_area/init_gungho_lbcs_alg_mod.x90 @@ -37,7 +37,8 @@ module init_gungho_lbcs_alg_mod use linked_list_mod, only: linked_list_type use mr_indices_mod, only: nummr, & mr_names - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF use masked_minmax_alg_mod, only: log_field_masked_minmax implicit none @@ -167,16 +168,12 @@ module init_gungho_lbcs_alg_mod type(linked_list_type), intent(in) :: lbc_times_list class(model_clock_type), intent(in) :: clock type(field_type), pointer :: lbc_v_u + integer(tik) :: id - type(namelist_type), pointer :: io_nml type(namelist_type), pointer :: initialization_nml - logical(l_def) :: subroutine_timers integer(i_def) :: lbc_option - io_nml => configuration%get_namelist('io') - call io_nml%get_value( 'subroutine_timers', subroutine_timers ) - - if ( subroutine_timers ) call timer('init_lbcs') + if ( LPROF ) call start_timing( id, 'init_lbcs' ) nullify(lbc_v_u) @@ -209,7 +206,7 @@ module init_gungho_lbcs_alg_mod end if - if ( subroutine_timers ) call timer('init_lbcs') + if ( LPROF ) call stop_timing( id, 'init_lbcs' ) end subroutine init_lbcs_file_alg @@ -230,16 +227,12 @@ module init_gungho_lbcs_alg_mod type(linked_list_type), intent(in) :: lbc_times_list class(model_clock_type), intent(in) :: clock type(field_type), pointer :: lbc_v_u + integer(tik) :: id - type(namelist_type), pointer :: io_nml type(namelist_type), pointer :: initialization_nml - logical(l_def) :: subroutine_timers integer(i_def) :: lbc_option - io_nml => configuration%get_namelist('io') - call io_nml%get_value( 'subroutine_timers', subroutine_timers ) - - if ( subroutine_timers ) call timer('update_lbcs') + if ( LPROF ) call start_timing( id, 'update_lbcs' ) nullify(lbc_v_u) @@ -267,7 +260,7 @@ module init_gungho_lbcs_alg_mod ! Define boundary_u_driving call define_boundary_u( configuration, lbc_fields ) - if ( subroutine_timers ) call timer('update_lbcs') + if ( LPROF ) call stop_timing( id, 'update_lbcs' ) end subroutine update_lbcs_file_alg diff --git a/science/gungho/source/algorithm/physics/calc_phys_predictors_alg_mod.x90 b/science/gungho/source/algorithm/physics/calc_phys_predictors_alg_mod.x90 index 9a5d3c211..2148a97dc 100644 --- a/science/gungho/source/algorithm/physics/calc_phys_predictors_alg_mod.x90 +++ b/science/gungho/source/algorithm/physics/calc_phys_predictors_alg_mod.x90 @@ -22,8 +22,7 @@ module calc_phys_predictors_alg_mod use sci_hori_mass_matrix_solver_alg_mod, & only: hori_mass_matrix_solver_alg - use io_config_mod, only: subroutine_timers - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, tik, LPROF use limited_area_lbc_alg_mod, only: overwrite_blending_zone use boundaries_config_mod, only: limited_area, transport_boundary_depth @@ -76,8 +75,9 @@ subroutine calc_phys_predictors_alg( derived_fields, rhs_np1, rhs_adv, & type( field_type ), pointer :: lbc_theta => null() type( field_type ) :: du, dtheta, rhsu_np1, w_in_w3_star + integer( tik ) :: id - if ( subroutine_timers ) call timer("calc_phys_predictors") + if ( LPROF ) call start_timing( id, 'calc_phys_predictors' ) call derived_fields%get_field('theta_star', theta_star) call derived_fields%get_field('u_star', u_star) @@ -137,7 +137,7 @@ subroutine calc_phys_predictors_alg( derived_fields, rhs_np1, rhs_adv, & u_star) call w_in_w3_star%field_final() - if ( subroutine_timers ) call timer("calc_phys_predictors") + if ( LPROF ) call stop_timing( id, 'calc_phys_predictors' ) end subroutine calc_phys_predictors_alg diff --git a/science/gungho/source/algorithm/physics/external_forcing_alg_mod.X90 b/science/gungho/source/algorithm/physics/external_forcing_alg_mod.X90 index 1a0eb304d..ebde5ce20 100644 --- a/science/gungho/source/algorithm/physics/external_forcing_alg_mod.X90 +++ b/science/gungho/source/algorithm/physics/external_forcing_alg_mod.X90 @@ -59,8 +59,7 @@ module external_forcing_alg_mod get_dx_at_w2 use mesh_mod, only: mesh_type use mr_indices_mod, only: nummr - use io_config_mod, only: subroutine_timers, write_diag, & - use_xios_io + use io_config_mod, only: write_diag, use_xios_io use planet_config_mod, only: kappa use section_choice_config_mod, only: cloud, cloud_um use cloud_config_mod, only: scheme, scheme_pc2 @@ -75,7 +74,8 @@ module external_forcing_alg_mod use vapour_forcing_profile_alg_mod, only: vapour_forcing_profile_alg use wind_forcing_profile_alg_mod, only: wind_forcing_profile_alg - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF use w2_filter_alg_mod, only: w2_filter_alg @@ -153,8 +153,9 @@ contains type( mesh_type ), pointer :: mesh => null() procedure(write_interface), pointer :: write_behaviour => null() + integer(tik) :: id - if ( subroutine_timers ) call timer("external_forcing_alg") + if ( LPROF ) call start_timing( id, 'external_forcing_alg' ) mesh => theta%get_mesh() height_wth => get_height_fv( Wtheta, mesh%get_id() ) @@ -457,8 +458,7 @@ contains call write_forcing_diagnostics(du_forcing=du_forcing, output_wind_inc=wind_forcing_done) end if - - if ( subroutine_timers ) call timer("external_forcing_alg") + if ( LPROF ) call stop_timing( id, 'external_forcing_alg' ) end subroutine external_forcing_alg diff --git a/science/gungho/source/algorithm/physics/fast_physics_alg_mod.X90 b/science/gungho/source/algorithm/physics/fast_physics_alg_mod.X90 index 34bc852f4..851921548 100644 --- a/science/gungho/source/algorithm/physics/fast_physics_alg_mod.X90 +++ b/science/gungho/source/algorithm/physics/fast_physics_alg_mod.X90 @@ -24,9 +24,8 @@ module fast_physics_alg_mod use log_mod, only: LOG_LEVEL_INFO, LOG_LEVEL_ERROR, log_event, & log_scratch_space use print_field_stats_alg_mod, only: print_field_stats_alg - use io_config_mod, only: subroutine_timers, & - write_conservation_diag - use timer_mod, only: timer + use io_config_mod, only: write_conservation_diag + use timing_mod, only: start_timing, stop_timing, tik, LPROF use physics_config_mod, only: blayer_placement, blayer_placement_fast, & convection_placement, & @@ -201,8 +200,9 @@ contains real( kind=r_def ) :: Rv, cpv, cl integer(i_def) :: i_mr + integer(tik) :: id - if ( subroutine_timers ) call timer("fast_physics") + if ( LPROF ) call start_timing( id, 'fast_physics' ) use_moisture = ( moisture_formulation /= moisture_formulation_dry ) @@ -411,7 +411,7 @@ contains call moisture_conservation_alg( rho, mr, 'After fast' ) end if - if ( subroutine_timers ) call timer("fast_physics") + if ( LPROF ) call stop_timing( id, 'fast_physics' ) end subroutine fast_physics diff --git a/science/gungho/source/algorithm/physics/map_fd_to_prognostics_alg_mod.x90 b/science/gungho/source/algorithm/physics/map_fd_to_prognostics_alg_mod.x90 index 7c006b9f1..3c5498ea1 100644 --- a/science/gungho/source/algorithm/physics/map_fd_to_prognostics_alg_mod.x90 +++ b/science/gungho/source/algorithm/physics/map_fd_to_prognostics_alg_mod.x90 @@ -45,7 +45,6 @@ module map_fd_to_prognostics_alg_mod get_geopotential use fs_continuity_mod, only: W3, W2, W2broken, Wtheta use sci_sort_ref_kernel_mod, only: sort_ref_kernel_type - use timer_mod, only: timer use combine_w2_field_kernel_mod, only: combine_w2_field_kernel_type use idealised_config_mod, only: perturb_init, & perturb_magnitude @@ -62,7 +61,6 @@ module map_fd_to_prognostics_alg_mod topology_fully_periodic use formulation_config_mod, only: rotating, shallow use finite_element_config_mod, only: coord_system, coord_system_native - use io_config_mod, only: subroutine_timers use physics_config_mod, only: sample_physics_winds, & sample_physics_winds_correction use planet_config_mod, only: gravity, p_zero, kappa, rd, cp @@ -230,6 +228,8 @@ contains use sci_w3_to_w2_average_kernel_mod, only: w3_to_w2_average_kernel_type use sci_w3_to_w2_correction_kernel_mod, & only: w3_to_w2_correction_kernel_type + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF implicit none @@ -249,8 +249,9 @@ contains type( function_space_type ), pointer :: w2b_fs type( mesh_type ), pointer :: mesh + integer(tik) :: id - if ( subroutine_timers ) call timer("set_wind") + if ( LPROF ) call start_timing( id, 'set_wind' ) mesh => u%get_mesh() @@ -326,7 +327,7 @@ contains call mass_matrix_solver_alg(u, r_u) end if - if ( subroutine_timers ) call timer("set_wind") + if ( LPROF ) call stop_timing( id, 'set_wind' ) end subroutine set_wind diff --git a/science/gungho/source/algorithm/physics/map_physics_fields_alg_mod.x90 b/science/gungho/source/algorithm/physics/map_physics_fields_alg_mod.x90 index af4f90412..f280ef887 100644 --- a/science/gungho/source/algorithm/physics/map_physics_fields_alg_mod.x90 +++ b/science/gungho/source/algorithm/physics/map_physics_fields_alg_mod.x90 @@ -34,9 +34,7 @@ module map_physics_fields_alg_mod use print_field_stats_alg_mod, only: print_field_stats_alg use sci_field_minmax_alg_mod, only: log_field_minmax - use io_config_mod, only: subroutine_timers - use timer_mod, only: timer - + use timing_mod, only: start_timing, stop_timing, tik, LPROF implicit none private @@ -88,10 +86,10 @@ contains type( mesh_type ), pointer :: mesh => null() - real(kind=r_def) :: l2 - - if ( subroutine_timers ) call timer("map_physics_fields") + real(kind=r_def) :: l2 + integer(tik) :: id + if ( LPROF ) call start_timing( id, 'map_physics_fields' ) mesh => u%get_mesh() call derived_fields%get_field('theta_in_w3', theta_in_w3) @@ -176,8 +174,7 @@ contains setval_X(u_in_w3_star, u_in_w3), & setval_X(v_in_w3_star, v_in_w3) ) end if - - if ( subroutine_timers ) call timer("map_physics_fields") + if ( LPROF ) call stop_timing( id, 'map_physics_fields' ) end subroutine map_physics_fields_alg diff --git a/science/gungho/source/algorithm/physics/slow_physics_alg_mod.X90 b/science/gungho/source/algorithm/physics/slow_physics_alg_mod.X90 index f2bbe547f..52a55e1be 100644 --- a/science/gungho/source/algorithm/physics/slow_physics_alg_mod.X90 +++ b/science/gungho/source/algorithm/physics/slow_physics_alg_mod.X90 @@ -89,9 +89,8 @@ module slow_physics_alg_mod use formulation_config_mod, only: moisture_formulation, & moisture_formulation_dry, & theta_moist_source - use io_config_mod, only: subroutine_timers, & - write_conservation_diag - use timer_mod, only: timer + use io_config_mod, only: write_conservation_diag + use timing_mod, only: start_timing, stop_timing, tik, LPROF use external_forcing_alg_mod, only: external_forcing_alg use evap_condense_kernel_mod, only: evap_condense_kernel_type use physics_mappings_alg_mod, only: map_physics_scalars @@ -364,8 +363,8 @@ contains type(mesh_type), pointer :: aerosol_mesh => null() type(mesh_type), pointer :: aerosol_twod_mesh => null() #endif - - if ( subroutine_timers ) call timer("slow_physics") + integer(tik) :: id + if ( LPROF ) call start_timing( id, 'slow_physics' ) !-------------------------------------------------------------------- ! Initialisation of fields and flags @@ -1175,8 +1174,7 @@ contains if (write_conservation_diag) & call moisture_conservation_alg( rho, mr, 'After slow' ) end if - - if ( subroutine_timers ) call timer("slow_physics") + if ( LPROF ) call stop_timing( id, 'slow_physics' ) end subroutine slow_physics diff --git a/science/gungho/source/algorithm/runtime_constants/dycore_constants_mod.x90 b/science/gungho/source/algorithm/runtime_constants/dycore_constants_mod.x90 index 9421aba5b..3baecd806 100644 --- a/science/gungho/source/algorithm/runtime_constants/dycore_constants_mod.x90 +++ b/science/gungho/source/algorithm/runtime_constants/dycore_constants_mod.x90 @@ -25,14 +25,15 @@ module dycore_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 model_clock_mod, only: model_clock_type use operator_mod, only: operator_type use quadrature_xyoz_mod, only: quadrature_xyoz_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, & @@ -102,6 +103,7 @@ contains type(field_type), pointer :: panel_id type(quadrature_xyoz_type), pointer :: qr type(function_space_type), pointer :: w2_fs + integer(tik) :: id ! Initialise inventory if it hasn't been done so already if (.not. coriolis_inventory%is_initialised()) then @@ -119,7 +121,7 @@ contains panel_id => get_panel_id(mesh_id) qr => get_qr_fe() - if ( subroutine_timers ) call timer('runtime_constants.dycore') + if ( LPROF ) call start_timing( id, 'runtime_constants.dycore' ) call coriolis_inventory%add_operator(coriolis, w2_fs, w2_fs, mesh) @@ -127,7 +129,7 @@ contains chi, panel_id, & scaled_omega, & f_lat, qr) ) - if ( subroutine_timers ) call timer('runtime_constants.dycore') + if ( LPROF ) call stop_timing( id, 'runtime_constants.dycore' ) end if ! Return constant @@ -156,6 +158,7 @@ contains type(quadrature_xyoz_type), pointer :: qr type(function_space_type), pointer :: w2_fs type(function_space_type), pointer :: wt_fs + integer(tik) :: id ! Initialise inventory if it hasn't been done so already if (.not. vert_coriolis_inventory%is_initialised()) then @@ -174,7 +177,7 @@ contains panel_id => get_panel_id(mesh_id) qr => get_qr_fe() - if ( subroutine_timers ) call timer('runtime_constants.dycore') + if ( LPROF ) call start_timing( id, 'runtime_constants.dycore' ) call vert_coriolis_inventory%add_operator(vert_coriolis, wt_fs, w2_fs, mesh) @@ -182,7 +185,7 @@ contains chi, panel_id, & scaled_omega, & f_lat, qr) ) - if ( subroutine_timers ) call timer('runtime_constants.dycore') + if ( LPROF ) call stop_timing( id, 'runtime_constants.dycore' ) end if ! Return constant @@ -209,6 +212,7 @@ contains type(field_type), pointer :: geopotential type(field_type), pointer :: chi(:) type(function_space_type), pointer :: w3_fs + integer(tik) :: id ! Initialise inventory if it hasn't been done so already if (.not. geopotential_inventory%is_initialised()) then @@ -224,7 +228,7 @@ contains element_order_v, W3) chi => get_coordinates(mesh_id) - if ( subroutine_timers ) call timer('runtime_constants.dycore') + if ( LPROF ) call start_timing( id, 'runtime_constants.dycore' ) call geopotential_inventory%add_field(geopotential, w3_fs, mesh) @@ -240,7 +244,7 @@ contains call log_event( "Geopotential computation needs modifying "// & "for standard W3 mapping", LOG_LEVEL_ERROR ) end if - if ( subroutine_timers ) call timer('runtime_constants.dycore') + if ( LPROF ) call stop_timing( id, 'runtime_constants.dycore' ) end if ! Return constant @@ -293,6 +297,7 @@ contains real(kind=r_def) :: const real(kind=r_second) :: dt type(operator_type), pointer :: coriolis + integer(tik) :: id ! Check inventories are initialised if (.not. mm_w2_si_inventory%is_initialised()) then @@ -371,7 +376,7 @@ contains panel_id => get_panel_id(mesh_id) qr => get_qr_fe() - if ( subroutine_timers ) call timer('runtime_constants.dycore') + if ( LPROF ) call start_timing( id, 'runtime_constants.dycore' ) call invoke( name = "compute_damping_layer_mass_matrix", & compute_dl_matrix_kernel_type(mm_w2_dl, chi, panel_id, & dl_base, dl_str, & @@ -381,7 +386,7 @@ contains element_order_v, & dt_stored, & qr) ) - if ( subroutine_timers ) call timer('runtime_constants.dycore') + if ( LPROF ) call stop_timing( id, 'runtime_constants.dycore' ) else ! No damping layer, just copy the W2 mass matrix on this level mm_w2 => get_mass_matrix_fe(W2, mesh_id) @@ -399,7 +404,7 @@ contains call mm_w2_dl_lagged_inventory%get_operator(mesh, mm_w2_dl_lagged) else ! We are going to need to create this matrix - if ( subroutine_timers ) call timer('runtime_constants.dycore') + if ( LPROF ) call start_timing( id, 'runtime_constants.dycore' ) if (w2_op_name == w2_lagged_damping_layer_matrix) then ! This is our target matrix, so store it @@ -423,7 +428,7 @@ contains ! No lagged orography, just copy the W2 mass matrix on this level call invoke( operator_setval_x_kernel_type(mm_w2_dl_lagged, mm_w2_dl) ) end if - if ( subroutine_timers ) call timer('runtime_constants.dycore') + if ( LPROF ) call stop_timing( id, 'runtime_constants.dycore' ) end if end if @@ -431,7 +436,7 @@ contains ! S.I. MATRIX ! ====================================================================== ! if (w2_op_name == w2_si_matrix) then - if ( subroutine_timers ) call timer('runtime_constants.dycore') + if ( LPROF ) call start_timing( id, 'runtime_constants.dycore' ) call mm_w2_si_inventory%add_operator(mm_w2_si, fs, fs, mesh) if ( rotating ) then @@ -449,8 +454,7 @@ contains call invoke( name = "set_w2_si_mass_matrix_with_damping_layer", & operator_x_plus_ay_kernel_type(mm_w2_si, mm_w2_dl_lagged, & const, coriolis) ) - - if ( subroutine_timers ) call timer('runtime_constants.dycore') + if ( LPROF ) call stop_timing( id, 'runtime_constants.dycore' ) end if end if diff --git a/science/gungho/source/algorithm/runtime_constants/limited_area_constants_mod.x90 b/science/gungho/source/algorithm/runtime_constants/limited_area_constants_mod.x90 index c709f92a2..b1c8479ac 100644 --- a/science/gungho/source/algorithm/runtime_constants/limited_area_constants_mod.x90 +++ b/science/gungho/source/algorithm/runtime_constants/limited_area_constants_mod.x90 @@ -29,7 +29,6 @@ module limited_area_constants_mod use sci_geometric_constants_mod, only: get_coordinates use inventory_by_local_mesh_mod, only: inventory_by_local_mesh_type use inventory_by_mesh_mod, only: inventory_by_mesh_type - use io_config_mod, only: subroutine_timers use lfric_xios_write_mod, only: write_field_generic use local_mesh_mod, only: local_mesh_type use log_mod, only: log_event, & @@ -37,7 +36,8 @@ module limited_area_constants_mod LOG_LEVEL_DEBUG 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 base_mesh_config_mod, only: geometry, geometry_spherical @@ -165,9 +165,10 @@ contains type(field_type) :: w2parallel_mask type(field_type) :: w2perp_mask type(field_type) :: w2interior_mask + integer(tik) :: id ! Temporary mask fields to point to those in inventories - if ( subroutine_timers ) call timer('runtime_constants.limited_area') + if ( LPROF ) call start_timing( id, 'runtime_constants.limited_area' ) ! Point to the correct inventories if (use_fe) then @@ -259,7 +260,7 @@ contains if (run_log_level == run_log_level_debug) call list_mask_fields() - if ( subroutine_timers ) call timer('runtime_constants.limited_area') + if ( LPROF ) call stop_timing( id, 'runtime_constants.limited_area' ) end subroutine create_standard_masks @@ -296,8 +297,9 @@ contains integer(kind=i_def) :: i integer(kind=i_def) :: current_fs_id integer(kind=i_def) :: k_h, k_v + integer(tik) :: id - if ( subroutine_timers ) call timer('runtime_constants.limited_area') + if ( LPROF ) call start_timing( id, 'runtime_constants.limited_area' ) ! Point to the correct inventories if (use_fe) then @@ -356,7 +358,7 @@ contains ! Return function space chain to its position call multigrid_function_space_chain%set_current(current_fs_id) - if ( subroutine_timers ) call timer('runtime_constants.limited_area') + if ( LPROF ) call stop_timing( id, 'runtime_constants.limited_area' ) end subroutine !> @brief Write out the name of each mask in the mask field collection @@ -659,6 +661,7 @@ contains type(inventory_by_mesh_type), pointer :: inventory character(len=str_def) :: inventory_name type(function_space_type), pointer :: fs + integer(tik) :: id ! Get appropriate inventory select case (space) @@ -690,14 +693,14 @@ contains ! Create constant if it doesn't already exist mask_r_def => get_mask_fe(space, mesh_id, finest_mesh_name) - if ( subroutine_timers ) call timer('runtime_constants.limited_area') + if ( LPROF ) call start_timing( id, 'runtime_constants.limited_area' ) fs => function_space_collection%get_fs(mesh, element_order_h, & element_order_v, space) call inventory%add_field(mask_r_solver, fs, mesh) call copy_field(mask_r_def, mask_r_solver) - if ( subroutine_timers ) call timer('runtime_constants.limited_area') + if ( LPROF ) call stop_timing( id, 'runtime_constants.limited_area' ) end if ! Return constant @@ -724,6 +727,7 @@ contains logical(kind=l_def) :: constant_exists 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 @@ -753,7 +757,7 @@ contains if (.not. constant_exists) then ! Create constant if it doesn't already exist - if ( subroutine_timers ) call timer('runtime_constants.limited_area') + if ( LPROF ) call start_timing( id, 'runtime_constants.limited_area' ) ! Check if this is the finest mesh finest_mesh => mesh_collection%get_mesh(finest_mesh_name) @@ -767,7 +771,7 @@ contains call create_standard_masks(mesh, use_fe=.true., & finest_mesh_name=finest_mesh_name) - if ( subroutine_timers ) call timer('runtime_constants.limited_area') + if ( LPROF ) call stop_timing( id, 'runtime_constants.limited_area' ) end if ! Return constant @@ -794,6 +798,7 @@ contains logical(kind=l_def) :: constant_exists type(inventory_by_mesh_type), pointer :: inventory character(len=str_def) :: inventory_name + integer(tik) :: id ! Get appropriate inventory select case (space) @@ -817,7 +822,7 @@ contains if (.not. constant_exists) then ! Create constant if it doesn't already exist - if ( subroutine_timers ) call timer('runtime_constants.limited_area') + if ( LPROF ) call start_timing( id, 'runtime_constants.limited_area' ) ! Check if this is the finest mesh finest_mesh => mesh_collection%get_mesh(finest_mesh_name) @@ -831,7 +836,7 @@ contains call create_standard_masks(mesh, use_fe=.false., & finest_mesh_name=finest_mesh_name) - if ( subroutine_timers ) call timer('runtime_constants.limited_area') + if ( LPROF ) call stop_timing( id, 'runtime_constants.limited_area' ) end if ! Return constant @@ -861,6 +866,7 @@ contains character(len=str_def) :: inventory_name character(len=str_def) :: field_name type(function_space_type), pointer :: fs + integer(tik) :: id ! If running at lowest order, use finite volume if (element_order_h == 0 .and. element_order_v == 0) then @@ -902,7 +908,7 @@ contains onion_layers => get_onion_layers(mesh_id, finest_mesh_name) chi => get_coordinates(mesh_id) - if ( subroutine_timers ) call timer('runtime_constants.limited_area') + if ( LPROF ) call start_timing( id, 'runtime_constants.limited_area' ) fs => function_space_collection%get_fs(mesh, element_order_h, & element_order_v, space) @@ -916,7 +922,7 @@ contains end if call mask_collection%add_field( mask_ptr ) - if ( subroutine_timers ) call timer('runtime_constants.limited_area') + if ( LPROF ) call stop_timing( id, 'runtime_constants.limited_area' ) end if ! Return constant @@ -946,6 +952,7 @@ contains character(len=str_def) :: inventory_name character(len=str_def) :: field_name type(function_space_type), pointer :: fs + integer(tik) :: id ! Get appropriate inventory select case (space) @@ -981,7 +988,7 @@ contains onion_layers => get_onion_layers(mesh_id, finest_mesh_name) chi => get_coordinates(mesh_id) - if ( subroutine_timers ) call timer('runtime_constants.limited_area') + if ( LPROF ) call start_timing( id, 'runtime_constants.limited_area' ) fs => function_space_collection%get_fs(mesh, 0, 0, space) call inventory%add_field(mask_ptr, fs, mesh, name=field_name) @@ -994,7 +1001,7 @@ contains end if call mask_collection%add_field( mask_ptr ) - if ( subroutine_timers ) call timer('runtime_constants.limited_area') + if ( LPROF ) call stop_timing( id, 'runtime_constants.limited_area' ) end if ! Return constant @@ -1021,6 +1028,7 @@ contains type(field_type), pointer :: onion_layers logical(kind=l_def) :: constant_exists type(function_space_type), pointer :: w3_fs + integer(tik) :: id ! Initialise inventory if this is the first time getting this constant if (.not. onion_layers_inventory%is_initialised()) then @@ -1041,7 +1049,7 @@ contains if (prime_mesh%get_id() == finest_mesh%get_id()) then - if ( subroutine_timers ) call timer('runtime_constants.limited_area') + if ( LPROF ) call start_timing( id, 'runtime_constants.limited_area' ) ! Onion layers are only defined for lowest order finite elements w3_fs => function_space_collection%get_fs( & @@ -1062,7 +1070,7 @@ contains call mask_collection%initialise(name='mask_collection') end if call mask_collection%add_field( onion_layers ) - if ( subroutine_timers ) call timer('runtime_constants.limited_area') + if ( LPROF ) call stop_timing( id, 'runtime_constants.limited_area' ) else call log_event('Onion layers only implemented on finest mesh', LOG_LEVEL_ERROR) @@ -1095,6 +1103,7 @@ contains type(inventory_by_mesh_type), pointer :: inventory character(len=str_def) :: inventory_name type(function_space_type), pointer :: fs + integer(tik) :: id ! Get appropriate inventory select case (space) @@ -1127,7 +1136,7 @@ contains onion_layers => get_onion_layers(mesh_id, finest_mesh_name) chi => get_coordinates(mesh_id) - if ( subroutine_timers ) call timer('runtime_constants.limited_area') + if ( LPROF ) call start_timing( id, 'runtime_constants.limited_area' ) fs => function_space_collection%get_fs(mesh, element_order_h, & element_order_v, space) @@ -1141,7 +1150,7 @@ contains end if call mask_collection%add_field( mask_ptr ) - if ( subroutine_timers ) call timer('runtime_constants.limited_area') + if ( LPROF ) call stop_timing( id, 'runtime_constants.limited_area' ) end if ! Return constant diff --git a/science/gungho/source/algorithm/runtime_constants/physics_constants_mod.X90 b/science/gungho/source/algorithm/runtime_constants/physics_constants_mod.X90 index db3321e1d..94a95dcf1 100644 --- a/science/gungho/source/algorithm/runtime_constants/physics_constants_mod.X90 +++ b/science/gungho/source/algorithm/runtime_constants/physics_constants_mod.X90 @@ -26,13 +26,13 @@ module physics_constants_mod use function_space_mod, only: function_space_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 model_clock_mod, only: model_clock_type - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF implicit none @@ -120,6 +120,7 @@ contains integer(i_def), parameter :: n_centres = 1_i_def logical(l_def), parameter :: inc_surf = .true. logical(l_def), parameter :: ign_surf = .false. + integer(tik) :: id mesh_id = mesh%get_id() @@ -129,7 +130,7 @@ contains height_wth => get_height_fv(Wtheta, mesh_id) delta_at_wtheta => get_delta_at_wtheta(mesh_id) - if ( subroutine_timers ) call timer('runtime_constants.physics') + if ( LPROF ) call start_timing( id, 'runtime_constants.physics' ) if (.not. dtrdz_fd2_inventory%is_initialised()) then call dtrdz_fd2_inventory%initialise(name='dtrdz_fd2') @@ -207,7 +208,7 @@ contains inc_X_powint_n(max_diff_wtheta, 2_i_def), & inc_a_times_X(diffusion_const, max_diff_wtheta) ) - if ( subroutine_timers ) call timer('runtime_constants.physics') + if ( LPROF ) call stop_timing( id, 'runtime_constants.physics' ) end subroutine create_mixing_geometries @@ -408,6 +409,7 @@ contains type(mesh_type), pointer :: twod_mesh type(function_space_type), pointer :: fs logical(kind=l_def) :: constant_exists + integer(tik) :: id ! Check inventory is initialised if (.not. Pnm_star_inventory%is_initialised()) then @@ -425,14 +427,14 @@ contains latitude => get_latitude_fv(W3, mesh_id) fs => function_space_collection%get_fs(twod_mesh, 0, 0, W3, stph_spectral_dim) - if ( subroutine_timers ) call timer('runtime_constants.physics') + if ( LPROF ) call start_timing( id, 'runtime_constants.physics' ) call Pnm_star_inventory%add_field(Pnm_star, fs, local_mesh) call invoke( setval_c(Pnm_star, 0.0_r_def), & get_Pnm_star_kernel_type(Pnm_star, latitude, stph_n_max) ) - if ( subroutine_timers ) call timer('runtime_constants.physics') + if ( LPROF ) call stop_timing( id, 'runtime_constants.physics' ) end if call Pnm_star_inventory%get_field(local_mesh, Pnm_star) diff --git a/science/gungho/source/algorithm/runtime_constants/runtime_constants_mod.f90 b/science/gungho/source/algorithm/runtime_constants/runtime_constants_mod.f90 index b47d85b51..2ba68ed68 100644 --- a/science/gungho/source/algorithm/runtime_constants/runtime_constants_mod.f90 +++ b/science/gungho/source/algorithm/runtime_constants/runtime_constants_mod.f90 @@ -14,15 +14,13 @@ module runtime_constants_mod use base_mesh_config_mod, only: prime_mesh_name use constants_mod, only: i_def, l_def use formulation_config_mod, only: l_multigrid - use io_config_mod, only: subroutine_timers use log_mod, only: log_event, LOG_LEVEL_INFO, & LOG_LEVEL_ERROR use mesh_collection_mod, only: mesh_collection use mesh_mod, only: mesh_type use model_clock_mod, only: model_clock_type use multigrid_config_mod, only: chain_mesh_tags - use timer_mod, only: timer - + use timing_mod, only: start_timing, stop_timing, tik, LPROF implicit none private @@ -46,8 +44,9 @@ subroutine create_runtime_constants() integer(kind=i_def) :: i integer(kind=i_def), allocatable :: mg_mesh_ids(:) integer(kind=i_def) :: num_mg_meshes + integer(tik) :: id - if ( subroutine_timers ) call timer('runtime_constants_alg') + if ( LPROF ) call start_timing( id, 'runtime_constants_alg' ) !==========================================================================! ! Turn all the meshes and coordinate fields into lists @@ -81,7 +80,7 @@ subroutine create_runtime_constants() ! code structure call runge_kutta_init() - if ( subroutine_timers ) call timer('runtime_constants_alg') + if ( LPROF ) call stop_timing( id, 'runtime_constants_alg' ) end subroutine create_runtime_constants diff --git a/science/gungho/source/algorithm/runtime_constants/solver_constants_mod.x90 b/science/gungho/source/algorithm/runtime_constants/solver_constants_mod.x90 index 2070e1038..eb1c31144 100644 --- a/science/gungho/source/algorithm/runtime_constants/solver_constants_mod.x90 +++ b/science/gungho/source/algorithm/runtime_constants/solver_constants_mod.x90 @@ -24,7 +24,6 @@ module solver_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 @@ -32,7 +31,8 @@ module solver_constants_mod r_solver_operator_type use quadrature_xyoz_mod, only: quadrature_xyoz_type use r_solver_field_mod, only: r_solver_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, & @@ -107,6 +107,7 @@ contains type(field_type), pointer :: chi(:) type(field_type), pointer :: panel_id type(function_space_type), pointer :: w3_fs + integer(tik) :: id ! Check inventory is initialised if (.not. detj_at_w3_r_solver_inventory%is_initialised()) then @@ -122,7 +123,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.solver') + if ( LPROF ) call start_timing( id, 'runtime_constants.solver' ) w3_fs => function_space_collection%get_fs(mesh, element_order_h, & element_order_v, W3) @@ -131,7 +132,7 @@ contains halo_depth = 0 ! No need to calculate into halos call invoke( calc_detj_at_w3_kernel_type(detj_r_solver, chi, panel_id, & halo_depth) ) - if ( subroutine_timers ) call timer('runtime_constants.solver') + if ( LPROF ) call stop_timing( id, 'runtime_constants.solver' ) end if ! Get existing constant @@ -162,6 +163,7 @@ contains type(r_solver_operator_type), pointer :: mm_r_solver 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) @@ -189,7 +191,7 @@ contains ! Create constant if it doesn't already exist mm_r_def => get_mass_matrix_fe(space, mesh_id) - if ( subroutine_timers ) call timer('runtime_constants.solver') + if ( LPROF ) call start_timing( id, 'runtime_constants.solver' ) fs => function_space_collection%get_fs(mesh, element_order_h, & element_order_v, space) @@ -197,7 +199,7 @@ contains call invoke( operator_setval_x_kernel_type(mm_r_solver, mm_r_def) ) - if ( subroutine_timers ) call timer('runtime_constants.solver') + if ( LPROF ) call stop_timing( id, 'runtime_constants.solver' ) end if ! Return existing constant @@ -223,6 +225,7 @@ contains type(r_solver_operator_type), pointer :: mm_inv_r_solver 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) @@ -247,7 +250,7 @@ contains ! Create constant if it doesn't already exist mm_inv_r_def => get_inverse_mass_matrix_fe(space, mesh_id) - if ( subroutine_timers ) call timer('runtime_constants.solver') + if ( LPROF ) call start_timing( id, 'runtime_constants.solver' ) fs => function_space_collection%get_fs(mesh, element_order_h, & element_order_v, space) @@ -255,7 +258,7 @@ contains call invoke( operator_setval_x_kernel_type(mm_inv_r_solver, mm_inv_r_def) ) - if ( subroutine_timers ) call timer('runtime_constants.solver') + if ( LPROF ) call stop_timing( id, 'runtime_constants.solver' ) end if ! Return existing constant @@ -284,6 +287,7 @@ contains type(operator_type), pointer :: mm_r_def type(r_solver_operator_type), pointer :: mm_r_solver type(inventory_by_mesh_type), pointer :: inventory + integer(tik) :: id ! Determine which inventory to point to select case (w2_op_name) @@ -307,7 +311,7 @@ contains ! Create constant if it doesn't already exist mm_r_def => get_w2_mass_matrix(w2_op_name, mesh_id) - if ( subroutine_timers ) call timer('runtime_constants.solver') + if ( LPROF ) call start_timing( id, 'runtime_constants.solver' ) fs => function_space_collection%get_fs(mesh, element_order_h, & element_order_v, W2) @@ -315,7 +319,7 @@ contains call invoke( operator_setval_x_kernel_type(mm_r_solver, mm_r_def) ) - if ( subroutine_timers ) call timer('runtime_constants.solver') + if ( LPROF ) call stop_timing( id, 'runtime_constants.solver' ) end if ! Return existing constant @@ -344,6 +348,7 @@ contains type(quadrature_xyoz_type), pointer :: qr 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_r_solver_inventory%is_initialised()) then @@ -366,7 +371,7 @@ contains w3_fs => function_space_collection%get_fs( mesh, element_order_h, & element_order_v, W3 ) - if ( subroutine_timers ) call timer('runtime_constants.solver') + if ( LPROF ) call start_timing( id, 'runtime_constants.solver' ) call div_r_solver%initialise( w3_fs, w2_fs ) call im3_div_r_solver_inventory%add_operator(im3_div_r_solver, w3_fs, w2_fs, mesh) ! @TODO #416: may be able to optimise memory by calculating div @@ -375,7 +380,7 @@ contains operator_x_times_y_kernel_type(im3_div_r_solver, & mm_w3_inv_r_solver, & div_r_solver) ) - if ( subroutine_timers ) call timer('runtime_constants.solver') + if ( LPROF ) call stop_timing( id, 'runtime_constants.solver' ) end if call im3_div_r_solver_inventory%get_operator(mesh, im3_div_r_solver) @@ -408,6 +413,7 @@ contains type(field_type), pointer :: panel_id type(function_space_type), pointer :: fs integer(kind=i_def), parameter :: i_minus_one = -1_i_def + integer(tik) :: id ! Special case, Wtheta normalisation is the lumped inverse mass matrix select case (space) @@ -430,7 +436,7 @@ contains fs => function_space_collection%get_fs(mesh, element_order_h, & element_order_v, space) - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call start_timing( id, 'runtime_constants.fem' ) call nodal_multiplicity%initialise( fs ) call w2_normalisation_inventory%add_field(normalisation, fs, mesh) @@ -443,7 +449,7 @@ contains nodal_multiplicity), & inc_X_powint_n(normalisation, i_minus_one) ) - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call stop_timing( id, 'runtime_constants.fem' ) end if ! Return constant @@ -473,6 +479,7 @@ contains type(r_solver_field_type), pointer :: normalisation_r_solver 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) @@ -500,7 +507,7 @@ contains ! Create constant if it doesn't already exist normalisation_r_def => get_normalisation(space, mesh_id) - if ( subroutine_timers ) call timer('runtime_constants.solver') + if ( LPROF ) call start_timing( id, 'runtime_constants.solver' ) fs => function_space_collection%get_fs(mesh, element_order_h, & element_order_v, space) @@ -508,7 +515,7 @@ contains call copy_field(normalisation_r_def, normalisation_r_solver) - if ( subroutine_timers ) call timer('runtime_constants.solver') + if ( LPROF ) call stop_timing( id, 'runtime_constants.solver' ) end if ! Return existing constant diff --git a/science/gungho/source/algorithm/runtime_constants/transport_constants_mod.x90 b/science/gungho/source/algorithm/runtime_constants/transport_constants_mod.x90 index 4da0c7222..9fc70bf38 100644 --- a/science/gungho/source/algorithm/runtime_constants/transport_constants_mod.x90 +++ b/science/gungho/source/algorithm/runtime_constants/transport_constants_mod.x90 @@ -31,7 +31,6 @@ module transport_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_scratch_space, & LOG_LEVEL_ERROR, & @@ -48,7 +47,8 @@ module transport_constants_mod use reference_element_mod, only: reference_element_type use r_tran_field_mod, only: r_tran_field_type use sci_field_minmax_alg_mod, only: get_field_minmax - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF ! Kernels use sci_operator_algebra_kernel_mod, only: operator_setval_x_kernel_type @@ -183,8 +183,9 @@ contains logical(kind=l_def) :: linear_remap integer(kind=i_def) :: ndata, halo_depth + integer(tik) :: id - if ( subroutine_timers ) call timer('runtime_constants.transport') + if ( LPROF ) call start_timing( id, 'runtime_constants.transport' ) if (.not. ext_mesh_weights_inventory%is_initialised()) then call ext_mesh_weights_inventory%initialise(name="extended_mesh_weights") @@ -227,7 +228,7 @@ contains linear_remap, ndata & ) - if ( subroutine_timers ) call timer('runtime_constants.transport') + if ( LPROF ) call stop_timing( id, 'runtime_constants.transport' ) end subroutine initialise_remap_on_extended_mesh @@ -257,8 +258,9 @@ contains type(field_type), pointer :: panel_id integer(kind=i_def) :: ncolumns_1d integer(kind=i_def), parameter :: MINUS_FAR_AWAY = -FAR_AWAY + integer(tik) :: id - if ( subroutine_timers ) call timer('runtime_constants.transport') + if ( LPROF ) call start_timing( id, 'runtime_constants.transport' ) ! Initialise inventories if they haven't already been if (.not. panel_edge_dist_inventory%is_initialised()) then @@ -306,7 +308,7 @@ contains int_setval_c(panel_edge_dist(4), MINUS_FAR_AWAY) ) end if - if ( subroutine_timers ) call timer('runtime_constants.transport') + if ( LPROF ) call stop_timing( id, 'runtime_constants.transport' ) end subroutine compute_panel_edge_dists @@ -333,10 +335,11 @@ contains type(field_type), pointer :: panel_edge_coords_y(:) type(field_type), pointer :: chi(:) type(field_type), pointer :: panel_id + integer(kind=tik) :: id panel_edge_dist => get_panel_edge_dist(mesh_id) - if ( subroutine_timers ) call timer('runtime_constants.transport') + if ( LPROF ) call start_timing( id, 'runtime_constants.transport' ) ! Initialise inventories if they haven't already been if (.not. panel_edge_coords_x_inventory%is_initialised()) then @@ -368,7 +371,7 @@ contains panel_edge_dist, & depth, field_depth) ) - if ( subroutine_timers ) call timer('runtime_constants.transport') + if ( LPROF ) call stop_timing( id, 'runtime_constants.transport' ) end subroutine compute_panel_edge_coords @@ -400,6 +403,7 @@ contains type(function_space_type), pointer :: w3_fs integer(kind=i_def) :: ndata, max_halo_depth, remap_depth, cross_depth + integer(kind=tik) :: id ! Get pointers to coordinates and masks for panel edges chi => get_coordinates(mesh_id) @@ -408,7 +412,7 @@ contains panel_edge_coords_x => get_panel_edge_coords_x(mesh_id) panel_edge_coords_y => get_panel_edge_coords_y(mesh_id) - if ( subroutine_timers ) call timer('runtime_constants.transport') + if ( LPROF ) call start_timing( id, 'runtime_constants.transport' ) ! Set up fields on 2D mesh in multidata W3 space mesh => mesh_collection%get_mesh(mesh_id) @@ -479,7 +483,7 @@ contains remap_depth) & ) - if ( subroutine_timers ) call timer('runtime_constants.transport') + if ( LPROF ) call stop_timing( id, 'runtime_constants.transport' ) end subroutine compute_panel_edge_weights @@ -503,8 +507,9 @@ contains type(function_space_type), pointer :: w3_fs integer(kind=i_def) :: max_halo_depth, cross_depth + integer(kind=tik) :: id - if ( subroutine_timers ) call timer('runtime_constants.transport') + if ( LPROF ) call start_timing( id, 'runtime_constants.transport' ) ! Set up fields on 2D mesh in multidata W3 space mesh => mesh_collection%get_mesh(mesh_id) @@ -539,7 +544,7 @@ contains call invoke_halo_mask_xy_kernel_type(halo_mask_x, halo_mask_y, halo_mask, & cross_depth, max_halo_depth) - if ( subroutine_timers ) call timer('runtime_constants.transport') + if ( LPROF ) call stop_timing( id, 'runtime_constants.transport' ) end subroutine compute_halo_masks @@ -559,6 +564,7 @@ contains type(r_tran_field_type) :: dz_w3_rtran type(field_type), pointer :: dz_w3_rdef type(function_space_type), pointer :: w3_fs + integer(tik) :: id ! Check inventory is initialised if (.not. third_dla_dz_inventory%is_initialised()) then @@ -573,7 +579,7 @@ contains mesh => mesh_collection%get_mesh(mesh_id) - if ( subroutine_timers ) call timer('runtime_constants.transport') + if ( LPROF ) call start_timing( id, 'runtime_constants.transport' ) w3_fs => function_space_collection%get_fs(mesh, 0, 0, W3) @@ -586,7 +592,7 @@ contains call invoke( ffsl_third_dldz_kernel_type(dla_dz, dlb_dz, dz_w3_rtran) ) - if ( subroutine_timers ) call timer('runtime_constants.transport') + if ( LPROF ) call stop_timing( id, 'runtime_constants.transport' ) end subroutine compute_third_dl_dz @@ -617,6 +623,7 @@ contains type(field_type), pointer :: panel_id type(field_type), pointer :: detj_r_def type(function_space_type), pointer :: w3_fs + integer(tik) :: id ! Check inventory is initialised if (.not. detj_at_w3_r_tran_inventory%is_initialised()) then @@ -646,7 +653,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.transport') + if ( LPROF ) call start_timing( id, 'runtime_constants.transport' ) w3_fs => function_space_collection%get_fs(mesh, & element_order_h, & @@ -662,7 +669,7 @@ contains else call copy_field(detj_r_def, detj_r_tran) end if - if ( subroutine_timers ) call timer('runtime_constants.transport') + if ( LPROF ) call stop_timing( id, 'runtime_constants.transport' ) end if ! Get existing constant @@ -693,6 +700,7 @@ contains integer(kind=i_def) :: detj_direction integer(kind=i_def) :: element_order_h, & element_order_v + integer(tik) :: id ! Check inventory is initialised if (.not. detj_at_w2_above_inventory%is_initialised()) then @@ -718,7 +726,7 @@ contains end if ! Create the object as it doesn't exist yet - if ( subroutine_timers ) call timer('runtime_constants.transport') + if ( LPROF ) call start_timing( id, 'runtime_constants.transport' ) detj_direction = 1 w2_fs => function_space_collection%get_fs(mesh, & @@ -731,7 +739,7 @@ contains calc_directional_detj_at_w2_kernel_type(detj_above, & chi, panel_id, & detj_direction) ) - if ( subroutine_timers ) call timer('runtime_constants.transport') + if ( LPROF ) call stop_timing( id, 'runtime_constants.transport' ) end if ! Get existing constant @@ -762,6 +770,7 @@ contains integer(kind=i_def) :: detj_direction integer(kind=i_def) :: element_order_h, & element_order_v + integer(tik) :: id ! Check inventory is initialised if (.not. detj_at_w2_below_inventory%is_initialised()) then @@ -786,7 +795,7 @@ contains end if ! Create the object as it doesn't exist yet - if ( subroutine_timers ) call timer('runtime_constants.transport') + if ( LPROF ) call start_timing( id, 'runtime_constants.transport' ) detj_direction = 0 w2_fs => function_space_collection%get_fs(mesh, & @@ -799,7 +808,7 @@ contains calc_directional_detj_at_w2_kernel_type(detj_below, & chi, panel_id, & detj_direction) ) - if ( subroutine_timers ) call timer('runtime_constants.transport') + if ( LPROF ) call stop_timing( id, 'runtime_constants.transport' ) end if ! Get existing constant @@ -887,6 +896,7 @@ contains type(r_tran_field_type) :: dz_w3_rtran type(field_type), pointer :: dz_w3_rdef type(function_space_type), pointer :: w2v_fs + integer(tik) :: id ! Check inventory is initialised if (.not. fourth_dl_dz_inventory%is_initialised()) then @@ -900,7 +910,7 @@ contains if (.not. constant_exists) then ! Create the object as it doesn't exist yet - if ( subroutine_timers ) call timer('runtime_constants.transport') + if ( LPROF ) call start_timing( id, 'runtime_constants.transport' ) w2v_fs => function_space_collection%get_fs(mesh, 0, 0, W2v) @@ -912,7 +922,7 @@ contains call invoke( ffsl_fourth_dldz_kernel_type(dl_dz, dz_w3_rtran) ) - if ( subroutine_timers ) call timer('runtime_constants.transport') + if ( LPROF ) call stop_timing( id, 'runtime_constants.transport' ) end if ! Get existing constant @@ -946,6 +956,7 @@ contains character(len=str_def) :: inventory_name integer(kind=i_def) :: element_order_h, & element_order_v + integer(tik) :: id ! Point to appropriate inventory for this space select case (space) @@ -978,7 +989,7 @@ contains mm_r_def => get_mass_matrix_fe(space, mesh_id) end if - if ( subroutine_timers ) call timer('runtime_constants.transport') + if ( LPROF ) call start_timing( id, 'runtime_constants.transport' ) fs => function_space_collection%get_fs(mesh, & element_order_h, & @@ -988,7 +999,7 @@ contains call invoke( operator_setval_x_kernel_type(mm_r_tran, mm_r_def) ) - if ( subroutine_timers ) call timer('runtime_constants.transport') + if ( LPROF ) call stop_timing( id, 'runtime_constants.transport' ) end if ! Return existing constant @@ -1018,6 +1029,7 @@ contains character(len=str_def) :: inventory_name integer(kind=i_def) :: element_order_h, & element_order_v + integer(tik) :: id ! Point to appropriate inventory for this space select case (space) @@ -1050,7 +1062,7 @@ contains mm_inv_r_def => get_inverse_mass_matrix_fe(space, mesh_id) end if - if ( subroutine_timers ) call timer('runtime_constants.transport') + if ( LPROF ) call start_timing( id, 'runtime_constants.transport' ) fs => function_space_collection%get_fs(mesh, & element_order_h, & @@ -1060,7 +1072,7 @@ contains call invoke( operator_setval_x_kernel_type(mm_inv_r_tran, mm_inv_r_def) ) - if ( subroutine_timers ) call timer('runtime_constants.transport') + if ( LPROF ) call stop_timing( id, 'runtime_constants.transport' ) end if ! Return existing constant @@ -1139,6 +1151,7 @@ contains integer(kind=i_def) :: fs_id integer(kind=i_def) :: element_order_h, & element_order_v + integer(tik) :: id ! Point to appropriate inventory for this space select case (direction) @@ -1195,14 +1208,14 @@ contains w3_fs => function_space_collection%get_fs( mesh, element_order_h, & element_order_v, W3 ) - if ( subroutine_timers ) call timer('runtime_constants.transport') + if ( LPROF ) call start_timing( id, 'runtime_constants.transport' ) call div%initialise( w3_fs, w2_fs ) call im3_div%initialise( w3_fs, w2_fs ) call inventory%add_operator(im3_div_r_tran, w3_fs, w2_fs, mesh) call invoke( compute_div_operator_kernel_type(div, chi, panel_id, qr), & operator_x_times_y_kernel_type(im3_div, mm_w3_inv, div), & operator_setval_x_kernel_type(im3_div_r_tran, im3_div) ) - if ( subroutine_timers ) call timer('runtime_constants.transport') + if ( LPROF ) call stop_timing( id, 'runtime_constants.transport' ) end if call inventory%get_operator(mesh, im3_div_r_tran) @@ -1634,6 +1647,7 @@ contains integer(kind=i_def) :: nqp_xy, nqp_z, nqp_xyz integer(kind=i_def) :: element_order_h, element_order_v real(kind=r_def) :: transform_radius, chi3_max + integer(tik) :: id class(reference_element_type), pointer :: reference_element @@ -1667,7 +1681,7 @@ contains chi => get_coordinates(mesh%get_id()) panel_id => get_panel_id(mesh%get_id()) - if ( subroutine_timers ) call timer('runtime_constants.transport') + if ( LPROF ) call start_timing( id, 'runtime_constants.transport' ) reference_element => mesh%get_reference_element() @@ -1792,7 +1806,7 @@ contains qr, qrf) ) end if - if ( subroutine_timers ) call timer('runtime_constants.transport') + if ( LPROF ) call stop_timing( id, 'runtime_constants.transport' ) end if @@ -1822,6 +1836,7 @@ contains logical(kind=l_def) :: constant_exists type(quadrature_rule_gaussian_type) :: gaussian_quadrature type(quadrature_xyoz_type) :: qr + integer(tik) :: id ! Initialise inventory if it hasn't been done so already if (.not. vert_w3_mol_coeffs_inventory%is_initialised()) then @@ -1835,7 +1850,7 @@ contains if (.not. constant_exists) then height => get_height_fv(Wtheta, mesh%get_id()) - if ( subroutine_timers ) call timer('runtime_constants.transport') + if ( LPROF ) call start_timing( id, 'runtime_constants.transport' ) ndata_v = 2*(fv_vertical_order + 1) nqp_xyz = fv_vertical_order + 1_i_def qr = quadrature_xyoz_type(nqp_xyz, gaussian_quadrature) @@ -1854,7 +1869,7 @@ contains ndata_v, & fv_vertical_order, & qr) ) - if ( subroutine_timers ) call timer('runtime_constants.transport') + if ( LPROF ) call stop_timing( id, 'runtime_constants.transport' ) end if ! Return constant @@ -1884,6 +1899,7 @@ contains logical(kind=l_def) :: constant_exists type(quadrature_rule_gaussian_type) :: gaussian_quadrature type(quadrature_xyoz_type) :: qr + integer(tik) :: id ! Initialise inventory if it hasn't been done so already if (.not. rev_vert_w3_mol_coeffs_inventory%is_initialised()) then @@ -1899,7 +1915,7 @@ contains if (.not. constant_exists) then height => get_height_fv(Wtheta, mesh%get_id()) - if ( subroutine_timers ) call timer('runtime_constants.transport') + if ( LPROF ) call start_timing( id, 'runtime_constants.transport' ) vertical_order = fv_vertical_order - 1 ndata_v = fv_vertical_order nqp_xyz = fv_vertical_order + 1_i_def @@ -1918,7 +1934,7 @@ contains ndata_v, & vertical_order, & qr) ) - if ( subroutine_timers ) call timer('runtime_constants.transport') + if ( LPROF ) call stop_timing( id, 'runtime_constants.transport' ) end if ! Return constant @@ -1980,6 +1996,7 @@ contains real(kind=r_def) :: transform_radius, chi3_max type(quadrature_rule_gauss_lobatto_type) :: gauss_lobatto_quadrature class(reference_element_type), pointer :: reference_element + integer(tik) :: id ! Initialise inventory if it hasn't been done so already if (.not. hori_wt_mol_coeffs_inventory%is_initialised()) then @@ -2009,7 +2026,7 @@ contains chi => get_coordinates(mesh%get_id()) panel_id => get_panel_id(mesh%get_id()) - if ( subroutine_timers ) call timer('runtime_constants.transport') + if ( LPROF ) call start_timing( id, 'runtime_constants.transport' ) reference_element => mesh%get_reference_element() @@ -2138,7 +2155,7 @@ contains qr, qre) ) end if - if ( subroutine_timers ) call timer('runtime_constants.transport') + if ( LPROF ) call stop_timing( id, 'runtime_constants.transport' ) end if @@ -2166,6 +2183,7 @@ contains integer(kind=i_def) :: vertical_order integer(kind=i_def) :: ndata_v logical(kind=l_def) :: constant_exists + integer(tik) :: id ! Initialise inventory if it hasn't been done so already if (.not. vert_wt_mol_coeffs_inventory%is_initialised()) then @@ -2179,7 +2197,7 @@ contains if (.not. constant_exists) then height => get_height_fv(Wtheta, mesh%get_id()) - if ( subroutine_timers ) call timer('runtime_constants.transport') + if ( LPROF ) call start_timing( id, 'runtime_constants.transport' ) vertical_order = fv_vertical_order + 1 ndata_v = 2*(vertical_order + 1) ! Set up function space @@ -2195,7 +2213,7 @@ contains height, & ndata_v, & vertical_order) ) - if ( subroutine_timers ) call timer('runtime_constants.transport') + if ( LPROF ) call stop_timing( id, 'runtime_constants.transport' ) end if ! Return constant @@ -2221,6 +2239,7 @@ contains type(function_space_type), pointer :: multidata_fs integer(kind=i_def) :: ndata_v logical(kind=l_def) :: constant_exists + integer(tik) :: id ! Initialise inventory if it hasn't been done so already if (.not. rev_vert_wt_mol_coeffs_inventory%is_initialised()) then @@ -2236,7 +2255,7 @@ contains if (.not. constant_exists) then height => get_height_fv(Wtheta, mesh%get_id()) - if ( subroutine_timers ) call timer('runtime_constants.transport') + if ( LPROF ) call start_timing( id, 'runtime_constants.transport' ) ndata_v = 2*(fv_vertical_order + 1) ! Set up function space multidata_fs => function_space_collection%get_fs( & @@ -2251,7 +2270,7 @@ contains height, & ndata_v, & fv_vertical_order) ) - if ( subroutine_timers ) call timer('runtime_constants.transport') + if ( LPROF ) call stop_timing( id, 'runtime_constants.transport' ) end if ! Return constant diff --git a/science/gungho/source/algorithm/solver/lam_rhs_alg_mod.x90 b/science/gungho/source/algorithm/solver/lam_rhs_alg_mod.x90 index 17342e738..cb3cb3bc8 100644 --- a/science/gungho/source/algorithm/solver/lam_rhs_alg_mod.x90 +++ b/science/gungho/source/algorithm/solver/lam_rhs_alg_mod.x90 @@ -15,7 +15,7 @@ module lam_rhs_alg_mod use dg_inc_matrix_vector_kernel_mod, & only: dg_inc_matrix_vector_kernel_type use sci_enforce_bc_kernel_mod, only: enforce_bc_kernel_type - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, tik, LPROF use derived_config_mod, only: bundle_size use si_operators_alg_mod, only: get_rho_at_u use sci_fem_constants_mod, only: get_im3_div_fe @@ -88,9 +88,8 @@ contains !> @param[in] model_clock Time in the model !> @param[in] finest_mesh_name Name of the finest mesh !> @param[in] tau_r Relaxation parameter for density in semi-implicit method - !> @param[in] subroutine_timers Enable output of subroutine runtimes subroutine calc_rhs_lbc( rhs, lbc_fields, model_clock, finest_mesh_name, & - tau_r, subroutine_timers ) + tau_r ) implicit none @@ -99,7 +98,6 @@ contains class(model_clock_type), intent(in) :: model_clock character(len=str_def), intent(in) :: finest_mesh_name real(r_def), intent(in) :: tau_r - logical(l_def), intent(in) :: subroutine_timers type(field_type), pointer :: boundary_u => null() type(operator_type), pointer :: mm_vel => null(), & @@ -119,9 +117,9 @@ contains integer(i_def) :: mesh_id type(r_solver_field_type), pointer :: r_solver_rho_at_u => null() + integer(tik) :: id - - if ( subroutine_timers ) call timer('rhs_lbc') + if ( LPROF ) call start_timing( id, 'rhs_lbc' ) mesh_id = rhs(igh_u)%get_mesh_id() @@ -190,7 +188,7 @@ contains nullify ( div, mt_lumped_inv, m2_diag, mm_vel ) nullify ( r_solver_rho_at_u ) - if ( subroutine_timers ) call timer('rhs_lbc') + if ( LPROF ) call stop_timing( id, 'rhs_lbc' ) end subroutine calc_rhs_lbc diff --git a/science/gungho/source/algorithm/solver/mixed_operator_alg_mod.x90 b/science/gungho/source/algorithm/solver/mixed_operator_alg_mod.x90 index 72454b170..f8ac6783f 100644 --- a/science/gungho/source/algorithm/solver/mixed_operator_alg_mod.x90 +++ b/science/gungho/source/algorithm/solver/mixed_operator_alg_mod.x90 @@ -96,9 +96,9 @@ contains subroutine apply_mixed_operator(self, x, y) use boundaries_config_mod, only: limited_area - use io_config_mod, only: subroutine_timers use timestepping_config_mod, only: dt, tau_r - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF use field_indices_mod, only: isol_u, isol_p, & isol_w, isol_uv use operator_mod, only: r_solver_operator_type @@ -172,8 +172,9 @@ contains type(integer_field_type), pointer :: face_selector_ew type(integer_field_type), pointer :: face_selector_ns + integer(tik) :: id - if ( subroutine_timers ) call timer('mixed_operator') + if ( LPROF ) call start_timing( id, 'mixed_operator' ) ! Extract mesh ID select type (y) @@ -359,7 +360,7 @@ contains call log_event(log_scratch_space, LOG_LEVEL_ERROR) end select - if ( subroutine_timers ) call timer('mixed_operator') + if ( LPROF ) call stop_timing( id, 'mixed_operator' ) end subroutine apply_mixed_operator diff --git a/science/gungho/source/algorithm/solver/mixed_schur_preconditioner_alg_mod.x90 b/science/gungho/source/algorithm/solver/mixed_schur_preconditioner_alg_mod.x90 index e9f613b8c..b6f1a69c6 100644 --- a/science/gungho/source/algorithm/solver/mixed_schur_preconditioner_alg_mod.x90 +++ b/science/gungho/source/algorithm/solver/mixed_schur_preconditioner_alg_mod.x90 @@ -100,8 +100,8 @@ module mixed_schur_preconditioner_alg_mod use sci_r_solver_field_vector_mod, only: r_solver_field_vector_type use field_indices_mod, only: isol_u, isol_p, & isol_uv, isol_w - use io_config_mod, only: subroutine_timers - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF use mixed_solver_config_mod, only: split_w use log_mod, only: log_event, & LOG_LEVEL_ERROR, & @@ -248,8 +248,11 @@ contains class(mixed_schur_preconditioner_type), intent(inout) :: self class(abstract_vector_type), intent(in) :: x class(abstract_vector_type), intent(inout) :: y + integer(tik) :: id_precon, & + id_solve - if ( subroutine_timers ) call timer('mixed_schur_preconditioner_alg') + if ( LPROF ) call start_timing( id_precon, & + 'mixed_schur_preconditioner_alg' ) select type(x) type is(r_solver_field_vector_type) @@ -260,7 +263,7 @@ contains ! STEP 2: Solve Helmholtz system ! Krylov solver to obtain pressure increment - if ( subroutine_timers ) call timer('mixed_schur solve') + if ( LPROF ) call start_timing( id_solve, 'mixed_schur_solve' ) ! Set initial guess to pressure incremenet to 0 call self%pressure_x%set_scalar(0.0_r_def) @@ -269,7 +272,7 @@ contains call log_event('Schur preconditioner pressure solve:', LOG_LEVEL_DEBUG) call self%pressure_solver%apply(self%pressure_x, self%pressure_b) - if ( subroutine_timers ) call timer('mixed_schur solve') + if ( LPROF ) call stop_timing( id_solve, 'mixed_schur_solve' ) ! STEP 3: Back substitute to obtain other fields call self%back_substitute(y) @@ -285,7 +288,7 @@ contains call log_event(log_scratch_space, LOG_LEVEL_ERROR) end select - if ( subroutine_timers ) call timer('mixed_schur_preconditioner_alg') + if ( LPROF ) call stop_timing( id_precon, 'mixed_schur_preconditioner_alg' ) end subroutine apply_mixed_schur_preconditioner @@ -336,8 +339,9 @@ contains type(integer_field_type), pointer :: face_selector_ew type(integer_field_type), pointer :: face_selector_ns + integer(tik) :: id - if ( subroutine_timers ) call timer('mixed_schur rhs') + if ( LPROF ) call start_timing( id, 'mixed_schur_rhs' ) rhs => self%pressure_b%get_field_from_position(1) @@ -414,7 +418,7 @@ contains call invoke( inc_X_times_Y(rhs, h_diag) ) end if - if ( subroutine_timers ) call timer('mixed_schur rhs') + if ( LPROF ) call stop_timing( id, 'mixed_schur_rhs' ) end subroutine build_pressure_rhs @@ -452,8 +456,9 @@ contains exner_inc type(r_solver_field_type), target :: dummy_field + integer(tik) :: id - if ( subroutine_timers ) call timer('Schur back substitute') + if ( LPROF ) call start_timing( id, 'schur_back_substitute' ) exner_inc => self%pressure_x%get_field_from_position(1) @@ -502,7 +507,7 @@ contains state_p => state%get_field_from_position(isol_p) call invoke( setval_X(state_p, exner_inc) ) - if ( subroutine_timers ) call timer('Schur back substitute') + if ( LPROF ) call stop_timing( id, 'schur_back_substitute' ) end subroutine back_substitute diff --git a/science/gungho/source/algorithm/solver/pressure_operator_alg_mod.x90 b/science/gungho/source/algorithm/solver/pressure_operator_alg_mod.x90 index cbc33df07..5a57da068 100644 --- a/science/gungho/source/algorithm/solver/pressure_operator_alg_mod.x90 +++ b/science/gungho/source/algorithm/solver/pressure_operator_alg_mod.x90 @@ -132,8 +132,8 @@ contains use operator_mod, only: r_solver_operator_type use sci_enforce_bc_kernel_mod, only: enforce_bc_kernel_type use apply_variable_hx_kernel_mod, only: apply_variable_hx_kernel_type - use io_config_mod, only: subroutine_timers - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF use helmholtz_solver_config_mod, only: normalise use apply_helmholtz_operator_kernel_mod, & only: apply_helmholtz_operator_kernel_type @@ -165,8 +165,9 @@ contains integer(kind=i_def), parameter :: one_int = 1_i_def integer(kind=i_def) :: mesh_id logical(kind=l_def) :: lam_mesh + integer(tik) :: id - if ( subroutine_timers ) call timer('helmholtz lhs') + if ( LPROF ) call start_timing( id, 'helmholtz_lhs' ) select type (x) type is (r_solver_field_vector_type) @@ -241,7 +242,7 @@ contains nullify( w3_mask, w2_mask ) end if nullify( x_vec, y_vec ) - if ( subroutine_timers ) call timer('helmholtz lhs') + if ( LPROF ) call stop_timing( id, 'helmholtz_lhs' ) class default diff --git a/science/gungho/source/algorithm/solver/semi_implicit_solver_alg_mod.x90 b/science/gungho/source/algorithm/solver/semi_implicit_solver_alg_mod.x90 index 893deb5b1..c7acd5387 100644 --- a/science/gungho/source/algorithm/solver/semi_implicit_solver_alg_mod.x90 +++ b/science/gungho/source/algorithm/solver/semi_implicit_solver_alg_mod.x90 @@ -70,8 +70,8 @@ module semi_implicit_solver_alg_mod use combine_w2_field_kernel_mod, only: combine_w2_field_kernel_type ! IO - use io_config_mod, only: subroutine_timers - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF implicit none @@ -573,8 +573,9 @@ contains integer( kind=i_def ) :: mesh_id type(integer_field_type), pointer :: face_selector_ew type(integer_field_type), pointer :: face_selector_ns + integer(tik) :: id_si, id_mix - if ( subroutine_timers ) call timer('semi_implicit_solver_alg') + if ( LPROF ) call start_timing( id_si, 'semi_implicit_solver_alg' ) ! Input fields are r_def fields so preliminary work uses field_types mesh_id = state(igh_p)%get_mesh_id() @@ -669,14 +670,14 @@ contains end if ! Solve the semi-implicit operator - if ( subroutine_timers ) call timer('mixed_solver') + if ( LPROF ) call start_timing( id_mix, 'mixed_solver' ) call log_event( "Gungho: mixed solve:", LOG_LEVEL_DEBUG ) ! Create field vectors out of field arrays call construct_solver_state(vector_inc, rhs_rsol, import_fields = .false.) call construct_solver_state(vector_rhs, rhs_rsol, import_fields = .true.) call vector_inc%set_scalar(0.0_r_def) call mixed_solver%apply(vector_inc, vector_rhs) - if ( subroutine_timers ) call timer('mixed_solver') + if ( LPROF ) call stop_timing( id_mix, 'mixed_solver' ) ! Get the pressure increment inc_exner_rsol => vector_inc%get_field_from_position(isol_p) @@ -742,7 +743,7 @@ contains if ( write_moisture_diag ) & call moisture_conservation_alg( state(igh_d), mr, 'After solve' ) - if ( subroutine_timers ) call timer('semi_implicit_solver_alg') + if ( LPROF ) call stop_timing( id_si, 'semi_implicit_solver_alg' ) end subroutine semi_implicit_solver_alg_step diff --git a/science/gungho/source/algorithm/solver/si_operators_alg_mod.x90 b/science/gungho/source/algorithm/solver/si_operators_alg_mod.x90 index 0b116dad8..97e1164bc 100644 --- a/science/gungho/source/algorithm/solver/si_operators_alg_mod.x90 +++ b/science/gungho/source/algorithm/solver/si_operators_alg_mod.x90 @@ -35,9 +35,7 @@ module si_operators_alg_mod preconditioner_tridiagonal, & preconditioner_multigrid, & normalise - use io_config_mod, only: subroutine_timers - use timer_mod, only: timer - + use timing_mod, only: start_timing, stop_timing, tik, LPROF use function_space_chain_mod, only: multigrid_function_space_chain, & w2_multigrid_function_space_chain, & wtheta_multigrid_function_space_chain @@ -192,8 +190,8 @@ contains type(function_space_type), pointer :: w2_fs => null() type(function_space_type), pointer :: w3_fs => null() type(function_space_type), pointer :: wt_fs => null() - - if ( subroutine_timers ) call timer('si_operators_alg:create') + integer(tik) :: id + if ( LPROF ) call start_timing( id, 'si_operators_alg:create' ) call log_event( "Gungho: creating si_operators", LOG_LEVEL_DEBUG ) if(l_multigrid) then @@ -281,8 +279,7 @@ contains end if end do nullify( w2_fs, w3_fs, wt_fs ) - - if ( subroutine_timers ) call timer('si_operators_alg:create') + if ( LPROF ) call stop_timing( id, 'si_operators_alg:create' ) end subroutine create_si_operators @@ -471,8 +468,8 @@ contains ! needs to be one bigger than the required stencil_depth integer(kind=i_def), parameter :: req_stencil_depth = 1 integer(kind=i_def), parameter :: req_halo_depth = req_stencil_depth + 1 - - if ( subroutine_timers ) call timer('si_operators_alg:compute') + integer(tik) :: id + if ( LPROF ) call start_timing( id, 'si_operators_alg:compute' ) call log_event( "Gungho: computing si_operators", LOG_LEVEL_DEBUG ) dt = real(model_clock%get_seconds_per_step(), r_def) @@ -823,8 +820,7 @@ contains nullify( chi, panel_id, m3_inv, div, w2_rmultiplicity, & mesh, reference_element, m2, u_normalisation, t_normalisation, & w2_mask, mesh ) - - if ( subroutine_timers ) call timer('si_operators_alg:compute') + if ( LPROF ) call stop_timing( id, 'si_operators_alg:compute' ) end subroutine compute_si_operators diff --git a/science/gungho/source/algorithm/timestepping/rk_alg_timestep_mod.x90 b/science/gungho/source/algorithm/timestepping/rk_alg_timestep_mod.x90 index 45605e512..d649c8eff 100644 --- a/science/gungho/source/algorithm/timestepping/rk_alg_timestep_mod.x90 +++ b/science/gungho/source/algorithm/timestepping/rk_alg_timestep_mod.x90 @@ -83,8 +83,8 @@ module rk_alg_timestep_mod use moist_dyn_mod, only: num_moist_factors, gas_law use mr_indices_mod, only: nummr - use io_config_mod, only: subroutine_timers - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF use sci_field_minmax_alg_mod, only: log_field_minmax implicit none @@ -329,8 +329,9 @@ contains integer(kind=i_def) :: element_order_h, element_order_v integer(kind=i_def) :: nqp_h, nqp_v logical(kind=l_def) :: horizontal_face, vertical_face, cheap_update + integer(tik) :: id - if ( subroutine_timers ) call timer('rk_alg') + if ( LPROF ) call start_timing( id, 'rk_alg' ) qr => get_qr_fe() mesh => theta%get_mesh() reference_element => mesh%get_reference_element() @@ -464,7 +465,7 @@ contains nullify( geopotential, chi, panel_id, m3_inv, & mesh, reference_element, qr ) - if ( subroutine_timers ) call timer('rk_alg') + if ( LPROF ) call stop_timing( id, 'rk_alg' ) end subroutine run_step diff --git a/science/gungho/source/algorithm/timestepping/semi_implicit_timestep_alg_mod.X90 b/science/gungho/source/algorithm/timestepping/semi_implicit_timestep_alg_mod.X90 index 7aa360475..4c71fdad2 100644 --- a/science/gungho/source/algorithm/timestepping/semi_implicit_timestep_alg_mod.X90 +++ b/science/gungho/source/algorithm/timestepping/semi_implicit_timestep_alg_mod.X90 @@ -48,8 +48,7 @@ module semi_implicit_timestep_alg_mod moisture_formulation, & moisture_formulation_dry, & exner_from_eos - use io_config_mod, only: subroutine_timers, & - write_conservation_diag, write_diag, & + use io_config_mod, only: write_conservation_diag, write_diag, & use_xios_io, diagnostic_frequency, & checkpoint_read use initialization_config_mod, only: init_option, & @@ -147,7 +146,7 @@ module semi_implicit_timestep_alg_mod #endif use cld_incs_mod, only: cld_incs_init, cld_incs_output - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, tik, LPROF use ageofair_alg_mod, only: ageofair_update implicit none @@ -662,8 +661,9 @@ contains logical(l_def) :: microphysics_casim logical(l_def) :: murk_lbc real(r_def) :: tau_r + integer(tik) :: id - if ( subroutine_timers ) call timer('semi_implicit_timestep_alg') + if ( LPROF ) call start_timing( id, 'semi_implicit_timestep_alg' ) cast_dt = real(model_clock%get_seconds_per_step(), r_def) @@ -979,7 +979,7 @@ contains if ( limited_area .and. inner == 1 .and. outer == 1 ) then call lam_solver_lbc(self%state(igh_u), lbc_fields, prime_mesh_name) call calc_rhs_lbc(self%rhs_lbc, lbc_fields, model_clock, prime_mesh_name, & - tau_r, subroutine_timers) + tau_r) end if !-------------------------------------------------------------------- @@ -1156,7 +1156,7 @@ contains nullify( mm_wt, mm_vel ) - if ( subroutine_timers ) call timer('semi_implicit_timestep_alg') + if ( LPROF ) call stop_timing( id, 'semi_implicit_timestep_alg' ) end subroutine run_step diff --git a/science/gungho/source/algorithm/transport/common/calc_dep_pts_alg_mod.x90 b/science/gungho/source/algorithm/transport/common/calc_dep_pts_alg_mod.x90 index 02150f9a1..288a589ee 100644 --- a/science/gungho/source/algorithm/transport/common/calc_dep_pts_alg_mod.x90 +++ b/science/gungho/source/algorithm/transport/common/calc_dep_pts_alg_mod.x90 @@ -28,7 +28,8 @@ module calc_dep_pts_alg_mod LOG_LEVEL_ERROR use mesh_mod, only: mesh_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 ! Configs use departure_points_config_mod, only: horizontal_method, & @@ -49,7 +50,6 @@ module calc_dep_pts_alg_mod vertical_limit_boundary, & vertical_limit_exponential, & vertical_sorting - use io_config_mod, only: subroutine_timers use transport_config_mod, only: dep_pt_stencil_extent, & calculate_detj, & calculate_detj_averaged, & @@ -158,8 +158,9 @@ contains type(r_tran_field_type) :: wind_adv type(r_tran_field_type) :: dep_wind type(r_tran_field_type) :: dep_wind_np1 + integer(tik) :: id - if ( subroutine_timers ) call timer( 'transport.hori_dep_pts' ) + if ( LPROF ) call start_timing( id, 'transport.hori_dep_pts' ) ! Get function space, mesh, and Det(J) at W3 w2_fs => wind_n%get_function_space() @@ -280,7 +281,7 @@ contains nullify( w2_fs, w2h_fs, mesh, detj_at_w3, face_selector_ew, face_selector_ns ) - if ( subroutine_timers ) call timer( 'transport.hori_dep_pts' ) + if ( LPROF ) call stop_timing( id, 'transport.hori_dep_pts' ) end subroutine calc_hori_dep_pts @@ -472,9 +473,10 @@ contains type(function_space_type), pointer :: w2v_fs type(mesh_type), pointer :: mesh - real(kind=r_tran) :: half + real(kind=r_tran) :: half + integer(tik) :: id - if ( subroutine_timers ) call timer( 'transport.vert_dep_pts' ) + if ( LPROF ) call start_timing( id, 'transport.vert_dep_pts' ) ! Get function spaces mesh => wind_n%get_mesh() @@ -558,7 +560,7 @@ contains call log_event('Vertical departure point method not recognised', LOG_LEVEL_ERROR) end select - if ( subroutine_timers ) call timer( 'transport.vert_dep_pts' ) + if ( LPROF ) call stop_timing( id, 'transport.vert_dep_pts' ) end subroutine calc_vert_dep_pts diff --git a/science/gungho/source/algorithm/transport/common/end_of_transport_step_alg_mod.x90 b/science/gungho/source/algorithm/transport/common/end_of_transport_step_alg_mod.x90 index 34ee74e25..6fdc207a4 100644 --- a/science/gungho/source/algorithm/transport/common/end_of_transport_step_alg_mod.x90 +++ b/science/gungho/source/algorithm/transport/common/end_of_transport_step_alg_mod.x90 @@ -42,7 +42,6 @@ module end_of_transport_step_alg_mod get_face_selector_ns use integer_field_mod, only: integer_field_type use iterate_min_flux_kernel_mod, only: iterate_min_flux_kernel_type - use io_config_mod, only: subroutine_timers use limited_area_lbc_alg_mod, only: overwrite_blending_zone_rtran use log_mod, only: log_event, & log_scratch_space, & @@ -57,7 +56,8 @@ module end_of_transport_step_alg_mod use r_tran_operator_mod, only: r_tran_operator_type use split_transport_utils_mod, only: get_num_split_steps, & get_dry_config - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF use transport_config_mod, only: dry_field_name, & min_val_abs_tol, & min_val_max_iterations, & @@ -125,8 +125,9 @@ contains integer(kind=i_def) :: step logical(kind=l_def) :: do_overwrite type(r_tran_field_type), pointer :: field_start + integer(tik) :: id - if ( subroutine_timers ) call timer('transport.end_of_transport') + if ( LPROF ) call start_timing( id, 'transport.end_of_transport' ) mesh => field_np1%get_mesh() @@ -172,7 +173,7 @@ contains call log_field_minmax( LOG_LEVEL_DEBUG, 'field_np1: end_of_advective_step', field_np1) - if ( subroutine_timers ) call timer('transport.end_of_transport') + if ( LPROF ) call stop_timing( id, 'transport.end_of_transport' ) end subroutine end_of_advective_step_alg @@ -232,8 +233,9 @@ contains real(kind=r_tran) :: adv_dt real(kind=r_tran) :: acceptable_min real(kind=r_tran) :: field_min, field_max + integer(tik) :: id_end, id_iter - if ( subroutine_timers ) call timer('transport.end_of_transport') + if ( LPROF ) call start_timing( id_end, 'transport.end_of_transport' ) ! Extract transport runtime mesh => field_np1%get_mesh() @@ -274,7 +276,7 @@ contains if (enforce_min_value .and. min_val_method == min_val_method_iterative) then - if ( subroutine_timers ) call timer('transport.iterative_min_val') + if ( LPROF ) call start_timing( id_iter, 'transport.iterative_min_val' ) div => get_directional_im3_div_r_tran(mesh_id, direction_3d) ! TODO #3706: the flux limiter should use r_tran precision @@ -313,7 +315,7 @@ contains end if end do - if ( subroutine_timers ) call timer('transport.iterative_min_val') + if ( LPROF ) call stop_timing( id_iter, 'transport.iterative_min_val' ) else if (operators == operators_fem) then ! Finite element transport, so need full divergence operator @@ -390,7 +392,7 @@ contains call log_field_minmax( LOG_LEVEL_DEBUG, 'field_np1: end_of_conservative_step', field_np1) - if ( subroutine_timers ) call timer('transport.end_of_transport') + if ( LPROF ) call stop_timing( id_end, 'transport.end_of_transport' ) end subroutine end_of_conservative_step_alg @@ -490,8 +492,9 @@ contains real(kind=r_tran) :: acceptable_min real(kind=r_tran) :: field_min, field_max logical(kind=l_def) :: to_compute_field_np1 + integer(tik) :: id_end, id_theta, id_iter - if ( subroutine_timers ) call timer('transport.end_of_transport') + if ( LPROF ) call start_timing( id_end, 'transport.end_of_transport' ) ! Extract transport runtime prime_extrusion_mesh => field_np1%get_mesh() @@ -532,7 +535,7 @@ contains (trim(transport_metadata%get_name()) == 'potential_temperature' .or. & trim(transport_metadata%get_name()) == 'theta')) then - if ( subroutine_timers ) call timer('transport.theta_dispersion') + if ( LPROF ) call start_timing( id_theta, 'transport.theta_dispersion' ) shifted_mesh => mesh_collection%get_mesh(prime_extrusion_mesh, SHIFTED) sh_w3_fs => function_space_collection%get_fs(shifted_mesh, 0, 0, W3) @@ -571,7 +574,8 @@ contains face_selector_ns), & inc_X_plus_Y(flux, flux_correction) ) - if ( subroutine_timers ) call timer('transport.theta_dispersion') + if ( LPROF ) call stop_timing( id_theta, 'transport.theta_dispersion' ) + end if ! ------------------------------------------------------------------------ ! @@ -644,7 +648,7 @@ contains call build_up_flux(sum_flux, flux, transport_counter, transport_metadata) if (enforce_min_value .and. min_val_method == min_val_method_iterative) then - if ( subroutine_timers ) call timer('transport.iterative_min_val') + if ( LPROF ) call start_timing( id_iter, 'transport.iterative_min_val' ) select case( mr_function_space ) case ( W3 ) @@ -683,7 +687,7 @@ contains end if end do - if ( subroutine_timers ) call timer('transport.iterative_min_val') + if ( LPROF ) call stop_timing( id_iter, 'transport.iterative_min_val' ) else ! Compute updated field using flux for whole transport step @@ -766,7 +770,7 @@ contains call log_field_minmax( LOG_LEVEL_DEBUG, 'field_np1: end_of_consistent_step', field_np1) - if ( subroutine_timers ) call timer('transport.end_of_transport') + if ( LPROF ) call stop_timing( id_end, 'transport.end_of_transport' ) end subroutine end_of_consistent_step_alg @@ -808,8 +812,9 @@ contains type(r_tran_field_type) :: combined_flux logical(kind=l_def) :: is_flux_3d logical(kind=l_def) :: is_flux_split + integer(tik) :: id - if ( subroutine_timers ) call timer('transport.build_up_flux') + if ( LPROF ) call start_timing( id, 'transport.build_up_flux' ) ! Don't know which function space the fluxes are in -- add up each mesh => sum_flux%get_mesh() @@ -890,7 +895,7 @@ contains end if end if - if ( subroutine_timers ) call timer('transport.build_up_flux') + if ( LPROF ) call stop_timing( id, 'transport.build_up_flux' ) end subroutine build_up_flux diff --git a/science/gungho/source/algorithm/transport/common/flux_precomputations_mod.x90 b/science/gungho/source/algorithm/transport/common/flux_precomputations_mod.x90 index 993b71d38..a6b121e1a 100644 --- a/science/gungho/source/algorithm/transport/common/flux_precomputations_mod.x90 +++ b/science/gungho/source/algorithm/transport/common/flux_precomputations_mod.x90 @@ -47,7 +47,6 @@ module flux_precomputations_alg_mod use sci_geometric_constants_mod, only: get_face_selector_ew, & get_face_selector_ns use integer_field_mod, only: integer_field_type - use io_config_mod, only: subroutine_timers use lfric_mpi_mod, only: global_mpi use limited_area_lbc_alg_mod, only: overwrite_blending_zone_rtran use local_mesh_mod, only: local_mesh_type @@ -74,7 +73,8 @@ module flux_precomputations_alg_mod get_fraction_from_idx, & get_fraction_idx, & get_num_split_steps - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF use transport_config_mod, only: panel_edge_treatment, & panel_edge_treatment_extended_mesh,& ffsl_inner_order, & @@ -277,8 +277,9 @@ contains type(r_tran_field_type) :: flux_vert type(r_tran_field_type), pointer :: flux_ptr type(r_tran_field_type), target :: ref_flux_restricted + integer(tik) :: id - if ( subroutine_timers ) call timer('transport.flux_precomp_init') + if ( LPROF ) call start_timing( id, 'transport.flux_precomp_init' ) self%splitting = splitting self%num_substeps = num_substeps @@ -562,7 +563,7 @@ contains self%transporting_wind => wind self%dt = dt - if ( subroutine_timers ) call timer('transport.flux_precomp_init') + if ( LPROF ) call stop_timing( id, 'transport.flux_precomp_init' ) end subroutine flux_precomputations_initialiser @@ -645,8 +646,9 @@ contains type(function_space_type), pointer :: w2_fs type(integer_field_type), pointer :: face_selector_ew type(integer_field_type), pointer :: face_selector_ns + integer(tik) :: id - if ( subroutine_timers ) call timer('transport.flux_precomp_init') + if ( LPROF ) call start_timing( id, 'transport.flux_precomp_init' ) ! Checks ------------------------------------------------------------------ ! Is the reference flux on a prime extrusion? @@ -718,7 +720,7 @@ contains call invoke( setval_X(self%ref_flux(1, step), ref_flux) ) end if - if ( subroutine_timers ) call timer('transport.flux_precomp_init') + if ( LPROF ) call stop_timing( id, 'transport.flux_precomp_init' ) end subroutine initialise_step @@ -839,6 +841,7 @@ contains type(integer_field_type), pointer :: face_selector_ew type(integer_field_type), pointer :: face_selector_ns type(r_tran_field_type), pointer :: ref_flux + integer(tik) :: id ! If substepping, step can exceed num_steps, so take that into account here ! This is because, when transporting by the wind field (and using unity as @@ -867,7 +870,7 @@ contains face_selector_ew => get_face_selector_ew(self%mesh_ids(2)) face_selector_ns => get_face_selector_ns(self%mesh_ids(2)) - if ( subroutine_timers ) call timer('transport.get_ref_flux') + if ( LPROF ) call start_timing( id, 'transport.get_ref_flux' ) ! Transform fluxes to the shifted mesh, with case depending on fs_id select case (fs_id) @@ -894,7 +897,7 @@ contains self%ref_flux(1, step_idx)) ) end select - if ( subroutine_timers ) call timer('transport.get_ref_flux') + if ( LPROF ) call stop_timing( id, 'transport.get_ref_flux' ) end if ! Point to existing field @@ -940,6 +943,7 @@ contains type(r_tran_field_type), pointer :: ref_field type(r_tran_field_type), pointer :: detj_w3 character(len=str_def) :: field_name + integer(tik) :: id mesh_idx = self%idx_from_mesh_id(mesh_id) @@ -961,7 +965,7 @@ contains ! Obtain reference field from mass ref_mass => self%get_ref_mass(mesh_id, step) - if ( subroutine_timers ) call timer('transport.get_ref_field') + if ( LPROF ) call start_timing( id, 'transport.get_ref_field' ) call self%ref_field(mesh_idx, step)%initialise(w3_fs, halo_depth=halo_depth) @@ -973,7 +977,7 @@ contains detj_w3) ) end if - if ( subroutine_timers ) call timer('transport.get_ref_field') + if ( LPROF ) call stop_timing( id, 'transport.get_ref_field' ) end if ! Return existing field @@ -1045,6 +1049,7 @@ contains type(r_tran_field_type) :: tmp_mass type(r_tran_field_type) :: tmp_field character(len=str_def) :: field_name + integer(tik) :: id mesh_idx = self%idx_from_mesh_id(mesh_id) @@ -1079,7 +1084,7 @@ contains ref_flux => self%get_ref_flux(mesh_id, step-1) call increment%initialise(w3_fs) - if ( subroutine_timers ) call timer('transport.get_ref_mass') + if ( LPROF ) call start_timing( id, 'transport.get_ref_mass' ) ! Take divergence of flux to get increment fs_id = ref_flux%which_function_space() @@ -1140,14 +1145,14 @@ contains depth=transport_boundary_depth) end if - if ( subroutine_timers ) call timer('transport.get_ref_mass') + if ( LPROF ) call stop_timing( id, 'transport.get_ref_mass' ) ! ---------------------------------------------------------------------- ! ! 2. The density from this step (multiplied by cell volumes) ! ---------------------------------------------------------------------- ! else if (self%ref_field(mesh_idx, step)%is_initialised()) then - if ( subroutine_timers ) call timer('transport.get_ref_mass') + if ( LPROF ) call start_timing( id, 'transport.get_ref_mass' ) detj_w3 => get_detj_at_w3_r_tran(mesh_id) if (panel_edge_treatment == panel_edge_treatment_extended_mesh) then call invoke_deep_X_times_Y(self%ref_mass(mesh_idx, step), & @@ -1157,13 +1162,13 @@ contains self%ref_field(mesh_idx, step), detj_w3) ) end if - if ( subroutine_timers ) call timer('transport.get_ref_mass') + if ( LPROF ) call stop_timing( id, 'transport.get_ref_mass' ) ! ---------------------------------------------------------------------- ! ! 3. If on the shifted mesh, obtain the mass by shifting the mass ! ---------------------------------------------------------------------- ! else if (mesh_idx == 2) then - if ( subroutine_timers ) call timer('transport.get_ref_mass') + if ( LPROF ) call start_timing( id, 'transport.get_ref_mass' ) ref_mass_prime => self%get_ref_mass(self%mesh_ids(1), step, negative_check_flag) if (panel_edge_treatment == panel_edge_treatment_extended_mesh) then ! Original field has already been remapped, so can perform a "deep" @@ -1176,7 +1181,7 @@ contains call invoke( shift_mass_w3_kernel_type(self%ref_mass(2, step), & ref_mass_prime) ) end if - if ( subroutine_timers ) call timer('transport.get_ref_mass') + if ( LPROF ) call stop_timing( id, 'transport.get_ref_mass' ) end if ! Check if the computed reference mass is negative ----------------------- @@ -1224,6 +1229,7 @@ contains type(r_tran_field_type), pointer :: ref_mass type(r_tran_field_type), pointer :: detj_w3 type(r_tran_field_type), pointer :: ref_field + integer(tik) :: id ! If substepping, step can exceed num_steps, so take that into account here step_idx = MOD(step - 1, self%num_steps) + 1 @@ -1246,7 +1252,7 @@ contains detj_w3 => get_detj_at_w3_r_tran(mesh_id) w3_fs => function_space_collection%get_fs(mesh, 0, 0, W3) - if ( subroutine_timers ) call timer('transport.get_ref_field_xy') + if ( LPROF ) call start_timing( id, 'transport.get_ref_field_xy' ) call self%ref_field_x(mesh_idx, step_idx)%initialise(w3_fs, halo_depth=halo_depth) @@ -1257,7 +1263,7 @@ contains call invoke( X_divideby_Y(self%ref_field_x(mesh_idx, step_idx), & ref_mass, detj_w3) ) end if - if ( subroutine_timers ) call timer('transport.get_ref_field_xy') + if ( LPROF ) call stop_timing( id, 'transport.get_ref_field_xy' ) end if ! Return existing field @@ -1288,6 +1294,7 @@ contains type(r_tran_field_type), pointer :: ref_mass type(r_tran_field_type), pointer :: detj_w3 type(r_tran_field_type), pointer :: ref_field + integer(tik) :: id ! If substepping, step can exceed num_steps, so take that into account here step_idx = MOD(step - 1, self%num_steps) + 1 @@ -1310,7 +1317,7 @@ contains detj_w3 => get_detj_at_w3_r_tran(mesh_id) w3_fs => function_space_collection%get_fs(mesh, 0, 0, W3) - if ( subroutine_timers ) call timer('transport.get_ref_field_xy') + if ( LPROF ) call start_timing( id, 'transport.get_ref_field_xy' ) call self%ref_field_y(mesh_idx, step_idx)%initialise(w3_fs, halo_depth=halo_depth) @@ -1321,7 +1328,7 @@ contains call invoke( X_divideby_Y(self%ref_field_y(mesh_idx, step_idx), & ref_mass, detj_w3) ) end if - if ( subroutine_timers ) call timer('transport.get_ref_field_xy') + if ( LPROF ) call stop_timing( id, 'transport.get_ref_field_xy' ) end if ! Return existing field @@ -1642,6 +1649,7 @@ contains real(kind=r_tran) :: dep_min, dep_max type(mesh_type), pointer :: mesh type(r_tran_field_type), pointer :: dep_dist + integer(tik) :: id ! If substepping, step can exceed num_steps, so take that into account here step_idx = MOD(step - 1, self%num_steps) + 1 @@ -1666,7 +1674,7 @@ contains mesh => mesh_collection%get_mesh(mesh_id) dep_dist => self%get_dep_dist(mesh_id, step, outer_step_local) - if ( subroutine_timers ) call timer('transport.get_dep_stencil_extent') + if ( LPROF ) call start_timing( id, 'transport.get_dep_stencil_extent' ) ! We can shorten the stencil extent to the Courant number call get_field_minmax(dep_dist, dep_min, dep_max) @@ -1684,7 +1692,7 @@ contains self%max_stencil_extent_computed = .true. end if - if ( subroutine_timers ) call timer('transport.get_dep_stencil_extent') + if ( LPROF ) call stop_timing( id, 'transport.get_dep_stencil_extent' ) end if ! INNER STEP EXTENTS ------------------------------------------------------- @@ -1703,7 +1711,7 @@ contains mesh => mesh_collection%get_mesh(mesh_id) dep_dist => self%get_dep_dist(mesh_id, step, outer_step_local) - if ( subroutine_timers ) call timer('transport.get_dep_stencil_extent') + if ( LPROF ) call start_timing( id, 'transport.get_dep_stencil_extent' ) ! We can shorten the stencil extent to the Courant number call get_field_minmax(dep_dist, dep_min, dep_max) @@ -1721,7 +1729,7 @@ contains self%max_stencil_extent_computed = .true. end if - if ( subroutine_timers ) call timer('transport.get_dep_stencil_extent') + if ( LPROF ) call stop_timing( id, 'transport.get_dep_stencil_extent' ) end if end function get_dep_stencil_extent @@ -1809,7 +1817,7 @@ contains type(r_tran_field_type) :: increment_y type(r_tran_field_type) :: tmp_mass type(r_tran_field_type) :: tmp_field - + integer(tik) :: id ! If substepping, step can exceed num_steps, so take that into account here step_idx = MOD(step - 1, self%num_steps) + 1 mesh_idx = self%idx_from_mesh_id(mesh_id) @@ -1835,7 +1843,7 @@ contains ref_flux => self%get_ref_flux(mesh_id, step) w3_fs => function_space_collection%get_fs(mesh, 0, 0, W3) - if ( subroutine_timers ) call timer('transport.get_ref_mass_xy') + if ( LPROF ) call start_timing( id, 'transport.get_ref_mass_xy' ) call self%ref_mass_x(mesh_idx, step_idx)%initialise(w3_fs, halo_depth=halo_depth) call self%ref_mass_y(mesh_idx, step_idx)%initialise(w3_fs, halo_depth=halo_depth) @@ -1891,7 +1899,7 @@ contains ) end if - if ( subroutine_timers ) call timer('transport.get_ref_mass_xy') + if ( LPROF ) call stop_timing( id, 'transport.get_ref_mass_xy' ) end subroutine compute_ref_mass_x_and_y @@ -1923,6 +1931,7 @@ contains type(r_tran_field_type), pointer :: ref_mass type(r_tran_field_type), pointer :: ref_flux character(len=str_def) :: field_name + integer(tik) :: id ! If substepping, step can exceed num_steps, so take that into account here step_idx = MOD(step - 1, self%num_steps) + 1 @@ -1937,7 +1946,7 @@ contains end if ref_flux => self%get_ref_flux(mesh_id, step) - if ( subroutine_timers ) call timer('transport.compute_dep_dists') + if ( LPROF ) call start_timing( id, 'transport.compute_dep_dists' ) w2_fs => ref_flux%get_function_space() call self%dep_dist(mesh_idx, step_idx)%initialise(w2_fs) @@ -1979,7 +1988,7 @@ contains ) end if - if ( subroutine_timers ) call timer('transport.compute_dep_dists') + if ( LPROF ) call stop_timing( id, 'transport.compute_dep_dists' ) end subroutine compute_dep_dist_inner @@ -2011,6 +2020,7 @@ contains type(r_tran_field_type), pointer :: ref_mass_x type(r_tran_field_type), pointer :: ref_mass_y character(len=str_def) :: field_name + integer(tik) :: id ! If substepping, step can exceed num_steps, so take that into account here step_idx = MOD(step - 1, self%num_steps) + 1 @@ -2021,7 +2031,7 @@ contains ref_mass_x => self%get_ref_mass_x(mesh_id, step) ref_mass_y => self%get_ref_mass_y(mesh_id, step) - if ( subroutine_timers ) call timer('transport.compute_dep_dists') + if ( LPROF ) call start_timing( id, 'transport.compute_dep_dists' ) if (direction /= direction_h) then write(log_scratch_space, '(A,I8,A)') & @@ -2059,7 +2069,7 @@ contains ) end if - if ( subroutine_timers ) call timer('transport.compute_dep_dists') + if ( LPROF ) call stop_timing( id, 'transport.compute_dep_dists' ) end subroutine compute_dep_dist_outer diff --git a/science/gungho/source/algorithm/transport/common/panel_edge_remap_alg_mod.x90 b/science/gungho/source/algorithm/transport/common/panel_edge_remap_alg_mod.x90 index 77eedd2e8..7d8f58959 100644 --- a/science/gungho/source/algorithm/transport/common/panel_edge_remap_alg_mod.x90 +++ b/science/gungho/source/algorithm/transport/common/panel_edge_remap_alg_mod.x90 @@ -13,8 +13,7 @@ module panel_edge_remap_alg_mod use r_tran_field_mod, only: r_tran_field_type use integer_field_mod, only: integer_field_type use mesh_mod, only: mesh_type - use io_config_mod, only: subroutine_timers - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, tik, LPROF use function_space_mod, only: function_space_type use transport_config_mod, only: ffsl_inner_order, ffsl_outer_order, & panel_edge_high_order @@ -80,9 +79,9 @@ contains integer(kind=i_def) :: mesh_id, ndata integer(kind=i_def) :: max_halo_depth, cross_depth integer(kind=i_def) :: field_read_depth, remap_depth + integer(kind=tik) :: id - - if ( subroutine_timers ) call timer('transport.panel_edge_remap') + if ( LPROF ) call start_timing( id, 'transport.panel_edge_remap' ) mesh => field_for_x%get_mesh() mesh_id = mesh%get_id() @@ -161,7 +160,7 @@ contains ffsl_depth & ) - if ( subroutine_timers ) call timer('transport.panel_edge_remap') + if ( LPROF ) call stop_timing( id, 'transport.panel_edge_remap' ) end subroutine panel_edge_remap_alg diff --git a/science/gungho/source/algorithm/transport/common/remap_on_extended_mesh_alg_mod.x90 b/science/gungho/source/algorithm/transport/common/remap_on_extended_mesh_alg_mod.x90 index 87cc7ce82..528d5b2fd 100644 --- a/science/gungho/source/algorithm/transport/common/remap_on_extended_mesh_alg_mod.x90 +++ b/science/gungho/source/algorithm/transport/common/remap_on_extended_mesh_alg_mod.x90 @@ -14,8 +14,7 @@ module remap_on_extended_mesh_alg_mod use integer_field_mod, only: integer_field_type use mesh_mod, only: mesh_type use psykal_lite_transport_mod, only: invoke_remap_on_extended_mesh_kernel_type - use io_config_mod, only: subroutine_timers - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, tik, LPROF use function_space_mod, only: function_space_type use check_configuration_mod, only: get_required_stencil_depth use transport_constants_mod, only: get_extended_mesh_weights, & @@ -64,9 +63,10 @@ contains integer(kind=i_def) :: ndata integer(kind=i_def) :: depth type(r_tran_field_type) :: field_to_remap + integer(tik) :: id - if ( subroutine_timers ) call timer('transport.remap_extended_mesh') + if ( LPROF ) call start_timing( id, 'transport.remap_extended_mesh' ) mesh => field%get_mesh() panel_id => get_panel_id(mesh%get_id()) @@ -105,7 +105,7 @@ contains depth ) nullify(mesh, fs, panel_id) - if ( subroutine_timers ) call timer('transport.remap_extended_mesh') + if ( LPROF ) call stop_timing( id, 'transport.remap_extended_mesh' ) end subroutine remap_on_extended_mesh diff --git a/science/gungho/source/algorithm/transport/common/wind_precomputations_mod.x90 b/science/gungho/source/algorithm/transport/common/wind_precomputations_mod.x90 index 0578f128b..cbebf3942 100644 --- a/science/gungho/source/algorithm/transport/common/wind_precomputations_mod.x90 +++ b/science/gungho/source/algorithm/transport/common/wind_precomputations_mod.x90 @@ -35,7 +35,6 @@ module wind_precomputations_alg_mod use sci_geometric_constants_mod, only: get_face_selector_ew, & get_face_selector_ns use integer_field_mod, only: integer_field_type - use io_config_mod, only: subroutine_timers use local_mesh_mod, only: local_mesh_type use log_mod, only: log_event, & log_scratch_space, & @@ -52,7 +51,8 @@ module wind_precomputations_alg_mod get_fraction_from_idx, & get_fraction_idx, & get_num_split_steps - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF use transport_enumerated_types_mod, only: direction_h, & direction_v, & direction_3d @@ -188,6 +188,7 @@ contains type(mesh_type), pointer :: mesh integer(kind=i_def) :: num_meshes integer(kind=i_def) :: num_fractions + integer(tik) :: id type(function_space_type), pointer :: w2_fs type(function_space_type), pointer :: w2h_fs @@ -195,7 +196,7 @@ contains type(integer_field_type), pointer :: face_selector_ew type(integer_field_type), pointer :: face_selector_ns - if ( subroutine_timers ) call timer('transport.wind_precomp_init') + if ( LPROF ) call start_timing( id, 'transport.wind_precomp_init' ) ! ------------------------------------------------------------------------ ! ! Get correct element order arguments @@ -347,7 +348,7 @@ contains self%courant_computed(:) = .false. self%is_initialised_flag = .true. - if ( subroutine_timers ) call timer('transport.wind_precomp_init') + if ( LPROF ) call stop_timing( id, 'transport.wind_precomp_init' ) end subroutine wind_precomputations_initialiser @@ -813,6 +814,7 @@ contains integer(kind=i_def) :: stencil_extent real(kind=r_tran) :: dt_split_step real(kind=r_tran) :: dep_min, dep_max + integer(tik) :: id ! If departure points calculated using "FFSL" method, get these from the ! flux precomputations object @@ -826,7 +828,7 @@ contains ! Otherwise, the departure points are those stored in this object else - if ( subroutine_timers ) call timer('transport.dep_dist_reset_unity') + if ( LPROF ) call start_timing( id, 'transport.dep_dist_reset_unity' ) ! Check if they have been computed, based on if they are initialised mesh_idx = self%idx_from_mesh_id(mesh_id) @@ -861,7 +863,7 @@ contains dep_dist_xy => self%dep_dist_xy(mesh_idx, frac_idx) - if ( subroutine_timers ) call timer('transport.dep_dist_reset_unity') + if ( LPROF ) call stop_timing( id, 'transport.dep_dist_reset_unity' ) end if end function get_dep_dist_xy @@ -895,6 +897,7 @@ contains integer(kind=i_def) :: frac real(kind=r_tran) :: dt_split_step logical(kind=l_def) :: compute_dep_cfl + integer(tik) :: id ! If departure points calculated using "FFSL" method, get these from the ! flux precomputations object @@ -905,7 +908,7 @@ contains ! Otherwise, the departure points are those stored in this object else - if ( subroutine_timers ) call timer('transport.dep_dist_reset_unity') + if ( LPROF ) call start_timing( id, 'transport.dep_dist_reset_unity' ) ! Check if they have been computed, based on if they are initialised mesh_idx = self%idx_from_mesh_id(mesh_id) @@ -931,7 +934,7 @@ contains dep_dist_z => self%dep_dist_z(mesh_idx, frac_idx) - if ( subroutine_timers ) call timer('transport.dep_dist_reset_unity') + if ( LPROF ) call stop_timing( id, 'transport.dep_dist_reset_unity' ) end if end function get_dep_dist_z @@ -1253,12 +1256,13 @@ contains type(r_tran_field_type) :: dep_dist_z type(r_tran_field_type) :: frac_vert_wind logical(kind=l_def) :: compute_cfl_dep + integer(tik) :: id mesh_idx = self%idx_from_mesh_id(mesh_id) ! Has the field already been computed? If not, compute it now if (.not. self%dep_courant_vert(mesh_idx)%is_initialised()) then - if ( subroutine_timers ) call timer('transport.dep_dist_courant') + if ( LPROF ) call start_timing( id, 'transport.dep_dist_courant' ) ! Calculate vertical departure distance mesh => mesh_collection%get_mesh(mesh_id) @@ -1278,7 +1282,7 @@ contains self%wind_n(mesh_idx), self%wind_np1(mesh_idx), self%dt_substep, & compute_cfl_dep & ) - if ( subroutine_timers ) call timer('transport.dep_dist_courant') + if ( LPROF ) call stop_timing( id, 'transport.dep_dist_courant' ) end if dep_courant_vert => self%dep_courant_vert(mesh_idx) @@ -1376,6 +1380,7 @@ contains real(kind=r_tran) :: min_courant_hori, max_courant_hori real(kind=r_tran) :: min_courant_3d, max_courant_3d real(kind=r_tran) :: cfl_limit + integer(tik) :: id mesh => mesh_collection%get_mesh(mesh_id) mesh_idx = self%idx_from_mesh_id(mesh_id) @@ -1397,7 +1402,7 @@ contains face_selector_ns => get_face_selector_ns(mesh_id) wind_3d => self%get_wind(mesh_id, direction_3d) - if ( subroutine_timers ) call timer('transport.compute_courant') + if ( LPROF ) call start_timing( id, 'transport.compute_courant' ) ! ------------------------------------------------------------------------ ! ! Determine Courant number field @@ -1509,7 +1514,7 @@ contains self%courant_computed(mesh_idx) = .true. - if ( subroutine_timers ) call timer('transport.compute_courant') + if ( LPROF ) call stop_timing( id, 'transport.compute_courant' ) end subroutine compute_courant @@ -1543,6 +1548,7 @@ contains type(r_tran_field_type), pointer :: dep_dist_z type(r_tran_field_type), pointer :: coeffs(:) type(integer_field_type), pointer :: sl_indices(:) + integer(tik) :: id mesh => mesh_collection%get_mesh(mesh_id) fs => function_space_collection%get_fs(mesh, 0, 0, space) @@ -1552,7 +1558,7 @@ contains frac_idx = get_fraction_idx(splitting, step) dep_dist_z => self%get_dep_dist_z(mesh_id, splitting, step) - if ( subroutine_timers ) call timer('transport.compute_sl_coeffs') + if ( LPROF ) call start_timing( id, 'transport.compute_sl_coeffs' ) ! Points to appropriate coefficients and indices --------------------------- select case (space) @@ -1624,7 +1630,7 @@ contains ! Compute coefficients ----------------------------------------------------- call compute_sl_coefficients_alg(coeffs, sl_indices, dep_dist_z, order) - if ( subroutine_timers ) call timer('transport.compute_sl_coeffs') + if ( LPROF ) call stop_timing( id, 'transport.compute_sl_coeffs' ) end subroutine compute_sl_coefficients diff --git a/science/gungho/source/algorithm/transport/control/gungho_transport_control_alg_mod.X90 b/science/gungho/source/algorithm/transport/control/gungho_transport_control_alg_mod.X90 index 7ebe3d4eb..e87bc62b2 100644 --- a/science/gungho/source/algorithm/transport/control/gungho_transport_control_alg_mod.X90 +++ b/science/gungho/source/algorithm/transport/control/gungho_transport_control_alg_mod.X90 @@ -34,6 +34,8 @@ module gungho_transport_control_alg_mod use check_configuration_mod, only: check_any_shifted, & check_transport_name, & check_any_eqn_consistent + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF implicit none @@ -209,8 +211,6 @@ contains coarse_collection_transport_alg use transport_field_mod, only: transport_field use wind_transport_alg_mod, only: wind_transport_alg - use io_config_mod, only: subroutine_timers - use timer_mod, only: timer implicit none @@ -262,9 +262,13 @@ contains type(transport_metadata_type), pointer :: transport_metadata type(transport_controller_type) :: transport_controller type(transport_controller_type) :: aerosol_transport_controller + integer(tik) :: id_cont, id_dens + integer(tik) :: id_moisture, id_temp + integer(tik) :: id_trac_adv, id_trac_con + integer(tik) :: id_trac_last_adv + integer(tik) :: id_trac_last_con - if ( subroutine_timers ) call timer('gungho_transport_control') - + if ( LPROF ) call start_timing( id_cont, 'gungho_transport_control' ) ! ======================================================================== ! ! Pre-transport initialisation tasks ! ======================================================================== ! @@ -322,6 +326,7 @@ contains ! ------------------------------------------------------------------------ ! ! Transport dry density call log_event( "Transporting density...", LOG_LEVEL_DEBUG) + if ( LPROF ) call start_timing( id_dens, 'control_density_transport' ) transport_metadata => & transport_metadata_collection%get_transport_metadata('density') @@ -339,6 +344,7 @@ contains flux_this_outer => flux_precomputations%get_total_ref_flux() call invoke( inc_X_plus_Y(total_dry_flux, flux_this_outer) ) end if + if ( LPROF ) call stop_timing( id_dens, 'control_density_transport' ) ! Check negative reference fields at this point if (check_any_eqn_consistent()) then @@ -365,6 +371,8 @@ contains ! ------------------------------------------------------------------------ ! ! Transport moisture mixing ratio fields if ( moisture_formulation /= moisture_formulation_dry ) then + if ( LPROF ) call start_timing( id_moisture, & + 'control_moisture_transport' ) ! Write out moisture diagnostics if ( do_moisture_diagnostics ) then call moisture_conservation_alg( rho_d_n, mr_in, 'Before transport' ) @@ -380,13 +388,14 @@ contains mr_out, mr_in, nummr_to_transport, & transport_controller, transport_metadata & ) - + if ( LPROF ) call stop_timing( id_moisture, 'control_moisture_transport' ) ! ---------------------------------------------------------------------- ! ! Transport tracers which are active in fast physics, and therefore need ! transporting on every outer iteration if (present(adv_tracer_all_outer) & .and. check_transport_name('adv_tracer') ) then - + if ( LPROF ) call start_timing( id_trac_adv, & + 'control_advective_tracer_transport' ) call log_event( & "Transporting advective tracers (all)...", LOG_LEVEL_DEBUG & ) @@ -397,10 +406,13 @@ contains adv_tracer_all_outer, adv_tracer_all_outer_after_slow, & transport_controller, transport_metadata & ) + if ( LPROF ) call stop_timing( id_trac_adv, & + 'control_advective_tracer_transport' ) end if if (present(con_tracer_all_outer) & .and. check_transport_name('con_tracer') ) then - + if ( LPROF ) call start_timing( id_trac_con, & + 'control_conservative_tracer_transport' ) call log_event( & "Transporting conservative tracers (all)...", LOG_LEVEL_DEBUG & ) @@ -411,6 +423,8 @@ contains con_tracer_all_outer, con_tracer_all_outer_after_slow, & transport_controller, transport_metadata & ) + if ( LPROF ) call stop_timing( id_trac_con, & + 'control_conservative_tracer_transport' ) end if end if @@ -419,6 +433,8 @@ contains ! (must be after moisture but before last_outer tracers due to cheap update) ! Note: the theta increment is pointwise call log_event( "Transporting potential temperature...", LOG_LEVEL_DEBUG) + if ( LPROF ) call start_timing( id_temp, & + 'control_potential_temperature_transport' ) transport_metadata => & transport_metadata_collection%get_transport_metadata('potential_temperature') @@ -426,6 +442,8 @@ contains fields_np1(igh_t), advection_inc(igh_t), advected_fields(igh_t), & mr_out, mr_in, transport_controller, transport_metadata & ) + if ( LPROF ) call stop_timing( id_temp, & + 'control_potential_temperature_transport' ) ! ======================================================================== ! ! TRANSPORT OF PROGNOSTICS: LAST OUTER LOOP @@ -479,7 +497,8 @@ contains ! Advective tracers if (present(adv_tracer_last_outer) & .and. check_transport_name('adv_tracer') ) then - + if ( LPROF ) call start_timing( id_trac_last_adv, & + 'control_last_advective_tracer_transport' ) call log_event( & "Transporting advective tracers (last)...", LOG_LEVEL_DEBUG & ) @@ -492,13 +511,16 @@ contains adv_tracer_last_outer, adv_tracer_last_outer_after_slow, & transport_controller, transport_metadata & ) + if ( LPROF ) call stop_timing( id_trac_last_adv, & + 'control_last_advective_tracer_transport' ) end if ! ---------------------------------------------------------------------- ! ! Conservative tracers if (present(con_tracer_last_outer) & .and. check_transport_name('con_tracer') ) then - + if ( LPROF ) call start_timing( id_trac_last_con, & + 'control_last_conservative_tracer_transport' ) call log_event( & "Transporting conservative tracers (last)...", LOG_LEVEL_DEBUG & ) @@ -518,6 +540,8 @@ contains transport_controller, transport_metadata & ) end if + if ( LPROF ) call stop_timing( id_trac_last_con, & + 'control_last_conservative_tracer_transport' ) end if end if @@ -555,7 +579,7 @@ contains call transport_controller%finalise() call aerosol_transport_controller%finalise() - if ( subroutine_timers ) call timer('gungho_transport_control') + if ( LPROF ) call stop_timing( id_cont, 'gungho_transport_control' ) end subroutine gungho_transport_control_alg diff --git a/science/gungho/source/algorithm/transport/control/moist_mr_transport_alg_mod.x90 b/science/gungho/source/algorithm/transport/control/moist_mr_transport_alg_mod.x90 index 98c9f75b3..a82e7bdde 100644 --- a/science/gungho/source/algorithm/transport/control/moist_mr_transport_alg_mod.x90 +++ b/science/gungho/source/algorithm/transport/control/moist_mr_transport_alg_mod.x90 @@ -9,10 +9,10 @@ module moist_mr_transport_alg_mod use constants_mod, only: i_def, r_def use field_mod, only: field_type - use io_config_mod, only: subroutine_timers use log_mod, only: log_event, LOG_LEVEL_ERROR use mr_indices_mod, only: nummr - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF use transport_enumerated_types_mod, only: equation_form_advective, & equation_form_conservative, & equation_form_consistent @@ -61,8 +61,9 @@ contains ! Internal variables integer(kind=i_def) :: imr integer(kind=i_def) :: equation_form + integer(tik) :: id - if ( subroutine_timers ) call timer('transport.moisture') + if ( LPROF ) call start_timing( id, 'transport.moisture' ) ! If performing advective transport in the first outer loop, then the ! transport metadata needs setting here to make that choice @@ -132,7 +133,7 @@ contains call invoke( setval_X(mr_out_rdef(imr), mr_in_rdef(imr)) ) end do - if ( subroutine_timers ) call timer('transport.moisture') + if ( LPROF ) call stop_timing( id, 'transport.moisture' ) end subroutine moist_mr_transport_alg diff --git a/science/gungho/source/algorithm/transport/control/theta_transport_alg_mod.x90 b/science/gungho/source/algorithm/transport/control/theta_transport_alg_mod.x90 index 55c1c3b9a..ad31be337 100644 --- a/science/gungho/source/algorithm/transport/control/theta_transport_alg_mod.x90 +++ b/science/gungho/source/algorithm/transport/control/theta_transport_alg_mod.x90 @@ -24,7 +24,6 @@ module theta_transport_alg_mod use function_space_collection_mod, only: function_space_collection use fv_divergence_3d_kernel_mod, only: fv_divergence_3d_kernel_type use sci_geometric_constants_mod, only: get_height_fv, get_height_fe - use io_config_mod, only: subroutine_timers use log_mod, only: log_event, LOG_LEVEL_ERROR use map_w2_to_sh_w2_alg_mod, only: map_w2_to_sh_w2_alg use mesh_mod, only: mesh_type @@ -42,7 +41,6 @@ module theta_transport_alg_mod get_num_split_steps, & get_dry_config use theta_moist_source_kernel_mod, only: theta_moist_source_kernel_type - use timer_mod, only: timer use timestepping_config_mod, only: time_method => method, & method_semi_implicit use transport_config_mod, only: theta_variable, & diff --git a/science/gungho/source/algorithm/transport/control/tracer_collection_transport_alg_mod.x90 b/science/gungho/source/algorithm/transport/control/tracer_collection_transport_alg_mod.x90 index e8d80ac54..51822e943 100644 --- a/science/gungho/source/algorithm/transport/control/tracer_collection_transport_alg_mod.x90 +++ b/science/gungho/source/algorithm/transport/control/tracer_collection_transport_alg_mod.x90 @@ -16,14 +16,13 @@ module tracer_collection_transport_mod use field_collection_iterator_mod, only: field_collection_iterator_type use function_space_mod, only: function_space_type use function_space_collection_mod, only: function_space_collection - use io_config_mod, only: subroutine_timers use log_mod, only: log_event, & LOG_LEVEL_ERROR, & LOG_LEVEL_DEBUG use mesh_mod, only: mesh_type use mesh_collection_mod, only: mesh_collection - use timer_mod, only: timer - + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF use transport_controller_mod, only: transport_controller_type use transport_enumerated_types_mod, only: equation_form_advective, & equation_form_conservative, & @@ -78,8 +77,9 @@ contains type(field_type), pointer :: single_field_in integer(kind=i_def) :: equation_form + integer(tik) :: id - if ( subroutine_timers ) call timer('transport.tracer_collection') + if ( LPROF ) call start_timing( id, 'transport.tracer_collection' ) ! If performing advective transport in the first outer loop, then the ! transport metadata needs setting here to make that choice @@ -162,7 +162,7 @@ contains ! but in case there are no fields in the collection, also reset it here call transport_controller%after_transport_field() - if ( subroutine_timers ) call timer('transport.tracer_collection') + if ( LPROF ) call stop_timing( id, 'transport.tracer_collection' ) end subroutine tracer_collection_transport_alg @@ -215,8 +215,9 @@ contains ! Transport runtime and form of transport equation integer(kind=i_def) :: equation_form + integer(tik) :: id - if ( subroutine_timers ) call timer('transport.tracer_collection') + if ( LPROF ) call start_timing( id, 'transport.tracer_collection' ) ! If performing advective transport in the first outer loop, then the ! transport metadata needs setting here to make that choice @@ -301,7 +302,7 @@ contains end if - if ( subroutine_timers ) call timer('transport.tracer_collection') + if ( LPROF ) call stop_timing( id, 'transport.tracer_collection' ) end subroutine coarse_collection_transport_alg diff --git a/science/gungho/source/algorithm/transport/control/transport_controller_mod.x90 b/science/gungho/source/algorithm/transport/control/transport_controller_mod.x90 index c6e678f8f..618cf2534 100644 --- a/science/gungho/source/algorithm/transport/control/transport_controller_mod.x90 +++ b/science/gungho/source/algorithm/transport/control/transport_controller_mod.x90 @@ -35,7 +35,8 @@ module transport_controller_mod use mesh_collection_mod, only: mesh_collection use model_clock_mod, only: model_clock_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 ! Pointers to other objects use sci_geometric_constants_mod, only: get_face_selector_ew, & @@ -61,7 +62,6 @@ module transport_controller_mod ! Config use departure_points_config_mod, only: share_stencil_extent - use io_config_mod, only: subroutine_timers use transport_config_mod, only: dep_pt_stencil_extent implicit none @@ -206,8 +206,9 @@ contains logical(kind=l_def) :: fixed_multiple_substeps logical(kind=l_def) :: logged_lipschitz character(len=str_def) :: splitting_name + integer(tik) :: id - if ( subroutine_timers ) call timer('transport.controller_init') + if ( LPROF ) call start_timing( id, 'transport.controller_init' ) ! Set options, to be passed to objects initialised later if (present(outer)) then @@ -481,7 +482,7 @@ contains call log_event(log_scratch_space, LOG_LEVEL_INFO) end if - if ( subroutine_timers ) call timer('transport.controller_init') + if ( LPROF ) call stop_timing( id, 'transport.controller_init' ) end subroutine initialise diff --git a/science/gungho/source/algorithm/transport/control/wind_transport_alg_mod.x90 b/science/gungho/source/algorithm/transport/control/wind_transport_alg_mod.x90 index 73a649ade..91123b9ee 100644 --- a/science/gungho/source/algorithm/transport/control/wind_transport_alg_mod.x90 +++ b/science/gungho/source/algorithm/transport/control/wind_transport_alg_mod.x90 @@ -26,7 +26,6 @@ module wind_transport_alg_mod use function_space_mod, only: function_space_type use function_space_collection_mod, only: function_space_collection use sci_geometric_constants_mod, only: get_coordinates, get_panel_id - use io_config_mod, only: subroutine_timers use log_mod, only: log_event, & LOG_LEVEL_ERROR, & LOG_LEVEL_TRACE @@ -35,7 +34,8 @@ module wind_transport_alg_mod get_project_zdot_to_w2 use mesh_mod, only: mesh_type use operator_mod, only: operator_type - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF use transport_config_mod, only: broken_w2_projection use transport_constants_mod, only: get_element_order_h_transport, & get_element_order_v_transport @@ -102,8 +102,9 @@ contains type(function_space_type), pointer :: w2_fs type(function_space_type), pointer :: w2b_fs logical(kind=l_def) :: optimised_conversion + integer(tik) :: id, id_to, id_from - if ( subroutine_timers ) call timer('transport.wind') + if ( LPROF ) call start_timing( id, 'transport.wind' ) k_h = get_element_order_h_transport() k_v = get_element_order_v_transport() @@ -137,7 +138,7 @@ contains ! Split wind into components in W3 ! -------------------------------------------------------------------- ! - if ( subroutine_timers ) call timer('transport.wind_to_comps') + if ( LPROF ) call start_timing( id_to, 'transport.wind_to_comps' ) do dir = 1,3 call u_w3_n(dir)%initialise( w3_fs ) @@ -165,7 +166,7 @@ contains call log_field_minmax( LOG_LEVEL_TRACE, 'ydot', u_w3_n(2) ) call log_field_minmax( LOG_LEVEL_TRACE, 'zdot', u_w3_n(3) ) - if ( subroutine_timers ) call timer('transport.wind_to_comps') + if ( LPROF ) call stop_timing( id_to, 'transport.wind_to_comps' ) ! -------------------------------------------------------------------- ! ! Transport wind components in W3 @@ -182,7 +183,7 @@ contains ! Return from components to full wind field in W2 ! -------------------------------------------------------------------- ! - if ( subroutine_timers ) call timer('transport.wind_from_comps') + if ( LPROF ) call start_timing( id_from, 'transport.wind_from_comps' ) project_xdot_to_w2 => get_project_xdot_to_w2(mesh%get_id()) project_ydot_to_w2 => get_project_ydot_to_w2(mesh%get_id()) @@ -246,7 +247,7 @@ contains enforce_bc_kernel_type(rhs_u) ) end if - if ( subroutine_timers ) call timer('transport.wind_from_comps') + if ( LPROF ) call stop_timing( id_from, 'transport.wind_from_comps' ) ! ---------------------------------------------------------------------- ! ! Default form of transport equation @@ -262,7 +263,7 @@ contains end if ! si_momentum_equation - if ( subroutine_timers ) call timer('transport.wind') + if ( LPROF ) call stop_timing( id, 'transport.wind' ) end subroutine wind_transport_alg diff --git a/science/gungho/source/algorithm/transport/ffsl/ffsl_3d_alg_mod.x90 b/science/gungho/source/algorithm/transport/ffsl/ffsl_3d_alg_mod.x90 index a028b1068..645f8822a 100644 --- a/science/gungho/source/algorithm/transport/ffsl/ffsl_3d_alg_mod.x90 +++ b/science/gungho/source/algorithm/transport/ffsl/ffsl_3d_alg_mod.x90 @@ -20,7 +20,8 @@ module ffsl_3d_alg_mod use log_mod, only: log_event, LOG_LEVEL_ERROR use mesh_mod, only: mesh_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 use transport_constants_mod, only: get_element_order_h_transport, & get_element_order_v_transport @@ -41,7 +42,6 @@ module ffsl_3d_alg_mod use combine_w2_field_kernel_mod, only: combine_w2_field_kernel_type ! Configuration options - use io_config_mod, only: subroutine_timers use transport_config_mod, only: ffsl_inner_order, & ffsl_outer_order @@ -134,8 +134,9 @@ contains real(kind=r_tran) :: third_dt logical(kind=l_def) :: compute_adv_inc integer(kind=i_def) :: vertical_order + integer(tik) :: id - if ( subroutine_timers ) call timer(routine_name) + if ( LPROF ) call start_timing( id, 'ffsl_3d_transport_alg' ) ! Get pre-computed objects and set pointers -------------------------------- mesh => field_n%get_mesh() @@ -284,7 +285,7 @@ contains call log_event('FFSL_3D: equation not implemented', LOG_LEVEL_ERROR) end select - if ( subroutine_timers ) call timer(routine_name) + if ( LPROF ) call stop_timing( id, 'ffsl_3d_transport_alg' ) end subroutine ffsl_3d_splitting_alg diff --git a/science/gungho/source/algorithm/transport/ffsl/ffsl_hori_alg_mod.x90 b/science/gungho/source/algorithm/transport/ffsl/ffsl_hori_alg_mod.x90 index 7b8f88d2f..46214a091 100644 --- a/science/gungho/source/algorithm/transport/ffsl/ffsl_hori_alg_mod.x90 +++ b/science/gungho/source/algorithm/transport/ffsl/ffsl_hori_alg_mod.x90 @@ -22,7 +22,8 @@ module ffsl_hori_alg_mod use log_mod, only: log_event, LOG_LEVEL_ERROR use mesh_mod, only: mesh_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 ! Transport control use flux_precomputations_alg_mod, only: flux_precomputations_type @@ -74,7 +75,6 @@ module ffsl_hori_alg_mod transport_overwrite_freq_all use check_configuration_mod, only: check_any_eqn_consistent, & get_required_stencil_depth - use io_config_mod, only: subroutine_timers use transport_config_mod, only: & panel_edge_treatment, & panel_edge_treatment_extended_mesh, & @@ -163,8 +163,9 @@ contains ! Useful constants real(kind=r_tran) :: half_dt logical(kind=l_def) :: swift_splitting + integer(tik) :: id - if ( subroutine_timers ) call timer(routine_name) + if ( LPROF ) call start_timing( id, 'transport.ffsl_horizontal' ) ! Get pre-computed objects and set pointers -------------------------------- mesh => field_n%get_mesh() @@ -259,7 +260,7 @@ contains end if end if - if ( subroutine_timers ) call timer(routine_name) + if ( LPROF ) call stop_timing( id, 'transport.ffsl_horizontal' ) end subroutine ffsl_hori_splitting_alg @@ -334,6 +335,7 @@ contains integer(kind=i_def) :: order real(kind=r_tran) :: min_val logical(kind=l_def) :: is_cubed_sphere + integer(tik) :: id_sweeps, id_unify, id_update ! Get pre-computed objects and set pointers -------------------------------- mesh_id = field_n%get_mesh_id() @@ -436,7 +438,7 @@ contains ! used as two kernel arguments field_ptr_copy => field_big_halo - if ( subroutine_timers ) call timer('transport.ffsl_hori_sweeps') + if ( LPROF ) call start_timing( id_sweeps, 'transport.ffsl_hori_sweeps' ) ! MASS FLUX COMPUTATION ==================================================== if (panel_edge_treatment == panel_edge_treatment_special_edges) then ! Special edge treatment ------------------------------------------------ @@ -488,28 +490,28 @@ contains min_val, ndep, dt ) ) end if - if ( subroutine_timers ) call timer('transport.ffsl_hori_sweeps') + if ( LPROF ) call stop_timing( id_sweeps, 'transport.ffsl_hori_sweeps' ) ! fluxes may need unifying to guarantee a unique flux for each face -------- if ( panel_edge_treatment == panel_edge_treatment_extended_mesh ) then - if ( subroutine_timers ) call timer('transport.ffsl_flux_unify') + if ( LPROF ) call start_timing( id_unify, 'transport.ffsl_flux_unify' ) w2b_fs => function_space_collection%get_fs(mesh, 0, 0, W2Hbroken) call flux_broken%initialise( w2b_fs ) call invoke( average_w2_to_w2b_kernel_type(flux_broken, flux), & ffsl_unify_flux_kernel_type(flux, flux_broken, & 1, panel_id, 1) ) - if ( subroutine_timers ) call timer('transport.ffsl_flux_unify') + if ( LPROF ) call stop_timing( id_unify, 'transport.ffsl_flux_unify' ) end if ! Compute updated advective fields ----------------------------------------- - if ( subroutine_timers ) call timer('transport.ffsl_hori_update') + if ( LPROF ) call start_timing( id_update, 'transport.ffsl_hori_update' ) call invoke( fv_divergence_x_kernel_type(increment_x, flux, detj_at_w3), & fv_divergence_y_kernel_type(increment_y, flux, detj_at_w3) ) call ffsl_advective_increment(increment_x, field_n, dt, adv_one_x) call ffsl_advective_increment(increment_y, field_n, dt, adv_one_y) - if ( subroutine_timers ) call timer('transport.ffsl_hori_update') + if ( LPROF ) call stop_timing( id_update, 'transport.ffsl_hori_update' ) end subroutine ffsl_hori_cosmic_inner_alg @@ -594,6 +596,7 @@ contains real(kind=r_tran) :: min_val logical(kind=l_def) :: enforce_minvalue logical(kind=l_def) :: is_cubed_sphere + integer(tik) :: id_sweeps, id_unify, id_update ! Get pre-computed objects and set pointers -------------------------------- mesh_id = field_x%get_mesh_id() @@ -737,7 +740,7 @@ contains field_ptr_copy => field_big_halo - if ( subroutine_timers ) call timer('transport.ffsl_hori_sweeps') + if ( LPROF ) call start_timing( id_sweeps, 'transport.ffsl_hori_sweeps' ) ! MASS FLUX COMPUTATION ==================================================== if (panel_edge_treatment == panel_edge_treatment_remapping) then ! Use remapped fields at panel edges ------------------------------------- @@ -810,21 +813,22 @@ contains end if - if ( subroutine_timers ) call timer('transport.ffsl_hori_sweeps') + if ( LPROF ) call stop_timing( id_sweeps, 'transport.ffsl_hori_sweeps' ) ! fluxes may need unifying to guarantee a unique flux for each face -------- if ( panel_edge_treatment == panel_edge_treatment_extended_mesh ) then - if ( subroutine_timers ) call timer('transport.ffsl_flux_unify') + if ( LPROF ) call start_timing( id_unify, 'transport.ffsl_flux_unify' ) w2b_fs => function_space_collection%get_fs(mesh, 0, 0, W2Hbroken) call flux_broken%initialise( w2b_fs ) call invoke( average_w2_to_w2b_kernel_type(flux_broken, flux), & ffsl_unify_flux_kernel_type(flux, flux_broken, & 1, panel_id, 1) ) - if ( subroutine_timers ) call timer('transport.ffsl_flux_unify') + + if ( LPROF ) call stop_timing( id_unify, 'transport.ffsl_flux_unify' ) end if ! Compute advected fields - if ( subroutine_timers ) call timer('transport.ffsl_hori_update') + if ( LPROF ) call start_timing( id_update, 'transport.ffsl_hori_update' ) call invoke( fv_difference_x_kernel_type(increment_x, flux), & fv_difference_y_kernel_type(increment_y, flux) ) ! Obtain updated mixing ratio by dividing by updated density @@ -833,7 +837,7 @@ contains call swift_inner_update_tracer(field_y, field_n, dry_mass_y, & dry_mass_n, increment_y, step_dt) - if ( subroutine_timers ) call timer('transport.ffsl_hori_update') + if ( LPROF ) call stop_timing( id_update, 'transport.ffsl_hori_update' ) end subroutine ffsl_hori_swift_inner_alg @@ -943,6 +947,7 @@ contains integer(kind=i_def) :: order logical(kind=l_def) :: outer logical(kind=l_def) :: is_cubed_sphere + integer(tik) :: id_sweeps, id_unify, id_update ! Get pre-computed objects and set pointers -------------------------------- mesh_id = field_x%get_mesh_id() @@ -1104,7 +1109,7 @@ contains ) end if - if ( subroutine_timers ) call timer('transport.ffsl_hori_sweeps') + if ( LPROF ) call start_timing( id_sweeps, 'transport.ffsl_hori_sweeps' ) ! MASS FLUX COMPUTATION ==================================================== if (panel_edge_treatment == panel_edge_treatment_remapping) then @@ -1179,22 +1184,22 @@ contains end if - if ( subroutine_timers ) call timer('transport.ffsl_hori_sweeps') + if ( LPROF ) call stop_timing( id_sweeps, 'transport.ffsl_hori_sweeps' ) ! fluxes may need unifying to guarantee a unique flux for each face -------- if ( panel_edge_treatment == panel_edge_treatment_extended_mesh ) then - if ( subroutine_timers ) call timer('transport.ffsl_flux_unify') + if ( LPROF ) call start_timing( id_unify, 'transport.ffsl_flux_unify' ) w2b_fs => function_space_collection%get_fs(mesh, 0, 0, W2Hbroken) call flux_broken%initialise( w2b_fs ) call invoke( average_w2_to_w2b_kernel_type(flux_broken, flux), & ffsl_unify_flux_kernel_type(flux, flux_broken, & 1, panel_id, 1) ) - if ( subroutine_timers ) call timer('transport.ffsl_flux_unify') + if ( LPROF ) call stop_timing( id_unify, 'transport.ffsl_flux_unify' ) end if ! Compute advective increments, if required -------------------------------- if (to_compute_adv_inc .or. to_compute_field_np1) then - if ( subroutine_timers ) call timer('transport.ffsl_hori_update') + if ( LPROF ) call start_timing( id_update, 'transport.ffsl_hori_update' ) call increment_x%initialise( vector_space = field_fs ) call increment_y%initialise( vector_space = field_fs ) @@ -1262,7 +1267,7 @@ contains end if end if - if ( subroutine_timers ) call timer('transport.ffsl_hori_update') + if ( LPROF ) call stop_timing( id_update, 'transport.ffsl_hori_update' ) end if end subroutine ffsl_hori_outer_alg diff --git a/science/gungho/source/algorithm/transport/ffsl/ffsl_vert_alg_mod.x90 b/science/gungho/source/algorithm/transport/ffsl/ffsl_vert_alg_mod.x90 index 23f70801b..eb972d3b5 100644 --- a/science/gungho/source/algorithm/transport/ffsl/ffsl_vert_alg_mod.x90 +++ b/science/gungho/source/algorithm/transport/ffsl/ffsl_vert_alg_mod.x90 @@ -18,7 +18,8 @@ module ffsl_vert_alg_mod use log_mod, only: log_event, LOG_LEVEL_ERROR use mesh_mod, only: mesh_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 ! Transport control use flux_precomputations_alg_mod, only: flux_precomputations_type @@ -49,7 +50,6 @@ module ffsl_vert_alg_mod use fv_divergence_z_kernel_mod, only: fv_divergence_z_kernel_type ! Configuration options - use io_config_mod, only: subroutine_timers use transport_config_mod, only: ffsl_unity_3d, & wind_mono_top, & wind_mono_top_depth @@ -131,8 +131,9 @@ contains ! Useful constants integer(kind=i_def) :: mesh_id, step real(kind=r_tran) :: one_over_dt + integer(tik) :: id - if ( subroutine_timers ) call timer(routine_name) + if ( LPROF ) call start_timing( id, 'transport.ffsl_vertical' ) transport_counter => transport_controller%get_transport_counter() transport_metadata => transport_controller%get_transport_metadata() @@ -206,8 +207,7 @@ contains step_dt, increment) ) end if end if - - if ( subroutine_timers ) call timer(routine_name) + if ( LPROF ) call stop_timing( id, 'transport.ffsl_vertical' ) end subroutine ffsl_vert_transport_alg diff --git a/science/gungho/source/algorithm/transport/mol/mol_advective_alg_mod.x90 b/science/gungho/source/algorithm/transport/mol/mol_advective_alg_mod.x90 index 4e9d1e563..16d16b65d 100644 --- a/science/gungho/source/algorithm/transport/mol/mol_advective_alg_mod.x90 +++ b/science/gungho/source/algorithm/transport/mol/mol_advective_alg_mod.x90 @@ -11,7 +11,8 @@ module mol_advective_alg_mod use constants_mod, only: r_def, i_def, l_def, r_tran use mesh_mod, only: mesh_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 ! Algorithms and transport code use advective_and_flux_alg_mod, only: advective_and_flux_alg @@ -27,7 +28,6 @@ module mol_advective_alg_mod ! Configuration use base_mesh_config_mod, only: topology, topology_non_periodic use boundaries_config_mod, only: limited_area, transport_boundary_depth - use io_config_mod, only: subroutine_timers use transport_config_mod, only: runge_kutta_method implicit none @@ -73,9 +73,10 @@ contains type(transport_counter_type), pointer :: transport_counter type(transport_metadata_type), pointer :: transport_metadata type(wind_precomputations_type), pointer :: wind_precomputations + integer(tik) :: id - if ( subroutine_timers ) call timer('transport.mol_advective') + if ( LPROF ) call start_timing( id, 'transport.mol_advective' ) ! ------------------------------------------------------------------------ ! ! Extract pre-existing objects and initialise temporary fields @@ -177,7 +178,7 @@ contains if ( allocated( rk_field ) ) deallocate( rk_field ) if ( allocated( rk_weights ) ) deallocate( rk_weights ) - if ( subroutine_timers ) call timer('transport.mol_advective') + if ( LPROF ) call stop_timing( id, 'transport.mol_advective' ) end subroutine mol_advective_alg diff --git a/science/gungho/source/algorithm/transport/mol/mol_conservative_alg_mod.x90 b/science/gungho/source/algorithm/transport/mol/mol_conservative_alg_mod.x90 index cd0bfb1b8..9d8d4fc67 100644 --- a/science/gungho/source/algorithm/transport/mol/mol_conservative_alg_mod.x90 +++ b/science/gungho/source/algorithm/transport/mol/mol_conservative_alg_mod.x90 @@ -15,7 +15,8 @@ module mol_conservative_alg_mod use operator_mod, only: operator_type use r_tran_field_mod, only: r_tran_field_type use r_tran_operator_mod, only: r_tran_operator_type - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF ! Algorithms and transport code use advective_and_flux_alg_mod, only: advective_and_flux_alg @@ -39,7 +40,6 @@ module mol_conservative_alg_mod ! Configuration use base_mesh_config_mod, only: topology, topology_non_periodic use boundaries_config_mod, only: limited_area, transport_boundary_depth - use io_config_mod, only: subroutine_timers use transport_config_mod, only: runge_kutta_method, & dry_field_name, & operators, & @@ -96,8 +96,9 @@ module mol_conservative_alg_mod type(transport_metadata_type), pointer :: transport_metadata type(wind_precomputations_type), pointer :: wind_precomputations type(flux_precomputations_type), pointer :: flux_precomputations + integer(tik) :: id - if ( subroutine_timers ) call timer('transport.mol_conservative') + if ( LPROF ) call start_timing( id, 'transport.mol_conservective' ) ! ------------------------------------------------------------------------ ! ! Extract pre-existing objects and initialise temporary fields @@ -273,7 +274,7 @@ module mol_conservative_alg_mod if ( allocated(rk_field) ) deallocate(rk_field) if ( allocated(rk_weights) ) deallocate(rk_weights) - if ( subroutine_timers ) call timer('transport.mol_conservative') + if ( LPROF ) call stop_timing( id, 'transport.mol_conservective' ) end subroutine mol_conservative_alg diff --git a/science/gungho/source/algorithm/transport/mol/mol_consistent_alg_mod.x90 b/science/gungho/source/algorithm/transport/mol/mol_consistent_alg_mod.x90 index e64af7764..bbdf8e6ab 100644 --- a/science/gungho/source/algorithm/transport/mol/mol_consistent_alg_mod.x90 +++ b/science/gungho/source/algorithm/transport/mol/mol_consistent_alg_mod.x90 @@ -18,7 +18,8 @@ module mol_consistent_alg_mod use mesh_mod, only: mesh_type use mesh_collection_mod, only: mesh_collection 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 ! Algorithms and transport code use advective_and_flux_alg_mod, only: advective_and_flux_alg @@ -41,7 +42,6 @@ module mol_consistent_alg_mod use base_mesh_config_mod, only: topology, topology_non_periodic use boundaries_config_mod, only: limited_area, & transport_boundary_depth - use io_config_mod, only: subroutine_timers use transport_config_mod, only: runge_kutta_method implicit none @@ -104,8 +104,9 @@ module mol_consistent_alg_mod type(transport_metadata_type), pointer :: transport_metadata type(wind_precomputations_type), pointer :: wind_precomputations type(flux_precomputations_type), pointer :: flux_precomputations + integer(tik) :: id - if ( subroutine_timers ) call timer('transport.mol_consistent') + if ( LPROF ) call start_timing( id, 'transport.mol_consistent' ) ! ------------------------------------------------------------------------ ! ! Extract pre-existing objects and initialise temporary fields @@ -335,7 +336,7 @@ module mol_consistent_alg_mod if ( allocated( rk_field ) ) deallocate( rk_field ) if ( allocated( rk_weights ) ) deallocate( rk_weights ) - if ( subroutine_timers ) call timer('transport.mol_consistent') + if ( LPROF ) call stop_timing( id, 'transport.mol_consistent' ) end subroutine mol_consistent_alg diff --git a/science/gungho/source/algorithm/transport/mol/reconstruct_w3_field_alg_mod.x90 b/science/gungho/source/algorithm/transport/mol/reconstruct_w3_field_alg_mod.x90 index 6bed73bed..b7038d05c 100644 --- a/science/gungho/source/algorithm/transport/mol/reconstruct_w3_field_alg_mod.x90 +++ b/science/gungho/source/algorithm/transport/mol/reconstruct_w3_field_alg_mod.x90 @@ -60,8 +60,8 @@ module reconstruct_w3_field_alg_mod use polyv_w3_koren_kernel_mod, only: polyv_w3_koren_kernel_type use polyh_w3_koren_kernel_mod, only: polyh_w3_koren_kernel_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 @@ -176,8 +176,9 @@ contains integer(kind=i_def) :: stencil_size logical(kind=l_def) :: monotone integer(kind=i_def) :: remap_depth + integer(tik) :: id - if ( subroutine_timers ) call timer('transport.w3_hori_recon') + if ( LPROF ) call start_timing( id, 'transport.w3_hori_recon' ) mesh => field_new%get_mesh() mesh_id = mesh%get_id() @@ -237,7 +238,7 @@ contains stencil_size) ) end if - if ( subroutine_timers ) call timer('transport.w3_hori_recon') + if ( LPROF ) call stop_timing( id, 'transport.w3_hori_recon' ) end subroutine hori_w3_reconstruct_alg @@ -268,8 +269,9 @@ contains logical(kind=l_def) :: logspace logical(kind=l_def) :: reversible integer(kind=i_def) :: monotonicity + integer(tik) :: id - if ( subroutine_timers ) call timer('transport.w3_vert_recon') + if ( LPROF ) call start_timing( id, 'transport.w3_vert_recon' ) reversible = ( transport_metadata%get_reversible() .and. final_rk_stage ) logspace = transport_metadata%get_log_space() @@ -311,7 +313,7 @@ contains end if - if ( subroutine_timers ) call timer('transport.w3_vert_recon') + if ( LPROF ) call stop_timing( id, 'transport.w3_vert_recon' ) end subroutine vert_w3_reconstruct_alg diff --git a/science/gungho/source/algorithm/transport/mol/wt_advective_update_alg_mod.x90 b/science/gungho/source/algorithm/transport/mol/wt_advective_update_alg_mod.x90 index 310165201..c14d1a899 100644 --- a/science/gungho/source/algorithm/transport/mol/wt_advective_update_alg_mod.x90 +++ b/science/gungho/source/algorithm/transport/mol/wt_advective_update_alg_mod.x90 @@ -67,8 +67,8 @@ module wt_advective_update_alg_mod use polyh_wtheta_koren_kernel_mod, only: polyh_wtheta_koren_kernel_type use polyv_wtheta_koren_kernel_mod, only: polyv_wtheta_koren_kernel_type use copy_field_alg_mod, only: copy_field - use io_config_mod, only: subroutine_timers - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF implicit none @@ -113,8 +113,9 @@ contains integer(kind=i_def) :: stencil_size logical(kind=l_def) :: monotone integer(kind=i_def) :: remap_depth + integer(tik) :: id - if ( subroutine_timers ) call timer('transport.wt_hori_recon') + if ( LPROF ) call start_timing( id, 'transport.wt_hori_recon' ) mesh => wind%get_mesh() mesh_id = mesh%get_id() @@ -196,7 +197,7 @@ contains wind, & wind_dir, stencil_extent)) - if ( subroutine_timers ) call timer('transport.wt_hori_recon') + if ( LPROF ) call stop_timing( id, 'transport.wt_hori_recon' ) end subroutine hori_wt_update_alg @@ -230,8 +231,9 @@ contains logical(kind=l_def) :: logspace logical(kind=l_def) :: reversible integer(kind=i_def) :: monotonicity + integer(tik) :: id - if ( subroutine_timers ) call timer('transport.wt_vert_recon') + if ( LPROF ) call start_timing( id, 'transport.wt_vert_recon' ) reversible = ( transport_metadata%get_reversible() .and. final_rk_stage ) logspace = transport_metadata%get_log_space() @@ -268,7 +270,7 @@ contains logspace ) ) end if - if ( subroutine_timers ) call timer('transport.wt_vert_recon') + if ( LPROF ) call stop_timing( id, 'transport.wt_vert_recon' ) end subroutine vert_wt_update_alg diff --git a/science/gungho/source/algorithm/transport/sl/horizontal_sl_advective_alg_mod.x90 b/science/gungho/source/algorithm/transport/sl/horizontal_sl_advective_alg_mod.x90 index d547900e1..3b09e0618 100644 --- a/science/gungho/source/algorithm/transport/sl/horizontal_sl_advective_alg_mod.x90 +++ b/science/gungho/source/algorithm/transport/sl/horizontal_sl_advective_alg_mod.x90 @@ -18,7 +18,8 @@ module horizontal_sl_advective_alg_mod use integer_field_mod, only: integer_field_type use mesh_mod, only: mesh_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 ! Transport control use flux_precomputations_alg_mod, only: flux_precomputations_type @@ -53,7 +54,6 @@ module horizontal_sl_advective_alg_mod transport_overwrite_freq, & transport_overwrite_freq_all use departure_points_config_mod, only: share_stencil_extent - use io_config_mod, only: subroutine_timers use transport_config_mod, only: & panel_edge_treatment, & panel_edge_treatment_extended_mesh, & @@ -119,6 +119,8 @@ module horizontal_sl_advective_alg_mod logical(kind=l_def) :: do_overwrite real(kind=r_tran) :: dt_frac, dt real(kind=r_tran) :: one_over_dt, half_dt + integer(tik) :: id + ! Transport objects type(wind_precomputations_type), pointer :: wind_precomputations @@ -128,7 +130,7 @@ module horizontal_sl_advective_alg_mod type(r_tran_field_type), pointer :: dep_dist_xy integer(kind=i_def) :: dep_stencil_extent_xy - if ( subroutine_timers ) call timer('transport.sl_horizontal') + if ( LPROF ) call start_timing( id, 'transport.sl_horizontal' ) ! Get mesh ID and panel ID mesh_id = field_n%get_mesh_id() @@ -295,7 +297,7 @@ module horizontal_sl_advective_alg_mod field_np1, field_n, transport_counter, transport_metadata & ) - if ( subroutine_timers ) call timer('transport.sl_horizontal') + if ( LPROF ) call stop_timing( id, 'transport.sl_horizontal' ) end subroutine horizontal_sl_advective_alg diff --git a/science/gungho/source/algorithm/transport/sl/vertical_sl_advective_alg_mod.x90 b/science/gungho/source/algorithm/transport/sl/vertical_sl_advective_alg_mod.x90 index 0828d532a..46e7b4698 100644 --- a/science/gungho/source/algorithm/transport/sl/vertical_sl_advective_alg_mod.x90 +++ b/science/gungho/source/algorithm/transport/sl/vertical_sl_advective_alg_mod.x90 @@ -17,7 +17,8 @@ module vertical_sl_advective_alg_mod use log_mod, only: log_event, LOG_LEVEL_ERROR use mesh_mod, only: mesh_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 ! Transport control use transport_controller_mod, only: transport_controller_type @@ -37,7 +38,6 @@ module vertical_sl_advective_alg_mod use vertical_quintic_sl_kernel_mod, only: vertical_quintic_sl_kernel_type ! Configs - use io_config_mod, only: subroutine_timers use transport_config_mod, only: vertical_sl_order, & vertical_sl_order_cubic, & vertical_sl_order_quintic, & @@ -84,13 +84,14 @@ contains integer(kind=i_def) :: splitting logical(kind=l_def) :: reversibility logical(kind=l_def) :: log_space + integer(tik) :: id ! Interpolation coefficients type(r_tran_field_type), pointer :: linear_coeffs(:) type(r_tran_field_type), pointer :: interp_coeffs(:) type(integer_field_type), pointer :: interp_indices(:) - if ( subroutine_timers ) call timer( 'transport.sl_vertical' ) + if ( LPROF ) call start_timing( id, 'transport.sl_vertical' ) if ( vertical_sl_order /= vertical_sl_order_cubic .and. & vertical_sl_order /= vertical_sl_order_cubic_hermite .and. & @@ -187,7 +188,7 @@ contains field_np1, field_n, transport_counter, transport_metadata & ) - if ( subroutine_timers ) call timer( 'transport.sl_vertical' ) + if ( LPROF ) call stop_timing( id, 'transport.sl_vertical' ) end subroutine vertical_sl_advective_alg diff --git a/science/gungho/source/algorithm/transport/sl/vertical_sl_conservative_alg_mod.x90 b/science/gungho/source/algorithm/transport/sl/vertical_sl_conservative_alg_mod.x90 index 77ec2cd1b..8c5741982 100644 --- a/science/gungho/source/algorithm/transport/sl/vertical_sl_conservative_alg_mod.x90 +++ b/science/gungho/source/algorithm/transport/sl/vertical_sl_conservative_alg_mod.x90 @@ -21,7 +21,8 @@ module vertical_sl_conservative_alg_mod use r_tran_field_mod, only: r_tran_field_type use r_tran_operator_mod, only: r_tran_operator_type - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF ! Transport control use flux_precomputations_alg_mod, only: flux_precomputations_type @@ -51,7 +52,6 @@ module vertical_sl_conservative_alg_mod get_inverse_mass_matrix_r_tran ! Configs - use io_config_mod, only: subroutine_timers use transport_config_mod, only: slice_order, & slice_order_linear, & slice_order_parabola, & @@ -117,8 +117,9 @@ contains logical(kind=l_def) :: reversibility logical(kind=l_def) :: enforce_min_value logical(kind=l_def) :: final_split_step + integer(tik) :: id - if ( subroutine_timers ) call timer( 'transport.slice_vertical' ) + if ( LPROF ) call start_timing( id, 'transport.slice_vertical' ) if ( slice_order /= slice_order_linear .and. & slice_order /= slice_order_cubic .and. & @@ -247,7 +248,7 @@ contains transport_counter, transport_metadata & ) - if ( subroutine_timers ) call timer( 'transport.slice_vertical' ) + if ( LPROF ) call stop_timing( id, 'transport.slice_vertical' ) end subroutine vertical_sl_conservative_alg diff --git a/science/gungho/source/diagnostics/external_forcing_diagnostics.f90 b/science/gungho/source/diagnostics/external_forcing_diagnostics.f90 index 7f0bc7751..9b1899721 100644 --- a/science/gungho/source/diagnostics/external_forcing_diagnostics.f90 +++ b/science/gungho/source/diagnostics/external_forcing_diagnostics.f90 @@ -12,8 +12,7 @@ module external_forcing_diagnostics_mod use field_mod, only: field_type use log_mod, only: log_event, LOG_LEVEL_INFO use constants_mod, only: l_def - use io_config_mod, only: subroutine_timers - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, tik, LPROF use initialise_diagnostics_mod, only: init_diag => init_diagnostic_field use physics_mappings_alg_mod, only: map_physics_winds @@ -40,8 +39,9 @@ subroutine write_forcing_diagnostics(du_forcing, output_wind_inc) output_dv_force, & output_dw_force type( field_type ) :: du_force, dv_force, dw_force + integer(tik) :: id - if ( subroutine_timers ) call timer("write_forcing_diagnostics") + if ( LPROF ) call start_timing( id, 'write_forcing_diagnostics' ) if ( output_wind_inc ) then ! @@ -92,7 +92,7 @@ subroutine write_forcing_diagnostics(du_forcing, output_wind_inc) end if - if ( subroutine_timers ) call timer("write_forcing_diagnostics") + if ( LPROF ) call stop_timing( id, 'write_forcing_diagnostics' ) end subroutine write_forcing_diagnostics diff --git a/science/gungho/source/driver/gungho_diagnostics_driver_mod.F90 b/science/gungho/source/driver/gungho_diagnostics_driver_mod.F90 index 12cc745a4..aff34838f 100644 --- a/science/gungho/source/driver/gungho_diagnostics_driver_mod.F90 +++ b/science/gungho/source/driver/gungho_diagnostics_driver_mod.F90 @@ -48,8 +48,9 @@ module gungho_diagnostics_driver_mod use sci_geometric_constants_mod, & only : get_panel_id, get_height_fe, & get_height_fv, get_da_msl_proj - use io_config_mod, only : subroutine_timers, use_xios_io, write_fluxes + use io_config_mod, only : use_xios_io, write_fluxes use timer_mod, only : timer + use timing_mod, only : start_timing, stop_timing, tik, LPROF use transport_config_mod, only : transport_ageofair use driver_modeldb_mod, only : modeldb_type @@ -136,9 +137,8 @@ subroutine gungho_diagnostics_driver( modeldb, & procedure(write_interface), pointer :: tmp_write_ptr => null() integer :: i - - if ( subroutine_timers ) call timer('gungho_diagnostics_driver') - + integer(tik) :: id + if ( LPROF ) call start_timing( id, 'gungho_diagnostics_driver' ) call log_event("Gungho: writing diagnostic output", LOG_LEVEL_DEBUG) ! Get pointers to field collections for use downstream @@ -333,8 +333,7 @@ subroutine gungho_diagnostics_driver( modeldb, & call write_divergence_diagnostic( u, modeldb%clock, mesh ) call write_hydbal_diagnostic( theta, moist_dyn, exner, mesh ) end if - - if ( subroutine_timers ) call timer('gungho_diagnostics_driver') + if ( LPROF ) call stop_timing( id, 'gungho_diagnostics_driver' ) end subroutine gungho_diagnostics_driver end module gungho_diagnostics_driver_mod diff --git a/science/gungho/source/driver/gungho_step_mod.x90 b/science/gungho/source/driver/gungho_step_mod.x90 index da004ab84..cd5169780 100644 --- a/science/gungho/source/driver/gungho_step_mod.x90 +++ b/science/gungho/source/driver/gungho_step_mod.x90 @@ -57,6 +57,8 @@ module gungho_step_mod use compute_total_energy_alg_mod, only : compute_total_energy_alg use compute_total_mass_alg_mod, only : compute_total_mass_alg use sci_field_minmax_alg_mod, only : log_field_minmax + use timing_mod, only : start_timing, stop_timing, & + tik, LPROF implicit none @@ -110,6 +112,9 @@ module gungho_step_mod real( r_def ) :: dt logical( l_def ) :: use_moisture + integer( tik ) :: id + + if ( LPROF ) call start_timing( id, 'gungho_timestep' ) write( log_scratch_space, '("/", A, "\ ")' ) repeat( "*", 76 ) call log_event( log_scratch_space, LOG_LEVEL_TRACE ) @@ -220,6 +225,7 @@ module gungho_step_mod call log_event( log_scratch_space, LOG_LEVEL_INFO ) write( log_scratch_space, '("\", A, "/ ")' ) repeat( "*", 76 ) call log_event( log_scratch_space, LOG_LEVEL_INFO ) + if ( LPROF ) call stop_timing( id, 'gungho_timestep' ) end subroutine gungho_step diff --git a/science/linear/source/algorithm/core_dynamics/tl_rhs_alg_mod.x90 b/science/linear/source/algorithm/core_dynamics/tl_rhs_alg_mod.x90 index 2d329e9d8..7e4f0f8ae 100644 --- a/science/linear/source/algorithm/core_dynamics/tl_rhs_alg_mod.x90 +++ b/science/linear/source/algorithm/core_dynamics/tl_rhs_alg_mod.x90 @@ -39,8 +39,8 @@ module tl_rhs_alg_mod use quadrature_rule_gaussian_mod, only: quadrature_rule_gaussian_type use derived_config_mod, only: bundle_size use field_indices_mod, only: igh_u, igh_t, igh_d, igh_p - use io_config_mod, only: subroutine_timers - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF use tl_rhs_project_eos_kernel_mod, only: tl_rhs_project_eos_kernel_type use tl_rhs_sample_eos_kernel_mod, only: tl_rhs_sample_eos_kernel_type use moist_dyn_mod, only: num_moist_factors, gas_law @@ -133,8 +133,9 @@ subroutine tl_rhs_alg(rhs, alpha_dt, base_state, state, moist_dyn, & ls_exner_big_halo integer(kind=i_def), parameter :: exner_stencil_depth = 1 + integer(tik) :: id - if ( subroutine_timers ) call timer('rhs_alg') + if ( LPROF ) call start_timing( id, 'tl_rhs_alg' ) mesh => base_state(igh_u)%get_mesh() @@ -290,7 +291,7 @@ subroutine tl_rhs_alg(rhs, alpha_dt, base_state, state, moist_dyn, & mesh, reference_element ) - if ( subroutine_timers ) call timer('rhs_alg') + if ( LPROF ) call stop_timing( id, 'tl_rhs_alg' ) end subroutine tl_rhs_alg diff --git a/science/linear/source/algorithm/timestepping/tl_rk_alg_timestep_mod.x90 b/science/linear/source/algorithm/timestepping/tl_rk_alg_timestep_mod.x90 index 30d391f99..08e47604a 100644 --- a/science/linear/source/algorithm/timestepping/tl_rk_alg_timestep_mod.x90 +++ b/science/linear/source/algorithm/timestepping/tl_rk_alg_timestep_mod.x90 @@ -82,8 +82,8 @@ module tl_rk_alg_timestep_mod use moist_dyn_mod, only: num_moist_factors, gas_law use mr_indices_mod, only: nummr - use io_config_mod, only: subroutine_timers - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF use sci_field_minmax_alg_mod, only: log_field_minmax @@ -255,8 +255,9 @@ contains ! Fields with larger halos type(field_type) :: ls_exner_big_halo, & exner_big_halo + integer(tik) :: id - if ( subroutine_timers ) call timer('tl_rk_alg') + if ( LPROF ) call start_timing( id, 'tl_rk_alg' ) cast_dt = real(model_clock%get_seconds_per_step(), r_def) @@ -508,7 +509,7 @@ contains nullify( geopotential, chi, panel_id, m3_inv, & mesh, reference_element, qr ) - if ( subroutine_timers ) call timer('tl_rk_alg') + if ( LPROF ) call stop_timing( id, 'tl_rk_alg' ) end subroutine tl_rk_alg_step diff --git a/science/linear/source/algorithm/timestepping/tl_si_timestep_alg_mod.x90 b/science/linear/source/algorithm/timestepping/tl_si_timestep_alg_mod.x90 index c4bfedbd2..533d5ccff 100644 --- a/science/linear/source/algorithm/timestepping/tl_si_timestep_alg_mod.x90 +++ b/science/linear/source/algorithm/timestepping/tl_si_timestep_alg_mod.x90 @@ -25,9 +25,7 @@ module tl_si_timestep_alg_mod use_wavedynamics, & si_momentum_equation, & exner_from_eos - - use io_config_mod, only: subroutine_timers, & - write_conservation_diag + use io_config_mod, only: write_conservation_diag use linear_config_mod, only: fixed_ls, & l_stabilise_bl, & n_bl_levels_to_stabilise, & @@ -107,7 +105,7 @@ module tl_si_timestep_alg_mod ! Mixing settings use mixing_config_mod, only: smagorinsky - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, tik, LPROF implicit none @@ -396,8 +394,9 @@ contains ! Configuration type( namelist_type ), pointer :: mixed_solver_nml real( kind=r_def ) :: mixed_solver_a_tol + integer(tik) :: id - if ( subroutine_timers ) call timer('semi_implicit_timestep_alg') + if ( LPROF ) call start_timing( id, 'tl_semi_implicit_timestep_alg' ) cast_dt = real(modeldb%clock%get_seconds_per_step(), r_def) @@ -891,7 +890,7 @@ contains nullify( mm_wt, mm_vel, qr ) - if ( subroutine_timers ) call timer('semi_implicit_timestep_alg') + if ( LPROF ) call stop_timing( id, 'tl_semi_implicit_timestep_alg' ) end subroutine tl_semi_implicit_alg_step diff --git a/science/linear/source/algorithm/transport/common/tl_end_of_transport_step_alg_mod.x90 b/science/linear/source/algorithm/transport/common/tl_end_of_transport_step_alg_mod.x90 index 0cda7d6a0..d688438dd 100644 --- a/science/linear/source/algorithm/transport/common/tl_end_of_transport_step_alg_mod.x90 +++ b/science/linear/source/algorithm/transport/common/tl_end_of_transport_step_alg_mod.x90 @@ -17,7 +17,6 @@ module tl_end_of_transport_step_alg_mod use fs_continuity_mod, only: W2, W2H, W2V use function_space_mod, only: function_space_type use function_space_collection_mod, only: function_space_collection - use io_config_mod, only: subroutine_timers use log_mod, only: log_event, LOG_LEVEL_ERROR use mesh_mod, only: mesh_type use mesh_collection_mod, only: mesh_collection diff --git a/science/linear/source/algorithm/transport/control/tl_moist_mr_transport_alg_mod.x90 b/science/linear/source/algorithm/transport/control/tl_moist_mr_transport_alg_mod.x90 index bf534b144..8291318e1 100644 --- a/science/linear/source/algorithm/transport/control/tl_moist_mr_transport_alg_mod.x90 +++ b/science/linear/source/algorithm/transport/control/tl_moist_mr_transport_alg_mod.x90 @@ -10,11 +10,11 @@ module tl_moist_mr_transport_alg_mod use constants_mod, only: i_def, r_def use sci_enforce_lower_bound_kernel_mod, only: enforce_lower_bound_kernel_type use field_mod, only: field_type - use io_config_mod, only: subroutine_timers use log_mod, only: log_event, & LOG_LEVEL_ERROR use mr_indices_mod, only: nummr - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF use tl_transport_controller_mod, only: tl_transport_controller_type use transport_enumerated_types_mod, only: equation_form_advective, & equation_form_conservative @@ -61,8 +61,9 @@ contains ! Internal variables integer(kind=i_def) :: imr + integer(tik) :: id - if ( subroutine_timers ) call timer('tl moist mixing ratio transport') + if ( LPROF ) call start_timing( id, 'tl_moist_mixing_ratio_transport' ) ! Choose form of transport equation select case ( transport_metadata%get_equation_form() ) @@ -106,7 +107,7 @@ contains call invoke( setval_X(mr_out(imr), mr_in(imr)) ) end do - if ( subroutine_timers ) call timer('tl moist mixing ratio transport') + if ( LPROF ) call stop_timing( id, 'tl_moist_mixing_ratio_transport' ) end subroutine tl_moist_mr_transport_alg diff --git a/science/linear/source/algorithm/transport/control/tl_theta_transport_alg_mod.x90 b/science/linear/source/algorithm/transport/control/tl_theta_transport_alg_mod.x90 index 157823b27..bcc06de5e 100644 --- a/science/linear/source/algorithm/transport/control/tl_theta_transport_alg_mod.x90 +++ b/science/linear/source/algorithm/transport/control/tl_theta_transport_alg_mod.x90 @@ -17,7 +17,6 @@ module tl_theta_transport_alg_mod use log_mod, only: log_event, & LOG_LEVEL_ERROR use operator_mod, only: operator_type - use timer_mod, only: timer use timestepping_config_mod, only: time_method => method, & method_semi_implicit use tl_transport_field_mod, only: tl_transport_field diff --git a/science/linear/source/algorithm/transport/control/tl_transport_control_alg_mod.x90 b/science/linear/source/algorithm/transport/control/tl_transport_control_alg_mod.x90 index 337b471df..be30bb11b 100644 --- a/science/linear/source/algorithm/transport/control/tl_transport_control_alg_mod.x90 +++ b/science/linear/source/algorithm/transport/control/tl_transport_control_alg_mod.x90 @@ -66,8 +66,8 @@ contains use tl_theta_transport_alg_mod, only: tl_theta_transport_alg use tl_transport_field_mod, only: tl_transport_field use tl_wind_transport_alg_mod, only: tl_wind_transport_alg - use io_config_mod, only: subroutine_timers - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF implicit none @@ -88,11 +88,12 @@ contains ! Internal variables type(field_type) :: fields_np1(bundle_size) logical(kind=l_def) :: cheap_update_step + integer(tik) :: id type(transport_metadata_type), pointer :: transport_metadata type(tl_transport_controller_type) :: tl_transport_controller - if ( subroutine_timers ) call timer('tl_transport_control') + if ( LPROF ) call start_timing( id, 'tl_transport_control' ) ! ======================================================================== ! ! Pre-transport initialisation tasks @@ -182,7 +183,7 @@ contains call tl_transport_controller%finalise() - if ( subroutine_timers ) call timer('tl_transport_control') + if ( LPROF ) call stop_timing( id, 'tl_transport_control' ) end subroutine tl_transport_control_alg diff --git a/science/linear/source/algorithm/transport/control/tl_wind_transport_alg_mod.x90 b/science/linear/source/algorithm/transport/control/tl_wind_transport_alg_mod.x90 index 9c8a74613..db3cb2f03 100644 --- a/science/linear/source/algorithm/transport/control/tl_wind_transport_alg_mod.x90 +++ b/science/linear/source/algorithm/transport/control/tl_wind_transport_alg_mod.x90 @@ -21,7 +21,6 @@ module tl_wind_transport_alg_mod use function_space_mod, only: function_space_type use function_space_collection_mod, only: function_space_collection use sci_geometric_constants_mod, only: get_coordinates, get_panel_id - use io_config_mod, only: subroutine_timers use log_mod, only: log_event, & LOG_LEVEL_ERROR, & LOG_LEVEL_INFO @@ -30,7 +29,8 @@ module tl_wind_transport_alg_mod get_project_zdot_to_w2 use mesh_mod, only: mesh_type use operator_mod, only: operator_type - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF use transport_config_mod, only: broken_w2_projection use tl_transport_controller_mod, only: tl_transport_controller_type use tl_transport_field_mod, only: tl_transport_field @@ -96,8 +96,9 @@ contains type(function_space_type), pointer :: w3_fs type(function_space_type), pointer :: w2_fs type(function_space_type), pointer :: w2b_fs + integer(tik) :: id - if ( subroutine_timers ) call timer('tl wind transport') + if ( LPROF ) call start_timing( id, 'tl_wind_transport' ) ! ------------------------------------------------------------------------ ! ! Semi-implicit formulation @@ -238,7 +239,7 @@ contains end if ! si_momentum_equation - if ( subroutine_timers ) call timer('tl wind transport') + if ( LPROF ) call stop_timing( id, 'tl_wind_transport' ) end subroutine tl_wind_transport_alg diff --git a/science/linear/source/algorithm/transport/mol/tl_mol_conservative_alg_mod.x90 b/science/linear/source/algorithm/transport/mol/tl_mol_conservative_alg_mod.x90 index b4563234e..e3a865cd2 100644 --- a/science/linear/source/algorithm/transport/mol/tl_mol_conservative_alg_mod.x90 +++ b/science/linear/source/algorithm/transport/mol/tl_mol_conservative_alg_mod.x90 @@ -15,7 +15,8 @@ module tl_mol_conservative_alg_mod LOG_LEVEL_INFO use mesh_mod, only: mesh_type use operator_mod, only: operator_type - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF ! Algorithms and transport code use advective_and_flux_alg_mod, only: advective_and_flux_alg @@ -42,7 +43,6 @@ module tl_mol_conservative_alg_mod ! Configuration use boundaries_config_mod, only: limited_area use base_mesh_config_mod, only: topology, topology_non_periodic - use io_config_mod, only: subroutine_timers use transport_config_mod, only: runge_kutta_method, & dry_field_name, & operators, & @@ -115,8 +115,9 @@ module tl_mol_conservative_alg_mod type(flux_precomputations_type), pointer :: flux_precomputations type(flux_precomputations_type), pointer :: ls_wind_flux_precomp type(flux_precomputations_type), pointer :: pert_wind_flux_precomp + integer(tik) :: id - if ( subroutine_timers ) call timer('tl_mol_conservative_alg') + if ( LPROF ) call start_timing( id, 'tl_mol_conservative_alg' ) ! ------------------------------------------------------------------------ ! ! Extract transport objects and initialise temporary fields @@ -411,7 +412,7 @@ module tl_mol_conservative_alg_mod if ( allocated(rk_weights) ) deallocate(rk_weights) if ( allocated(stored_ls_field) ) deallocate(stored_ls_field) - if ( subroutine_timers ) call timer('tl_mol_conservative_alg') + if ( LPROF ) call stop_timing( id, 'tl_mol_conservative_alg' ) end subroutine tl_mol_conservative_alg