Class perfmon_class
In: LatticeClass/perfmon_class.F90
iso_c_binding timer_class omp_lib perfmon_class dot/f_255.png

Methods

delete   final_papi   flop_counter   init_papi   new   print   read   start   stop  

Included Modules

iso_c_binding timer_class omp_lib

Public Instance methods

Subroutine :
this :type(flop_counter), intent(inout)

[Source]

subroutine delete_perfmon(this)
  use omp_lib
  implicit none
  type(flop_counter), intent(inout) :: this
  integer(C_INT) :: ierr,istat
  integer :: iomp

!$OMP PARALLEL PRIVATE(ierr,iomp)
  iomp = omp_get_thread_num()

  call PAPIF_state(this%eventset(iomp),istat,ierr)
  if (ierr /= PAPI_OK) Then
    print *, "Abort After PAPIF_state: ", ierr, iomp
  endif

  if (istat == PAPI_RUNNING) then
    call PAPIF_stop(this%eventset(iomp),this%values(:,iomp),ierr)
    if (ierr /= PAPI_OK) Then
      print *, "Abort After PAPIF_stop: ", ierr, iomp
    endif
  endif

  call PAPIF_cleanup_eventset(this%eventset(iomp), ierr)
  if (ierr /= PAPI_OK) then
    print *, "Abort After PAPIF_cleanup_eventset: ", ierr, iomp
    call abort
  endif

  call PAPIF_destroy_eventset(this%eventset(iomp), ierr)
  if (ierr /= PAPI_OK) then
    print *, "Abort After PAPIF_destroy_eventset: ", ierr, iomp
    call abort
  endif

!$OMP END PARALLEL

  if (allocated(this%eventset)) deallocate(this%eventset)
  if (allocated(this%values))   deallocate(this%values)
  if (allocated(this%t_flop))   deallocate(this%t_flop)
  if (allocated(this%t_ins))    deallocate(this%t_ins)

  return
end subroutine
Subroutine :

[Source]

subroutine final_papi()
  implicit none
  integer(C_INT) :: ierr
  if (m_is_initialized) then
    call PAPIF_shutdown()
    m_is_initialized = .FALSE.
  endif
  return
end subroutine
flop_counter
Derived Type :
num_thread :integer
eventset(:) :integer(C_INT), allocatable
values(:,:) :integer(C_LONG_LONG), allocatable
t_flop(:) :real(DP), allocatable
t_ins(:) :real(DP), allocatable
flop :real(DP)
mflops :real(DP)
interval :real(DP)
elapse :real(DP)
etime :type(timer)
Subroutine :

[Source]

subroutine init_papi()
  use omp_lib
  implicit none
  integer(C_INT) :: ierr
  if (.not.m_is_initialized) then
    ierr = PAPI_VER_CURRENT
    call PAPIF_library_init(ierr)
    if (ierr /= PAPI_VER_CURRENT) Then
      print *, "PAPI Library Version is out of Date: ",ierr
      call abort
    endif

    call PAPIF_thread_init(omp_get_thread_num, ierr)
    if (ierr /= PAPI_OK) Then
      print *, "Abort After PAPIF_thead_init: ", ierr
      call abort
    endif

    m_is_initialized = .TRUE.

  endif
  return
end subroutine
Subroutine :
this :type(flop_counter), intent(inout)

[Source]

subroutine new_perfmon(this)
  use omp_lib
  implicit none
  type(flop_counter), intent(inout) :: this
  integer(C_INT) :: ierr
  integer :: iomp

  if (.not.m_is_initialized) call init_papi()

  this%num_thread = omp_get_max_threads()
  if (.not.allocated(this%eventset)) allocate(this%eventset(0:this%num_thread-1))
  if (.not.allocated(this%values))   allocate(this%values(NUM_EVENTS,0:this%num_thread-1))
  if (.not.allocated(this%t_flop))   allocate(this%t_flop(0:this%num_thread-1))
  if (.not.allocated(this%t_ins))   allocate(this%t_ins(0:this%num_thread-1))

!$OMP PARALLEL PRIVATE(ierr,iomp)
  iomp = omp_get_thread_num()

  this%eventset(iomp) = PAPI_NULL
  call PAPIF_create_eventset(this%eventset(iomp),ierr)
  if (ierr /= PAPI_OK) Then
    print *, "Abort After PAPIF_create_eventset: ", ierr, iomp
    call abort
  endif

  call PAPIF_add_event(this%eventset(iomp), PAPI_TOT_CYC, ierr)
  if (ierr /= PAPI_OK) then
    print *, "Abort After PAPIF_add_event PAPI_TOT_CYC: ", ierr, iomp
    call abort
  endif

  call PAPIF_add_event(this%eventset(iomp), PAPI_DP_OPS, ierr)
  if (ierr /= PAPI_OK) then
    print *, "Abort After PAPIF_add_event PAPI_DP_OPS : ", ierr, iomp
    call abort
  endif

  call PAPIF_add_event(this%eventset(iomp), PAPI_TOT_INS, ierr)
  if (ierr /= PAPI_OK) then
    print *, "Abort After PAPIF_add_event PAPI_TOT_INS : ", ierr, iomp
    call abort
  endif
!$OMP END PARALLEL

  call new(this%etime)
  this%flop = 0.0_DP

  return
end subroutine
Subroutine :
this :type(flop_counter), intent(in)

[Source]

subroutine print_perfmon(this)
  implicit none
  type(flop_counter), intent(in) :: this
  integer :: iomp
  do iomp=0,this%num_thread-1
    write(*,'("THREAD:",I4," FLOP:",F24.6," INS:",F24.6)')iomp,this%t_flop(iomp),this%t_ins(iomp)
  enddo
  write(*,'("TOTFLOP:",F24.6," ETIME:",F14.6," MFLOPS:",F14.6)')this%flop,this%elapse,this%mflops
  return
end subroutine
Subroutine :
this :type(flop_counter), intent(inout)

[Source]

subroutine read_perfmon(this)
  use omp_lib
  implicit none
  type(flop_counter), intent(inout) :: this
  integer(C_INT) :: ierr
  integer :: iomp

!$OMP PARALLEL PRIVATE(ierr,iomp)

  iomp = omp_get_thread_num()
  call PAPIF_read(this%eventset(iomp),this%values(:,iomp),ierr)
  if (ierr /= PAPI_OK) Then
    print *, "Abort After PAPIF_read: ", ierr, iomp
  endif

!$OMP END PARALLEL

  call toc(this%etime)
  this%interval = get_interval(this%etime)

  this%flop = 0
  do iomp=0,this%num_thread-1
    this%t_flop(iomp) = this%values(2,iomp)
    this%t_ins(iomp)  = this%values(3,iomp)
    this%flop = this%flop + this%values(2,iomp)
#ifdef _DEBUG_
    write(*,*)this%values(1,iomp),this%values(2,iomp),this%values(3,iomp)
#endif
  enddo
  this%mflops = this%flop/this%interval/1000_DP/1000_DP

  return
end subroutine
Subroutine :
this :type(flop_counter), intent(inout)

[Source]

subroutine start_perfmon(this)
  use omp_lib
  implicit none
  type(flop_counter), intent(inout) :: this
  integer(C_INT) :: ierr
  integer :: iomp

  call tic(this%etime)

!$OMP PARALLEL PRIVATE(ierr,iomp)
  iomp = omp_get_thread_num()
  this%t_flop(iomp) = 0.0_DP
  this%t_ins(iomp) = 0.0_DP

  call PAPIF_reset(this%eventset(iomp),ierr)
  if (ierr /= PAPI_OK) Then
    print *, "Abort After PAPIF_reset: ", ierr, iomp
  endif

  call PAPIF_start(this%eventset(iomp),ierr)
  if (ierr /= PAPI_OK) Then
    print *, "Abort After PAPIF_start: ", ierr, iomp
  endif

!$OMP END PARALLEL
  
  return
end subroutine
Subroutine :
this :type(flop_counter), intent(inout)

[Source]

subroutine stop_perfmon(this)
  use omp_lib
  implicit none
  type(flop_counter), intent(inout) :: this
  integer(C_INT) :: ierr
  integer :: iomp

!$OMP PARALLEL PRIVATE(ierr,iomp)

  iomp = omp_get_thread_num()
  call PAPIF_stop(this%eventset(iomp),this%values(:,iomp),ierr)
  if (ierr /= PAPI_OK) Then
    print *, "Abort After PAPIF_stop: ", ierr, iomp
  endif

!$OMP END PARALLEL

  call toc(this%etime)
  this%elapse = get_elapse(this%etime)

  this%flop = 0
  do iomp=0,this%num_thread-1
    this%t_flop(iomp) = this%values(2,iomp)
    this%t_ins(iomp)  = this%values(3,iomp)
    this%flop =this%flop + this%values(2,iomp)
#ifdef _DEBUG_
    write(*,*)this%values(1,iomp),this%values(2,iomp),this%values(3,iomp)
#endif
  enddo
  this%mflops = this%flop/this%elapse/1000_DP/1000_DP

  call delete(this%etime)
  
  return
end subroutine