From 5c62bfb4f8929fbfeac407fa78ea3d88c262456d Mon Sep 17 00:00:00 2001 From: Steve Scalpone Date: Mon, 26 Aug 2019 14:58:10 -0700 Subject: [PATCH] [flang] Implement int_ptr_kind. Split omp_lib.F90 into two files: a Fortran file used to create the omp_lib module and a .h file that can be used directly, which apparently some codes do. Because of the split, and wanting to avoid forcing use isc_c_binding, use int_ptr_kind() instead of c_intptr_t. Original-commit: flang-compiler/f18@ce6a9fb17322608096c09f2b4d533f4e86d56b74 Reviewed-on: https://github.com/flang-compiler/f18/pull/690 Tree-same-pre-rewrite: false --- flang/documentation/Extensions.md | 1 + flang/lib/evaluate/fold.cc | 2 + flang/lib/evaluate/intrinsics.cc | 1 + flang/module/omp_lib.f90 | 540 +------------------------------------ flang/module/omp_lib.h | 548 ++++++++++++++++++++++++++++++++++++++ 5 files changed, 555 insertions(+), 537 deletions(-) create mode 100644 flang/module/omp_lib.h diff --git a/flang/documentation/Extensions.md b/flang/documentation/Extensions.md index 79a2c05..e849b29 100644 --- a/flang/documentation/Extensions.md +++ b/flang/documentation/Extensions.md @@ -95,6 +95,7 @@ Extensions, deletions, and legacy features supported by default the arguments as if they were operands to an intrinsic `+` operator, and defining the result type accordingly. * DOUBLE COMPLEX intrinsics DCMPLX, DCONJG and DIMAG. +* INT_PTR_KIND intrinsic returns the kind of c_intptr_t. Extensions supported when enabled by options -------------------------------------------- diff --git a/flang/lib/evaluate/fold.cc b/flang/lib/evaluate/fold.cc index d6d21b7..14b8926 100644 --- a/flang/lib/evaluate/fold.cc +++ b/flang/lib/evaluate/fold.cc @@ -686,6 +686,8 @@ Expr> FoldIntrinsicFunction( }, std::move(expr->u)); } + } else if (name == "int_ptr_kind") { + return Expr{8}; } else if (name == "kind") { if constexpr (common::HasMember) { return Expr{args[0].value().GetType()->kind()}; diff --git a/flang/lib/evaluate/intrinsics.cc b/flang/lib/evaluate/intrinsics.cc index 2241ab1..0f8b1f2 100644 --- a/flang/lib/evaluate/intrinsics.cc +++ b/flang/lib/evaluate/intrinsics.cc @@ -443,6 +443,7 @@ static const IntrinsicInterface genericIntrinsicFunction[]{ SubscriptDefaultKIND}, KINDInt}, {"int", {{"a", AnyNumeric, Rank::elementalOrBOZ}, DefaultingKIND}, KINDInt}, + {"int_ptr_kind", {}, DefaultInt, Rank::scalar}, {"ior", {{"i", SameInt}, {"j", SameInt, Rank::elementalOrBOZ}}, SameInt}, {"ior", {{"i", BOZ}, {"j", SameInt}}, SameInt}, {"ishft", {{"i", SameInt}, {"shift", AnyInt}}, SameInt}, diff --git a/flang/module/omp_lib.f90 b/flang/module/omp_lib.f90 index 7f9c782..0f6ad68 100644 --- a/flang/module/omp_lib.f90 +++ b/flang/module/omp_lib.f90 @@ -12,542 +12,8 @@ ! See the License for the specific language governing permissions and ! limitations under the License. - module omp_lib - use, intrinsic :: iso_c_binding +module omp_lib - integer, parameter :: omp_integer_kind = 4 - integer, parameter :: omp_logical_kind = 4 - integer, parameter :: omp_pause_resource_kind = 4 - integer, parameter :: omp_event_handle_kind = 4 - integer, parameter :: omp_lock_kind = c_intptr_t - integer, parameter :: omp_nest_lock_kind = c_intptr_t - integer, parameter :: omp_sched_kind = & - & omp_integer_kind - integer, parameter :: omp_proc_bind_kind = & - & omp_integer_kind - integer, parameter :: omp_sync_hint_kind = & - & omp_integer_kind - integer, parameter :: omp_depend_kind = & - & omp_integer_kind - integer, parameter :: omp_memspace_handle_kind = 4 - integer, parameter :: omp_allocator_handle_kind = 4 - integer, parameter :: omp_alloctrait_key_kind = 4 - integer, parameter :: omp_alloctrait_val_kind = 4 +include "omp_lib.h" - integer(kind=omp_sched_kind), parameter :: & - & omp_sched_static = 1 - integer(kind=omp_sched_kind), parameter :: & - & omp_sched_dynamic = 2 - integer(kind=omp_sched_kind), parameter :: & - & omp_sched_guided = 3 - integer(kind=omp_sched_kind), parameter :: omp_sched_auto = 4 - - integer (kind=omp_proc_bind_kind), parameter :: & - & omp_proc_bind_false = 0 - integer (kind=omp_proc_bind_kind), parameter :: & - & omp_proc_bind_true = 1 - integer (kind=omp_proc_bind_kind), parameter :: & - & omp_proc_bind_master = 2 - integer (kind=omp_proc_bind_kind), parameter :: & - & omp_proc_bind_close = 3 - integer (kind=omp_proc_bind_kind), parameter :: & - & omp_proc_bind_spread = 4 - - integer (kind=omp_pause_resource_kind), parameter :: & - & omp_pause_soft = 1 - integer (kind=omp_pause_resource_kind), parameter :: & - & omp_pause_hard = 2 - - integer, parameter :: omp_lock_hint_kind = omp_sync_hint_kind - integer (kind=omp_sync_hint_kind), parameter :: & - & omp_sync_hint_none = int(Z'0', kind=omp_sync_hint_kind) - integer (kind=omp_lock_hint_kind), parameter :: & - & omp_lock_hint_none = omp_sync_hint_none - integer (kind=omp_sync_hint_kind), parameter :: & - & omp_sync_hint_uncontended = & - & int(Z'1', kind=omp_sync_hint_kind) - integer (kind=omp_lock_hint_kind), parameter :: & - & omp_lock_hint_uncontended = omp_sync_hint_uncontended - integer (kind=omp_sync_hint_kind), parameter :: & - & omp_sync_hint_contended = & - & int(Z'2', kind=omp_sync_hint_kind) - integer (kind=omp_lock_hint_kind), parameter :: & - & omp_lock_hint_contended = omp_sync_hint_contended - integer (kind=omp_sync_hint_kind), parameter :: & - & omp_sync_hint_nonspeculative = & - & int(Z'4', kind=omp_sync_hint_kind) - integer (kind=omp_lock_hint_kind), parameter :: & - & omp_lock_hint_nonspeculative = & - & omp_sync_hint_nonspeculative - integer (kind=omp_sync_hint_kind), parameter :: & - & omp_sync_hint_speculative = & - & int(Z'8', kind=omp_sync_hint_kind) - integer (kind=omp_lock_hint_kind), parameter :: & - & omp_lock_hint_speculative = omp_sync_hint_speculative - - integer (kind=omp_event_handle_kind), parameter :: & - & omp_allow_completion_event = 0 - integer (kind=omp_event_handle_kind), parameter :: & - & omp_task_fulfill_event = 1 - - integer(kind=omp_alloctrait_key_kind), parameter :: & - & omp_atk_sync_hint = 1 - integer(kind=omp_alloctrait_key_kind), parameter :: & - & omp_atk_alignment = 2 - integer(kind=omp_alloctrait_key_kind), parameter :: & - & omp_atk_access = 3 - integer(kind=omp_alloctrait_key_kind), parameter :: & - & omp_atk_pool_size = 4 - integer(kind=omp_alloctrait_key_kind), parameter :: & - & omp_atk_fallback = 5 - integer(kind=omp_alloctrait_key_kind), parameter :: & - & omp_atk_fb_data = 6 - integer(kind=omp_alloctrait_key_kind), parameter :: & - & omp_atk_pinned = 7 - integer(kind=omp_alloctrait_key_kind), parameter :: & - & omp_atk_partition = 8 - - integer(kind=omp_alloctrait_val_kind), parameter :: & - & omp_atv_false = 0 - integer(kind=omp_alloctrait_val_kind), parameter :: & - & omp_atv_true = 1 - integer(kind=omp_alloctrait_val_kind), parameter :: & - & omp_atv_default = 2 - integer(kind=omp_alloctrait_val_kind), parameter :: & - & omp_atv_contended = 3 - integer(kind=omp_alloctrait_val_kind), parameter :: & - & omp_atv_uncontended = 4 - integer(kind=omp_alloctrait_val_kind), parameter :: & - & omp_atv_sequential = 5 - integer(kind=omp_alloctrait_val_kind), parameter :: & - & omp_atv_private = 6 - integer(kind=omp_alloctrait_val_kind), parameter :: & - & omp_atv_all = 7 - integer(kind=omp_alloctrait_val_kind), parameter :: & - & omp_atv_thread = 8 - integer(kind=omp_alloctrait_val_kind), parameter :: & - & omp_atv_pteam = 9 - integer(kind=omp_alloctrait_val_kind), parameter :: & - & omp_atv_cgroup = 10 - integer(kind=omp_alloctrait_val_kind), parameter :: & - & omp_atv_default_mem_fb = 11 - integer(kind=omp_alloctrait_val_kind), parameter :: & - & omp_atv_null_fb = 12 - integer(kind=omp_alloctrait_val_kind), parameter :: & - & omp_atv_abort_fb = 13 - integer(kind=omp_alloctrait_val_kind), parameter :: & - & omp_atv_allocator_fb = 14 - integer(kind=omp_alloctrait_val_kind), parameter :: & - & omp_atv_environment = 15 - integer(kind=omp_alloctrait_val_kind), parameter :: & - & omp_atv_nearest = 16 - integer(kind=omp_alloctrait_val_kind), parameter :: & - & omp_atv_blocked = 17 - integer(kind=omp_alloctrait_val_kind), parameter :: & - & omp_atv_interleaved = 18 - - type omp_alloctrait - integer(kind=omp_alloctrait_key_kind) key - integer(kind=omp_alloctrait_val_kind) value - end type omp_alloctrait - - integer(kind=omp_allocator_handle_kind), parameter :: & - & omp_null_allocator = 0 - - integer (kind=omp_memspace_handle_kind), parameter :: & - & omp_default_mem_space = 0 - integer (kind=omp_memspace_handle_kind), parameter :: & - & omp_large_cap_mem_space = 0 - integer (kind=omp_memspace_handle_kind), parameter :: & - & omp_const_mem_space = 0 - integer (kind=omp_memspace_handle_kind), parameter :: & - & omp_high_bw_mem_space = 0 - integer (kind=omp_memspace_handle_kind), parameter :: & - & omp_low_lat_mem_space = 0 - - integer (kind=omp_memspace_handle_kind), parameter :: & - & omp_default_mem_alloc = 1 - integer (kind=omp_memspace_handle_kind), parameter :: & - & omp_large_cap_mem_alloc = omp_default_mem_alloc - integer (kind=omp_memspace_handle_kind), parameter :: & - & omp_const_mem_alloc = 1 - integer (kind=omp_memspace_handle_kind), parameter :: & - & omp_high_bw_mem_alloc = 1 - integer (kind=omp_memspace_handle_kind), parameter :: & - & omp_low_lat_mem_alloc = 1 - integer (kind=omp_memspace_handle_kind), parameter :: & - & omp_thread_mem_alloc = omp_atv_thread - integer (kind=omp_memspace_handle_kind), parameter :: & - & omp_pteam_mem_alloc = omp_atv_pteam - integer (kind=omp_memspace_handle_kind), parameter :: & - & omp_cgroup_mem_alloc = omp_atv_cgroup - - integer (kind=omp_integer_kind), parameter :: & - & openmp_version = 200805 - - interface - - subroutine omp_set_num_threads(nthreads) bind(c) - import - integer (kind=omp_integer_kind), VALUE :: nthreads - end subroutine omp_set_num_threads - - function omp_get_num_threads() bind(c) - import - integer (kind=omp_integer_kind) omp_get_num_threads - end function omp_get_num_threads - - function omp_get_max_threads() bind(c) - import - integer (kind=omp_integer_kind) omp_get_max_threads - end function omp_get_max_threads - - function omp_get_thread_num() bind(c) - import - integer (kind=omp_integer_kind) omp_get_thread_num - end function omp_get_thread_num - - function omp_get_num_procs() bind(c) - import - integer (kind=omp_integer_kind) omp_get_num_procs - end function omp_get_num_procs - - function omp_in_parallel() bind(c) - import - logical (kind=omp_logical_kind) omp_in_parallel - end function omp_in_parallel - - subroutine omp_set_dynamic(enable) bind(c) - import - logical (kind=omp_logical_kind), VALUE :: enable - end subroutine omp_set_dynamic - - function omp_get_dynamic() bind(c) - import - logical (kind=omp_logical_kind) omp_get_dynamic - end function omp_get_dynamic - - function omp_get_cancelation() bind(c) - import - logical (kind=omp_logical_kind) omp_get_cancelation - end function omp_get_cancelation - - subroutine omp_set_nested(enable) bind(c) - import - logical (kind=omp_logical_kind), VALUE :: enable - end subroutine omp_set_nested - - function omp_get_nested() bind(c) - import - logical (kind=omp_logical_kind) omp_get_nested - end function omp_get_nested - - subroutine omp_set_schedule(kind, modifier) bind(c) - import - integer (kind=omp_integer_kind), VALUE :: kind - integer (kind=omp_integer_kind), VALUE :: modifier - end subroutine omp_set_schedule - - subroutine omp_get_schedule(kind, modifier) bind(c) - import - integer (kind=omp_integer_kind) :: kind - integer (kind=omp_integer_kind) :: modifier - end subroutine omp_get_schedule - - function omp_get_thread_limit() bind(c) - import - integer (kind=omp_integer_kind) omp_get_thread_limit - end function omp_get_thread_limit - - function omp_get_supported_active_levels() bind(c) - import - integer (kind=omp_integer_kind) omp_get_supported_active_levels - end function omp_get_supported_active_levels - - subroutine omp_set_max_active_levels(max_levels) bind(c) - import - integer (kind=omp_integer_kind), VALUE :: max_levels - end subroutine omp_set_max_active_levels - - function omp_get_max_active_levels() bind(c) - import - integer (kind=omp_integer_kind) omp_get_max_active_levels - end function omp_get_max_active_levels - - function omp_get_level() bind(c) - import - integer (kind=omp_integer_kind) omp_get_level - end function omp_get_level - - function omp_get_ancestor_thread_num(level) bind(c) - import - integer (kind=omp_integer_kind) level - integer (kind=omp_integer_kind) omp_get_ancestor_thread_num - end function omp_get_ancestor_thread_num - - function omp_get_team_size(level) bind(c) - import - integer (kind=omp_integer_kind) omp_get_team_size - integer (kind=omp_integer_kind), VALUE :: level - end function omp_get_team_size - - function omp_get_active_level() bind(c) - import - integer (kind=omp_integer_kind) omp_get_active_level - end function omp_get_active_level - - function omp_in_final() bind(c) - import - logical (kind=omp_logical_kind) omp_in_final - end function omp_in_final - - function omp_get_proc_bind() bind(c) - import - integer (kind=omp_proc_bind_kind) omp_get_proc_bind - end function omp_get_proc_bind - - function omp_get_num_places() bind(c) - import - integer (kind=omp_integer_kind) omp_get_num_places - end function omp_get_num_places - - function omp_get_place_num_procs(place_num) bind(c) - import - integer (kind=omp_integer_kind), VALUE :: place_num - integer (kind=omp_integer_kind) omp_get_place_num_procs - end function omp_get_place_num_procs - - subroutine omp_get_place_proc_ids(place_num, ids) bind(c) - import - integer (kind=omp_integer_kind), VALUE :: place_num - integer (kind=omp_integer_kind), intent(out) :: ids(*) - end subroutine omp_get_place_proc_ids - - function omp_get_place_num() bind(c) - import - integer (kind=omp_integer_kind) omp_get_place_num - end function omp_get_place_num - - function omp_get_partition_num_places() bind(c) - import - integer (kind=omp_integer_kind) omp_get_partition_num_places - end function omp_get_partition_num_places - - subroutine omp_get_partition_place_nums(place_nums) bind(c) - import - integer (kind=omp_integer_kind), intent(out) :: place_nums(*) - end subroutine omp_get_partition_place_nums - - subroutine omp_set_affinity_format(format) - import - character(len=*), intent(in) :: format - end subroutine omp_set_affinity_format - - function omp_get_affinity_format(buffer) - import - character(len=*), intent(out) :: buffer - integer (kind=omp_integer_kind) omp_get_affinity_format - end function omp_get_affinity_format - - subroutine omp_display_affinity(format) - import - character(len=*), intent(in) :: format - end subroutine omp_display_affinity - - function omp_capture_affinity(buffer, format) - import - character(len=*), intent(out) :: buffer - character(len=*), intent(in) :: format - integer (kind=omp_integer_kind) omp_capture_affinity - end function omp_capture_affinity - - subroutine omp_set_default_device(device_num) bind(c) - import - integer (kind=omp_integer_kind) device_num - end subroutine omp_set_default_device - - function omp_get_default_device() bind(c) - import - integer (kind=omp_integer_kind) omp_get_default_device - end function omp_get_default_device - - function omp_get_num_devices() bind(c) - import - integer (kind=omp_integer_kind) omp_get_num_devices - end function omp_get_num_devices - - function omp_get_device_num() bind(c) - import - integer (kind=omp_integer_kind) omp_get_device_num - end function omp_get_device_num - - function omp_get_num_teams() bind(c) - import - integer (kind=omp_integer_kind) omp_get_num_teams - end function omp_get_num_teams - - function omp_get_team_num() bind(c) - import - integer (kind=omp_integer_kind) omp_get_team_num - end function omp_get_team_num - - function omp_is_initial_device() bind(c) - import - integer (kind=omp_integer_kind) omp_is_initial_device - end function omp_is_initial_device - - function omp_get_initial_device() bind(c) - import - integer (kind=omp_integer_kind) omp_get_initial_device - end function omp_get_initial_device - - function omp_get_max_task_priority() bind(c) - import - integer (kind=omp_integer_kind) omp_get_max_task_priority - end function omp_get_max_task_priority - - function omp_pause_resource(kind, device_num) bind(c) - import - integer (kind=omp_pause_resource_kind) kind - integer device_num - integer omp_pause_resource - end function omp_pause_resource - - function omp_pause_resource_all(kind) - import - integer (kind=omp_pause_resource_kind) kind - integer omp_pause_resource_all - end function omp_pause_resource_all - -! Lock routines - subroutine omp_init_lock(lockvar) & - & bind(c, name='omp_init_lock_') - import - integer (kind=omp_lock_kind), intent(out) :: lockvar - end subroutine omp_init_lock - - subroutine omp_init_lock_with_hint(lockvar, hint) & - & bind(c, name='omp_init_lock_with_hint_') - import - integer (kind=omp_lock_kind), intent(out) :: lockvar - integer (kind=omp_sync_hint_kind), intent(in) :: hint - end subroutine omp_init_lock_with_hint - - subroutine omp_destroy_lock(lockvar) & - & bind(c, name='omp_destroy_lock_') - import - integer (kind=omp_lock_kind), intent(inout) :: lockvar - end subroutine omp_destroy_lock - - subroutine omp_set_lock(lockvar) & - & bind(c, name='omp_set_lock_') - import - integer (kind=omp_lock_kind), intent(inout) :: lockvar - end subroutine omp_set_lock - - subroutine omp_unset_lock(lockvar) & - & bind(c, name='omp_unset_lock_') - import - integer (kind=omp_lock_kind), intent(inout) :: lockvar - end subroutine omp_unset_lock - - function omp_test_lock(lockvar) & - & bind(c, name='omp_test_lock_') - import - logical (kind=omp_logical_kind) omp_test_lock - integer (kind=omp_lock_kind), intent(inout) :: lockvar - end function omp_test_lock - - subroutine omp_init_nest_lock(lockvar) & - & bind(c, name='omp_init_nest_lock_') - import - integer (kind=omp_nest_lock_kind), intent(out) :: lockvar - end subroutine omp_init_nest_lock - - subroutine omp_init_nest_lock_with_hint(lockvar, hint) & - & bind(c, name='omp_init_nest_lock_with_hint_') - import - integer (kind=omp_lock_kind), intent(out) :: lockvar - integer (kind=omp_sync_hint_kind), intent(in) :: hint - end subroutine omp_init_nest_lock_with_hint - - subroutine omp_destroy_nest_lock(lockvar) & - & bind(c, name='omp_destroy_nest_lock_') - import - integer (kind=omp_nest_lock_kind), & - & intent(inout) :: lockvar - end subroutine omp_destroy_nest_lock - - subroutine omp_set_nest_lock(lockvar) & - & bind(c, name='omp_set_nest_lock_') - import - integer (kind=omp_nest_lock_kind), & - & intent(inout) :: lockvar - end subroutine omp_set_nest_lock - - subroutine omp_unset_nest_lock(lockvar) & - & bind(c, name='omp_unset_nest_lock_') - import - integer (kind=omp_nest_lock_kind), & - & intent(inout) :: lockvar - end subroutine omp_unset_nest_lock - - function omp_test_nest_lock(lockvar) & - & bind(c, name='omp_test_nest_lock_') - import - integer (kind=omp_integer_kind) omp_test_nest_lock - integer (kind=omp_nest_lock_kind), & - & intent(inout) :: lockvar - end function omp_test_nest_lock - -! Timing routines - function omp_get_wtime() bind(c) - import - double precision omp_get_wtime - end function omp_get_wtime - - function omp_get_wtick() bind(c) - import - double precision omp_get_wtick - end function omp_get_wtick - - -! Event Routine - subroutine omp_fullfill_event(event) bind(c) - import - integer (kind=omp_event_handle_kind) event - end subroutine omp_fullfill_event - -! Device Memory Routines - -! Memory Management Routines - function omp_init_allocator(memspace, ntraits, traits) - import - integer (kind=omp_memspace_handle_kind), & - & intent(in) :: memspace - integer, intent(in) :: ntraits - type(omp_alloctrait), intent(in) :: traits(*) - integer (kind=omp_allocator_handle_kind) omp_init_allocator - end function omp_init_allocator - - subroutine omp_destroy_allocator(allocator) bind(c) - import - integer (kind=omp_allocator_handle_kind), & - & intent(in) :: allocator - end subroutine omp_destroy_allocator - - subroutine omp_set_default_allocator(allocator) bind(c) - import - integer(kind=omp_allocator_handle_kind), & - & intent(in) :: allocator - end subroutine omp_set_default_allocator - - function omp_get_default_allocator() - import - integer (kind=omp_allocator_handle_kind) & - & omp_get_default_allocator - end function omp_get_default_allocator - - end interface - - end module omp_lib +end module omp_lib diff --git a/flang/module/omp_lib.h b/flang/module/omp_lib.h new file mode 100644 index 0000000..fc1ef02 --- /dev/null +++ b/flang/module/omp_lib.h @@ -0,0 +1,548 @@ +! Copyright (c) 2019, NVIDIA CORPORATION. All rights reserved. +! +! Licensed under the Apache License, Version 2.0 (the "License"); +! you may not use this file except in compliance with the License. +! You may obtain a copy of the License at +! +! http://www.apache.org/licenses/LICENSE-2.0 +! +! Unless required by applicable law or agreed to in writing, software +! distributed under the License is distributed on an "AS IS" BASIS, +! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +! See the License for the specific language governing permissions and +! limitations under the License. + + integer, parameter :: omp_integer_kind = 4 + integer, parameter :: omp_logical_kind = 4 + integer, parameter :: omp_pause_resource_kind = 4 + integer, parameter :: omp_event_handle_kind = 4 + integer, parameter :: omp_lock_kind = int_ptr_kind() + integer, parameter :: omp_nest_lock_kind = int_ptr_kind() + integer, parameter :: omp_sched_kind = & + & omp_integer_kind + integer, parameter :: omp_proc_bind_kind = & + & omp_integer_kind + integer, parameter :: omp_sync_hint_kind = & + & omp_integer_kind + integer, parameter :: omp_depend_kind = & + & omp_integer_kind + integer, parameter :: omp_memspace_handle_kind = 4 + integer, parameter :: omp_allocator_handle_kind = 4 + integer, parameter :: omp_alloctrait_key_kind = 4 + integer, parameter :: omp_alloctrait_val_kind = 4 + + integer(kind=omp_sched_kind), parameter :: & + & omp_sched_static = 1 + integer(kind=omp_sched_kind), parameter :: & + & omp_sched_dynamic = 2 + integer(kind=omp_sched_kind), parameter :: & + & omp_sched_guided = 3 + integer(kind=omp_sched_kind), parameter :: omp_sched_auto = 4 + + integer (kind=omp_proc_bind_kind), parameter :: & + & omp_proc_bind_false = 0 + integer (kind=omp_proc_bind_kind), parameter :: & + & omp_proc_bind_true = 1 + integer (kind=omp_proc_bind_kind), parameter :: & + & omp_proc_bind_master = 2 + integer (kind=omp_proc_bind_kind), parameter :: & + & omp_proc_bind_close = 3 + integer (kind=omp_proc_bind_kind), parameter :: & + & omp_proc_bind_spread = 4 + + integer (kind=omp_pause_resource_kind), parameter :: & + & omp_pause_soft = 1 + integer (kind=omp_pause_resource_kind), parameter :: & + & omp_pause_hard = 2 + + integer, parameter :: omp_lock_hint_kind = omp_sync_hint_kind + integer (kind=omp_sync_hint_kind), parameter :: & + & omp_sync_hint_none = int(Z'0', kind=omp_sync_hint_kind) + integer (kind=omp_lock_hint_kind), parameter :: & + & omp_lock_hint_none = omp_sync_hint_none + integer (kind=omp_sync_hint_kind), parameter :: & + & omp_sync_hint_uncontended = & + & int(Z'1', kind=omp_sync_hint_kind) + integer (kind=omp_lock_hint_kind), parameter :: & + & omp_lock_hint_uncontended = omp_sync_hint_uncontended + integer (kind=omp_sync_hint_kind), parameter :: & + & omp_sync_hint_contended = & + & int(Z'2', kind=omp_sync_hint_kind) + integer (kind=omp_lock_hint_kind), parameter :: & + & omp_lock_hint_contended = omp_sync_hint_contended + integer (kind=omp_sync_hint_kind), parameter :: & + & omp_sync_hint_nonspeculative = & + & int(Z'4', kind=omp_sync_hint_kind) + integer (kind=omp_lock_hint_kind), parameter :: & + & omp_lock_hint_nonspeculative = & + & omp_sync_hint_nonspeculative + integer (kind=omp_sync_hint_kind), parameter :: & + & omp_sync_hint_speculative = & + & int(Z'8', kind=omp_sync_hint_kind) + integer (kind=omp_lock_hint_kind), parameter :: & + & omp_lock_hint_speculative = omp_sync_hint_speculative + + integer (kind=omp_event_handle_kind), parameter :: & + & omp_allow_completion_event = 0 + integer (kind=omp_event_handle_kind), parameter :: & + & omp_task_fulfill_event = 1 + + integer(kind=omp_alloctrait_key_kind), parameter :: & + & omp_atk_sync_hint = 1 + integer(kind=omp_alloctrait_key_kind), parameter :: & + & omp_atk_alignment = 2 + integer(kind=omp_alloctrait_key_kind), parameter :: & + & omp_atk_access = 3 + integer(kind=omp_alloctrait_key_kind), parameter :: & + & omp_atk_pool_size = 4 + integer(kind=omp_alloctrait_key_kind), parameter :: & + & omp_atk_fallback = 5 + integer(kind=omp_alloctrait_key_kind), parameter :: & + & omp_atk_fb_data = 6 + integer(kind=omp_alloctrait_key_kind), parameter :: & + & omp_atk_pinned = 7 + integer(kind=omp_alloctrait_key_kind), parameter :: & + & omp_atk_partition = 8 + + integer(kind=omp_alloctrait_val_kind), parameter :: & + & omp_atv_false = 0 + integer(kind=omp_alloctrait_val_kind), parameter :: & + & omp_atv_true = 1 + integer(kind=omp_alloctrait_val_kind), parameter :: & + & omp_atv_default = 2 + integer(kind=omp_alloctrait_val_kind), parameter :: & + & omp_atv_contended = 3 + integer(kind=omp_alloctrait_val_kind), parameter :: & + & omp_atv_uncontended = 4 + integer(kind=omp_alloctrait_val_kind), parameter :: & + & omp_atv_sequential = 5 + integer(kind=omp_alloctrait_val_kind), parameter :: & + & omp_atv_private = 6 + integer(kind=omp_alloctrait_val_kind), parameter :: & + & omp_atv_all = 7 + integer(kind=omp_alloctrait_val_kind), parameter :: & + & omp_atv_thread = 8 + integer(kind=omp_alloctrait_val_kind), parameter :: & + & omp_atv_pteam = 9 + integer(kind=omp_alloctrait_val_kind), parameter :: & + & omp_atv_cgroup = 10 + integer(kind=omp_alloctrait_val_kind), parameter :: & + & omp_atv_default_mem_fb = 11 + integer(kind=omp_alloctrait_val_kind), parameter :: & + & omp_atv_null_fb = 12 + integer(kind=omp_alloctrait_val_kind), parameter :: & + & omp_atv_abort_fb = 13 + integer(kind=omp_alloctrait_val_kind), parameter :: & + & omp_atv_allocator_fb = 14 + integer(kind=omp_alloctrait_val_kind), parameter :: & + & omp_atv_environment = 15 + integer(kind=omp_alloctrait_val_kind), parameter :: & + & omp_atv_nearest = 16 + integer(kind=omp_alloctrait_val_kind), parameter :: & + & omp_atv_blocked = 17 + integer(kind=omp_alloctrait_val_kind), parameter :: & + & omp_atv_interleaved = 18 + + type omp_alloctrait + integer(kind=omp_alloctrait_key_kind) key + integer(kind=omp_alloctrait_val_kind) value + end type omp_alloctrait + + integer(kind=omp_allocator_handle_kind), parameter :: & + & omp_null_allocator = 0 + + integer (kind=omp_memspace_handle_kind), parameter :: & + & omp_default_mem_space = 0 + integer (kind=omp_memspace_handle_kind), parameter :: & + & omp_large_cap_mem_space = 0 + integer (kind=omp_memspace_handle_kind), parameter :: & + & omp_const_mem_space = 0 + integer (kind=omp_memspace_handle_kind), parameter :: & + & omp_high_bw_mem_space = 0 + integer (kind=omp_memspace_handle_kind), parameter :: & + & omp_low_lat_mem_space = 0 + + integer (kind=omp_memspace_handle_kind), parameter :: & + & omp_default_mem_alloc = 1 + integer (kind=omp_memspace_handle_kind), parameter :: & + & omp_large_cap_mem_alloc = omp_default_mem_alloc + integer (kind=omp_memspace_handle_kind), parameter :: & + & omp_const_mem_alloc = 1 + integer (kind=omp_memspace_handle_kind), parameter :: & + & omp_high_bw_mem_alloc = 1 + integer (kind=omp_memspace_handle_kind), parameter :: & + & omp_low_lat_mem_alloc = 1 + integer (kind=omp_memspace_handle_kind), parameter :: & + & omp_thread_mem_alloc = omp_atv_thread + integer (kind=omp_memspace_handle_kind), parameter :: & + & omp_pteam_mem_alloc = omp_atv_pteam + integer (kind=omp_memspace_handle_kind), parameter :: & + & omp_cgroup_mem_alloc = omp_atv_cgroup + + integer (kind=omp_integer_kind), parameter :: & + & openmp_version = 200805 + + interface + + subroutine omp_set_num_threads(nthreads) bind(c) + import + integer (kind=omp_integer_kind), VALUE :: nthreads + end subroutine omp_set_num_threads + + function omp_get_num_threads() bind(c) + import + integer (kind=omp_integer_kind) omp_get_num_threads + end function omp_get_num_threads + + function omp_get_max_threads() bind(c) + import + integer (kind=omp_integer_kind) omp_get_max_threads + end function omp_get_max_threads + + function omp_get_thread_num() bind(c) + import + integer (kind=omp_integer_kind) omp_get_thread_num + end function omp_get_thread_num + + function omp_get_num_procs() bind(c) + import + integer (kind=omp_integer_kind) omp_get_num_procs + end function omp_get_num_procs + + function omp_in_parallel() bind(c) + import + logical (kind=omp_logical_kind) omp_in_parallel + end function omp_in_parallel + + subroutine omp_set_dynamic(enable) bind(c) + import + logical (kind=omp_logical_kind), VALUE :: enable + end subroutine omp_set_dynamic + + function omp_get_dynamic() bind(c) + import + logical (kind=omp_logical_kind) omp_get_dynamic + end function omp_get_dynamic + + function omp_get_cancelation() bind(c) + import + logical (kind=omp_logical_kind) omp_get_cancelation + end function omp_get_cancelation + + subroutine omp_set_nested(enable) bind(c) + import + logical (kind=omp_logical_kind), VALUE :: enable + end subroutine omp_set_nested + + function omp_get_nested() bind(c) + import + logical (kind=omp_logical_kind) omp_get_nested + end function omp_get_nested + + subroutine omp_set_schedule(kind, modifier) bind(c) + import + integer (kind=omp_integer_kind), VALUE :: kind + integer (kind=omp_integer_kind), VALUE :: modifier + end subroutine omp_set_schedule + + subroutine omp_get_schedule(kind, modifier) bind(c) + import + integer (kind=omp_integer_kind) :: kind + integer (kind=omp_integer_kind) :: modifier + end subroutine omp_get_schedule + + function omp_get_thread_limit() bind(c) + import + integer (kind=omp_integer_kind) omp_get_thread_limit + end function omp_get_thread_limit + + function omp_get_supported_active_levels() bind(c) + import + integer (kind=omp_integer_kind) omp_get_supported_active_levels + end function omp_get_supported_active_levels + + subroutine omp_set_max_active_levels(max_levels) bind(c) + import + integer (kind=omp_integer_kind), VALUE :: max_levels + end subroutine omp_set_max_active_levels + + function omp_get_max_active_levels() bind(c) + import + integer (kind=omp_integer_kind) omp_get_max_active_levels + end function omp_get_max_active_levels + + function omp_get_level() bind(c) + import + integer (kind=omp_integer_kind) omp_get_level + end function omp_get_level + + function omp_get_ancestor_thread_num(level) bind(c) + import + integer (kind=omp_integer_kind) level + integer (kind=omp_integer_kind) omp_get_ancestor_thread_num + end function omp_get_ancestor_thread_num + + function omp_get_team_size(level) bind(c) + import + integer (kind=omp_integer_kind) omp_get_team_size + integer (kind=omp_integer_kind), VALUE :: level + end function omp_get_team_size + + function omp_get_active_level() bind(c) + import + integer (kind=omp_integer_kind) omp_get_active_level + end function omp_get_active_level + + function omp_in_final() bind(c) + import + logical (kind=omp_logical_kind) omp_in_final + end function omp_in_final + + function omp_get_proc_bind() bind(c) + import + integer (kind=omp_proc_bind_kind) omp_get_proc_bind + end function omp_get_proc_bind + + function omp_get_num_places() bind(c) + import + integer (kind=omp_integer_kind) omp_get_num_places + end function omp_get_num_places + + function omp_get_place_num_procs(place_num) bind(c) + import + integer (kind=omp_integer_kind), VALUE :: place_num + integer (kind=omp_integer_kind) omp_get_place_num_procs + end function omp_get_place_num_procs + + subroutine omp_get_place_proc_ids(place_num, ids) bind(c) + import + integer (kind=omp_integer_kind), VALUE :: place_num + integer (kind=omp_integer_kind), intent(out) :: ids(*) + end subroutine omp_get_place_proc_ids + + function omp_get_place_num() bind(c) + import + integer (kind=omp_integer_kind) omp_get_place_num + end function omp_get_place_num + + function omp_get_partition_num_places() bind(c) + import + integer (kind=omp_integer_kind) omp_get_partition_num_places + end function omp_get_partition_num_places + + subroutine omp_get_partition_place_nums(place_nums) bind(c) + import + integer (kind=omp_integer_kind), intent(out) :: place_nums(*) + end subroutine omp_get_partition_place_nums + + subroutine omp_set_affinity_format(format) + import + character(len=*), intent(in) :: format + end subroutine omp_set_affinity_format + + function omp_get_affinity_format(buffer) + import + character(len=*), intent(out) :: buffer + integer (kind=omp_integer_kind) omp_get_affinity_format + end function omp_get_affinity_format + + subroutine omp_display_affinity(format) + import + character(len=*), intent(in) :: format + end subroutine omp_display_affinity + + function omp_capture_affinity(buffer, format) + import + character(len=*), intent(out) :: buffer + character(len=*), intent(in) :: format + integer (kind=omp_integer_kind) omp_capture_affinity + end function omp_capture_affinity + + subroutine omp_set_default_device(device_num) bind(c) + import + integer (kind=omp_integer_kind) device_num + end subroutine omp_set_default_device + + function omp_get_default_device() bind(c) + import + integer (kind=omp_integer_kind) omp_get_default_device + end function omp_get_default_device + + function omp_get_num_devices() bind(c) + import + integer (kind=omp_integer_kind) omp_get_num_devices + end function omp_get_num_devices + + function omp_get_device_num() bind(c) + import + integer (kind=omp_integer_kind) omp_get_device_num + end function omp_get_device_num + + function omp_get_num_teams() bind(c) + import + integer (kind=omp_integer_kind) omp_get_num_teams + end function omp_get_num_teams + + function omp_get_team_num() bind(c) + import + integer (kind=omp_integer_kind) omp_get_team_num + end function omp_get_team_num + + function omp_is_initial_device() bind(c) + import + integer (kind=omp_integer_kind) omp_is_initial_device + end function omp_is_initial_device + + function omp_get_initial_device() bind(c) + import + integer (kind=omp_integer_kind) omp_get_initial_device + end function omp_get_initial_device + + function omp_get_max_task_priority() bind(c) + import + integer (kind=omp_integer_kind) omp_get_max_task_priority + end function omp_get_max_task_priority + + function omp_pause_resource(kind, device_num) bind(c) + import + integer (kind=omp_pause_resource_kind) kind + integer device_num + integer omp_pause_resource + end function omp_pause_resource + + function omp_pause_resource_all(kind) + import + integer (kind=omp_pause_resource_kind) kind + integer omp_pause_resource_all + end function omp_pause_resource_all + +! Lock routines + subroutine omp_init_lock(lockvar) & + & bind(c, name='omp_init_lock_') + import + integer (kind=omp_lock_kind), intent(out) :: lockvar + end subroutine omp_init_lock + + subroutine omp_init_lock_with_hint(lockvar, hint) & + & bind(c, name='omp_init_lock_with_hint_') + import + integer (kind=omp_lock_kind), intent(out) :: lockvar + integer (kind=omp_sync_hint_kind), intent(in) :: hint + end subroutine omp_init_lock_with_hint + + subroutine omp_destroy_lock(lockvar) & + & bind(c, name='omp_destroy_lock_') + import + integer (kind=omp_lock_kind), intent(inout) :: lockvar + end subroutine omp_destroy_lock + + subroutine omp_set_lock(lockvar) & + & bind(c, name='omp_set_lock_') + import + integer (kind=omp_lock_kind), intent(inout) :: lockvar + end subroutine omp_set_lock + + subroutine omp_unset_lock(lockvar) & + & bind(c, name='omp_unset_lock_') + import + integer (kind=omp_lock_kind), intent(inout) :: lockvar + end subroutine omp_unset_lock + + function omp_test_lock(lockvar) & + & bind(c, name='omp_test_lock_') + import + logical (kind=omp_logical_kind) omp_test_lock + integer (kind=omp_lock_kind), intent(inout) :: lockvar + end function omp_test_lock + + subroutine omp_init_nest_lock(lockvar) & + & bind(c, name='omp_init_nest_lock_') + import + integer (kind=omp_nest_lock_kind), intent(out) :: lockvar + end subroutine omp_init_nest_lock + + subroutine omp_init_nest_lock_with_hint(lockvar, hint) & + & bind(c, name='omp_init_nest_lock_with_hint_') + import + integer (kind=omp_lock_kind), intent(out) :: lockvar + integer (kind=omp_sync_hint_kind), intent(in) :: hint + end subroutine omp_init_nest_lock_with_hint + + subroutine omp_destroy_nest_lock(lockvar) & + & bind(c, name='omp_destroy_nest_lock_') + import + integer (kind=omp_nest_lock_kind), & + & intent(inout) :: lockvar + end subroutine omp_destroy_nest_lock + + subroutine omp_set_nest_lock(lockvar) & + & bind(c, name='omp_set_nest_lock_') + import + integer (kind=omp_nest_lock_kind), & + & intent(inout) :: lockvar + end subroutine omp_set_nest_lock + + subroutine omp_unset_nest_lock(lockvar) & + & bind(c, name='omp_unset_nest_lock_') + import + integer (kind=omp_nest_lock_kind), & + & intent(inout) :: lockvar + end subroutine omp_unset_nest_lock + + function omp_test_nest_lock(lockvar) & + & bind(c, name='omp_test_nest_lock_') + import + integer (kind=omp_integer_kind) omp_test_nest_lock + integer (kind=omp_nest_lock_kind), & + & intent(inout) :: lockvar + end function omp_test_nest_lock + +! Timing routines + function omp_get_wtime() bind(c) + import + double precision omp_get_wtime + end function omp_get_wtime + + function omp_get_wtick() bind(c) + import + double precision omp_get_wtick + end function omp_get_wtick + + +! Event Routine + subroutine omp_fullfill_event(event) bind(c) + import + integer (kind=omp_event_handle_kind) event + end subroutine omp_fullfill_event + +! Device Memory Routines + +! Memory Management Routines + function omp_init_allocator(memspace, ntraits, traits) + import + integer (kind=omp_memspace_handle_kind), & + & intent(in) :: memspace + integer, intent(in) :: ntraits + type(omp_alloctrait), intent(in) :: traits(*) + integer (kind=omp_allocator_handle_kind) omp_init_allocator + end function omp_init_allocator + + subroutine omp_destroy_allocator(allocator) bind(c) + import + integer (kind=omp_allocator_handle_kind), & + & intent(in) :: allocator + end subroutine omp_destroy_allocator + + subroutine omp_set_default_allocator(allocator) bind(c) + import + integer(kind=omp_allocator_handle_kind), & + & intent(in) :: allocator + end subroutine omp_set_default_allocator + + function omp_get_default_allocator() + import + integer (kind=omp_allocator_handle_kind) & + & omp_get_default_allocator + end function omp_get_default_allocator + + end interface -- 2.7.4