mirror of
https://github.com/autc04/Retro68.git
synced 2024-11-30 19:53:46 +00:00
283 lines
13 KiB
Fortran
283 lines
13 KiB
Fortran
|
!
|
||
|
|
! Copyright (c) 2014 Intel Corporation. All Rights Reserved.
|
||
|
|
!
|
||
|
|
! Redistribution and use in source and binary forms, with or without
|
||
|
|
! modification, are permitted provided that the following conditions
|
||
|
|
! are met:
|
||
|
|
!
|
||
|
|
! * Redistributions of source code must retain the above copyright
|
||
|
|
! notice, this list of conditions and the following disclaimer.
|
||
|
|
! * Redistributions in binary form must reproduce the above copyright
|
||
|
|
! notice, this list of conditions and the following disclaimer in the
|
||
|
|
! documentation and/or other materials provided with the distribution.
|
||
|
|
! * Neither the name of Intel Corporation nor the names of its
|
||
|
|
! contributors may be used to endorse or promote products derived
|
||
|
|
! from this software without specific prior written permission.
|
||
|
|
!
|
||
|
|
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||
|
|
! "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
|
||
|
|
! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
|
||
|
|
! A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
|
||
|
|
! HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
|
||
|
|
! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
|
||
|
|
! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
|
||
|
|
! DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
|
||
|
|
! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
|
||
|
|
! (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
||
|
|
! OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||
|
|
!
|
||
|
|
|
||
|
|
|
||
|
|
! **********************************************************************************
|
||
|
|
! * This file is intended to support the Intel(r) Many Integrated Core Architecture.
|
||
|
|
! **********************************************************************************
|
||
|
|
! free form Fortran source - should be named .f90
|
||
|
|
! lines are longer than 72 characters
|
||
|
|
|
||
|
|
module mic_lib
|
||
|
|
use, intrinsic :: iso_c_binding
|
||
|
|
|
||
|
|
integer, parameter:: target_mic=2
|
||
|
|
integer, parameter:: default_target_type=target_mic
|
||
|
|
integer, parameter:: default_target_number=0
|
||
|
|
|
||
|
|
enum, bind(C)
|
||
|
|
enumerator :: OFFLOAD_SUCCESS = 0
|
||
|
|
enumerator :: OFFLOAD_DISABLED ! offload is disabled
|
||
|
|
enumerator :: OFFLOAD_UNAVAILABLE ! card is not available
|
||
|
|
enumerator :: OFFLOAD_OUT_OF_MEMORY ! not enough memory on device
|
||
|
|
enumerator :: OFFLOAD_PROCESS_DIED ! target process has died
|
||
|
|
enumerator :: OFFLOAD_ERROR ! unspecified error
|
||
|
|
end enum
|
||
|
|
|
||
|
|
type, bind (C) :: offload_status
|
||
|
|
integer(kind=c_int) :: result = OFFLOAD_DISABLED
|
||
|
|
integer(kind=c_int) :: device_number = -1
|
||
|
|
integer(kind=c_size_t) :: data_sent = 0
|
||
|
|
integer(kind=c_size_t) :: data_received = 0
|
||
|
|
end type offload_status
|
||
|
|
|
||
|
|
interface
|
||
|
|
function offload_number_of_devices () &
|
||
|
|
bind (C, name = "_Offload_number_of_devices")
|
||
|
|
!dec$ attributes default :: offload_number_of_devices
|
||
|
|
import :: c_int
|
||
|
|
integer (kind=c_int) :: offload_number_of_devices
|
||
|
|
!dec$ attributes offload:mic :: offload_number_of_devices
|
||
|
|
!dir$ attributes known_intrinsic :: offload_number_of_devices
|
||
|
|
end function offload_number_of_devices
|
||
|
|
|
||
|
|
function offload_signaled(target_number, signal) &
|
||
|
|
bind (C, name = "_Offload_signaled")
|
||
|
|
!dec$ attributes default :: offload_signaled
|
||
|
|
import :: c_int, c_int64_t
|
||
|
|
integer (kind=c_int) :: offload_signaled
|
||
|
|
integer (kind=c_int), value :: target_number
|
||
|
|
integer (kind=c_int64_t), value :: signal
|
||
|
|
!dec$ attributes offload:mic :: offload_signaled
|
||
|
|
end function offload_signaled
|
||
|
|
|
||
|
|
subroutine offload_report(val) &
|
||
|
|
bind (C, name = "_Offload_report")
|
||
|
|
!dec$ attributes default :: offload_report
|
||
|
|
import :: c_int
|
||
|
|
integer (kind=c_int), value :: val
|
||
|
|
!dec$ attributes offload:mic :: offload_report
|
||
|
|
end subroutine offload_report
|
||
|
|
|
||
|
|
function offload_get_device_number() &
|
||
|
|
bind (C, name = "_Offload_get_device_number")
|
||
|
|
!dec$ attributes default :: offload_get_device_number
|
||
|
|
import :: c_int
|
||
|
|
integer (kind=c_int) :: offload_get_device_number
|
||
|
|
!dec$ attributes offload:mic :: offload_get_device_number
|
||
|
|
end function offload_get_device_number
|
||
|
|
|
||
|
|
function offload_get_physical_device_number() &
|
||
|
|
bind (C, name = "_Offload_get_physical_device_number")
|
||
|
|
!dec$ attributes default :: offload_get_physical_device_number
|
||
|
|
import :: c_int
|
||
|
|
integer (kind=c_int) :: offload_get_physical_device_number
|
||
|
|
!dec$ attributes offload:mic :: offload_get_physical_device_number
|
||
|
|
end function offload_get_physical_device_number
|
||
|
|
|
||
|
|
! OpenMP API wrappers
|
||
|
|
|
||
|
|
subroutine omp_set_num_threads_target (target_type, &
|
||
|
|
target_number, &
|
||
|
|
num_threads) &
|
||
|
|
bind (C, name = "omp_set_num_threads_target")
|
||
|
|
import :: c_int
|
||
|
|
integer (kind=c_int), value :: target_type, target_number, num_threads
|
||
|
|
end subroutine omp_set_num_threads_target
|
||
|
|
|
||
|
|
function omp_get_max_threads_target (target_type, &
|
||
|
|
target_number) &
|
||
|
|
bind (C, name = "omp_get_max_threads_target")
|
||
|
|
import :: c_int
|
||
|
|
integer (kind=c_int) :: omp_get_max_threads_target
|
||
|
|
integer (kind=c_int), value :: target_type, target_number
|
||
|
|
end function omp_get_max_threads_target
|
||
|
|
|
||
|
|
function omp_get_num_procs_target (target_type, &
|
||
|
|
target_number) &
|
||
|
|
bind (C, name = "omp_get_num_procs_target")
|
||
|
|
import :: c_int
|
||
|
|
integer (kind=c_int) :: omp_get_num_procs_target
|
||
|
|
integer (kind=c_int), value :: target_type, target_number
|
||
|
|
end function omp_get_num_procs_target
|
||
|
|
|
||
|
|
subroutine omp_set_dynamic_target (target_type, &
|
||
|
|
target_number, &
|
||
|
|
num_threads) &
|
||
|
|
bind (C, name = "omp_set_dynamic_target")
|
||
|
|
import :: c_int
|
||
|
|
integer (kind=c_int), value :: target_type, target_number, num_threads
|
||
|
|
end subroutine omp_set_dynamic_target
|
||
|
|
|
||
|
|
function omp_get_dynamic_target (target_type, &
|
||
|
|
target_number) &
|
||
|
|
bind (C, name = "omp_get_dynamic_target")
|
||
|
|
import :: c_int
|
||
|
|
integer (kind=c_int) :: omp_get_dynamic_target
|
||
|
|
integer (kind=c_int), value :: target_type, target_number
|
||
|
|
end function omp_get_dynamic_target
|
||
|
|
|
||
|
|
subroutine omp_set_nested_target (target_type, &
|
||
|
|
target_number, &
|
||
|
|
nested) &
|
||
|
|
bind (C, name = "omp_set_nested_target")
|
||
|
|
import :: c_int
|
||
|
|
integer (kind=c_int), value :: target_type, target_number, nested
|
||
|
|
end subroutine omp_set_nested_target
|
||
|
|
|
||
|
|
function omp_get_nested_target (target_type, &
|
||
|
|
target_number) &
|
||
|
|
bind (C, name = "omp_get_nested_target")
|
||
|
|
import :: c_int
|
||
|
|
integer (kind=c_int) :: omp_get_nested_target
|
||
|
|
integer (kind=c_int), value :: target_type, target_number
|
||
|
|
end function omp_get_nested_target
|
||
|
|
|
||
|
|
subroutine omp_set_schedule_target (target_type, &
|
||
|
|
target_number, &
|
||
|
|
kind, &
|
||
|
|
modifier) &
|
||
|
|
bind (C, name = "omp_set_schedule_target")
|
||
|
|
import :: c_int
|
||
|
|
integer (kind=c_int), value :: target_type, target_number, kind, modifier
|
||
|
|
end subroutine omp_set_schedule_target
|
||
|
|
|
||
|
|
subroutine omp_get_schedule_target (target_type, &
|
||
|
|
target_number, &
|
||
|
|
kind, &
|
||
|
|
modifier) &
|
||
|
|
bind (C, name = "omp_get_schedule_target")
|
||
|
|
import :: c_int, c_intptr_t
|
||
|
|
integer (kind=c_int), value :: target_type, target_number
|
||
|
|
integer (kind=c_intptr_t), value :: kind, modifier
|
||
|
|
end subroutine omp_get_schedule_target
|
||
|
|
|
||
|
|
! lock API functions
|
||
|
|
|
||
|
|
subroutine omp_init_lock_target (target_type, &
|
||
|
|
target_number, &
|
||
|
|
lock) &
|
||
|
|
bind (C, name = "omp_init_lock_target")
|
||
|
|
import :: c_int, c_intptr_t
|
||
|
|
!dir$ attributes known_intrinsic :: omp_init_lock_target
|
||
|
|
integer (kind=c_int), value :: target_type, target_number
|
||
|
|
integer (kind=c_intptr_t), value :: lock
|
||
|
|
end subroutine omp_init_lock_target
|
||
|
|
|
||
|
|
subroutine omp_destroy_lock_target (target_type, &
|
||
|
|
target_number, &
|
||
|
|
lock) &
|
||
|
|
bind (C, name = "omp_destroy_lock_target")
|
||
|
|
import :: c_int, c_intptr_t
|
||
|
|
!dir$ attributes known_intrinsic :: omp_destroy_lock_target
|
||
|
|
integer (kind=c_int), value :: target_type, target_number
|
||
|
|
integer (kind=c_intptr_t), value :: lock
|
||
|
|
end subroutine omp_destroy_lock_target
|
||
|
|
|
||
|
|
subroutine omp_set_lock_target (target_type, &
|
||
|
|
target_number, &
|
||
|
|
lock) &
|
||
|
|
bind (C, name = "omp_set_lock_target")
|
||
|
|
import :: c_int, c_intptr_t
|
||
|
|
!dir$ attributes known_intrinsic :: omp_set_lock_target
|
||
|
|
integer (kind=c_int), value :: target_type, target_number
|
||
|
|
integer (kind=c_intptr_t), value :: lock
|
||
|
|
end subroutine omp_set_lock_target
|
||
|
|
|
||
|
|
subroutine omp_unset_lock_target (target_type, &
|
||
|
|
target_number, &
|
||
|
|
lock) &
|
||
|
|
bind (C, name = "omp_unset_lock_target")
|
||
|
|
import :: c_int, c_intptr_t
|
||
|
|
!dir$ attributes known_intrinsic :: omp_unset_lock_target
|
||
|
|
integer (kind=c_int), value :: target_type, target_number
|
||
|
|
integer (kind=c_intptr_t), value :: lock
|
||
|
|
end subroutine omp_unset_lock_target
|
||
|
|
|
||
|
|
function omp_test_lock_target (target_type, &
|
||
|
|
target_number, &
|
||
|
|
lock) &
|
||
|
|
bind (C, name = "omp_test_lock_target")
|
||
|
|
import :: c_int, c_intptr_t
|
||
|
|
integer (kind=c_int) :: omp_test_lock_target
|
||
|
|
integer (kind=c_int), value :: target_type, target_number
|
||
|
|
integer (kind=c_intptr_t), value :: lock
|
||
|
|
end function omp_test_lock_target
|
||
|
|
|
||
|
|
! nested lock API functions
|
||
|
|
|
||
|
|
subroutine omp_init_nest_lock_target (target_type, &
|
||
|
|
target_number, &
|
||
|
|
lock) &
|
||
|
|
bind (C, name = "omp_init_nest_lock_target")
|
||
|
|
import :: c_int, c_intptr_t
|
||
|
|
integer (kind=c_int), value :: target_type, target_number
|
||
|
|
integer (kind=c_intptr_t), value :: lock
|
||
|
|
end subroutine omp_init_nest_lock_target
|
||
|
|
|
||
|
|
subroutine omp_destroy_nest_lock_target (target_type, &
|
||
|
|
target_number, &
|
||
|
|
lock) &
|
||
|
|
bind (C, name = "omp_destroy_nest_lock_target")
|
||
|
|
import :: c_int, c_intptr_t
|
||
|
|
integer (kind=c_int), value :: target_type, target_number
|
||
|
|
integer (kind=c_intptr_t), value :: lock
|
||
|
|
end subroutine omp_destroy_nest_lock_target
|
||
|
|
|
||
|
|
subroutine omp_set_nest_lock_target (target_type, &
|
||
|
|
target_number, &
|
||
|
|
lock) &
|
||
|
|
bind (C, name = "omp_set_nest_lock_target")
|
||
|
|
import :: c_int, c_intptr_t
|
||
|
|
integer (kind=c_int), value :: target_type, target_number
|
||
|
|
integer (kind=c_intptr_t), value :: lock
|
||
|
|
end subroutine omp_set_nest_lock_target
|
||
|
|
|
||
|
|
subroutine omp_unset_nest_lock_target (target_type, &
|
||
|
|
target_number, &
|
||
|
|
lock) &
|
||
|
|
bind (C, name = "omp_unset_nest_lock_target")
|
||
|
|
import :: c_int, c_intptr_t
|
||
|
|
integer (kind=c_int), value :: target_type, target_number
|
||
|
|
integer (kind=c_intptr_t), value :: lock
|
||
|
|
end subroutine omp_unset_nest_lock_target
|
||
|
|
|
||
|
|
function omp_test_nest_lock_target (target_type, &
|
||
|
|
target_number, &
|
||
|
|
lock) &
|
||
|
|
bind (C, name = "omp_test_nest_lock_target")
|
||
|
|
import :: c_int, c_intptr_t
|
||
|
|
integer (kind=c_int) :: omp_test_nest_lock_target
|
||
|
|
integer (kind=c_int), value :: target_type, target_number
|
||
|
|
integer (kind=c_intptr_t), value :: lock
|
||
|
|
end function omp_test_nest_lock_target
|
||
|
|
|
||
|
|
end interface
|
||
|
|
end module mic_lib
|