ittnotify.f90 22 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473
  1. ! ========================================================================
  2. ! <copyright>
  3. ! This file is provided under a dual BSD/GPLv2 license. When using or
  4. ! redistributing this file, you may do so under either license.
  5. !
  6. ! GPL LICENSE SUMMARY
  7. !
  8. ! Copyright (c) 2005-2014 Intel Corporation. All rights reserved.
  9. !
  10. ! This program is free software; you can redistribute it and/or modify
  11. ! it under the terms of version 2 of the GNU General Public License as
  12. ! published by the Free Software Foundation.
  13. !
  14. ! This program is distributed in the hope that it will be useful, but
  15. ! WITHOUT ANY WARRANTY; without even the implied warranty of
  16. ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
  17. ! General Public License for more details.
  18. !
  19. ! You should have received a copy of the GNU General Public License
  20. ! along with this program; if not, write to the Free Software
  21. ! Foundation, Inc., 51 Franklin St - Fifth Floor, Boston, MA 02110-1301 USA.
  22. ! The full GNU General Public License is included in this distribution
  23. ! in the file called LICENSE.GPL.
  24. !
  25. ! Contact Information:
  26. ! http://software.intel.com/en-us/articles/intel-vtune-amplifier-xe/
  27. !
  28. ! BSD LICENSE
  29. !
  30. ! Copyright (c) 2005-2014 Intel Corporation. All rights reserved.
  31. ! All rights reserved.
  32. !
  33. ! Redistribution and use in source and binary forms, with or without
  34. ! modification, are permitted provided that the following conditions
  35. ! are met:
  36. !
  37. ! * Redistributions of source code must retain the above copyright
  38. ! notice, this list of conditions and the following disclaimer.
  39. ! * Redistributions in binary form must reproduce the above copyright
  40. ! notice, this list of conditions and the following disclaimer in
  41. ! the documentation and/or other materials provided with the
  42. ! distribution.
  43. ! * Neither the name of Intel Corporation nor the names of its
  44. ! contributors may be used to endorse or promote products derived
  45. ! from this software without specific prior written permission.
  46. !
  47. ! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
  48. ! "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
  49. ! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
  50. ! A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
  51. ! OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
  52. ! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
  53. ! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
  54. ! DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
  55. ! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
  56. ! (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
  57. ! OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  58. ! </copyright>
  59. ! ========================================================================
  60. !
  61. !--------
  62. !
  63. ! This file defines functions used by Intel(R) Parallel Inspector and
  64. ! Amplifier.
  65. !
  66. ! Version of ittnotify that was used to generate this file.
  67. ! This is not Fortran code that can be used to check but rather a comment
  68. ! that only serves to identify the interface.
  69. ! INTEL_ITT_FORTRAN_API_VERSION 3.0
  70. !--------
  71. module ittnotify
  72. use, intrinsic :: iso_c_binding, only: C_PTR, C_FUNPTR, C_INT, C_CHAR, C_NULL_CHAR, C_F_PROCPOINTER, C_LOC, C_ASSOCIATED
  73. implicit none
  74. !--------
  75. !
  76. ! Public interface
  77. !
  78. !--------
  79. integer, parameter :: itt_ptr = int_ptr_kind()
  80. public :: itt_pause
  81. public :: itt_resume
  82. public :: itt_thread_ignore
  83. public :: itt_suppress_push
  84. public :: itt_suppress_pop
  85. public :: itt_suppress_mark_range
  86. public :: itt_suppress_clear_range
  87. public :: itt_sync_prepare
  88. public :: itt_sync_cancel
  89. public :: itt_sync_acquired
  90. public :: itt_sync_releasing
  91. public :: itt_fsync_prepare
  92. public :: itt_fsync_cancel
  93. public :: itt_fsync_acquired
  94. public :: itt_fsync_releasing
  95. public :: itt_sync_destroy
  96. public :: itt_sync_create
  97. public :: itt_sync_rename
  98. public :: itt_thread_set_name
  99. public :: itt_heap_record_memory_growth_begin
  100. public :: itt_heap_record_memory_growth_end
  101. public :: itt_heap_reset_detection
  102. public :: itt_heap_record
  103. integer, parameter, public :: itt_attr_barrier = 1
  104. integer, parameter, public :: itt_attr_mutex = 2
  105. integer, parameter, public :: itt_suppress_threading_errors = 255
  106. integer, parameter, public :: itt_suppress_memory_errors = 65280
  107. integer, parameter, public :: itt_suppress_all_errors = 2147483647
  108. integer, parameter, public :: itt_unsuppress_range = 0
  109. integer, parameter, public :: itt_suppress_range = 1
  110. integer, parameter, public :: itt_heap_leaks = 1
  111. integer, parameter, public :: itt_heap_growth = 2
  112. private
  113. abstract interface
  114. subroutine itt_proc_none() bind(C)
  115. import
  116. end subroutine itt_proc_none
  117. subroutine itt_proc_sup_push(mask) bind(C)
  118. import
  119. integer, intent(in), value :: mask
  120. end subroutine itt_proc_sup_push
  121. subroutine itt_proc_sup_range(action, mask, addr, size) bind(C)
  122. import
  123. integer, intent(in), value :: action
  124. integer, intent(in), value :: mask
  125. integer(kind=itt_ptr), intent(in), value :: addr
  126. integer(kind=itt_ptr), intent(in), value :: size
  127. end subroutine itt_proc_sup_range
  128. subroutine itt_proc_address(addr) bind(C)
  129. import
  130. integer(kind=itt_ptr), intent(in), value :: addr
  131. end subroutine itt_proc_address
  132. subroutine itt_proc_create(addr, objname, attribute) bind(C)
  133. import
  134. integer(kind=itt_ptr), intent(in), value :: addr
  135. character(kind=C_CHAR), dimension(*), intent(in) :: objname
  136. integer, intent(in), value :: attribute
  137. end subroutine itt_proc_create
  138. subroutine itt_proc_name(name) bind(C)
  139. import
  140. character(kind=C_CHAR), dimension(*), intent(in) :: name
  141. end subroutine itt_proc_name
  142. subroutine itt_proc_rename(addr, objname) bind(C)
  143. import
  144. integer(kind=itt_ptr), intent(in), value :: addr
  145. character(kind=C_CHAR), dimension(*), intent(in) :: objname
  146. end subroutine itt_proc_rename
  147. subroutine itt_proc_heapmask(heapmask) bind(C)
  148. import
  149. integer, intent(in), value :: heapmask
  150. end subroutine itt_proc_heapmask
  151. end interface
  152. type(C_FUNPTR) :: itt_pause_fort_ptr
  153. !DEC$ ATTRIBUTES C, EXTERN, ALIAS:'__itt_pause_ptr__3_0' :: itt_pause_fort_ptr
  154. type(C_FUNPTR) :: itt_resume_fort_ptr
  155. !DEC$ ATTRIBUTES C, EXTERN, ALIAS:'__itt_resume_ptr__3_0' :: itt_resume_fort_ptr
  156. type(C_FUNPTR) :: itt_thread_ignore_fort_ptr
  157. !DEC$ ATTRIBUTES C, EXTERN, ALIAS:'__itt_thread_ignore_ptr__3_0' :: itt_thread_ignore_fort_ptr
  158. type(C_FUNPTR) :: itt_suppress_push_fort_ptr
  159. !DEC$ ATTRIBUTES C, EXTERN, ALIAS:'__itt_suppress_push_ptr__3_0' :: itt_suppress_push_fort_ptr
  160. type(C_FUNPTR) :: itt_suppress_pop_fort_ptr
  161. !DEC$ ATTRIBUTES C, EXTERN, ALIAS:'__itt_suppress_pop_ptr__3_0' :: itt_suppress_pop_fort_ptr
  162. type(C_FUNPTR) :: itt_suppress_mark_range_fort_ptr
  163. !DEC$ ATTRIBUTES C, EXTERN, ALIAS:'__itt_suppress_mark_range_ptr__3_0' :: itt_suppress_mark_range_fort_ptr
  164. type(C_FUNPTR) :: itt_suppress_clear_range_fort_ptr
  165. !DEC$ ATTRIBUTES C, EXTERN, ALIAS:'__itt_suppress_clear_range_ptr__3_0' :: itt_suppress_clear_range_fort_ptr
  166. type(C_FUNPTR) :: itt_sync_prepare_fort_ptr
  167. !DEC$ ATTRIBUTES C, EXTERN, ALIAS:'__itt_sync_prepare_ptr__3_0' :: itt_sync_prepare_fort_ptr
  168. type(C_FUNPTR) :: itt_sync_cancel_fort_ptr
  169. !DEC$ ATTRIBUTES C, EXTERN, ALIAS:'__itt_sync_cancel_ptr__3_0' :: itt_sync_cancel_fort_ptr
  170. type(C_FUNPTR) :: itt_sync_acquired_fort_ptr
  171. !DEC$ ATTRIBUTES C, EXTERN, ALIAS:'__itt_sync_acquired_ptr__3_0' :: itt_sync_acquired_fort_ptr
  172. type(C_FUNPTR) :: itt_sync_releasing_fort_ptr
  173. !DEC$ ATTRIBUTES C, EXTERN, ALIAS:'__itt_sync_releasing_ptr__3_0' :: itt_sync_releasing_fort_ptr
  174. type(C_FUNPTR) :: itt_fsync_prepare_fort_ptr
  175. !DEC$ ATTRIBUTES C, EXTERN, ALIAS:'__itt_fsync_prepare_ptr__3_0' :: itt_fsync_prepare_fort_ptr
  176. type(C_FUNPTR) :: itt_fsync_cancel_fort_ptr
  177. !DEC$ ATTRIBUTES C, EXTERN, ALIAS:'__itt_fsync_cancel_ptr__3_0' :: itt_fsync_cancel_fort_ptr
  178. type(C_FUNPTR) :: itt_fsync_acquired_fort_ptr
  179. !DEC$ ATTRIBUTES C, EXTERN, ALIAS:'__itt_fsync_acquired_ptr__3_0' :: itt_fsync_acquired_fort_ptr
  180. type(C_FUNPTR) :: itt_fsync_releasing_fort_ptr
  181. !DEC$ ATTRIBUTES C, EXTERN, ALIAS:'__itt_fsync_releasing_ptr__3_0' :: itt_fsync_releasing_fort_ptr
  182. type(C_FUNPTR) :: itt_sync_destroy_fort_ptr
  183. !DEC$ ATTRIBUTES C, EXTERN, ALIAS:'__itt_sync_destroy_ptr__3_0' :: itt_sync_destroy_fort_ptr
  184. type(C_FUNPTR) :: itt_sync_create_fort_ptr
  185. !DEC$ ATTRIBUTES C, EXTERN, ALIAS:'__itt_sync_create_ptr__3_0' :: itt_sync_create_fort_ptr
  186. type(C_FUNPTR) :: itt_sync_rename_fort_ptr
  187. !DEC$ ATTRIBUTES C, EXTERN, ALIAS:'__itt_sync_rename_ptr__3_0' :: itt_sync_rename_fort_ptr
  188. type(C_FUNPTR) :: itt_thread_set_name_fort_ptr
  189. !DEC$ ATTRIBUTES C, EXTERN, ALIAS:'__itt_thread_set_name_ptr__3_0' :: itt_thread_set_name_fort_ptr
  190. type(C_FUNPTR) :: itt_heap_record_memory_growth_begin_fort_ptr
  191. !DEC$ ATTRIBUTES C, EXTERN, ALIAS:'__itt_heap_record_memory_growth_begin_ptr__3_0' :: itt_heap_record_memory_growth_begin_fort_ptr
  192. type(C_FUNPTR) :: itt_heap_record_memory_growth_end_fort_ptr
  193. !DEC$ ATTRIBUTES C, EXTERN, ALIAS:'__itt_heap_record_memory_growth_end_ptr__3_0' :: itt_heap_record_memory_growth_end_fort_ptr
  194. type(C_FUNPTR) :: itt_heap_reset_detection_fort_ptr
  195. !DEC$ ATTRIBUTES C, EXTERN, ALIAS:'__itt_heap_reset_detection_ptr__3_0' :: itt_heap_reset_detection_fort_ptr
  196. type(C_FUNPTR) :: itt_heap_record_fort_ptr
  197. !DEC$ ATTRIBUTES C, EXTERN, ALIAS:'__itt_heap_record_ptr__3_0' :: itt_heap_record_fort_ptr
  198. contains
  199. subroutine itt_pause()
  200. procedure(itt_proc_none), pointer :: pause_ptr
  201. !DEC$ ATTRIBUTES DEFAULT :: itt_pause
  202. if (C_ASSOCIATED(itt_pause_fort_ptr)) then
  203. call C_F_PROCPOINTER(itt_pause_fort_ptr, pause_ptr)
  204. call pause_ptr()
  205. end if
  206. end subroutine itt_pause
  207. subroutine itt_resume()
  208. procedure(itt_proc_none), pointer :: resume_ptr
  209. !DEC$ ATTRIBUTES DEFAULT :: itt_resume
  210. if (C_ASSOCIATED(itt_resume_fort_ptr)) then
  211. call C_F_PROCPOINTER(itt_resume_fort_ptr, resume_ptr)
  212. call resume_ptr()
  213. end if
  214. end subroutine itt_resume
  215. subroutine itt_thread_ignore()
  216. procedure(itt_proc_none), pointer :: thread_ignore_ptr
  217. !DEC$ ATTRIBUTES DEFAULT :: itt_thread_ignore
  218. if (C_ASSOCIATED(itt_thread_ignore_fort_ptr)) then
  219. call C_F_PROCPOINTER(itt_thread_ignore_fort_ptr, thread_ignore_ptr)
  220. call thread_ignore_ptr()
  221. end if
  222. end subroutine itt_thread_ignore
  223. subroutine itt_suppress_push(mask)
  224. procedure(itt_proc_sup_push), pointer :: suppress_push_ptr
  225. !DEC$ ATTRIBUTES DEFAULT :: itt_suppress_push
  226. integer, intent(in), value :: mask
  227. if (C_ASSOCIATED(itt_suppress_push_fort_ptr)) then
  228. call C_F_PROCPOINTER(itt_suppress_push_fort_ptr, suppress_push_ptr)
  229. call suppress_push_ptr(mask)
  230. end if
  231. end subroutine itt_suppress_push
  232. subroutine itt_suppress_pop()
  233. procedure(itt_proc_none), pointer :: suppress_pop_ptr
  234. !DEC$ ATTRIBUTES DEFAULT :: itt_suppress_pop
  235. if (C_ASSOCIATED(itt_suppress_pop_fort_ptr)) then
  236. call C_F_PROCPOINTER(itt_suppress_pop_fort_ptr, suppress_pop_ptr)
  237. call suppress_pop_ptr()
  238. end if
  239. end subroutine itt_suppress_pop
  240. subroutine itt_suppress_mark_range(action, mask, addr, size)
  241. procedure(itt_proc_sup_range), pointer :: suppress_mark_range_ptr
  242. !DEC$ ATTRIBUTES DEFAULT :: itt_suppress_mark_range
  243. integer, intent(in), value :: action
  244. integer, intent(in), value :: mask
  245. integer(kind=itt_ptr), intent(in), value :: addr
  246. integer(kind=itt_ptr), intent(in), value :: size
  247. if (C_ASSOCIATED(itt_suppress_mark_range_fort_ptr)) then
  248. call C_F_PROCPOINTER(itt_suppress_mark_range_fort_ptr, suppress_mark_range_ptr)
  249. call suppress_mark_range_ptr(action, mask, addr, size)
  250. end if
  251. end subroutine itt_suppress_mark_range
  252. subroutine itt_suppress_clear_range(action, mask, addr, size)
  253. procedure(itt_proc_sup_range), pointer :: suppress_clear_range_ptr
  254. !DEC$ ATTRIBUTES DEFAULT :: itt_suppress_clear_range
  255. integer, intent(in), value :: action
  256. integer, intent(in), value :: mask
  257. integer(kind=itt_ptr), intent(in), value :: addr
  258. integer(kind=itt_ptr), intent(in), value :: size
  259. if (C_ASSOCIATED(itt_suppress_clear_range_fort_ptr)) then
  260. call C_F_PROCPOINTER(itt_suppress_clear_range_fort_ptr, suppress_clear_range_ptr)
  261. call suppress_clear_range_ptr(action, mask, addr, size)
  262. end if
  263. end subroutine itt_suppress_clear_range
  264. subroutine itt_sync_prepare(addr)
  265. procedure(itt_proc_address), pointer :: sync_prepare_ptr
  266. !DEC$ ATTRIBUTES DEFAULT :: itt_sync_prepare
  267. integer(kind=itt_ptr), intent(in), value :: addr
  268. if (C_ASSOCIATED(itt_sync_prepare_fort_ptr)) then
  269. call C_F_PROCPOINTER(itt_sync_prepare_fort_ptr, sync_prepare_ptr)
  270. call sync_prepare_ptr(addr)
  271. end if
  272. end subroutine itt_sync_prepare
  273. subroutine itt_sync_cancel(addr)
  274. procedure(itt_proc_address), pointer :: sync_cancel_ptr
  275. !DEC$ ATTRIBUTES DEFAULT :: itt_sync_cancel
  276. integer(kind=itt_ptr), intent(in), value :: addr
  277. if (C_ASSOCIATED(itt_sync_cancel_fort_ptr)) then
  278. call C_F_PROCPOINTER(itt_sync_cancel_fort_ptr, sync_cancel_ptr)
  279. call sync_cancel_ptr(addr)
  280. end if
  281. end subroutine itt_sync_cancel
  282. subroutine itt_sync_acquired(addr)
  283. procedure(itt_proc_address), pointer :: sync_acquired_ptr
  284. !DEC$ ATTRIBUTES DEFAULT :: itt_sync_acquired
  285. integer(kind=itt_ptr), intent(in), value :: addr
  286. if (C_ASSOCIATED(itt_sync_acquired_fort_ptr)) then
  287. call C_F_PROCPOINTER(itt_sync_acquired_fort_ptr, sync_acquired_ptr)
  288. call sync_acquired_ptr(addr)
  289. end if
  290. end subroutine itt_sync_acquired
  291. subroutine itt_sync_releasing(addr)
  292. procedure(itt_proc_address), pointer :: sync_releasing_ptr
  293. !DEC$ ATTRIBUTES DEFAULT :: itt_sync_releasing
  294. integer(kind=itt_ptr), intent(in), value :: addr
  295. if (C_ASSOCIATED(itt_sync_releasing_fort_ptr)) then
  296. call C_F_PROCPOINTER(itt_sync_releasing_fort_ptr, sync_releasing_ptr)
  297. call sync_releasing_ptr(addr)
  298. end if
  299. end subroutine itt_sync_releasing
  300. subroutine itt_fsync_prepare(addr)
  301. procedure(itt_proc_address), pointer :: fsync_prepare_ptr
  302. !DEC$ ATTRIBUTES DEFAULT :: itt_fsync_prepare
  303. integer(kind=itt_ptr), intent(in), value :: addr
  304. if (C_ASSOCIATED(itt_fsync_prepare_fort_ptr)) then
  305. call C_F_PROCPOINTER(itt_fsync_prepare_fort_ptr, fsync_prepare_ptr)
  306. call fsync_prepare_ptr(addr)
  307. end if
  308. end subroutine itt_fsync_prepare
  309. subroutine itt_fsync_cancel(addr)
  310. procedure(itt_proc_address), pointer :: fsync_cancel_ptr
  311. !DEC$ ATTRIBUTES DEFAULT :: itt_fsync_cancel
  312. integer(kind=itt_ptr), intent(in), value :: addr
  313. if (C_ASSOCIATED(itt_fsync_cancel_fort_ptr)) then
  314. call C_F_PROCPOINTER(itt_fsync_cancel_fort_ptr, fsync_cancel_ptr)
  315. call fsync_cancel_ptr(addr)
  316. end if
  317. end subroutine itt_fsync_cancel
  318. subroutine itt_fsync_acquired(addr)
  319. procedure(itt_proc_address), pointer :: fsync_acquired_ptr
  320. !DEC$ ATTRIBUTES DEFAULT :: itt_fsync_acquired
  321. integer(kind=itt_ptr), intent(in), value :: addr
  322. if (C_ASSOCIATED(itt_fsync_acquired_fort_ptr)) then
  323. call C_F_PROCPOINTER(itt_fsync_acquired_fort_ptr, fsync_acquired_ptr)
  324. call fsync_acquired_ptr(addr)
  325. end if
  326. end subroutine itt_fsync_acquired
  327. subroutine itt_fsync_releasing(addr)
  328. procedure(itt_proc_address), pointer :: fsync_releasing_ptr
  329. !DEC$ ATTRIBUTES DEFAULT :: itt_fsync_releasing
  330. integer(kind=itt_ptr), intent(in), value :: addr
  331. if (C_ASSOCIATED(itt_fsync_releasing_fort_ptr)) then
  332. call C_F_PROCPOINTER(itt_fsync_releasing_fort_ptr, fsync_releasing_ptr)
  333. call fsync_releasing_ptr(addr)
  334. end if
  335. end subroutine itt_fsync_releasing
  336. subroutine itt_sync_destroy(addr)
  337. procedure(itt_proc_address), pointer :: sync_destroy_ptr
  338. !DEC$ ATTRIBUTES DEFAULT :: itt_sync_destroy
  339. integer(kind=itt_ptr), intent(in), value :: addr
  340. if (C_ASSOCIATED(itt_sync_destroy_fort_ptr)) then
  341. call C_F_PROCPOINTER(itt_sync_destroy_fort_ptr, sync_destroy_ptr)
  342. call sync_destroy_ptr(addr)
  343. end if
  344. end subroutine itt_sync_destroy
  345. subroutine itt_sync_create(addr, objname, attribute)
  346. procedure(itt_proc_create), pointer :: sync_create_ptr
  347. !DEC$ ATTRIBUTES DEFAULT :: itt_sync_create
  348. integer(kind=itt_ptr), intent(in), value :: addr
  349. character(len=*), intent(in) :: objname
  350. integer, intent(in), value :: attribute
  351. CHARACTER(LEN=1,KIND=C_CHAR) :: objnametmp(LEN_TRIM(objname)+1)
  352. INTEGER :: iobjname, nobjname
  353. if (C_ASSOCIATED(itt_sync_create_fort_ptr)) then
  354. nobjname = LEN_TRIM(objname)
  355. DO iobjname = 1, nobjname
  356. objnametmp(iobjname) = objname(iobjname:iobjname)
  357. END DO
  358. objnametmp(nobjname + 1) = C_NULL_CHAR
  359. call C_F_PROCPOINTER(itt_sync_create_fort_ptr, sync_create_ptr)
  360. call sync_create_ptr(addr, objnametmp, attribute)
  361. end if
  362. end subroutine itt_sync_create
  363. subroutine itt_sync_rename(addr, objname)
  364. procedure(itt_proc_rename), pointer :: sync_rename_ptr
  365. !DEC$ ATTRIBUTES DEFAULT :: itt_sync_rename
  366. integer(kind=itt_ptr), intent(in), value :: addr
  367. character(len=*), intent(in) :: objname
  368. CHARACTER(LEN=1,KIND=C_CHAR) :: objnametmp(LEN_TRIM(objname)+1)
  369. INTEGER :: iobjname, nobjname
  370. if (C_ASSOCIATED(itt_sync_rename_fort_ptr)) then
  371. nobjname = LEN_TRIM(objname)
  372. DO iobjname = 1, nobjname
  373. objnametmp(iobjname) = objname(iobjname:iobjname)
  374. END DO
  375. objnametmp(nobjname + 1) = C_NULL_CHAR
  376. call C_F_PROCPOINTER(itt_sync_rename_fort_ptr, sync_rename_ptr)
  377. call sync_rename_ptr(addr, objnametmp)
  378. end if
  379. end subroutine itt_sync_rename
  380. subroutine itt_thread_set_name(name)
  381. procedure(itt_proc_name), pointer :: thread_set_name_ptr
  382. !DEC$ ATTRIBUTES DEFAULT :: itt_thread_set_name
  383. character(len=*), intent(in) :: name
  384. CHARACTER(LEN=1,KIND=C_CHAR) :: nametmp(LEN_TRIM(name)+1)
  385. INTEGER :: iname, nname
  386. if (C_ASSOCIATED(itt_thread_set_name_fort_ptr)) then
  387. nname = LEN_TRIM(name)
  388. DO iname = 1, nname
  389. nametmp(iname) = name(iname:iname)
  390. END DO
  391. nametmp(nname + 1) = C_NULL_CHAR
  392. call C_F_PROCPOINTER(itt_thread_set_name_fort_ptr, thread_set_name_ptr)
  393. call thread_set_name_ptr(nametmp)
  394. end if
  395. end subroutine itt_thread_set_name
  396. subroutine itt_heap_record_memory_growth_begin()
  397. procedure(itt_proc_none), pointer :: heap_record_memory_growth_begin_ptr
  398. !DEC$ ATTRIBUTES DEFAULT :: itt_heap_record_memory_growth_begin
  399. if (C_ASSOCIATED(itt_heap_record_memory_growth_begin_fort_ptr)) then
  400. call C_F_PROCPOINTER(itt_heap_record_memory_growth_begin_fort_ptr, heap_record_memory_growth_begin_ptr)
  401. call heap_record_memory_growth_begin_ptr()
  402. end if
  403. end subroutine itt_heap_record_memory_growth_begin
  404. subroutine itt_heap_record_memory_growth_end()
  405. procedure(itt_proc_none), pointer :: heap_record_memory_growth_end_ptr
  406. !DEC$ ATTRIBUTES DEFAULT :: itt_heap_record_memory_growth_end
  407. if (C_ASSOCIATED(itt_heap_record_memory_growth_end_fort_ptr)) then
  408. call C_F_PROCPOINTER(itt_heap_record_memory_growth_end_fort_ptr, heap_record_memory_growth_end_ptr)
  409. call heap_record_memory_growth_end_ptr()
  410. end if
  411. end subroutine itt_heap_record_memory_growth_end
  412. subroutine itt_heap_reset_detection(heapmask)
  413. procedure(itt_proc_heapmask), pointer :: heap_reset_detection_ptr
  414. !DEC$ ATTRIBUTES DEFAULT :: itt_heap_reset_detection
  415. integer, intent(in), value :: heapmask
  416. if (C_ASSOCIATED(itt_heap_reset_detection_fort_ptr)) then
  417. call C_F_PROCPOINTER(itt_heap_reset_detection_fort_ptr, heap_reset_detection_ptr)
  418. call heap_reset_detection_ptr(heapmask)
  419. end if
  420. end subroutine itt_heap_reset_detection
  421. subroutine itt_heap_record(heapmask)
  422. procedure(itt_proc_heapmask), pointer :: heap_record_ptr
  423. !DEC$ ATTRIBUTES DEFAULT :: itt_heap_record
  424. integer, intent(in), value :: heapmask
  425. if (C_ASSOCIATED(itt_heap_record_fort_ptr)) then
  426. call C_F_PROCPOINTER(itt_heap_record_fort_ptr, heap_record_ptr)
  427. call heap_record_ptr(heapmask)
  428. end if
  429. end subroutine itt_heap_record
  430. end module ittnotify