advisor_annotate.f90 27 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706
  1. ! ========================================================================
  2. !
  3. ! SAMPLE SOURCE CODE - SUBJECT TO THE TERMS OF END-USER LICENSE AGREEMENT
  4. ! FOR INTEL(R) ADVISOR XE 2016.
  5. !
  6. ! Copyright (c) 2012-2015 Intel Corporation. All rights reserved.
  7. !
  8. ! THIS FILE IS PROVIDED "AS IS" WITH NO WARRANTIES, EXPRESS OR IMPLIED,
  9. ! INCLUDING BUT NOT LIMITED TO ANY IMPLIED WARRANTY OF MERCHANTABILITY,
  10. ! FITNESS FOR A PARTICULAR PURPOSE, NON-INFRINGEMENT OF INTELLECTUAL
  11. ! PROPERTY RIGHTS.
  12. !
  13. ! ========================================================================
  14. !
  15. !--------
  16. !
  17. ! This file defines functions used by the Intel(R) Advisor XE
  18. ! "Dependencies Modeling" and "Suitability Modeling" analysis, which
  19. ! are described in the "Annotations" section of the help.
  20. !
  21. ! Version of the annotations.
  22. ! The presence of this macro serves to idetify the annotation definition
  23. ! file and the form of annotations.
  24. ! INTEL_ADVISOR_ANNOTATION_VERSION 1.0
  25. !--------
  26. module advisor_annotate
  27. use, intrinsic :: iso_c_binding, only: C_PTR, C_FUNPTR, C_INT, C_CHAR, C_NULL_CHAR, C_F_PROCPOINTER, C_LOC, C_ASSOCIATED
  28. implicit none
  29. !--------
  30. !
  31. ! Public interface
  32. !
  33. !--------
  34. public :: annotate_site_begin
  35. public :: annotate_site_end
  36. public :: annotate_task_begin
  37. public :: annotate_task_end
  38. public :: annotate_iteration_task
  39. public :: annotate_lock_acquire
  40. public :: annotate_lock_release
  41. public :: annotate_disable_observation_push
  42. public :: annotate_disable_observation_pop
  43. public :: annotate_disable_collection_push
  44. public :: annotate_disable_collection_pop
  45. public :: annotate_induction_uses
  46. public :: annotate_reduction_uses
  47. public :: annotate_observe_uses
  48. public :: annotate_clear_uses
  49. public :: annotate_aggregate_task
  50. interface annotate_induction_uses
  51. module procedure annotate_induction_uses_i2
  52. module procedure annotate_induction_uses_i4
  53. module procedure annotate_induction_uses_i8
  54. module procedure annotate_induction_uses_r4
  55. module procedure annotate_induction_uses_r8
  56. module procedure annotate_induction_uses_c4
  57. module procedure annotate_induction_uses_c8
  58. end interface annotate_induction_uses
  59. interface annotate_reduction_uses
  60. module procedure annotate_reduction_uses_i2
  61. module procedure annotate_reduction_uses_i4
  62. module procedure annotate_reduction_uses_i8
  63. module procedure annotate_reduction_uses_r4
  64. module procedure annotate_reduction_uses_r8
  65. module procedure annotate_reduction_uses_c4
  66. module procedure annotate_reduction_uses_c8
  67. end interface annotate_reduction_uses
  68. interface annotate_observe_uses
  69. module procedure annotate_observe_uses_i2
  70. module procedure annotate_observe_uses_i4
  71. module procedure annotate_observe_uses_i8
  72. module procedure annotate_observe_uses_r4
  73. module procedure annotate_observe_uses_r8
  74. module procedure annotate_observe_uses_c4
  75. module procedure annotate_observe_uses_c8
  76. end interface annotate_observe_uses
  77. interface annotate_clear_uses
  78. module procedure annotate_clear_uses_i2
  79. module procedure annotate_clear_uses_i4
  80. module procedure annotate_clear_uses_i8
  81. module procedure annotate_clear_uses_r4
  82. module procedure annotate_clear_uses_r8
  83. module procedure annotate_clear_uses_c4
  84. module procedure annotate_clear_uses_c8
  85. end interface annotate_clear_uses
  86. private
  87. !--------
  88. !
  89. ! Interfaces to the itt_notify entry points
  90. !
  91. !--------
  92. enum, bind(C)
  93. enumerator :: disable_observation
  94. enumerator :: disable_collection
  95. end enum
  96. abstract interface
  97. subroutine itt_proc_noargs() bind(C)
  98. end subroutine itt_proc_noargs
  99. subroutine itt_proc_with_name(name, len) bind(C)
  100. import
  101. character, dimension(*), intent(in) :: name
  102. integer(kind=C_INT), intent(in), value :: len
  103. end subroutine itt_proc_with_name
  104. subroutine itt_proc_with_int(intval) bind(C)
  105. import
  106. integer(kind=C_INT), intent(in), value :: intval
  107. end subroutine itt_proc_with_int
  108. subroutine itt_proc_with_disable(disable_kind) bind(C)
  109. import
  110. integer(kind=C_INT), intent(in), value :: disable_kind
  111. end subroutine itt_proc_with_disable
  112. subroutine itt_proc_with_addr_size(addr, size) bind(C)
  113. import
  114. type(C_PTR), intent(in), value :: addr
  115. integer(kind=C_INT), intent(in), value :: size
  116. end subroutine itt_proc_with_addr_size
  117. end interface
  118. !--------
  119. !
  120. ! Subroutine pointer variables to access the itt_notify entry points
  121. !
  122. !--------
  123. !dec$ if defined(use_initialized_proc_ptrs)
  124. procedure(itt_proc_with_name), pointer :: site_begin => site_begin_load
  125. procedure(itt_proc_noargs), pointer :: site_end_2 => site_end_2_load
  126. procedure(itt_proc_with_name), pointer :: task_begin => task_begin_load
  127. procedure(itt_proc_noargs), pointer :: task_end_2 => task_end_2_load
  128. procedure(itt_proc_noargs), pointer :: iteration_task => iteration_task_load
  129. procedure(itt_proc_with_int), pointer :: lock_acquire_2 => lock_acquire_2_load
  130. procedure(itt_proc_with_int), pointer :: lock_release_2 => lock_release_2_load
  131. procedure(itt_proc_with_disable), pointer :: disable_push => disable_push_load
  132. procedure(itt_proc_noargs), pointer :: disable_pop => disable_pop_load
  133. procedure(itt_proc_with_addr_size), pointer :: induction_uses => induction_uses_load
  134. procedure(itt_proc_with_addr_size), pointer :: reduction_uses => reduction_uses_load
  135. procedure(itt_proc_with_addr_size), pointer :: observe_uses => observe_uses_load
  136. procedure(itt_proc_with_addr_size), pointer :: clear_uses => clear_uses_load
  137. procedure(itt_proc_with_int), pointer :: aggregate_task => aggregate_task_load
  138. !dec$ else
  139. procedure(itt_proc_with_name), pointer :: site_begin
  140. procedure(itt_proc_noargs), pointer :: site_end_2
  141. procedure(itt_proc_with_name), pointer :: task_begin
  142. procedure(itt_proc_noargs), pointer :: task_end_2
  143. procedure(itt_proc_with_name), pointer :: iteration_task
  144. procedure(itt_proc_with_int), pointer :: lock_acquire_2
  145. procedure(itt_proc_with_int), pointer :: lock_release_2
  146. procedure(itt_proc_with_disable), pointer :: disable_push
  147. procedure(itt_proc_noargs), pointer :: disable_pop
  148. procedure(itt_proc_with_addr_size), pointer :: induction_uses
  149. procedure(itt_proc_with_addr_size), pointer :: reduction_uses
  150. procedure(itt_proc_with_addr_size), pointer :: observe_uses
  151. procedure(itt_proc_with_addr_size), pointer :: clear_uses
  152. procedure(itt_proc_with_int), pointer :: aggregate_task
  153. logical :: initialized = .false.
  154. !dec$ endif
  155. !--------
  156. !
  157. ! Functions for loading dynamic libraries
  158. !
  159. !--------
  160. interface
  161. !dec$ if defined(_WIN32)
  162. !DEC$OBJCOMMENT LIB:"KERNEL32.LIB"
  163. !DEC$OBJCOMMENT LIB:"advisor.lib"
  164. function load_library(file)
  165. import
  166. !dec$ attributes default, stdcall, decorate, alias : 'LoadLibraryA' :: load_library
  167. type(C_PTR) :: load_library
  168. character(kind=C_CHAR), dimension(*), intent(in) :: file
  169. end function load_library
  170. function get_library_entry(library, proc_name)
  171. import
  172. !dec$ attributes default, stdcall, decorate, alias : 'GetProcAddress' :: get_library_entry
  173. type(C_FUNPTR) :: get_library_entry
  174. type(C_PTR), intent(in), value :: library
  175. character(kind=C_CHAR), dimension(*), intent(in) :: proc_name
  176. end function get_library_entry
  177. !dec$ else
  178. function load_library(file, mode) bind(C, name="dlopen")
  179. import
  180. type(C_PTR) :: load_library
  181. character(kind=C_CHAR), dimension(*), intent(in) :: file
  182. integer(kind=C_INT), intent(in), value :: mode
  183. end function load_library
  184. function get_library_entry(library, proc_name) bind(C, name="dlsym")
  185. import
  186. type(C_FUNPTR) :: get_library_entry
  187. type(C_PTR), intent(in), value :: library
  188. character(kind=C_CHAR), dimension(*), intent(in) :: proc_name
  189. end function get_library_entry
  190. !dec$ endif
  191. end interface
  192. contains
  193. !--------
  194. !
  195. ! The public interface subroutines just make sure the module has been initialized,
  196. ! and then make an indirect call through the corresponding pointer variables.
  197. ! Initializing the module tries to load the itt notify library. If the library
  198. ! is loaded successfully, the variables are set to point to the corresponding
  199. ! entries in the library. If the library load fails, the variables are set to point
  200. ! to stub routines.
  201. !
  202. !--------
  203. subroutine annotate_site_begin(site_name)
  204. !DEC$ ATTRIBUTES DEFAULT :: annotate_site_begin
  205. character(len=*), intent(in) :: site_name
  206. if (.not. initialized) call load_itt_library
  207. call site_begin(site_name, len(site_name))
  208. end subroutine annotate_site_begin
  209. subroutine annotate_site_end
  210. !DEC$ ATTRIBUTES DEFAULT :: annotate_site_end
  211. if (.not. initialized) call load_itt_library
  212. call site_end_2
  213. end subroutine annotate_site_end
  214. subroutine annotate_task_begin(task_name)
  215. !DEC$ ATTRIBUTES DEFAULT :: annotate_task_begin
  216. character(len=*), intent(in) :: task_name
  217. if (.not. initialized) call load_itt_library
  218. call task_begin(task_name, len(task_name))
  219. end subroutine annotate_task_begin
  220. subroutine annotate_task_end
  221. !DEC$ ATTRIBUTES DEFAULT :: annotate_task_end
  222. if (.not. initialized) call load_itt_library
  223. call task_end_2
  224. end subroutine annotate_task_end
  225. subroutine annotate_iteration_task(task_name)
  226. !DEC$ ATTRIBUTES DEFAULT :: annotate_iteration_task
  227. character(len=*), intent(in) :: task_name
  228. if (.not. initialized) call load_itt_library
  229. call iteration_task(task_name, len(task_name))
  230. end subroutine annotate_iteration_task
  231. subroutine annotate_lock_acquire(lock_id)
  232. !DEC$ ATTRIBUTES DEFAULT :: annotate_lock_acquire
  233. integer, intent(in) :: lock_id
  234. if (.not. initialized) call load_itt_library
  235. call lock_acquire_2(lock_id)
  236. end subroutine annotate_lock_acquire
  237. subroutine annotate_lock_release(lock_id)
  238. !DEC$ ATTRIBUTES DEFAULT :: annotate_lock_release
  239. integer, intent(in) :: lock_id
  240. if (.not. initialized) call load_itt_library
  241. call lock_release_2(lock_id)
  242. end subroutine annotate_lock_release
  243. subroutine annotate_disable_observation_push
  244. !DEC$ ATTRIBUTES DEFAULT :: annotate_disable_observation_push
  245. if (.not. initialized) call load_itt_library
  246. call disable_push(disable_observation)
  247. end subroutine annotate_disable_observation_push
  248. subroutine annotate_disable_observation_pop
  249. !DEC$ ATTRIBUTES DEFAULT :: annotate_disable_observation_pop
  250. if (.not. initialized) call load_itt_library
  251. call disable_pop
  252. end subroutine annotate_disable_observation_pop
  253. subroutine annotate_disable_collection_push
  254. !DEC$ ATTRIBUTES DEFAULT :: annotate_disable_collection_push
  255. if (.not. initialized) call load_itt_library
  256. call disable_push(disable_collection)
  257. end subroutine annotate_disable_collection_push
  258. subroutine annotate_disable_collection_pop
  259. !DEC$ ATTRIBUTES DEFAULT :: annotate_disable_collection_pop
  260. if (.not. initialized) call load_itt_library
  261. call disable_pop
  262. end subroutine annotate_disable_collection_pop
  263. subroutine annotate_induction_uses_i2(x)
  264. !DEC$ ATTRIBUTES DEFAULT :: annotate_induction_uses_i2
  265. integer(kind=2), intent(in) :: x
  266. if (.not. initialized) call load_itt_library
  267. call induction_uses(C_LOC(x), 2)
  268. end subroutine annotate_induction_uses_i2
  269. subroutine annotate_induction_uses_i4(x)
  270. !DEC$ ATTRIBUTES DEFAULT :: annotate_induction_uses_i4
  271. integer(kind=4), intent(in) :: x
  272. if (.not. initialized) call load_itt_library
  273. call induction_uses(C_LOC(x), 4)
  274. end subroutine annotate_induction_uses_i4
  275. subroutine annotate_induction_uses_i8(x)
  276. !DEC$ ATTRIBUTES DEFAULT :: annotate_induction_uses_i8
  277. integer(kind=8), intent(in) :: x
  278. if (.not. initialized) call load_itt_library
  279. call induction_uses(C_LOC(x), 8)
  280. end subroutine annotate_induction_uses_i8
  281. subroutine annotate_induction_uses_r4(x)
  282. !DEC$ ATTRIBUTES DEFAULT :: annotate_induction_uses_r4
  283. real(kind=4), intent(in) :: x
  284. if (.not. initialized) call load_itt_library
  285. call induction_uses(C_LOC(x), 4)
  286. end subroutine annotate_induction_uses_r4
  287. subroutine annotate_induction_uses_r8(x)
  288. !DEC$ ATTRIBUTES DEFAULT :: annotate_induction_uses_r8
  289. real(kind=8), intent(in) :: x
  290. if (.not. initialized) call load_itt_library
  291. call induction_uses(C_LOC(x), 8)
  292. end subroutine annotate_induction_uses_r8
  293. subroutine annotate_induction_uses_c4(x)
  294. !DEC$ ATTRIBUTES DEFAULT :: annotate_induction_uses_c4
  295. complex(kind=4), intent(in) :: x
  296. if (.not. initialized) call load_itt_library
  297. call induction_uses(C_LOC(x), 8)
  298. end subroutine annotate_induction_uses_c4
  299. subroutine annotate_induction_uses_c8(x)
  300. !DEC$ ATTRIBUTES DEFAULT :: annotate_induction_uses_c8
  301. complex(kind=16), intent(in) :: x
  302. if (.not. initialized) call load_itt_library
  303. call reduction_uses(C_LOC(x), 16)
  304. end subroutine annotate_induction_uses_c8
  305. subroutine annotate_reduction_uses_i2(x)
  306. !DEC$ ATTRIBUTES DEFAULT :: annotate_reduction_uses_i2
  307. integer(kind=2), intent(in) :: x
  308. if (.not. initialized) call load_itt_library
  309. call reduction_uses(C_LOC(x), 2)
  310. end subroutine annotate_reduction_uses_i2
  311. subroutine annotate_reduction_uses_i4(x)
  312. !DEC$ ATTRIBUTES DEFAULT :: annotate_reduction_uses_i4
  313. integer(kind=4), intent(in) :: x
  314. if (.not. initialized) call load_itt_library
  315. call reduction_uses(C_LOC(x), 4)
  316. end subroutine annotate_reduction_uses_i4
  317. subroutine annotate_reduction_uses_i8(x)
  318. !DEC$ ATTRIBUTES DEFAULT :: annotate_reduction_uses_i8
  319. integer(kind=8), intent(in) :: x
  320. if (.not. initialized) call load_itt_library
  321. call reduction_uses(C_LOC(x), 8)
  322. end subroutine annotate_reduction_uses_i8
  323. subroutine annotate_reduction_uses_r4(x)
  324. !DEC$ ATTRIBUTES DEFAULT :: annotate_reduction_uses_r4
  325. real(kind=4), intent(in) :: x
  326. if (.not. initialized) call load_itt_library
  327. call reduction_uses(C_LOC(x), 4)
  328. end subroutine annotate_reduction_uses_r4
  329. subroutine annotate_reduction_uses_r8(x)
  330. !DEC$ ATTRIBUTES DEFAULT :: annotate_reduction_uses_r8
  331. real(kind=8), intent(in) :: x
  332. if (.not. initialized) call load_itt_library
  333. call reduction_uses(C_LOC(x), 8)
  334. end subroutine annotate_reduction_uses_r8
  335. subroutine annotate_reduction_uses_c4(x)
  336. !DEC$ ATTRIBUTES DEFAULT :: annotate_reduction_uses_c4
  337. complex(kind=4), intent(in) :: x
  338. if (.not. initialized) call load_itt_library
  339. call reduction_uses(C_LOC(x), 8)
  340. end subroutine annotate_reduction_uses_c4
  341. subroutine annotate_reduction_uses_c8(x)
  342. !DEC$ ATTRIBUTES DEFAULT :: annotate_reduction_uses_c8
  343. complex(kind=16), intent(in) :: x
  344. if (.not. initialized) call load_itt_library
  345. call reduction_uses(C_LOC(x), 16)
  346. end subroutine annotate_reduction_uses_c8
  347. subroutine annotate_observe_uses_i2(x)
  348. !DEC$ ATTRIBUTES DEFAULT :: annotate_observe_uses_i2
  349. integer(kind=2), intent(in) :: x
  350. if (.not. initialized) call load_itt_library
  351. call observe_uses(C_LOC(x), 2)
  352. end subroutine annotate_observe_uses_i2
  353. subroutine annotate_observe_uses_i4(x)
  354. !DEC$ ATTRIBUTES DEFAULT :: annotate_observe_uses_i4
  355. integer(kind=4), intent(in) :: x
  356. if (.not. initialized) call load_itt_library
  357. call observe_uses(C_LOC(x), 4)
  358. end subroutine annotate_observe_uses_i4
  359. subroutine annotate_observe_uses_i8(x)
  360. !DEC$ ATTRIBUTES DEFAULT :: annotate_observe_uses_i8
  361. integer(kind=8), intent(in) :: x
  362. if (.not. initialized) call load_itt_library
  363. call observe_uses(C_LOC(x), 8)
  364. end subroutine annotate_observe_uses_i8
  365. subroutine annotate_observe_uses_r4(x)
  366. !DEC$ ATTRIBUTES DEFAULT :: annotate_observe_uses_r4
  367. real(kind=4), intent(in) :: x
  368. if (.not. initialized) call load_itt_library
  369. call observe_uses(C_LOC(x), 4)
  370. end subroutine annotate_observe_uses_r4
  371. subroutine annotate_observe_uses_r8(x)
  372. !DEC$ ATTRIBUTES DEFAULT :: annotate_observe_uses_r8
  373. real(kind=8), intent(in) :: x
  374. if (.not. initialized) call load_itt_library
  375. call observe_uses(C_LOC(x), 8)
  376. end subroutine annotate_observe_uses_r8
  377. subroutine annotate_observe_uses_c4(x)
  378. !DEC$ ATTRIBUTES DEFAULT :: annotate_observe_uses_c4
  379. complex(kind=4), intent(in) :: x
  380. if (.not. initialized) call load_itt_library
  381. call observe_uses(C_LOC(x), 8)
  382. end subroutine annotate_observe_uses_c4
  383. subroutine annotate_observe_uses_c8(x)
  384. !DEC$ ATTRIBUTES DEFAULT :: annotate_observe_uses_c8
  385. complex(kind=16), intent(in) :: x
  386. if (.not. initialized) call load_itt_library
  387. call observe_uses(C_LOC(x), 16)
  388. end subroutine annotate_observe_uses_c8
  389. subroutine annotate_clear_uses_i2(x)
  390. !DEC$ ATTRIBUTES DEFAULT :: annotate_clear_uses_i2
  391. integer(kind=2), intent(in) :: x
  392. if (.not. initialized) call load_itt_library
  393. call clear_uses(C_LOC(x), 2)
  394. end subroutine annotate_clear_uses_i2
  395. subroutine annotate_clear_uses_i4(x)
  396. !DEC$ ATTRIBUTES DEFAULT :: annotate_clear_uses_i4
  397. integer(kind=4), intent(in) :: x
  398. if (.not. initialized) call load_itt_library
  399. call clear_uses(C_LOC(x), 4)
  400. end subroutine annotate_clear_uses_i4
  401. subroutine annotate_clear_uses_i8(x)
  402. !DEC$ ATTRIBUTES DEFAULT :: annotate_clear_uses_i8
  403. integer(kind=8), intent(in) :: x
  404. if (.not. initialized) call load_itt_library
  405. call clear_uses(C_LOC(x), 8)
  406. end subroutine annotate_clear_uses_i8
  407. subroutine annotate_clear_uses_r4(x)
  408. !DEC$ ATTRIBUTES DEFAULT :: annotate_clear_uses_r4
  409. real(kind=4), intent(in) :: x
  410. if (.not. initialized) call load_itt_library
  411. call clear_uses(C_LOC(x), 4)
  412. end subroutine annotate_clear_uses_r4
  413. subroutine annotate_clear_uses_r8(x)
  414. !DEC$ ATTRIBUTES DEFAULT :: annotate_clear_uses_r8
  415. real(kind=8), intent(in) :: x
  416. if (.not. initialized) call load_itt_library
  417. call clear_uses(C_LOC(x), 8)
  418. end subroutine annotate_clear_uses_r8
  419. subroutine annotate_clear_uses_c4(x)
  420. !DEC$ ATTRIBUTES DEFAULT :: annotate_clear_uses_c4
  421. complex(kind=4), intent(in) :: x
  422. if (.not. initialized) call load_itt_library
  423. call clear_uses(C_LOC(x), 8)
  424. end subroutine annotate_clear_uses_c4
  425. subroutine annotate_clear_uses_c8(x)
  426. !DEC$ ATTRIBUTES DEFAULT :: annotate_clear_uses_c8
  427. complex(kind=16), intent(in) :: x
  428. if (.not. initialized) call load_itt_library
  429. call clear_uses(C_LOC(x), 16)
  430. end subroutine annotate_clear_uses_c8
  431. subroutine annotate_aggregate_task(count)
  432. !DEC$ ATTRIBUTES DEFAULT :: annotate_aggregate_task
  433. integer, intent(in) :: count
  434. if (.not. initialized) call load_itt_library
  435. call aggregate_task(count)
  436. end subroutine annotate_aggregate_task
  437. !--------
  438. !
  439. ! These are the load-library subroutines.
  440. !
  441. !--------
  442. !dec$ if defined(use_initialized_proc_ptrs)
  443. subroutine site_begin_load(name, len) bind(C)
  444. character, dimension(*), intent(in) :: name
  445. integer(kind=C_INT), intent(in), value :: len
  446. call load_itt_library
  447. call site_begin(name, len)
  448. end subroutine site_begin_load
  449. subroutine site_end_2_load bind(C)
  450. call load_itt_library
  451. call site_end_2
  452. end subroutine site_end_2_load
  453. subroutine task_begin_load(name, len) bind(C)
  454. character, dimension(*), intent(in) :: name
  455. integer(kind=C_INT), intent(in), value :: len
  456. call load_itt_library
  457. call task_begin(name, len)
  458. end subroutine task_begin_load
  459. subroutine task_end_2_load bind(C)
  460. call load_itt_library
  461. call task_end_2
  462. end subroutine task_end_2_load
  463. subroutine iteration_task_load(name, len) bind(C)
  464. character, dimension(*), intent(in) :: name
  465. integer(kind=C_INT), intent(in), value :: len
  466. call load_itt_library
  467. call iteration_task(name, len)
  468. end subroutine iteration_task_load
  469. subroutine lock_acquire_2_load(lock_id) bind(C)
  470. integer(kind=C_INT), intent(in), value :: lock_id
  471. call load_itt_library
  472. call lock_acquire_2(lock_id)
  473. end subroutine lock_acquire_2_load
  474. subroutine lock_release_2_load(lock_id) bind(C)
  475. integer(kind=C_INT), intent(in), value :: lock_id
  476. call load_itt_library
  477. call lock_release_2(lock_id)
  478. end subroutine lock_release_2_load
  479. subroutine disable_push_load(disable_kind) bind(C)
  480. integer(kind=C_INT), intent(in), value :: disable_kind
  481. call load_itt_library
  482. call disable_push(disable_kind)
  483. end subroutine disable_push_load
  484. subroutine disable_pop_load bind(C)
  485. call load_itt_library
  486. call disable_pop
  487. end subroutine disable_pop_load
  488. subroutine induction_uses_load(addr, size) bind(C)
  489. type(C_PTR), intent(in), value :: addr
  490. integer(kind=C_INT), intent(in), value :: size
  491. call itt_load_library
  492. call induction_uses(addr, size)
  493. end subroutine induction_uses_load
  494. subroutine reduction_uses_load(addr, size) bind(C)
  495. type(C_PTR), intent(in), value :: addr
  496. integer(kind=C_INT), intent(in), value :: size
  497. call itt_load_library
  498. call reduction_uses(addr, size)
  499. end subroutine reduction_uses_load
  500. subroutine observe_uses_load(addr, size) bind(C)
  501. type(C_PTR), intent(in), value :: addr
  502. integer(kind=C_INT), intent(in), value :: size
  503. call itt_load_library
  504. call observe_uses(addr, size)
  505. end subroutine observe_uses_load
  506. subroutine clear_uses_load(addr, size) bind(C)
  507. type(C_PTR), intent(in), value :: addr
  508. integer(kind=C_INT), intent(in), value :: size
  509. call itt_load_library
  510. call clear_uses(addr, size)
  511. end subroutine clear_uses_load
  512. subroutine annotate_task_load(count) bind(C)
  513. integer(kind=C_INT), intent(in), value :: count
  514. call load_itt_library
  515. call annotate_task(count)
  516. end subroutine annotate_task_load
  517. !dec$ endif
  518. !--------
  519. !
  520. ! These are the stub subroutines.
  521. !
  522. !--------
  523. subroutine itt_proc_stub() bind(C)
  524. end subroutine itt_proc_stub
  525. subroutine itt_proc_with_name_stub(name, len) bind(C)
  526. character, dimension(*), intent(in) :: name
  527. integer(kind=C_INT), intent(in), value :: len
  528. end subroutine itt_proc_with_name_stub
  529. subroutine itt_proc_with_int_stub(count) bind(C)
  530. integer(kind=C_INT), intent(in), value :: count
  531. end subroutine itt_proc_with_int_stub
  532. subroutine itt_proc_with_disable_stub(disable_kind) bind(C)
  533. integer(kind=C_INT), value :: disable_kind
  534. end subroutine itt_proc_with_disable_stub
  535. subroutine itt_proc_with_addr_size_stub(addr, size) bind(C)
  536. type(C_PTR), intent(in), value :: addr
  537. integer(kind=C_INT), intent(in), value :: size
  538. end subroutine itt_proc_with_addr_size_stub
  539. !--------
  540. !
  541. ! Internal support code to load the itt notify library and get pointers
  542. ! to its entry points.
  543. !
  544. !--------
  545. subroutine load_itt_library
  546. type(C_PTR) :: library
  547. character*1024 ittnotify_path
  548. !dec$ if defined(_WIN32)
  549. library = load_library("libittnotify.dll"C)
  550. !dec$ else if defined(__APPLE__)
  551. library = load_library("libittnotify.dylib"C, 0)
  552. !dec$ else
  553. !dec$ if defined(__X86_64) .or. defined(_M_X64)
  554. call getenv('INTEL_LIBITTNOTIFY64',ittnotify_path)
  555. !dec$ else
  556. call getenv('INTEL_LIBITTNOTIFY32',ittnotify_path)
  557. !dec$ endif
  558. if ( ittnotify_path /= '' ) then
  559. ! print *,' libpath: "'//trim(ittnotify_path)//'"'
  560. library = load_library(trim(ittnotify_path)//char(0), 1) ! 1 is RTLD_LAZY
  561. else
  562. ! print *,' libpath: "libittnotify.so"'
  563. library = load_library("libittnotify.so"C, 1) ! 1 is RTLD_LAZY
  564. endif
  565. !dec$ endif
  566. if (C_ASSOCIATED(library)) then
  567. ! print *, "Library loaded"
  568. call C_F_PROCPOINTER(get_library_entry(library, "__itt_model_site_beginAL"C), site_begin)
  569. call C_F_PROCPOINTER(get_library_entry(library, "__itt_model_site_end_2"C), site_end_2)
  570. call C_F_PROCPOINTER(get_library_entry(library, "__itt_model_task_beginAL"C), task_begin)
  571. call C_F_PROCPOINTER(get_library_entry(library, "__itt_model_task_end_2"C), task_end_2)
  572. call C_F_PROCPOINTER(get_library_entry(library, "__itt_model_iteration_taskAL"C), iteration_task)
  573. call C_F_PROCPOINTER(get_library_entry(library, "__itt_model_lock_acquire_2"C), lock_acquire_2)
  574. call C_F_PROCPOINTER(get_library_entry(library, "__itt_model_lock_release_2"C), lock_release_2)
  575. call C_F_PROCPOINTER(get_library_entry(library, "__itt_model_disable_push"C), disable_push)
  576. call C_F_PROCPOINTER(get_library_entry(library, "__itt_model_disable_pop"C), disable_pop)
  577. call C_F_PROCPOINTER(get_library_entry(library, "__itt_model_induction_uses"C), induction_uses)
  578. call C_F_PROCPOINTER(get_library_entry(library, "__itt_model_reduction_uses"C), reduction_uses)
  579. call C_F_PROCPOINTER(get_library_entry(library, "__itt_model_observe_uses"C), observe_uses)
  580. call C_F_PROCPOINTER(get_library_entry(library, "__itt_model_clear_uses"C), clear_uses)
  581. call C_F_PROCPOINTER(get_library_entry(library, "__itt_model_aggregate_task"C), aggregate_task)
  582. else
  583. ! print *, "Library not found"
  584. site_begin => itt_proc_with_name_stub
  585. site_end_2 => itt_proc_stub
  586. task_begin => itt_proc_with_name_stub
  587. task_end_2 => itt_proc_stub
  588. iteration_task => itt_proc_with_name_stub
  589. lock_acquire_2 => itt_proc_with_int_stub
  590. lock_release_2 => itt_proc_with_int_stub
  591. disable_push => itt_proc_with_disable_stub
  592. disable_pop => itt_proc_stub
  593. induction_uses => itt_proc_with_addr_size_stub
  594. reduction_uses => itt_proc_with_addr_size_stub
  595. observe_uses => itt_proc_with_addr_size_stub
  596. clear_uses => itt_proc_with_addr_size_stub
  597. aggregate_task => itt_proc_with_int_stub
  598. end if
  599. initialized = .true.
  600. end subroutine
  601. end module advisor_annotate