80 lines
2.6 KiB
Fortran
80 lines
2.6 KiB
Fortran
! Fortran API
|
|
|
|
module rvprof
|
|
use iso_c_binding
|
|
use iso_fortran_env, only: int64
|
|
implicit none
|
|
|
|
private
|
|
|
|
public :: rvprof_init
|
|
public :: rvprof_finalize
|
|
public :: rvprof_region_begin
|
|
public :: rvprof_region_end
|
|
public :: rvprof_set_program_name
|
|
|
|
interface
|
|
! no need to call directly anymore
|
|
subroutine rvprof_init_c(filename) bind(C, name="rvprof_init_c")
|
|
use iso_c_binding
|
|
character(c_char), intent(in) :: filename(*)
|
|
end subroutine rvprof_init_c
|
|
|
|
! no need to call directly anymore
|
|
subroutine rvprof_finalize_c() bind(C, name="rvprof_finalize_c")
|
|
use iso_c_binding
|
|
end subroutine rvprof_finalize_c
|
|
|
|
subroutine rvprof_region_begin_c(name) bind(C, name="rvprof_region_begin_c")
|
|
use iso_c_binding
|
|
character(c_char), intent(in) :: name(*)
|
|
end subroutine rvprof_region_begin_c
|
|
|
|
subroutine rvprof_region_end_c(name) bind(C, name="rvprof_region_end_c")
|
|
use iso_c_binding
|
|
character(c_char), intent(in) :: name(*)
|
|
end subroutine rvprof_region_end_c
|
|
|
|
! no need to call directly anymore
|
|
subroutine rvprof_set_program_name_c(name) bind(C, name="rvprof_set_program_name_c")
|
|
use iso_c_binding
|
|
character(c_char), intent(in) :: name(*)
|
|
end subroutine rvprof_set_program_name_c
|
|
end interface
|
|
|
|
contains
|
|
! no need to call directly anymore
|
|
subroutine rvprof_init(filename)
|
|
character(len=*), intent(in), optional :: filename
|
|
|
|
if (present(filename)) then
|
|
call rvprof_init_c(trim(filename)//c_null_char)
|
|
else
|
|
! Use automatic filename generation: program_name_rvprof.log
|
|
call rvprof_init_c(''//c_null_char)
|
|
end if
|
|
end subroutine rvprof_init
|
|
|
|
! no need to call directly anymore
|
|
subroutine rvprof_finalize()
|
|
call rvprof_finalize_c()
|
|
end subroutine rvprof_finalize
|
|
|
|
subroutine rvprof_region_begin(name)
|
|
character(len=*), intent(in) :: name
|
|
call rvprof_region_begin_c(trim(name)//c_null_char)
|
|
end subroutine rvprof_region_begin
|
|
|
|
subroutine rvprof_region_end(name)
|
|
character(len=*), intent(in) :: name
|
|
call rvprof_region_end_c(trim(name)//c_null_char)
|
|
end subroutine rvprof_region_end
|
|
|
|
! no need to call directly anymore
|
|
subroutine rvprof_set_program_name(name)
|
|
character(len=*), intent(in) :: name
|
|
call rvprof_set_program_name_c(trim(name)//c_null_char)
|
|
end subroutine rvprof_set_program_name
|
|
|
|
end module rvprof
|