| ! ======================================================================== |
| ! Copyright (C) 2012-2017 Intel Corporation |
| ! SPDX-License-Identifier: GPL-2.0-only OR BSD-3-Clause |
| ! ======================================================================== |
| |
| !-------- |
| ! |
| ! This file defines functions used by the Intel(R) Advisor XE |
| ! "Dependencies Modeling" and "Suitability Modeling" analysis, which |
| ! are described in the "Annotations" section of the help. |
| ! |
| ! Version of the annotations. |
| ! The presence of this macro serves to idetify the annotation definition |
| ! file and the form of annotations. |
| ! INTEL_ADVISOR_ANNOTATION_VERSION 1.0 |
| !-------- |
| |
| module advisor_annotate |
| use, intrinsic :: iso_c_binding, only: C_PTR, C_FUNPTR, C_INT, C_CHAR, C_NULL_CHAR, C_F_PROCPOINTER, C_LOC, C_ASSOCIATED |
| implicit none |
| |
| !-------- |
| ! |
| ! Public interface |
| ! |
| !-------- |
| |
| public :: annotate_site_begin |
| public :: annotate_site_end |
| public :: annotate_task_begin |
| public :: annotate_task_end |
| public :: annotate_iteration_task |
| public :: annotate_lock_acquire |
| public :: annotate_lock_release |
| public :: annotate_disable_observation_push |
| public :: annotate_disable_observation_pop |
| public :: annotate_disable_collection_push |
| public :: annotate_disable_collection_pop |
| public :: annotate_induction_uses |
| public :: annotate_reduction_uses |
| public :: annotate_observe_uses |
| public :: annotate_clear_uses |
| public :: annotate_aggregate_task |
| |
| interface annotate_induction_uses |
| module procedure annotate_induction_uses_i2 |
| module procedure annotate_induction_uses_i4 |
| module procedure annotate_induction_uses_i8 |
| module procedure annotate_induction_uses_r4 |
| module procedure annotate_induction_uses_r8 |
| module procedure annotate_induction_uses_c4 |
| module procedure annotate_induction_uses_c8 |
| end interface annotate_induction_uses |
| |
| interface annotate_reduction_uses |
| module procedure annotate_reduction_uses_i2 |
| module procedure annotate_reduction_uses_i4 |
| module procedure annotate_reduction_uses_i8 |
| module procedure annotate_reduction_uses_r4 |
| module procedure annotate_reduction_uses_r8 |
| module procedure annotate_reduction_uses_c4 |
| module procedure annotate_reduction_uses_c8 |
| end interface annotate_reduction_uses |
| |
| interface annotate_observe_uses |
| module procedure annotate_observe_uses_i2 |
| module procedure annotate_observe_uses_i4 |
| module procedure annotate_observe_uses_i8 |
| module procedure annotate_observe_uses_r4 |
| module procedure annotate_observe_uses_r8 |
| module procedure annotate_observe_uses_c4 |
| module procedure annotate_observe_uses_c8 |
| end interface annotate_observe_uses |
| |
| interface annotate_clear_uses |
| module procedure annotate_clear_uses_i2 |
| module procedure annotate_clear_uses_i4 |
| module procedure annotate_clear_uses_i8 |
| module procedure annotate_clear_uses_r4 |
| module procedure annotate_clear_uses_r8 |
| module procedure annotate_clear_uses_c4 |
| module procedure annotate_clear_uses_c8 |
| end interface annotate_clear_uses |
| |
| private |
| |
| !-------- |
| ! |
| ! Interfaces to the itt_notify entry points |
| ! |
| !-------- |
| |
| enum, bind(C) |
| enumerator :: disable_observation |
| enumerator :: disable_collection |
| end enum |
| |
| abstract interface |
| |
| subroutine itt_proc_noargs() bind(C) |
| end subroutine itt_proc_noargs |
| |
| subroutine itt_proc_with_name(name, len) bind(C) |
| import |
| character, dimension(*), intent(in) :: name |
| integer(kind=C_INT), intent(in), value :: len |
| end subroutine itt_proc_with_name |
| |
| subroutine itt_proc_with_int(intval) bind(C) |
| import |
| integer(kind=C_INT), intent(in), value :: intval |
| end subroutine itt_proc_with_int |
| |
| subroutine itt_proc_with_disable(disable_kind) bind(C) |
| import |
| integer(kind=C_INT), intent(in), value :: disable_kind |
| end subroutine itt_proc_with_disable |
| |
| subroutine itt_proc_with_addr_size(addr, size) bind(C) |
| import |
| type(C_PTR), intent(in), value :: addr |
| integer(kind=C_INT), intent(in), value :: size |
| end subroutine itt_proc_with_addr_size |
| |
| end interface |
| |
| !-------- |
| ! |
| ! Subroutine pointer variables to access the itt_notify entry points |
| ! |
| !-------- |
| |
| !dec$ if defined(use_initialized_proc_ptrs) |
| procedure(itt_proc_with_name), pointer :: site_begin => site_begin_load |
| procedure(itt_proc_noargs), pointer :: site_end_2 => site_end_2_load |
| procedure(itt_proc_with_name), pointer :: task_begin => task_begin_load |
| procedure(itt_proc_noargs), pointer :: task_end_2 => task_end_2_load |
| procedure(itt_proc_noargs), pointer :: iteration_task => iteration_task_load |
| procedure(itt_proc_with_int), pointer :: lock_acquire_2 => lock_acquire_2_load |
| procedure(itt_proc_with_int), pointer :: lock_release_2 => lock_release_2_load |
| procedure(itt_proc_with_disable), pointer :: disable_push => disable_push_load |
| procedure(itt_proc_noargs), pointer :: disable_pop => disable_pop_load |
| procedure(itt_proc_with_addr_size), pointer :: induction_uses => induction_uses_load |
| procedure(itt_proc_with_addr_size), pointer :: reduction_uses => reduction_uses_load |
| procedure(itt_proc_with_addr_size), pointer :: observe_uses => observe_uses_load |
| procedure(itt_proc_with_addr_size), pointer :: clear_uses => clear_uses_load |
| procedure(itt_proc_with_int), pointer :: aggregate_task => aggregate_task_load |
| !dec$ else |
| procedure(itt_proc_with_name), pointer :: site_begin |
| procedure(itt_proc_noargs), pointer :: site_end_2 |
| procedure(itt_proc_with_name), pointer :: task_begin |
| procedure(itt_proc_noargs), pointer :: task_end_2 |
| procedure(itt_proc_with_name), pointer :: iteration_task |
| procedure(itt_proc_with_int), pointer :: lock_acquire_2 |
| procedure(itt_proc_with_int), pointer :: lock_release_2 |
| procedure(itt_proc_with_disable), pointer :: disable_push |
| procedure(itt_proc_noargs), pointer :: disable_pop |
| procedure(itt_proc_with_addr_size), pointer :: induction_uses |
| procedure(itt_proc_with_addr_size), pointer :: reduction_uses |
| procedure(itt_proc_with_addr_size), pointer :: observe_uses |
| procedure(itt_proc_with_addr_size), pointer :: clear_uses |
| procedure(itt_proc_with_int), pointer :: aggregate_task |
| |
| logical :: initialized = .false. |
| !dec$ endif |
| |
| |
| !-------- |
| ! |
| ! Functions for loading dynamic libraries |
| ! |
| !-------- |
| |
| interface |
| |
| !dec$ if defined(_WIN32) |
| |
| !DEC$OBJCOMMENT LIB:"KERNEL32.LIB" |
| !DEC$OBJCOMMENT LIB:"advisor.lib" |
| |
| function load_library(file) bind(C, name='LoadLibraryA') |
| import |
| !DEC$ ATTRIBUTES STDCALL :: load_library |
| type(C_PTR) :: load_library |
| character(kind=C_CHAR), dimension(*), intent(in) :: file |
| end function load_library |
| |
| function get_library_entry(library, proc_name) bind(C, name='GetProcAddress') |
| import |
| !DEC$ ATTRIBUTES STDCALL :: get_library_entry |
| type(C_FUNPTR) :: get_library_entry |
| type(C_PTR), intent(in), value :: library |
| character(kind=C_CHAR), dimension(*), intent(in) :: proc_name |
| end function get_library_entry |
| |
| !dec$ else |
| |
| function load_library(file, mode) bind(C, name="dlopen") |
| import |
| type(C_PTR) :: load_library |
| character(kind=C_CHAR), dimension(*), intent(in) :: file |
| integer(kind=C_INT), intent(in), value :: mode |
| end function load_library |
| |
| function get_library_entry(library, proc_name) bind(C, name="dlsym") |
| import |
| type(C_FUNPTR) :: get_library_entry |
| type(C_PTR), intent(in), value :: library |
| character(kind=C_CHAR), dimension(*), intent(in) :: proc_name |
| end function get_library_entry |
| |
| !dec$ endif |
| |
| end interface |
| |
| contains |
| |
| !-------- |
| ! |
| ! The public interface subroutines just make sure the module has been initialized, |
| ! and then make an indirect call through the corresponding pointer variables. |
| ! Initializing the module tries to load the itt notify library. If the library |
| ! is loaded successfully, the variables are set to point to the corresponding |
| ! entries in the library. If the library load fails, the variables are set to point |
| ! to stub routines. |
| ! |
| !-------- |
| |
| subroutine annotate_site_begin(site_name) |
| !DEC$ ATTRIBUTES DEFAULT :: annotate_site_begin |
| character(len=*), intent(in) :: site_name |
| if (.not. initialized) call load_itt_library |
| call site_begin(site_name, len(site_name)) |
| end subroutine annotate_site_begin |
| |
| subroutine annotate_site_end |
| !DEC$ ATTRIBUTES DEFAULT :: annotate_site_end |
| if (.not. initialized) call load_itt_library |
| call site_end_2 |
| end subroutine annotate_site_end |
| |
| subroutine annotate_task_begin(task_name) |
| !DEC$ ATTRIBUTES DEFAULT :: annotate_task_begin |
| character(len=*), intent(in) :: task_name |
| if (.not. initialized) call load_itt_library |
| call task_begin(task_name, len(task_name)) |
| end subroutine annotate_task_begin |
| |
| subroutine annotate_task_end |
| !DEC$ ATTRIBUTES DEFAULT :: annotate_task_end |
| if (.not. initialized) call load_itt_library |
| call task_end_2 |
| end subroutine annotate_task_end |
| |
| subroutine annotate_iteration_task(task_name) |
| !DEC$ ATTRIBUTES DEFAULT :: annotate_iteration_task |
| character(len=*), intent(in) :: task_name |
| if (.not. initialized) call load_itt_library |
| call iteration_task(task_name, len(task_name)) |
| end subroutine annotate_iteration_task |
| |
| subroutine annotate_lock_acquire(lock_id) |
| !DEC$ ATTRIBUTES DEFAULT :: annotate_lock_acquire |
| integer, intent(in) :: lock_id |
| if (.not. initialized) call load_itt_library |
| call lock_acquire_2(lock_id) |
| end subroutine annotate_lock_acquire |
| |
| subroutine annotate_lock_release(lock_id) |
| !DEC$ ATTRIBUTES DEFAULT :: annotate_lock_release |
| integer, intent(in) :: lock_id |
| if (.not. initialized) call load_itt_library |
| call lock_release_2(lock_id) |
| end subroutine annotate_lock_release |
| |
| subroutine annotate_disable_observation_push |
| !DEC$ ATTRIBUTES DEFAULT :: annotate_disable_observation_push |
| if (.not. initialized) call load_itt_library |
| call disable_push(disable_observation) |
| end subroutine annotate_disable_observation_push |
| |
| subroutine annotate_disable_observation_pop |
| !DEC$ ATTRIBUTES DEFAULT :: annotate_disable_observation_pop |
| if (.not. initialized) call load_itt_library |
| call disable_pop |
| end subroutine annotate_disable_observation_pop |
| |
| subroutine annotate_disable_collection_push |
| !DEC$ ATTRIBUTES DEFAULT :: annotate_disable_collection_push |
| if (.not. initialized) call load_itt_library |
| call disable_push(disable_collection) |
| end subroutine annotate_disable_collection_push |
| |
| subroutine annotate_disable_collection_pop |
| !DEC$ ATTRIBUTES DEFAULT :: annotate_disable_collection_pop |
| if (.not. initialized) call load_itt_library |
| call disable_pop |
| end subroutine annotate_disable_collection_pop |
| |
| subroutine annotate_induction_uses_i2(x) |
| !DEC$ ATTRIBUTES DEFAULT :: annotate_induction_uses_i2 |
| integer(kind=2), intent(in), target :: x |
| if (.not. initialized) call load_itt_library |
| call induction_uses(C_LOC(x), 2) |
| end subroutine annotate_induction_uses_i2 |
| |
| subroutine annotate_induction_uses_i4(x) |
| !DEC$ ATTRIBUTES DEFAULT :: annotate_induction_uses_i4 |
| integer(kind=4), intent(in), target :: x |
| if (.not. initialized) call load_itt_library |
| call induction_uses(C_LOC(x), 4) |
| end subroutine annotate_induction_uses_i4 |
| |
| subroutine annotate_induction_uses_i8(x) |
| !DEC$ ATTRIBUTES DEFAULT :: annotate_induction_uses_i8 |
| integer(kind=8), intent(in), target :: x |
| if (.not. initialized) call load_itt_library |
| call induction_uses(C_LOC(x), 8) |
| end subroutine annotate_induction_uses_i8 |
| |
| subroutine annotate_induction_uses_r4(x) |
| !DEC$ ATTRIBUTES DEFAULT :: annotate_induction_uses_r4 |
| real(kind=4), intent(in), target :: x |
| if (.not. initialized) call load_itt_library |
| call induction_uses(C_LOC(x), 4) |
| end subroutine annotate_induction_uses_r4 |
| |
| subroutine annotate_induction_uses_r8(x) |
| !DEC$ ATTRIBUTES DEFAULT :: annotate_induction_uses_r8 |
| real(kind=8), intent(in), target :: x |
| if (.not. initialized) call load_itt_library |
| call induction_uses(C_LOC(x), 8) |
| end subroutine annotate_induction_uses_r8 |
| |
| subroutine annotate_induction_uses_c4(x) |
| !DEC$ ATTRIBUTES DEFAULT :: annotate_induction_uses_c4 |
| complex(kind=4), intent(in), target :: x |
| if (.not. initialized) call load_itt_library |
| call induction_uses(C_LOC(x), 8) |
| end subroutine annotate_induction_uses_c4 |
| |
| subroutine annotate_induction_uses_c8(x) |
| !DEC$ ATTRIBUTES DEFAULT :: annotate_induction_uses_c8 |
| complex(kind=16), intent(in), target :: x |
| if (.not. initialized) call load_itt_library |
| call reduction_uses(C_LOC(x), 16) |
| end subroutine annotate_induction_uses_c8 |
| |
| subroutine annotate_reduction_uses_i2(x) |
| !DEC$ ATTRIBUTES DEFAULT :: annotate_reduction_uses_i2 |
| integer(kind=2), intent(in), target :: x |
| if (.not. initialized) call load_itt_library |
| call reduction_uses(C_LOC(x), 2) |
| end subroutine annotate_reduction_uses_i2 |
| |
| subroutine annotate_reduction_uses_i4(x) |
| !DEC$ ATTRIBUTES DEFAULT :: annotate_reduction_uses_i4 |
| integer(kind=4), intent(in), target :: x |
| if (.not. initialized) call load_itt_library |
| call reduction_uses(C_LOC(x), 4) |
| end subroutine annotate_reduction_uses_i4 |
| |
| subroutine annotate_reduction_uses_i8(x) |
| !DEC$ ATTRIBUTES DEFAULT :: annotate_reduction_uses_i8 |
| integer(kind=8), intent(in), target :: x |
| if (.not. initialized) call load_itt_library |
| call reduction_uses(C_LOC(x), 8) |
| end subroutine annotate_reduction_uses_i8 |
| |
| subroutine annotate_reduction_uses_r4(x) |
| !DEC$ ATTRIBUTES DEFAULT :: annotate_reduction_uses_r4 |
| real(kind=4), intent(in), target :: x |
| if (.not. initialized) call load_itt_library |
| call reduction_uses(C_LOC(x), 4) |
| end subroutine annotate_reduction_uses_r4 |
| |
| subroutine annotate_reduction_uses_r8(x) |
| !DEC$ ATTRIBUTES DEFAULT :: annotate_reduction_uses_r8 |
| real(kind=8), intent(in), target :: x |
| if (.not. initialized) call load_itt_library |
| call reduction_uses(C_LOC(x), 8) |
| end subroutine annotate_reduction_uses_r8 |
| |
| subroutine annotate_reduction_uses_c4(x) |
| !DEC$ ATTRIBUTES DEFAULT :: annotate_reduction_uses_c4 |
| complex(kind=4), intent(in), target :: x |
| if (.not. initialized) call load_itt_library |
| call reduction_uses(C_LOC(x), 8) |
| end subroutine annotate_reduction_uses_c4 |
| |
| subroutine annotate_reduction_uses_c8(x) |
| !DEC$ ATTRIBUTES DEFAULT :: annotate_reduction_uses_c8 |
| complex(kind=16), intent(in), target :: x |
| if (.not. initialized) call load_itt_library |
| call reduction_uses(C_LOC(x), 16) |
| end subroutine annotate_reduction_uses_c8 |
| |
| subroutine annotate_observe_uses_i2(x) |
| !DEC$ ATTRIBUTES DEFAULT :: annotate_observe_uses_i2 |
| integer(kind=2), intent(in), target :: x |
| if (.not. initialized) call load_itt_library |
| call observe_uses(C_LOC(x), 2) |
| end subroutine annotate_observe_uses_i2 |
| |
| subroutine annotate_observe_uses_i4(x) |
| !DEC$ ATTRIBUTES DEFAULT :: annotate_observe_uses_i4 |
| integer(kind=4), intent(in), target :: x |
| if (.not. initialized) call load_itt_library |
| call observe_uses(C_LOC(x), 4) |
| end subroutine annotate_observe_uses_i4 |
| |
| subroutine annotate_observe_uses_i8(x) |
| !DEC$ ATTRIBUTES DEFAULT :: annotate_observe_uses_i8 |
| integer(kind=8), intent(in), target :: x |
| if (.not. initialized) call load_itt_library |
| call observe_uses(C_LOC(x), 8) |
| end subroutine annotate_observe_uses_i8 |
| |
| subroutine annotate_observe_uses_r4(x) |
| !DEC$ ATTRIBUTES DEFAULT :: annotate_observe_uses_r4 |
| real(kind=4), intent(in), target :: x |
| if (.not. initialized) call load_itt_library |
| call observe_uses(C_LOC(x), 4) |
| end subroutine annotate_observe_uses_r4 |
| |
| subroutine annotate_observe_uses_r8(x) |
| !DEC$ ATTRIBUTES DEFAULT :: annotate_observe_uses_r8 |
| real(kind=8), intent(in), target :: x |
| if (.not. initialized) call load_itt_library |
| call observe_uses(C_LOC(x), 8) |
| end subroutine annotate_observe_uses_r8 |
| |
| subroutine annotate_observe_uses_c4(x) |
| !DEC$ ATTRIBUTES DEFAULT :: annotate_observe_uses_c4 |
| complex(kind=4), intent(in), target :: x |
| if (.not. initialized) call load_itt_library |
| call observe_uses(C_LOC(x), 8) |
| end subroutine annotate_observe_uses_c4 |
| |
| subroutine annotate_observe_uses_c8(x) |
| !DEC$ ATTRIBUTES DEFAULT :: annotate_observe_uses_c8 |
| complex(kind=16), intent(in), target :: x |
| if (.not. initialized) call load_itt_library |
| call observe_uses(C_LOC(x), 16) |
| end subroutine annotate_observe_uses_c8 |
| |
| subroutine annotate_clear_uses_i2(x) |
| !DEC$ ATTRIBUTES DEFAULT :: annotate_clear_uses_i2 |
| integer(kind=2), intent(in), target :: x |
| if (.not. initialized) call load_itt_library |
| call clear_uses(C_LOC(x), 2) |
| end subroutine annotate_clear_uses_i2 |
| |
| subroutine annotate_clear_uses_i4(x) |
| !DEC$ ATTRIBUTES DEFAULT :: annotate_clear_uses_i4 |
| integer(kind=4), intent(in), target :: x |
| if (.not. initialized) call load_itt_library |
| call clear_uses(C_LOC(x), 4) |
| end subroutine annotate_clear_uses_i4 |
| |
| subroutine annotate_clear_uses_i8(x) |
| !DEC$ ATTRIBUTES DEFAULT :: annotate_clear_uses_i8 |
| integer(kind=8), intent(in), target :: x |
| if (.not. initialized) call load_itt_library |
| call clear_uses(C_LOC(x), 8) |
| end subroutine annotate_clear_uses_i8 |
| |
| subroutine annotate_clear_uses_r4(x) |
| !DEC$ ATTRIBUTES DEFAULT :: annotate_clear_uses_r4 |
| real(kind=4), intent(in), target :: x |
| if (.not. initialized) call load_itt_library |
| call clear_uses(C_LOC(x), 4) |
| end subroutine annotate_clear_uses_r4 |
| |
| subroutine annotate_clear_uses_r8(x) |
| !DEC$ ATTRIBUTES DEFAULT :: annotate_clear_uses_r8 |
| real(kind=8), intent(in), target :: x |
| if (.not. initialized) call load_itt_library |
| call clear_uses(C_LOC(x), 8) |
| end subroutine annotate_clear_uses_r8 |
| |
| subroutine annotate_clear_uses_c4(x) |
| !DEC$ ATTRIBUTES DEFAULT :: annotate_clear_uses_c4 |
| complex(kind=4), intent(in), target :: x |
| if (.not. initialized) call load_itt_library |
| call clear_uses(C_LOC(x), 8) |
| end subroutine annotate_clear_uses_c4 |
| |
| subroutine annotate_clear_uses_c8(x) |
| !DEC$ ATTRIBUTES DEFAULT :: annotate_clear_uses_c8 |
| complex(kind=16), intent(in), target :: x |
| if (.not. initialized) call load_itt_library |
| call clear_uses(C_LOC(x), 16) |
| end subroutine annotate_clear_uses_c8 |
| |
| subroutine annotate_aggregate_task(count) |
| !DEC$ ATTRIBUTES DEFAULT :: annotate_aggregate_task |
| integer, intent(in) :: count |
| if (.not. initialized) call load_itt_library |
| call aggregate_task(count) |
| end subroutine annotate_aggregate_task |
| |
| |
| !-------- |
| ! |
| ! These are the load-library subroutines. |
| ! |
| !-------- |
| |
| !dec$ if defined(use_initialized_proc_ptrs) |
| |
| subroutine site_begin_load(name, len) bind(C) |
| character, dimension(*), intent(in) :: name |
| integer(kind=C_INT), intent(in), value :: len |
| call load_itt_library |
| call site_begin(name, len) |
| end subroutine site_begin_load |
| |
| subroutine site_end_2_load bind(C) |
| call load_itt_library |
| call site_end_2 |
| end subroutine site_end_2_load |
| |
| subroutine task_begin_load(name, len) bind(C) |
| character, dimension(*), intent(in) :: name |
| integer(kind=C_INT), intent(in), value :: len |
| call load_itt_library |
| call task_begin(name, len) |
| end subroutine task_begin_load |
| |
| subroutine task_end_2_load bind(C) |
| call load_itt_library |
| call task_end_2 |
| end subroutine task_end_2_load |
| |
| subroutine iteration_task_load(name, len) bind(C) |
| character, dimension(*), intent(in) :: name |
| integer(kind=C_INT), intent(in), value :: len |
| call load_itt_library |
| call iteration_task(name, len) |
| end subroutine iteration_task_load |
| |
| subroutine lock_acquire_2_load(lock_id) bind(C) |
| integer(kind=C_INT), intent(in), value :: lock_id |
| call load_itt_library |
| call lock_acquire_2(lock_id) |
| end subroutine lock_acquire_2_load |
| |
| subroutine lock_release_2_load(lock_id) bind(C) |
| integer(kind=C_INT), intent(in), value :: lock_id |
| call load_itt_library |
| call lock_release_2(lock_id) |
| end subroutine lock_release_2_load |
| |
| subroutine disable_push_load(disable_kind) bind(C) |
| integer(kind=C_INT), intent(in), value :: disable_kind |
| call load_itt_library |
| call disable_push(disable_kind) |
| end subroutine disable_push_load |
| |
| subroutine disable_pop_load bind(C) |
| call load_itt_library |
| call disable_pop |
| end subroutine disable_pop_load |
| |
| subroutine induction_uses_load(addr, size) bind(C) |
| type(C_PTR), intent(in), value :: addr |
| integer(kind=C_INT), intent(in), value :: size |
| call itt_load_library |
| call induction_uses(addr, size) |
| end subroutine induction_uses_load |
| |
| subroutine reduction_uses_load(addr, size) bind(C) |
| type(C_PTR), intent(in), value :: addr |
| integer(kind=C_INT), intent(in), value :: size |
| call itt_load_library |
| call reduction_uses(addr, size) |
| end subroutine reduction_uses_load |
| |
| subroutine observe_uses_load(addr, size) bind(C) |
| type(C_PTR), intent(in), value :: addr |
| integer(kind=C_INT), intent(in), value :: size |
| call itt_load_library |
| call observe_uses(addr, size) |
| end subroutine observe_uses_load |
| |
| subroutine clear_uses_load(addr, size) bind(C) |
| type(C_PTR), intent(in), value :: addr |
| integer(kind=C_INT), intent(in), value :: size |
| call itt_load_library |
| call clear_uses(addr, size) |
| end subroutine clear_uses_load |
| |
| subroutine annotate_task_load(count) bind(C) |
| integer(kind=C_INT), intent(in), value :: count |
| call load_itt_library |
| call annotate_task(count) |
| end subroutine annotate_task_load |
| |
| !dec$ endif |
| |
| !-------- |
| ! |
| ! These are the stub subroutines. |
| ! |
| !-------- |
| |
| subroutine itt_proc_stub() bind(C) |
| end subroutine itt_proc_stub |
| |
| subroutine itt_proc_with_name_stub(name, len) bind(C) |
| character, dimension(*), intent(in) :: name |
| integer(kind=C_INT), intent(in), value :: len |
| end subroutine itt_proc_with_name_stub |
| |
| subroutine itt_proc_with_int_stub(count) bind(C) |
| integer(kind=C_INT), intent(in), value :: count |
| end subroutine itt_proc_with_int_stub |
| |
| subroutine itt_proc_with_disable_stub(disable_kind) bind(C) |
| integer(kind=C_INT), intent(in), value :: disable_kind |
| end subroutine itt_proc_with_disable_stub |
| |
| subroutine itt_proc_with_addr_size_stub(addr, size) bind(C) |
| type(C_PTR), intent(in), value :: addr |
| integer(kind=C_INT), intent(in), value :: size |
| end subroutine itt_proc_with_addr_size_stub |
| |
| !-------- |
| ! |
| ! Internal support code to load the itt notify library and get pointers |
| ! to its entry points. |
| ! |
| !-------- |
| |
| subroutine load_itt_library |
| type(C_PTR) :: library |
| character*1024 ittnotify_path |
| |
| !dec$ if defined(__X86_64) .or. defined(_M_X64) |
| call getenv('INTEL_LIBITTNOTIFY64',ittnotify_path) |
| !dec$ else |
| call getenv('INTEL_LIBITTNOTIFY32',ittnotify_path) |
| !dec$ endif |
| if ( ittnotify_path /= '' ) then |
| ! print *,' libpath: "'//trim(ittnotify_path)//'"' |
| !dec$ if defined(WIN32) .or. defined(_WIN32) |
| library = load_library(trim(ittnotify_path)//char(0)) |
| !dec$ else if defined(__APPLE__) |
| library = load_library(trim(ittnotify_path)//char(0), 0) ! 0 is RTLD_NOW |
| !dec$ else |
| library = load_library(trim(ittnotify_path)//char(0), 1) ! 1 is RTLD_LAZY |
| !dec$ endif |
| else |
| ! print *,' libpath: "libittnotify.so"' |
| !dec$ if defined(WIN32) .or. defined(_WIN32) |
| library = load_library("libittnotify.dll"C) |
| !dec$ else if defined(__APPLE__) |
| library = load_library("libittnotify.dylib"C, 0) ! 0 is RTLD_NOW |
| !dec$ else |
| library = load_library("libittnotify.so"C, 1) ! 1 is RTLD_LAZY |
| !dec$ endif |
| endif |
| |
| if (C_ASSOCIATED(library)) then |
| ! print *, "Library loaded" |
| call C_F_PROCPOINTER(get_library_entry(library, "__itt_model_site_beginAL"C), site_begin) |
| call C_F_PROCPOINTER(get_library_entry(library, "__itt_model_site_end_2"C), site_end_2) |
| call C_F_PROCPOINTER(get_library_entry(library, "__itt_model_task_beginAL"C), task_begin) |
| call C_F_PROCPOINTER(get_library_entry(library, "__itt_model_task_end_2"C), task_end_2) |
| call C_F_PROCPOINTER(get_library_entry(library, "__itt_model_iteration_taskAL"C), iteration_task) |
| call C_F_PROCPOINTER(get_library_entry(library, "__itt_model_lock_acquire_2"C), lock_acquire_2) |
| call C_F_PROCPOINTER(get_library_entry(library, "__itt_model_lock_release_2"C), lock_release_2) |
| call C_F_PROCPOINTER(get_library_entry(library, "__itt_model_disable_push"C), disable_push) |
| call C_F_PROCPOINTER(get_library_entry(library, "__itt_model_disable_pop"C), disable_pop) |
| call C_F_PROCPOINTER(get_library_entry(library, "__itt_model_induction_uses"C), induction_uses) |
| call C_F_PROCPOINTER(get_library_entry(library, "__itt_model_reduction_uses"C), reduction_uses) |
| call C_F_PROCPOINTER(get_library_entry(library, "__itt_model_observe_uses"C), observe_uses) |
| call C_F_PROCPOINTER(get_library_entry(library, "__itt_model_clear_uses"C), clear_uses) |
| call C_F_PROCPOINTER(get_library_entry(library, "__itt_model_aggregate_task"C), aggregate_task) |
| else |
| ! print *, "Library not found" |
| site_begin => itt_proc_with_name_stub |
| site_end_2 => itt_proc_stub |
| task_begin => itt_proc_with_name_stub |
| task_end_2 => itt_proc_stub |
| iteration_task => itt_proc_with_name_stub |
| lock_acquire_2 => itt_proc_with_int_stub |
| lock_release_2 => itt_proc_with_int_stub |
| disable_push => itt_proc_with_disable_stub |
| disable_pop => itt_proc_stub |
| induction_uses => itt_proc_with_addr_size_stub |
| reduction_uses => itt_proc_with_addr_size_stub |
| observe_uses => itt_proc_with_addr_size_stub |
| clear_uses => itt_proc_with_addr_size_stub |
| aggregate_task => itt_proc_with_int_stub |
| end if |
| |
| initialized = .true. |
| end subroutine |
| |
| end module advisor_annotate |
