File: mpi-f08-interfaces-callbacks.F90

package info (click to toggle)
openmpi 5.0.7-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 202,312 kB
  • sloc: ansic: 612,441; makefile: 42,495; sh: 11,230; javascript: 9,244; f90: 7,052; java: 6,404; perl: 5,154; python: 1,856; lex: 740; fortran: 61; cpp: 20; tcl: 12
file content (225 lines) | stat: -rw-r--r-- 6,982 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
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
! -*- f90 -*-
! Copyright (c) 2009-2013 Cisco Systems, Inc.  All rights reserved.
! Copyright (c) 2009-2012 Los Alamos National Security, LLC.
!                         All rights reserved.
! Copyright (c) 2015-2018 Research Organization for Information Science
!                         and Technology (RIST).  All rights reserved.
! $COPYRIGHT$

#include "ompi/mpi/fortran/configure-fortran-output.h"

module mpi_f08_interfaces_callbacks

OMPI_ABSTRACT INTERFACE
  SUBROUTINE MPI_User_function(invec, inoutvec, len, datatype)
    USE mpi_f08_types
    USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR
    IMPLICIT NONE
    TYPE(C_PTR), VALUE :: invec, inoutvec
    INTEGER :: len
    TYPE(MPI_Datatype) :: datatype
  END SUBROUTINE
END INTERFACE

!Example of a user defined callback function
!
!  subroutine my_user_function( invec, inoutvec, len, datatype )   bind(c)
!    use, intrinsic :: iso_c_binding, only : c_ptr, c_f_pointer
!    type(c_ptr), value :: invec, inoutvec
!    integer, intent(in) :: len
!    type(MPI_Datatype) :: datatype
!    real, pointer :: invec_r(:), inoutvec_r(:)
!    if (datatype%MPI_VAL == MPI_REAL%MPI_VAL) then
!       call c_f_pointer(invec, invec_r, (/ len /) )
!       call c_f_pointer(inoutvec, inoutvec_r, (/ len /) )
!       inoutvec_r = invec_r + inoutvec_r
!    end if
!  end subroutine my_function
!
! The MPI library may internally store such callbacks in a global array
! All_MPI_Ops:
!
!  type, private :: Internal_MPI_op
!    procedure(user_function), nopass, pointer :: user_fn
!  end type
!  type(Internal_MPI_op), private :: All_MPI_Ops(Max_Operations)
!
! Within MPI_Op_create, the user_fn is stored in All_MPI_Ops:
!
!  subroutine MPI_Op_create( user_fn, commute, op )   bind(C)
!    procedure(user_function) :: user_fn
!    type(MPI_Op), intent(out) :: op
!    ...
!    Registered_Operations = Registered_Operations + 1
!    op%MPI_VAL = Registered_Operations
!    All_MPI_Ops(Registered_Operations)%user_fn => user_fn
!
! Within MPI_Reduce, the stored user_fn is used to, e.g., to combine
! recvbuf = sendbuf+recvbuf
!
!  subroutine MPI_Reduce( sendbuf, recvbuf, count, datatype, op )   bind(C)
!    use, intrinsic :: iso_c_binding, only : c_loc
!    ...
!    call All_MPI_Ops(op%MPI_VAL)%user_fn(c_loc(sendbuf), c_loc(recvbuf), count, datatype)
!


OMPI_ABSTRACT INTERFACE
SUBROUTINE MPI_Comm_copy_attr_function(oldcomm,comm_keyval,extra_state, &
                                       attribute_val_in,attribute_val_out,flag,ierror)
   USE mpi_f08_types
   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
END INTERFACE

OMPI_ABSTRACT INTERFACE
SUBROUTINE MPI_Comm_delete_attr_function(comm,comm_keyval, &
                                         attribute_val, extra_state, ierror)
   USE mpi_f08_types
   IMPLICIT NONE
   TYPE(MPI_Comm) :: comm
   INTEGER :: comm_keyval, ierror
   INTEGER(KIND=MPI_ADDRESS_KIND) :: attribute_val, extra_state
END SUBROUTINE
END INTERFACE

OMPI_ABSTRACT INTERFACE
SUBROUTINE MPI_Win_copy_attr_function(oldwin,win_keyval,extra_state, &
                                      attribute_val_in,attribute_val_out,flag,ierror)
   USE mpi_f08_types
   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
END INTERFACE

OMPI_ABSTRACT INTERFACE
SUBROUTINE MPI_Win_delete_attr_function(win,win_keyval,attribute_val, &
                                        extra_state,ierror)
   USE mpi_f08_types
   IMPLICIT NONE
   TYPE(MPI_Win) :: win
   INTEGER :: win_keyval, ierror
   INTEGER(KIND=MPI_ADDRESS_KIND) :: attribute_val, extra_state
END SUBROUTINE
END INTERFACE

OMPI_ABSTRACT INTERFACE
SUBROUTINE MPI_Type_copy_attr_function(oldtype,type_keyval,extra_state, &
                                       attribute_val_in,attribute_val_out,flag,ierror)
   USE mpi_f08_types
   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
END INTERFACE

OMPI_ABSTRACT INTERFACE
SUBROUTINE MPI_Type_delete_attr_function(datatype,type_keyval, &
                                         attribute_val,extra_state,ierror)
   USE mpi_f08_types
   IMPLICIT NONE
   TYPE(MPI_Datatype) :: datatype
   INTEGER :: type_keyval, ierror
   INTEGER(KIND=MPI_ADDRESS_KIND) :: attribute_val, extra_state
END SUBROUTINE
END INTERFACE

OMPI_ABSTRACT INTERFACE
SUBROUTINE MPI_Comm_errhandler_function(comm,error_code)
   USE mpi_f08_types
   IMPLICIT NONE
   TYPE(MPI_Comm) :: comm
   INTEGER :: error_code
END SUBROUTINE
END INTERFACE

OMPI_ABSTRACT INTERFACE
SUBROUTINE MPI_Win_errhandler_function(win, error_code)
   USE mpi_f08_types
   IMPLICIT NONE
   TYPE(MPI_Win) :: win
   INTEGER :: error_code
END SUBROUTINE
END INTERFACE

OMPI_ABSTRACT INTERFACE
SUBROUTINE MPI_File_errhandler_function(file, error_code)
   USE mpi_f08_types
   IMPLICIT NONE
   TYPE(MPI_File) :: file
   INTEGER :: error_code
END SUBROUTINE
END INTERFACE

OMPI_ABSTRACT INTERFACE
SUBROUTINE MPI_Session_errhandler_function(session,error_code)
   USE mpi_f08_types
   IMPLICIT NONE
   TYPE(MPI_Session) :: session
   INTEGER :: error_code
END SUBROUTINE
END INTERFACE

OMPI_ABSTRACT INTERFACE
SUBROUTINE MPI_Grequest_query_function(extra_state,status,ierror)
   USE mpi_f08_types
   IMPLICIT NONE
   TYPE(MPI_Status) :: status
   INTEGER :: ierror
   INTEGER(KIND=MPI_ADDRESS_KIND) :: extra_state
END SUBROUTINE
END INTERFACE

OMPI_ABSTRACT INTERFACE
SUBROUTINE MPI_Grequest_free_function(extra_state,ierror)
   USE mpi_f08_types
   IMPLICIT NONE
   INTEGER :: ierror
   INTEGER(KIND=MPI_ADDRESS_KIND) :: extra_state
END SUBROUTINE
END INTERFACE

OMPI_ABSTRACT INTERFACE
SUBROUTINE MPI_Grequest_cancel_function(extra_state,complete,ierror)
   USE mpi_f08_types
   IMPLICIT NONE
   INTEGER(KIND=MPI_ADDRESS_KIND) :: extra_state
   LOGICAL :: complete
   INTEGER :: ierror
END SUBROUTINE
END INTERFACE

OMPI_ABSTRACT INTERFACE
SUBROUTINE MPI_Datarep_extent_function(datatype, extent, extra_state, ierror)
   USE mpi_f08_types
   IMPLICIT NONE
   TYPE(MPI_Datatype) :: datatype
   INTEGER :: ierror
   INTEGER(KIND=MPI_ADDRESS_KIND) :: extent, extra_state
END SUBROUTINE
END INTERFACE

OMPI_ABSTRACT INTERFACE
SUBROUTINE MPI_Datarep_conversion_function(userbuf, datatype, count, &
                                           filebuf, position, extra_state, ierror)
   USE mpi_f08_types
   USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_PTR
   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

end module mpi_f08_interfaces_callbacks