! Conditional compilation : use scorep user task api #ifdef CPP_SCOREP #include "scorep/SCOREP_User.inc" #define SCOREP_DEFINE_HANDLE_ARRAY( handle ) SCOREP_USER_REGION_HANDLE, allocatable :: handle(:) #define SCOREP_ALLOCATE_HANDLE_ARRAY( handle, size ) allocate( scorep_handle(size) ) #else #define SCOREP_DEFINE_HANDLE_ARRAY(handle) #define SCOREP_ALLOCATE_HANDLE_ARRAY(handle,size) #define SCOREP_USER_REGION_INIT(handle,name,region_type) #define SCOREP_USER_REGION_ENTER(handle) #define SCOREP_USER_REGION_END(handle) #endif MODULE profiling_mod use omp_para, only : omp_size, omp_rank IMPLICIT NONE SAVE PRIVATE ! Shared variables LOGICAL, PARAMETER :: check_accuracy = .true. INTEGER, PARAMETER :: max_id=20, max_depth=10 INTEGER :: nb_id ! Number of timers CHARACTER(15), DIMENSION(max_id) :: name ! Timer names INTEGER :: id_profile ! Threadlocal variables INTEGER, ALLOCATABLE :: depth(:)!(omp_size) ! Number of current nested timers INTEGER, ALLOCATABLE :: current_id(:,:)!(omp_size, max_depth) ! Current nested timer ids REAL, ALLOCATABLE :: chrono(:,:)!(omp_size, max_depth) ! Last timer start time REAL, ALLOCATABLE :: elapsed(:,:)!(omp_size, max_id) ! Cumulative time for each timer SCOREP_DEFINE_HANDLE_ARRAY(scorep_handle) PUBLIC :: init_profiling, reset_profiling, register_id, enter_profile, exit_profile, print_profile CONTAINS SUBROUTINE init_profiling use omp_para, only : get_omp_size integer :: omp_size ! omp_size from module omp_para cannot be used here since it is not initialized yet ! TODO : conditional compilation to compile without openmp omp_size = get_omp_size() !$omp master nb_id=0 allocate(depth(0:omp_size-1)) allocate(current_id(0:omp_size-1, max_depth)) allocate(chrono(0:omp_size-1, max_depth)) allocate(elapsed(0:omp_size-1, max_id)) depth(:)=0 call reset_profiling() !$omp end master SCOREP_ALLOCATE_HANDLE_ARRAY(scorep_handle, max_id) !$omp barrier call register_id("print_profile", id_profile) END SUBROUTINE init_profiling SUBROUTINE reset_profiling use abort_mod !$omp barrier !$omp master if( any( depth /= 0 ) ) call dynamico_abort("Impossible to reset profiling : a profiling region is still open") elapsed(:,:)=0 !$omp end master !$omp barrier END SUBROUTINE SUBROUTINE register_id(thename, id) use abort_mod CHARACTER(*), INTENT(IN) :: thename INTEGER, INTENT(OUT) :: id !$OMP MASTER nb_id = nb_id+1 if(nb_id > max_id) call dynamico_abort("Too many timers") id = nb_id name(id)=thename !$OMP END MASTER SCOREP_USER_REGION_INIT( scorep_handle(id), thename, SCOREP_USER_REGION_TYPE_COMMON ) !$omp barrier END SUBROUTINE register_id FUNCTION get_elapsed(start) INTEGER(kind=8) :: count, count_rate REAL :: start,get_elapsed CALL SYSTEM_CLOCK(count,count_rate) if(check_accuracy .and. count < 10) print *, "Warning : Profiling elapsed time too short to be accurately measured" get_elapsed = (1.*count)/(1.*count_rate) - start IF(get_elapsed<0.) get_elapsed=0. END FUNCTION get_elapsed SUBROUTINE enter_profile(id) INTEGER, INTENT(IN) :: id depth(omp_rank) = depth(omp_rank)+1 chrono(omp_rank, depth(omp_rank)) = get_elapsed(0.) current_id(omp_rank,depth(omp_rank)) = id SCOREP_USER_REGION_ENTER(scorep_handle(id)) END SUBROUTINE enter_profile SUBROUTINE exit_profile(id) use abort_mod INTEGER, INTENT(IN) :: id INTEGER :: parent_id REAL :: my_elapsed IF(depth(omp_rank)<=0) call dynamico_abort("exit_profile called without a matching enter_profile (depth=0)") IF(id /= current_id(omp_rank, depth(omp_rank))) call dynamico_abort("wrong timer id : exit_profile id doesn't match enter_profile") SCOREP_USER_REGION_END(scorep_handle(id)) my_elapsed = get_elapsed(chrono(omp_rank, depth(omp_rank))) ! add elapsed to current profile elapsed(omp_rank,id) = elapsed(omp_rank,id) + my_elapsed depth(omp_rank) = depth(omp_rank)-1 ! and substract from parent profile IF(depth(omp_rank)>0) THEN parent_id = current_id(omp_rank,depth(omp_rank)) elapsed(omp_rank,parent_id) = elapsed(omp_rank,parent_id) - my_elapsed END IF END SUBROUTINE exit_profile SUBROUTINE print_profile use mpi_mod use mpipara use omp_para INTEGER :: i REAL :: mean_total, min_total, max_total, mean_total_local, min_total_local, max_total_local REAL :: omp_mean_time_local, omp_min_time_local, omp_max_time_local REAL :: mean_time, max_process, min_process, percent call enter_profile(id_profile) !$OMP MASTER ! mean_total : mean of sum of all timers on all threads and all procs mean_total_local = SUM(elapsed(:,1:nb_id))/omp_size/mpi_size call MPI_Reduce(mean_total_local, mean_total, 1, MPI_DOUBLE, MPI_SUM, 0, comm_icosa, ierr) ! min_total : min on all procs of sum of all timers on all threads min_total_local = MINVAL( SUM(elapsed(:,1:nb_id), 2) ) call MPI_Reduce(min_total_local, min_total, 1, MPI_DOUBLE, MPI_MIN, 0, comm_icosa, ierr) ! max_total : max on all procs of sum of all timers on all threads max_total_local = MAXVAL( SUM(elapsed(:,1:nb_id), 2) ) call MPI_Reduce(max_total_local, max_total, 1, MPI_DOUBLE, MPI_MAX, 0, comm_icosa, ierr) if(is_master) PRINT *, '---------------------- Profiling -----------------------' if(is_master) PRINT ('(A15, F12.3, A, F12.3, A, F12.3, A)'), 'Total (s) : ', mean_total, " [", min_total, ",", max_total, "]" if(is_master) PRINT ('(A15, A7, A47, A47)'), " "," % "," Process mean(s)[ min, max, diff/mean(%) ] ", "Process 1 threads(s)[ min, max, diff/mean(%) ]" DO i=1,nb_id omp_mean_time_local = SUM(elapsed(:,i))/omp_size ! Mean time of timer on local threads omp_min_time_local = MINVAL(elapsed(:,i)) ! Max time of timer on local threads omp_max_time_local = MAXVAL(elapsed(:,i)) ! Min time of timer on local threads !omp_inbalance_local = 100*(max_time-min_time)/min_time ! mean_time : mean of timer on all threads and all procs call MPI_Reduce(omp_mean_time_local, mean_time, 1, MPI_DOUBLE, MPI_SUM, 0, comm_icosa, ierr); mean_time = mean_time/mpi_size ! max_process_time : max on procs of mean omp time call MPI_Reduce(omp_mean_time_local, max_process, 1, MPI_DOUBLE, MPI_MAX, 0, comm_icosa, ierr) ! min_process_time : min on procs of mean omp time call MPI_Reduce(omp_mean_time_local, min_process, 1, MPI_DOUBLE, MPI_MIN, 0, comm_icosa, ierr) percent = 100*mean_time/mean_total if(is_master) PRINT ('(A15, F5.1, F12.3, A, F12.3, A, F12.3, A, F6.1, A, F12.3, A, F12.3, A, F12.3, A, F6.1, A)'), name(i), percent, mean_time, " [", min_process, ",", max_process, "," , inbalance(mean_time, min_process, max_process), "]", omp_mean_time_local, " [", omp_min_time_local, ",", omp_max_time_local, "," , inbalance(omp_mean_time_local, omp_min_time_local, omp_max_time_local) , "]" END DO if(is_master) PRINT *, '---------------------- Profiling -----------------------' !$OMP END MASTER call exit_profile(id_profile) contains function inbalance( mean, min, max ) real :: mean, min, max real :: inbalance inbalance = 100*(max-min)/(mean+1E-10) end function END SUBROUTINE print_profile END MODULE profiling_mod