Class | perfmon_class |
In: |
LatticeClass/perfmon_class.F90
|
Subroutine : | |
this : | type(flop_counter), intent(inout) |
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 : |
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
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 : |
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) |
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) |
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) |
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) |
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) |
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