module CTimer use ifwin, only: QueryPerformanceFrequency, QueryPerformanceCounter, T_LARGE_INTEGER use ISO_C_BINDING use ISO_FORTRAN_ENV implicit none public type, public :: Timer type(T_LARGE_INTEGER) :: StartTime type(T_LARGE_INTEGER) :: EndTime contains procedure :: Start => Start procedure :: Finish => Finish procedure :: ElapsedTimeMs => ElapsedTime end type Timer contains subroutine Start(this) implicit none class(Timer), intent(inout) :: this integer :: ApiResult ApiResult = QueryPerformanceCounter(this%StartTime) end subroutine subroutine Finish(this) implicit none class(Timer), intent(inout) :: this integer :: ApiResult ApiResult = QueryPerformanceCounter(this%EndTime) end subroutine integer function ElapsedTime(this) implicit none class(Timer), intent(inout) :: this real(kind=REAL128) :: time time = CalcTime(this%StartTime, this%EndTime) ElapsedTime = int(time * 1000.0) end function real(kind=REAL128) function CalcTime(start, finish) implicit none type(T_LARGE_INTEGER), intent(in) :: start type(T_LARGE_INTEGER), intent(in) :: finish type(T_LARGE_INTEGER) :: freq integer :: ApiResult integer(kind=INT64) :: freq_64 integer(kind=INT64) :: start_64 integer(kind=INT64) :: finish_64 start_64 = Make64(start) finish_64 = Make64(finish) ApiResult = QueryPerformanceFrequency(freq) freq_64 = Make64( freq) CalcTime = real(finish_64-start_64,kind=REAL128) / real(freq_64,kind=REAL128) end function integer(kind=INT64) function Make64(bit64_int) type(T_LARGE_INTEGER), intent(in) :: bit64_int Make64 = transfer(bit64_int, 0_INT64) end function end module CTimer