mpi_f08_callbacks.F90 10.1 KB
Newer Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
!   -*- Mode: Fortran; -*-
!
!   (C) 2014 by Argonne National Laboratory.
!   See COPYRIGHT in top-level directory.
!
module mpi_f08_callbacks

! MPI3.0, A.1.3,  p. 678

public :: MPI_COMM_DUP_FN
public :: MPI_COMM_NULL_COPY_FN
public :: MPI_COMM_NULL_DELETE_FN
public :: MPI_TYPE_DUP_FN
public :: MPI_TYPE_NULL_COPY_FN
public :: MPI_TYPE_NULL_DELETE_FN
public :: MPI_WIN_DUP_FN
public :: MPI_WIN_NULL_COPY_FN
public :: MPI_WIN_NULL_DELETE_FN
public :: MPI_CONVERSION_FN_NULL

abstract interface

Junchao Zhang's avatar
Junchao Zhang committed
23
subroutine MPI_User_function(invec, inoutvec, len, datatype)
24
25
26
27
28
29
30
31
32
    use, intrinsic :: iso_c_binding, only : c_ptr
    use mpi_f08_types, only : MPI_Datatype
    implicit none
    type(c_ptr), value :: invec, inoutvec
    integer :: len
    type(MPI_Datatype) :: datatype
end subroutine

subroutine MPI_Comm_copy_attr_function(oldcomm,comm_keyval,extra_state, &
Junchao Zhang's avatar
Junchao Zhang committed
33
       attribute_val_in,attribute_val_out,flag,ierror)
34
35
36
37
38
39
40
41
42
43
    use mpi_f08_types, only : MPI_Comm
    use mpi_f08_compile_constants, only : MPI_ADDRESS_KIND
    implicit none
    type(MPI_Comm) :: oldcomm
    integer :: comm_keyval, ierror
    integer(kind=MPI_ADDRESS_KIND) :: extra_state, attribute_val_in, attribute_val_out
    logical :: flag
end subroutine

subroutine MPI_Comm_delete_attr_function(comm,comm_keyval, &
Junchao Zhang's avatar
Junchao Zhang committed
44
       attribute_val, extra_state, ierror)
45
46
47
48
49
50
51
52
53
    use mpi_f08_types, only : MPI_Comm
    use mpi_f08_compile_constants, only : MPI_ADDRESS_KIND
    implicit none
    type(MPI_Comm) :: comm
    integer :: comm_keyval, ierror
    integer(kind=MPI_ADDRESS_KIND) :: attribute_val, extra_state
end subroutine

subroutine MPI_Win_copy_attr_function(oldwin,win_keyval,extra_state, &
Junchao Zhang's avatar
Junchao Zhang committed
54
       attribute_val_in,attribute_val_out,flag,ierror)
55
56
57
58
59
60
61
62
63
64
    use mpi_f08_types, only : MPI_Win
    use mpi_f08_compile_constants, only : MPI_ADDRESS_KIND
    implicit none
    type(MPI_Win) :: oldwin
    integer :: win_keyval, ierror
    integer(kind=MPI_ADDRESS_KIND) :: extra_state, attribute_val_in, attribute_val_out
    logical :: flag
end subroutine

subroutine MPI_Win_delete_attr_function(win,win_keyval,attribute_val, &
Junchao Zhang's avatar
Junchao Zhang committed
65
       extra_state,ierror)
66
67
68
69
70
71
72
73
74
    use mpi_f08_types, only : MPI_Win
    use mpi_f08_compile_constants, only : MPI_ADDRESS_KIND
    implicit none
    type(MPI_Win) :: win
    integer :: win_keyval, ierror
    integer(kind=MPI_ADDRESS_KIND) :: attribute_val, extra_state
end subroutine

subroutine MPI_Type_copy_attr_function(oldtype,type_keyval,extra_state, &
Junchao Zhang's avatar
Junchao Zhang committed
75
       attribute_val_in,attribute_val_out,flag,ierror)
76
77
78
79
80
81
82
83
84
85
    use mpi_f08_types, only : MPI_Datatype
    use mpi_f08_compile_constants, only : MPI_ADDRESS_KIND
    implicit none
    type(MPI_Datatype) :: oldtype
    integer :: type_keyval, ierror
    integer(kind=MPI_ADDRESS_KIND) :: extra_state, attribute_val_in, attribute_val_out
    logical :: flag
end subroutine

subroutine MPI_Type_delete_attr_function(datatype,type_keyval, &
Junchao Zhang's avatar
Junchao Zhang committed
86
       attribute_val,extra_state,ierror)
87
88
89
90
91
92
93
94
    use mpi_f08_types, only : MPI_Datatype
    use mpi_f08_compile_constants, only : MPI_ADDRESS_KIND
    implicit none
    type(MPI_Datatype) :: datatype
    integer :: type_keyval, ierror
    integer(kind=MPI_ADDRESS_KIND) :: attribute_val, extra_state
end subroutine

Junchao Zhang's avatar
Junchao Zhang committed
95
subroutine MPI_Comm_errhandler_function(comm,error_code)
96
97
98
99
100
101
102
    use mpi_f08_types, only : MPI_Comm
    use mpi_f08_compile_constants, only : MPI_ADDRESS_KIND
    implicit none
    type(MPI_Comm) :: comm
    integer :: error_code
end subroutine

Junchao Zhang's avatar
Junchao Zhang committed
103
subroutine MPI_Win_errhandler_function(win, error_code)
104
105
106
107
108
109
110
    use mpi_f08_types, only : MPI_Win
    use mpi_f08_compile_constants, only : MPI_ADDRESS_KIND
    implicit none
    type(MPI_Win) :: win
    integer :: error_code
end subroutine

Junchao Zhang's avatar
Junchao Zhang committed
111
subroutine MPI_File_errhandler_function(file, error_code)
112
113
114
115
116
117
118
    use mpi_f08_types, only : MPI_File
    use mpi_f08_compile_constants, only : MPI_ADDRESS_KIND
    implicit none
    type(MPI_File) :: file
    integer :: error_code
end subroutine

Junchao Zhang's avatar
Junchao Zhang committed
119
subroutine MPI_Grequest_query_function(extra_state,status,ierror)
120
121
122
123
124
125
126
127
    use mpi_f08_types, only : MPI_Status
    use mpi_f08_compile_constants, only : MPI_ADDRESS_KIND
    implicit none
    type(MPI_Status) :: status
    integer :: ierror
    integer(kind=MPI_ADDRESS_KIND) :: extra_state
end subroutine

Junchao Zhang's avatar
Junchao Zhang committed
128
subroutine MPI_Grequest_free_function(extra_state,ierror)
129
130
131
132
133
134
    use mpi_f08_compile_constants, only : MPI_ADDRESS_KIND
    implicit none
    integer :: ierror
    integer(kind=MPI_ADDRESS_KIND) :: extra_state
end subroutine

Junchao Zhang's avatar
Junchao Zhang committed
135
subroutine MPI_Grequest_cancel_function(extra_state,complete,ierror)
136
137
138
139
140
141
142
    use mpi_f08_compile_constants, only : MPI_ADDRESS_KIND
    implicit none
    integer(kind=MPI_ADDRESS_KIND) :: extra_state
    logical :: complete
    integer :: ierror
end subroutine

Junchao Zhang's avatar
Junchao Zhang committed
143
subroutine MPI_Datarep_extent_function(datatype, extent, extra_state, ierror)
144
145
146
147
148
149
150
151
152
    use mpi_f08_types, only : MPI_Datatype
    use mpi_f08_compile_constants, only : MPI_ADDRESS_KIND
    implicit none
    type(MPI_Datatype) :: datatype
    integer :: ierror
    integer(kind=MPI_ADDRESS_KIND) :: extent, extra_state
end subroutine

subroutine MPI_Datarep_conversion_function(userbuf, datatype, count, &
Junchao Zhang's avatar
Junchao Zhang committed
153
       filebuf, position, extra_state, ierror)
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
    use, intrinsic :: iso_c_binding, only : c_ptr
    use mpi_f08_types, only : MPI_Datatype
    use mpi_f08_compile_constants, only : MPI_OFFSET_KIND, MPI_ADDRESS_KIND
    implicit none
    type(c_ptr), value :: userbuf, filebuf
    type(MPI_Datatype) :: datatype
    integer :: count, ierror
    integer(kind=MPI_OFFSET_KIND) :: position
    integer(kind=MPI_ADDRESS_KIND) :: extra_state
end subroutine

end interface

contains

! See p.269, MPI 3.0
subroutine MPI_COMM_DUP_FN(oldcomm,comm_keyval,extra_state, &
       attribute_val_in,attribute_val_out,flag,ierror)
    use mpi_f08_types, only : MPI_Comm
    use mpi_f08_compile_constants, only : MPI_ADDRESS_KIND, MPI_SUCCESS
    implicit none
    type(MPI_Comm) :: oldcomm
    integer :: comm_keyval, ierror
    integer(kind=MPI_ADDRESS_KIND) :: extra_state, attribute_val_in, attribute_val_out
    logical :: flag

    flag = .true.
    attribute_val_out = attribute_val_in
    ierror = MPI_SUCCESS
end subroutine

subroutine MPI_COMM_NULL_COPY_FN(oldcomm,comm_keyval,extra_state, &
       attribute_val_in,attribute_val_out,flag,ierror)
    use mpi_f08_types, only : MPI_Comm
    use mpi_f08_compile_constants, only : MPI_ADDRESS_KIND, MPI_SUCCESS
    implicit none
    type(MPI_Comm) :: oldcomm
    integer :: comm_keyval, ierror
    integer(kind=MPI_ADDRESS_KIND) :: extra_state, attribute_val_in, attribute_val_out
    logical :: flag

    flag = .false.
    ierror = MPI_SUCCESS
end subroutine

subroutine MPI_COMM_NULL_DELETE_FN(comm,comm_keyval, &
       attribute_val, extra_state, ierror)
    use mpi_f08_types, only : MPI_Comm
    use mpi_f08_compile_constants, only : MPI_ADDRESS_KIND, MPI_SUCCESS
    implicit none
    type(MPI_Comm) :: comm
    integer :: comm_keyval, ierror
    integer(kind=MPI_ADDRESS_KIND) :: attribute_val, extra_state

    ierror = MPI_SUCCESS
end subroutine

subroutine MPI_TYPE_DUP_FN(oldtype,type_keyval,extra_state, &
       attribute_val_in,attribute_val_out,flag,ierror)
    use mpi_f08_types, only : MPI_Datatype
    use mpi_f08_compile_constants, only : MPI_ADDRESS_KIND, MPI_SUCCESS
    implicit none
    type(MPI_Datatype) :: oldtype
    integer :: type_keyval, ierror
    integer(kind=MPI_ADDRESS_KIND) :: extra_state, attribute_val_in, attribute_val_out
    logical :: flag

    flag = .true.
    attribute_val_out = attribute_val_in
    ierror = MPI_SUCCESS
end subroutine

subroutine MPI_TYPE_NULL_COPY_FN(oldtype,type_keyval,extra_state, &
       attribute_val_in,attribute_val_out,flag,ierror)
    use mpi_f08_types, only : MPI_Datatype
    use mpi_f08_compile_constants, only : MPI_ADDRESS_KIND, MPI_SUCCESS
    implicit none
    type(MPI_Datatype) :: oldtype
    integer :: type_keyval, ierror
    integer(kind=MPI_ADDRESS_KIND) :: extra_state, attribute_val_in, attribute_val_out
    logical :: flag

    flag = .false.
    ierror = MPI_SUCCESS
end subroutine

240
subroutine MPI_TYPE_NULL_DELETE_FN(datatype,type_keyval, &
241
242
243
244
       attribute_val, extra_state, ierror)
    use mpi_f08_types, only : MPI_Datatype
    use mpi_f08_compile_constants, only : MPI_ADDRESS_KIND, MPI_SUCCESS
    implicit none
245
    type(MPI_Datatype) :: datatype
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
    integer :: type_keyval, ierror
    integer(kind=MPI_ADDRESS_KIND) :: attribute_val, extra_state

    ierror = MPI_SUCCESS
end subroutine

subroutine MPI_WIN_DUP_FN(oldwin,win_keyval,extra_state, &
       attribute_val_in,attribute_val_out,flag,ierror)
    use mpi_f08_types, only : MPI_Win
    use mpi_f08_compile_constants, only : MPI_ADDRESS_KIND, MPI_SUCCESS
    implicit none
    type(MPI_Win) :: oldwin
    integer :: win_keyval, ierror
    integer(kind=MPI_ADDRESS_KIND) :: extra_state, attribute_val_in, attribute_val_out
    logical :: flag

    flag = .true.
    attribute_val_out = attribute_val_in
    ierror = MPI_SUCCESS
end subroutine

subroutine MPI_WIN_NULL_COPY_FN(oldwin,win_keyval,extra_state, &
       attribute_val_in,attribute_val_out,flag,ierror)
    use mpi_f08_types, only : MPI_Win
    use mpi_f08_compile_constants, only : MPI_ADDRESS_KIND, MPI_SUCCESS
    implicit none
    type(MPI_Win) :: oldwin
    integer :: win_keyval, ierror
    integer(kind=MPI_ADDRESS_KIND) :: extra_state, attribute_val_in, attribute_val_out
    logical :: flag

    flag = .false.
    ierror = MPI_SUCCESS
end subroutine

subroutine MPI_WIN_NULL_DELETE_FN(win,win_keyval, &
       attribute_val, extra_state, ierror)
    use mpi_f08_types, only : MPI_Win
    use mpi_f08_compile_constants, only : MPI_ADDRESS_KIND, MPI_SUCCESS
    implicit none
    type(MPI_Win) :: win
    integer :: win_keyval, ierror
    integer(kind=MPI_ADDRESS_KIND) :: attribute_val, extra_state

    ierror = MPI_SUCCESS
end subroutine

subroutine MPI_CONVERSION_FN_NULL(userbuf, datatype, count, &
Junchao Zhang's avatar
Junchao Zhang committed
294
       filebuf, position, extra_state, ierror)
295
296
297
298
299
300
301
302
303
304
305
306
307
    use, intrinsic :: iso_c_binding, only : c_ptr
    use mpi_f08_types, only : MPI_Datatype
    use mpi_f08_compile_constants, only : MPI_OFFSET_KIND, MPI_ADDRESS_KIND
    implicit none
    type(c_ptr), value :: userbuf, filebuf
    type(MPI_Datatype) :: datatype
    integer :: count, ierror
    integer(kind=MPI_OFFSET_KIND) :: position
    integer(kind=MPI_ADDRESS_KIND) :: extra_state
    ! Do nothing
end subroutine

end module mpi_f08_callbacks