1!
2!    Copyright (c) 2014 Intel Corporation.  All Rights Reserved.
3!
4!    Redistribution and use in source and binary forms, with or without
5!    modification, are permitted provided that the following conditions
6!    are met:
7!
8!      * Redistributions of source code must retain the above copyright
9!        notice, this list of conditions and the following disclaimer.
10!      * Redistributions in binary form must reproduce the above copyright
11!        notice, this list of conditions and the following disclaimer in the
12!        documentation and/or other materials provided with the distribution.
13!      * Neither the name of Intel Corporation nor the names of its
14!        contributors may be used to endorse or promote products derived
15!        from this software without specific prior written permission.
16!
17!    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
18!    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
19!    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
20!    A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
21!    HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
22!    SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
23!    LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
24!    DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
25!    THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
26!    (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
27!    OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
28!
29
30
31! **********************************************************************************
32! * This file is intended to support the Intel(r) Many Integrated Core Architecture.
33! **********************************************************************************
34! free form Fortran source - should be named .f90
35! lines are longer than 72 characters
36
37module mic_lib
38use, intrinsic :: iso_c_binding
39
40integer, parameter:: target_mic=2
41integer, parameter:: default_target_type=target_mic
42integer, parameter:: default_target_number=0
43
44enum, bind(C)
45    enumerator :: OFFLOAD_SUCCESS  = 0
46    enumerator :: OFFLOAD_DISABLED          ! offload is disabled
47    enumerator :: OFFLOAD_UNAVAILABLE       ! card is not available
48    enumerator :: OFFLOAD_OUT_OF_MEMORY     ! not enough memory on device
49    enumerator :: OFFLOAD_PROCESS_DIED      ! target process has died
50    enumerator :: OFFLOAD_ERROR             ! unspecified error
51end enum
52
53type, bind (C) :: offload_status
54    integer(kind=c_int)    ::  result          = OFFLOAD_DISABLED
55    integer(kind=c_int)    ::  device_number   = -1
56    integer(kind=c_size_t) ::  data_sent       = 0
57    integer(kind=c_size_t) ::  data_received   = 0
58end type offload_status
59
60interface
61function offload_number_of_devices ()                                  &
62           bind (C, name = "_Offload_number_of_devices")
63!dec$ attributes default :: offload_number_of_devices
64  import :: c_int
65  integer (kind=c_int)        :: offload_number_of_devices
66!dec$ attributes offload:mic :: offload_number_of_devices
67!dir$ attributes known_intrinsic ::  offload_number_of_devices
68end function offload_number_of_devices
69
70function offload_signaled(target_number, signal)                       &
71           bind (C, name = "_Offload_signaled")
72!dec$ attributes default :: offload_signaled
73  import :: c_int, c_int64_t
74  integer (kind=c_int) :: offload_signaled
75  integer (kind=c_int), value :: target_number
76  integer (kind=c_int64_t), value :: signal
77!dec$ attributes offload:mic :: offload_signaled
78end function offload_signaled
79
80subroutine offload_report(val)                                         &
81           bind (C, name = "_Offload_report")
82!dec$ attributes default :: offload_report
83  import :: c_int
84  integer (kind=c_int), value :: val
85!dec$ attributes offload:mic :: offload_report
86end subroutine offload_report
87
88function offload_get_device_number()                                   &
89           bind (C, name = "_Offload_get_device_number")
90!dec$ attributes default :: offload_get_device_number
91  import :: c_int
92  integer (kind=c_int)        :: offload_get_device_number
93!dec$ attributes offload:mic :: offload_get_device_number
94end function offload_get_device_number
95
96function offload_get_physical_device_number()                          &
97           bind (C, name = "_Offload_get_physical_device_number")
98!dec$ attributes default :: offload_get_physical_device_number
99  import :: c_int
100  integer (kind=c_int)        :: offload_get_physical_device_number
101!dec$ attributes offload:mic :: offload_get_physical_device_number
102end function offload_get_physical_device_number
103
104! OpenMP API wrappers
105
106subroutine omp_set_num_threads_target (target_type,                    &
107                                       target_number,                  &
108                                       num_threads)                    &
109           bind (C, name = "omp_set_num_threads_target")
110  import :: c_int
111  integer (kind=c_int), value :: target_type, target_number, num_threads
112end subroutine omp_set_num_threads_target
113
114function omp_get_max_threads_target (target_type,                      &
115                                     target_number)                    &
116         bind (C, name = "omp_get_max_threads_target")
117  import :: c_int
118  integer (kind=c_int)        :: omp_get_max_threads_target
119  integer (kind=c_int), value :: target_type, target_number
120end function omp_get_max_threads_target
121
122function omp_get_num_procs_target (target_type,                        &
123                                   target_number)                      &
124         bind (C, name = "omp_get_num_procs_target")
125  import :: c_int
126  integer (kind=c_int)        :: omp_get_num_procs_target
127  integer (kind=c_int), value :: target_type, target_number
128end function omp_get_num_procs_target
129
130subroutine omp_set_dynamic_target (target_type,                        &
131                                   target_number,                      &
132                                   num_threads)                        &
133           bind (C, name = "omp_set_dynamic_target")
134  import :: c_int
135  integer (kind=c_int), value :: target_type, target_number, num_threads
136end subroutine omp_set_dynamic_target
137
138function omp_get_dynamic_target (target_type,                          &
139                                 target_number)                        &
140         bind (C, name = "omp_get_dynamic_target")
141  import :: c_int
142  integer (kind=c_int)        :: omp_get_dynamic_target
143  integer (kind=c_int), value :: target_type, target_number
144end function omp_get_dynamic_target
145
146subroutine omp_set_nested_target (target_type,                         &
147                                  target_number,                       &
148                                  nested)                              &
149           bind (C, name = "omp_set_nested_target")
150  import :: c_int
151  integer (kind=c_int), value :: target_type, target_number, nested
152end subroutine omp_set_nested_target
153
154function omp_get_nested_target (target_type,                           &
155                                target_number)                         &
156         bind (C, name = "omp_get_nested_target")
157  import :: c_int
158  integer (kind=c_int)        :: omp_get_nested_target
159  integer (kind=c_int), value :: target_type, target_number
160end function omp_get_nested_target
161
162subroutine omp_set_schedule_target (target_type,                       &
163                                    target_number,                     &
164                                    kind,                              &
165                                    modifier)                          &
166           bind (C, name = "omp_set_schedule_target")
167  import :: c_int
168  integer (kind=c_int), value :: target_type, target_number, kind, modifier
169end subroutine omp_set_schedule_target
170
171subroutine omp_get_schedule_target (target_type,                       &
172                                    target_number,                     &
173                                    kind,                              &
174                                    modifier)                          &
175           bind (C, name = "omp_get_schedule_target")
176  import :: c_int, c_intptr_t
177  integer (kind=c_int), value :: target_type, target_number
178  integer (kind=c_intptr_t), value :: kind, modifier
179end subroutine omp_get_schedule_target
180
181! lock API functions
182
183subroutine omp_init_lock_target (target_type,                          &
184                                 target_number,                        &
185                                 lock)                                 &
186           bind (C, name = "omp_init_lock_target")
187  import :: c_int, c_intptr_t
188  !dir$ attributes known_intrinsic ::  omp_init_lock_target
189  integer (kind=c_int), value :: target_type, target_number
190  integer (kind=c_intptr_t), value :: lock
191end subroutine omp_init_lock_target
192
193subroutine omp_destroy_lock_target (target_type,                       &
194                                    target_number,                     &
195                                    lock)                              &
196           bind (C, name = "omp_destroy_lock_target")
197  import :: c_int, c_intptr_t
198  !dir$ attributes known_intrinsic ::  omp_destroy_lock_target
199  integer (kind=c_int), value :: target_type, target_number
200  integer (kind=c_intptr_t), value :: lock
201end subroutine omp_destroy_lock_target
202
203subroutine omp_set_lock_target (target_type,                           &
204                                target_number,                         &
205                                lock)                                  &
206           bind (C, name = "omp_set_lock_target")
207  import :: c_int, c_intptr_t
208  !dir$ attributes known_intrinsic ::  omp_set_lock_target
209  integer (kind=c_int), value :: target_type, target_number
210  integer (kind=c_intptr_t), value :: lock
211end subroutine omp_set_lock_target
212
213subroutine omp_unset_lock_target (target_type,                         &
214                                  target_number,                       &
215                                  lock)                                &
216           bind (C, name = "omp_unset_lock_target")
217  import :: c_int, c_intptr_t
218  !dir$ attributes known_intrinsic ::  omp_unset_lock_target
219  integer (kind=c_int), value :: target_type, target_number
220  integer (kind=c_intptr_t), value :: lock
221end subroutine omp_unset_lock_target
222
223function omp_test_lock_target (target_type,                            &
224                               target_number,                          &
225                               lock)                                   &
226           bind (C, name = "omp_test_lock_target")
227  import :: c_int, c_intptr_t
228  integer (kind=c_int)        :: omp_test_lock_target
229  integer (kind=c_int), value :: target_type, target_number
230  integer (kind=c_intptr_t), value :: lock
231end function omp_test_lock_target
232
233! nested lock API functions
234
235subroutine omp_init_nest_lock_target (target_type,                     &
236                                      target_number,                   &
237                                      lock)                            &
238           bind (C, name = "omp_init_nest_lock_target")
239  import :: c_int, c_intptr_t
240  integer (kind=c_int), value :: target_type, target_number
241  integer (kind=c_intptr_t), value :: lock
242end subroutine omp_init_nest_lock_target
243
244subroutine omp_destroy_nest_lock_target (target_type,                  &
245                                         target_number,                &
246                                         lock)                         &
247           bind (C, name = "omp_destroy_nest_lock_target")
248  import :: c_int, c_intptr_t
249  integer (kind=c_int), value :: target_type, target_number
250  integer (kind=c_intptr_t), value :: lock
251end subroutine omp_destroy_nest_lock_target
252
253subroutine omp_set_nest_lock_target (target_type,                      &
254                                     target_number,                    &
255                                     lock)                             &
256           bind (C, name = "omp_set_nest_lock_target")
257  import :: c_int, c_intptr_t
258  integer (kind=c_int), value :: target_type, target_number
259  integer (kind=c_intptr_t), value :: lock
260end subroutine omp_set_nest_lock_target
261
262subroutine omp_unset_nest_lock_target (target_type,                    &
263                                       target_number,                  &
264                                       lock)                           &
265           bind (C, name = "omp_unset_nest_lock_target")
266  import :: c_int, c_intptr_t
267  integer (kind=c_int), value :: target_type, target_number
268  integer (kind=c_intptr_t), value :: lock
269end subroutine omp_unset_nest_lock_target
270
271function omp_test_nest_lock_target (target_type,                       &
272                                    target_number,                     &
273                                    lock)                              &
274           bind (C, name = "omp_test_nest_lock_target")
275  import :: c_int, c_intptr_t
276  integer (kind=c_int)        :: omp_test_nest_lock_target
277  integer (kind=c_int), value :: target_type, target_number
278  integer (kind=c_intptr_t), value :: lock
279end function omp_test_nest_lock_target
280
281end interface
282end module mic_lib
283