SimulationCore2/CSharp/Common/CTimer.f90

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