1 ! Copyright (c) 2019, NVIDIA CORPORATION.  All rights reserved.
2 !
3 ! Licensed under the Apache License, Version 2.0 (the "License");
4 ! you may not use this file except in compliance with the License.
5 ! You may obtain a copy of the License at
6 !
7 !     http://www.apache.org/licenses/LICENSE-2.0
8 !
9 ! Unless required by applicable law or agreed to in writing, software
10 ! distributed under the License is distributed on an "AS IS" BASIS,
11 ! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
12 ! See the License for the specific language governing permissions and
13 ! limitations under the License.
14 
15 !dir$ free
16 
17   integer, parameter :: omp_integer_kind = selected_int_kind(9) ! 32-bit int
18   integer, parameter :: omp_logical_kind = kind(.true.)
19 
20   integer, parameter :: omp_sched_kind = omp_integer_kind
21   integer, parameter :: omp_proc_bind_kind = omp_integer_kind
22   integer, parameter :: omp_pause_resource_kind = omp_integer_kind
23   integer, parameter :: omp_sync_hint_kind = omp_integer_kind
24   integer, parameter :: omp_lock_hint_kind = omp_sync_hint_kind
25   integer, parameter :: omp_event_handle_kind = omp_integer_kind
26   integer, parameter :: omp_alloctrait_key_kind = omp_integer_kind
27   integer, parameter :: omp_alloctrait_val_kind = omp_integer_kind
28   integer, parameter :: omp_allocator_handle_kind = omp_integer_kind
29   integer, parameter :: omp_memspace_handle_kind = omp_integer_kind
30   integer, parameter :: omp_lock_kind = int_ptr_kind()
31   integer, parameter :: omp_nest_lock_kind = int_ptr_kind()
32   integer, parameter :: omp_depend_kind = omp_integer_kind
33 
34   integer(kind=omp_sched_kind), parameter :: &
35     omp_sched_static = 1, &
36     omp_sched_dynamic = 2, &
37     omp_sched_guided = 3, &
38     omp_sched_auto = 4
39 
40   integer(kind=omp_proc_bind_kind), parameter :: &
41     omp_proc_bind_false = 0, &
42     omp_proc_bind_true = 1, &
43     omp_proc_bind_master = 2, &
44     omp_proc_bind_close = 3, &
45     omp_proc_bind_spread = 4
46 
47   integer(kind=omp_pause_resource_kind), parameter :: &
48     omp_pause_soft = 1, &
49     omp_pause_hard = 2
50 
51   integer(kind=omp_sync_hint_kind), parameter :: &
52     omp_sync_hint_none = 0, &
53     omp_sync_hint_uncontended = 1, &
54     omp_sync_hint_contended = 2, &
55     omp_sync_hint_nonspeculative = 4, &
56     omp_sync_hint_speculative = 8
57   integer(kind=omp_lock_hint_kind), parameter :: &
58     omp_lock_hint_none = omp_sync_hint_none, &
59     omp_lock_hint_uncontended = omp_sync_hint_uncontended, &
60     omp_lock_hint_contended = omp_sync_hint_contended, &
61     omp_lock_hint_nonspeculative = omp_sync_hint_nonspeculative, &
62     omp_lock_hint_speculative = omp_sync_hint_speculative
63 
64   integer(kind=omp_event_handle_kind), parameter :: &
65     omp_allow_completion_event = 0, &
66     omp_task_fulfill_event = 1
67 
68   integer(kind=omp_alloctrait_key_kind), parameter :: &
69     omp_atk_sync_hint = 1, &
70     omp_atk_alignment = 2, &
71     omp_atk_access = 3, &
72     omp_atk_pool_size = 4, &
73     omp_atk_fallback = 5, &
74     omp_atk_fb_data = 6, &
75     omp_atk_pinned = 7, &
76     omp_atk_partition = 8
77 
78   integer(kind=omp_alloctrait_val_kind), parameter :: &
79     omp_atv_false = 0, &
80     omp_atv_true = 1, &
81     omp_atv_default = 2, &
82     omp_atv_contended = 3, &
83     omp_atv_uncontended = 4, &
84     omp_atv_sequential = 5, &
85     omp_atv_private = 6, &
86     omp_atv_all = 7, &
87     omp_atv_thread = 8, &
88     omp_atv_pteam = 9, &
89     omp_atv_cgroup = 10, &
90     omp_atv_default_mem_fb = 11, &
91     omp_atv_null_fb = 12, &
92     omp_atv_abort_fb = 13, &
93     omp_atv_allocator_fb = 14, &
94     omp_atv_environment = 15, &
95     omp_atv_nearest = 16, &
96     omp_atv_blocked = 17, &
97     omp_atv_interleaved = 18
98 
99   type :: omp_alloctrait
100     integer(kind=omp_alloctrait_key_kind) :: key, value
101   end type omp_alloctrait
102 
103   integer(kind=omp_allocator_handle_kind), parameter :: omp_null_allocator = 0
104 
105   integer(kind=omp_memspace_handle_kind), parameter :: &
106     omp_default_mem_space = 0, &
107     omp_large_cap_mem_space = 0, &
108     omp_const_mem_space = 0, &
109     omp_high_bw_mem_space = 0, &
110     omp_low_lat_mem_space = 0, &
111     omp_default_mem_alloc = 1, &
112     omp_large_cap_mem_alloc = omp_default_mem_alloc, &
113     omp_const_mem_alloc = 1, &
114     omp_high_bw_mem_alloc = 1, &
115     omp_low_lat_mem_alloc = 1, &
116     omp_thread_mem_alloc = omp_atv_thread, &
117     omp_pteam_mem_alloc = omp_atv_pteam, &
118     omp_cgroup_mem_alloc = omp_atv_cgroup
119 
120   integer(kind=omp_integer_kind), parameter :: openmp_version = 200805
121 
122   interface
123 
124     subroutine omp_set_num_threads(nthreads) bind(c)
125       import
126       integer(kind=omp_integer_kind), value :: nthreads
127     end subroutine omp_set_num_threads
128 
129     function omp_get_num_threads() bind(c)
130       import
131       integer(kind=omp_integer_kind) :: omp_get_num_threads
132     end function omp_get_num_threads
133 
134     function omp_get_max_threads() bind(c)
135       import
136       integer(kind=omp_integer_kind) :: omp_get_max_threads
137     end function omp_get_max_threads
138 
139     function omp_get_thread_num() bind(c)
140       import
141       integer(kind=omp_integer_kind) :: omp_get_thread_num
142     end function omp_get_thread_num
143 
144     function omp_get_num_procs() bind(c)
145       import
146       integer(kind=omp_integer_kind) :: omp_get_num_procs
147     end function omp_get_num_procs
148 
149     function omp_in_parallel() bind(c)
150       import
151       logical(kind=omp_logical_kind) :: omp_in_parallel
152     end function omp_in_parallel
153 
154     subroutine omp_set_dynamic(enable) bind(c)
155       import
156       logical(kind=omp_logical_kind), value :: enable
157     end subroutine omp_set_dynamic
158 
159     function omp_get_dynamic() bind(c)
160       import
161       logical(kind=omp_logical_kind) :: omp_get_dynamic
162     end function omp_get_dynamic
163 
164     function omp_get_cancelation() bind(c)
165       import
166       logical(kind=omp_logical_kind) :: omp_get_cancelation
167     end function omp_get_cancelation
168 
169     subroutine omp_set_nested(enable) bind(c)
170       import
171       logical(kind=omp_logical_kind), value :: enable
172     end subroutine omp_set_nested
173 
174     function omp_get_nested() bind(c)
175       import
176       logical(kind=omp_logical_kind) ::omp_get_nested
177     end function omp_get_nested
178 
179     subroutine omp_set_schedule(kind, modifier) bind(c)
180       import
181       integer(kind=omp_integer_kind), value :: kind, modifier
182     end subroutine omp_set_schedule
183 
184     subroutine omp_get_schedule(kind, modifier) bind(c)
185       import
186       integer(kind=omp_integer_kind), intent(out) :: kind, modifier
187     end subroutine omp_get_schedule
188 
189     function omp_get_thread_limit() bind(c)
190       import
191       integer(kind=omp_integer_kind) :: omp_get_thread_limit
192     end function omp_get_thread_limit
193 
194     function omp_get_supported_active_levels() bind(c)
195       import
196       integer(kind=omp_integer_kind) :: omp_get_supported_active_levels
197     end function omp_get_supported_active_levels
198 
199     subroutine omp_set_max_active_levels(max_levels) bind(c)
200       import
201       integer(kind=omp_integer_kind), value :: max_levels
202     end subroutine omp_set_max_active_levels
203 
204     function omp_get_max_active_levels() bind(c)
205       import
206       integer(kind=omp_integer_kind) :: omp_get_max_active_levels
207     end function omp_get_max_active_levels
208 
209     function omp_get_level() bind(c)
210       import
211       integer(kind=omp_integer_kind) :: omp_get_level
212     end function omp_get_level
213 
214     function omp_get_ancestor_thread_num(level) bind(c)
215       import
216       integer(kind=omp_integer_kind), value :: level
217       integer(kind=omp_integer_kind) :: omp_get_ancestor_thread_num
218     end function omp_get_ancestor_thread_num
219 
220     function omp_get_team_size(level) bind(c)
221       import
222       integer(kind=omp_integer_kind), value :: level
223       integer(kind=omp_integer_kind) :: omp_get_team_size
224     end function omp_get_team_size
225 
226     function omp_get_active_level() bind(c)
227       import
228       integer(kind=omp_integer_kind) :: omp_get_active_level
229     end function omp_get_active_level
230 
231     function omp_in_final() bind(c)
232       import
233       logical(kind=omp_logical_kind) :: omp_in_final
234     end function omp_in_final
235 
236     function omp_get_proc_bind() bind(c)
237       import
238       integer(kind=omp_proc_bind_kind) :: omp_get_proc_bind
239     end function omp_get_proc_bind
240 
241     function omp_get_num_places() bind(c)
242       import
243       integer(kind=omp_integer_kind) :: omp_get_num_places
244     end function omp_get_num_places
245 
246     function omp_get_place_num_procs(place_num) bind(c)
247       import
248       integer(kind=omp_integer_kind), value :: place_num
249       integer(kind=omp_integer_kind) omp_get_place_num_procs
250     end function omp_get_place_num_procs
251 
252     subroutine omp_get_place_proc_ids(place_num, ids) bind(c)
253       import
254       integer(kind=omp_integer_kind), value :: place_num
255       integer(kind=omp_integer_kind), intent(out) :: ids(*)
256     end subroutine omp_get_place_proc_ids
257 
258     function omp_get_place_num() bind(c)
259       import
260       integer(kind=omp_integer_kind) :: omp_get_place_num
261     end function omp_get_place_num
262 
263     function omp_get_partition_num_places() bind(c)
264       import
265       integer(kind=omp_integer_kind) :: omp_get_partition_num_places
266     end function omp_get_partition_num_places
267 
268     subroutine omp_get_partition_place_nums(place_nums) bind(c)
269       import
270       integer(kind=omp_integer_kind), intent(out) :: place_nums(*)
271     end subroutine omp_get_partition_place_nums
272 
273     subroutine omp_set_affinity_format(format)
274       import
275       character(len=*), intent(in) :: format
276     end subroutine omp_set_affinity_format
277 
278     function omp_get_affinity_format(buffer)
279       import
280       character(len=*), intent(out) :: buffer
281       integer(kind=omp_integer_kind) :: omp_get_affinity_format
282     end function omp_get_affinity_format
283 
284     subroutine omp_display_affinity(format)
285       import
286       character(len=*), intent(in) :: format
287     end subroutine omp_display_affinity
288 
289     function omp_capture_affinity(buffer, format)
290       import
291       character(len=*), intent(out) :: buffer
292       character(len=*), intent(in) :: format
293       integer(kind=omp_integer_kind) omp_capture_affinity
294     end function omp_capture_affinity
295 
296     subroutine omp_set_default_device(device_num) bind(c)
297       import
298       integer(kind=omp_integer_kind), value :: device_num
299     end subroutine omp_set_default_device
300 
301     function omp_get_default_device() bind(c)
302       import
303       integer(kind=omp_integer_kind) :: omp_get_default_device
304     end function omp_get_default_device
305 
306     function omp_get_num_devices() bind(c)
307       import
308       integer(kind=omp_integer_kind) :: omp_get_num_devices
309     end function omp_get_num_devices
310 
311     function omp_get_device_num() bind(c)
312       import
313       integer(kind=omp_integer_kind) :: omp_get_device_num
314     end function omp_get_device_num
315 
316     function omp_get_num_teams() bind(c)
317       import
318       integer(kind=omp_integer_kind) :: omp_get_num_teams
319     end function omp_get_num_teams
320 
321     function omp_get_team_num() bind(c)
322       import
323       integer(kind=omp_integer_kind) :: omp_get_team_num
324     end function omp_get_team_num
325 
326     function omp_is_initial_device() bind(c)
327       import
328       integer(kind=omp_logical_kind) :: omp_is_initial_device ! TODO: should this be LOGICAL?
329     end function omp_is_initial_device
330 
331     function omp_get_initial_device() bind(c)
332       import
333       integer(kind=omp_integer_kind) :: omp_get_initial_device
334     end function omp_get_initial_device
335 
336     function omp_get_max_task_priority() bind(c)
337       import
338       integer(kind=omp_integer_kind) :: omp_get_max_task_priority
339     end function omp_get_max_task_priority
340 
341     function omp_pause_resource(kind, device_num) bind(c)
342       import
343       integer(kind=omp_pause_resource_kind), value :: kind
344       integer(kind=omp_integer_kind), value :: device_num
345       integer(kind=omp_integer_kind) :: omp_pause_resource
346     end function omp_pause_resource
347 
348     function omp_pause_resource_all(kind)
349       import
350       integer(kind=omp_pause_resource_kind), value :: kind
351       integer(kind=omp_integer_kind) :: omp_pause_resource_all
352     end function omp_pause_resource_all
353 
354 ! Lock routines
355     subroutine omp_init_lock(lockvar) bind(c, name="omp_init_lock_")
356       import
357       integer(kind=omp_lock_kind), intent(out) :: lockvar
358     end subroutine omp_init_lock
359 
360     subroutine omp_init_lock_with_hint(lockvar, hint) bind(c, name="omp_init_lock_with_hint_")
361       import
362       integer(kind=omp_lock_kind), intent(out) :: lockvar
363       integer(kind=omp_sync_hint_kind), value :: hint
364     end subroutine omp_init_lock_with_hint
365 
366     subroutine omp_destroy_lock(lockvar) bind(c, name="omp_destroy_lock_")
367       import
368       integer(kind=omp_lock_kind), intent(inout) :: lockvar
369     end subroutine omp_destroy_lock
370 
371     subroutine omp_set_lock(lockvar) bind(c, name="omp_set_lock_")
372       import
373       integer(kind=omp_lock_kind), intent(inout) :: lockvar
374     end subroutine omp_set_lock
375 
376     subroutine omp_unset_lock(lockvar) bind(c, name="omp_unset_lock_")
377       import
378       integer(kind=omp_lock_kind), intent(inout) :: lockvar
379     end subroutine omp_unset_lock
380 
381     function omp_test_lock(lockvar) bind(c, name="omp_test_lock_")
382       import
383       integer(kind=omp_lock_kind), intent(inout) :: lockvar
384       logical(kind=omp_logical_kind) :: omp_test_lock
385     end function omp_test_lock
386 
387     subroutine omp_init_nest_lock(lockvar) bind(c, name="omp_init_nest_lock_")
388       import
389       integer(kind=omp_nest_lock_kind), intent(out) :: lockvar
390     end subroutine omp_init_nest_lock
391 
392     subroutine omp_init_nest_lock_with_hint(lockvar, hint) bind(c, name="omp_init_nest_lock_with_hint_")
393       import
394       integer(kind=omp_nest_lock_kind), intent(out) :: lockvar
395       integer(kind=omp_sync_hint_kind), value :: hint
396     end subroutine omp_init_nest_lock_with_hint
397 
398     subroutine omp_destroy_nest_lock(lockvar) bind(c, name="omp_destroy_nest_lock_")
399       import
400       integer(kind=omp_nest_lock_kind), intent(inout) :: lockvar
401     end subroutine omp_destroy_nest_lock
402 
403     subroutine omp_set_nest_lock(lockvar) bind(c, name="omp_set_nest_lock_")
404       import
405       integer(kind=omp_nest_lock_kind), intent(inout) :: lockvar
406     end subroutine omp_set_nest_lock
407 
408     subroutine omp_unset_nest_lock(lockvar) bind(c, name="omp_unset_nest_lock_")
409       import
410       integer(kind=omp_nest_lock_kind), intent(inout) :: lockvar
411     end subroutine omp_unset_nest_lock
412 
413     function omp_test_nest_lock(lockvar) bind(c, name="omp_test_nest_lock_")
414       import
415       integer(kind=omp_integer_kind) :: omp_test_nest_lock
416       integer(kind=omp_nest_lock_kind), intent(inout) :: lockvar
417     end function omp_test_nest_lock
418 
419 ! Timing routines
420     function omp_get_wtime() bind(c)
421       double precision omp_get_wtime
422     end function omp_get_wtime
423 
424     function omp_get_wtick() bind(c)
425       double precision omp_get_wtick
426     end function omp_get_wtick
427 
428 ! Event routine
429     subroutine omp_fullfill_event(event) bind(c) ! TODO: is this the correct spelling?
430       import
431       integer(kind=omp_event_handle_kind) :: event
432     end subroutine omp_fullfill_event
433 
434 ! Device Memory Routines
435 
436 ! Memory Management Routines
437     function omp_init_allocator(memspace, ntraits, traits)
438       import
439       integer(kind=omp_memspace_handle_kind), value :: memspace
440       integer, value :: ntraits
441       type(omp_alloctrait), intent(in) :: traits(*)
442       integer(kind=omp_allocator_handle_kind) :: omp_init_allocator
443     end function omp_init_allocator
444 
445     subroutine omp_destroy_allocator(allocator) bind(c)
446       import
447       integer(kind=omp_allocator_handle_kind), value :: allocator
448     end subroutine omp_destroy_allocator
449 
450     subroutine omp_set_default_allocator(allocator) bind(c)
451       import
452       integer(kind=omp_allocator_handle_kind), value :: allocator
453     end subroutine omp_set_default_allocator
454 
455     function omp_get_default_allocator()
456       import
457       integer(kind=omp_allocator_handle_kind) :: omp_get_default_allocator
458     end function omp_get_default_allocator
459 
460   end interface
461