source: codes/icosagcm/trunk/src/base/profiling.F90

! 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