AdjoinableMPI
 All Classes Files Functions Variables Typedefs Enumerations Enumerator Macros Groups Pages
ampi_f2c.c
Go to the documentation of this file.
1 /*
2 ##########################################################
3 # This file is part of the AdjoinableMPI library #
4 # released under the MIT License. #
5 # The full COPYRIGHT notice can be found in the top #
6 # level directory of the AdjoinableMPI distribution. #
7 ##########################################################
8 */
9 
10 #include <stdlib.h>
11 #include <mpi.h>
12 
13 #include "ampi/userIF/activity.h"
14 #include "ampi/userIF/pairedWith.h"
15 #include "ampi/userIF/request.h"
16 #include "ampi/userIF/nt.h"
17 #include "ampi/adTool/support.h"
18 #include "ampi/libCommon/modified.h"
19 #include "ampi/ampi.h"
20 
21 AMPI_PairedWith pairedWithTable[] =
22  {AMPI_TO_RECV, AMPI_FROM_SEND, AMPI_TO_IRECV_WAIT, AMPI_TO_IRECV_WAITALL,
23  AMPI_FROM_ISEND_WAIT, AMPI_FROM_ISEND_WAITALL, AMPI_FROM_BSEND, AMPI_FROM_RSEND} ;
24 
25 MPI_Fint ampi_adouble_precision_;
26 MPI_Fint ampi_areal_;
27 
28 void ampi_init_nt_(int* err_code) {
29  *err_code = AMPI_Init_NT(0, 0);
30 }
31 
32 void ampi_finalize_nt_(int* err_code) {
33  *err_code = AMPI_Finalize_NT();}
34 
35 void ampi_comm_rank_(MPI_Fint *commF, int *rank, int* err_code) {
36  MPI_Comm commC = MPI_Comm_f2c( *commF ) ;
37  *err_code = MPI_Comm_rank(commC, rank);
38 }
39 
40 void adtool_ampi_turn_(double *v, double *vb) {
41  ADTOOL_AMPI_Turn(v, vb) ;
42 }
43 
44 void fw_ampi_recv_(void* buf,
45  int *count,
46  MPI_Fint *datatypeF,
47  int *src,
48  int *tag,
49  int *pairedWithF,
50  int *commF,
51  int *status,
52  int *err_code) {
53  MPI_Datatype datatype = MPI_Type_f2c(*datatypeF) ;
54  AMPI_PairedWith pairedWith = pairedWithTable[*pairedWithF] ;
55  MPI_Comm commC = MPI_Comm_f2c( *commF ) ;
56  *err_code = FW_AMPI_Recv(buf, *count, datatype,
57  *src, *tag, pairedWith, commC,
58  (MPI_Status*)status);
59 }
60 
61 void bw_ampi_recv_(void* buf,
62  int *count,
63  MPI_Fint *datatypeF,
64  int* src,
65  int* tag,
66  int* pairedWithF,
67  int* commF,
68  int* status,
69  int* err_code) {
70  MPI_Datatype datatype = MPI_Type_f2c(*datatypeF) ;
71  AMPI_PairedWith pairedWith = pairedWithTable[*pairedWithF] ;
72  MPI_Comm commC = MPI_Comm_f2c( *commF ) ;
73  *err_code = BW_AMPI_Recv(buf, *count, datatype,
74  *src, *tag, pairedWith, commC,
75  (MPI_Status*)status);
76 }
77 
78 void tls_ampi_recv_(void* buf, void* shadowbuf,
79  int *count,
80  MPI_Fint *datatypeF, MPI_Fint *shadowdatatypeF,
81  int* src,
82  int* tag,
83  int* pairedWithF,
84  int* commF,
85  int* status,
86  int* err_code) {
87  MPI_Datatype datatype = MPI_Type_f2c(*datatypeF) ;
88  MPI_Datatype shadowdatatype = MPI_Type_f2c(*shadowdatatypeF) ;
89  AMPI_PairedWith pairedWith = pairedWithTable[*pairedWithF] ;
90  MPI_Comm commC = MPI_Comm_f2c( *commF ) ;
91  *err_code = TLS_AMPI_Recv(buf, shadowbuf, *count, datatype, shadowdatatype,
92  *src, *tag, pairedWith, commC,
93  (MPI_Status*)status);
94 }
95 
96 void fw_ampi_irecv_(void* buf,
97  int *count,
98  MPI_Fint *datatypeF,
99  int *source,
100  int *tag,
101  int *pairedWithF,
102  int *commF,
103  MPI_Fint *requestF,
104  int *err_code){
105  MPI_Datatype datatype = MPI_Type_f2c(*datatypeF) ;
106  MPI_Request request = MPI_Request_f2c(*requestF);
107  AMPI_PairedWith pairedWith = pairedWithTable[*pairedWithF] ;
108  MPI_Comm commC = MPI_Comm_f2c( *commF ) ;
109  *err_code = FW_AMPI_Irecv(buf, *count, datatype,
110  *source, *tag, pairedWith, commC, &request);
111  *requestF = MPI_Request_c2f(request);
112 }
113 
114 void bw_ampi_irecv_(void* buf,
115  int *count,
116  MPI_Fint *datatypeF,
117  int *source,
118  int *tag,
119  int *pairedWithF,
120  int *commF,
121  MPI_Fint *requestF,
122  int *err_code) {
123  MPI_Datatype datatype = MPI_Type_f2c(*datatypeF) ;
124  MPI_Request request = MPI_Request_f2c(*requestF);
125  AMPI_PairedWith pairedWith = pairedWithTable[*pairedWithF] ;
126  MPI_Comm commC = MPI_Comm_f2c( *commF ) ;
127  *err_code = BW_AMPI_Irecv(buf, *count, datatype,
128  *source, *tag, pairedWith, commC, &request);
129 }
130 
131 void tls_ampi_irecv_(void* buf, void* shadowbuf,
132  int *count,
133  MPI_Fint *datatypeF, MPI_Fint *shadowdatatypeF,
134  int *source,
135  int *tag,
136  int *pairedWithF,
137  int *commF,
138  MPI_Fint *requestF,
139  int *err_code) {
140  MPI_Datatype datatype = MPI_Type_f2c(*datatypeF) ;
141  MPI_Request request = MPI_Request_f2c(*requestF);
142  MPI_Datatype shadowdatatype = MPI_Type_f2c(*shadowdatatypeF) ;
143  AMPI_PairedWith pairedWith = pairedWithTable[*pairedWithF] ;
144  MPI_Comm commC = MPI_Comm_f2c( *commF ) ;
145  *err_code = TLS_AMPI_Irecv(buf, shadowbuf, *count, datatype, shadowdatatype,
146  *source, *tag, pairedWith, commC, &request);
147  *requestF = MPI_Request_c2f(request);
148 }
149 
150 void fw_ampi_send_(void* buf,
151  int *count,
152  MPI_Fint *datatypeF,
153  int *dest,
154  int *tag,
155  int *pairedWithF,
156  int *commF,
157  int *err_code) {
158  MPI_Datatype datatype = MPI_Type_f2c(*datatypeF) ;
159  AMPI_PairedWith pairedWith = pairedWithTable[*pairedWithF] ;
160  MPI_Comm commC = MPI_Comm_f2c( *commF ) ;
161  *err_code = FW_AMPI_Send (buf, *count, datatype,
162  *dest, *tag, pairedWith, commC);
163 }
164 
165 void bw_ampi_send_(void* buf,
166  int *count,
167  MPI_Fint *datatypeF,
168  int *dest,
169  int *tag,
170  int *pairedWithF,
171  int *commF,
172  int *err_code) {
173  MPI_Datatype datatype = MPI_Type_f2c(*datatypeF) ;
174  AMPI_PairedWith pairedWith = pairedWithTable[*pairedWithF] ;
175  MPI_Comm commC = MPI_Comm_f2c( *commF ) ;
176  *err_code = BW_AMPI_Send (buf, *count, datatype,
177  *dest, *tag, pairedWith, commC);
178 }
179 
180 void tls_ampi_send_(void* buf, void* shadowbuf,
181  int *count,
182  MPI_Fint *datatypeF, MPI_Fint *shadowdatatypeF,
183  int *dest,
184  int *tag,
185  int *pairedWithF,
186  int *commF,
187  int *err_code) {
188  MPI_Datatype datatype = MPI_Type_f2c(*datatypeF) ;
189  MPI_Datatype shadowdatatype = MPI_Type_f2c(*shadowdatatypeF) ;
190  AMPI_PairedWith pairedWith = pairedWithTable[*pairedWithF] ;
191  MPI_Comm commC = MPI_Comm_f2c( *commF ) ;
192  *err_code = TLS_AMPI_Send (buf, shadowbuf, *count, datatype, shadowdatatype,
193  *dest, *tag, pairedWith, commC);
194 }
195 
196 void fw_ampi_isend_(void* buf,
197  int *count,
198  MPI_Fint *datatypeF,
199  int *dest,
200  int *tag,
201  int *pairedWithF,
202  int *commF,
203  MPI_Fint *requestF,
204  int *err_code) {
205  MPI_Datatype datatype = MPI_Type_f2c(*datatypeF) ;
206  MPI_Request request = MPI_Request_f2c(*requestF);
207  AMPI_PairedWith pairedWith = pairedWithTable[*pairedWithF] ;
208  MPI_Comm commC = MPI_Comm_f2c( *commF ) ;
209  *err_code = FW_AMPI_Isend(buf, *count, datatype,
210  *dest, *tag, pairedWith, commC, &request);
211  *requestF = MPI_Request_c2f(request);
212 }
213 
214 void bw_ampi_isend_(void* buf,
215  int *count,
216  MPI_Fint *datatypeF,
217  int *dest,
218  int *tag,
219  int *pairedWithF,
220  int *commF,
221  MPI_Fint *requestF,
222  int *err_code) {
223  MPI_Datatype datatype = MPI_Type_f2c(*datatypeF) ;
224  MPI_Request request = MPI_Request_f2c(*requestF);
225  AMPI_PairedWith pairedWith = pairedWithTable[*pairedWithF] ;
226  MPI_Comm commC = MPI_Comm_f2c( *commF ) ;
227  *err_code = BW_AMPI_Isend(buf, *count, datatype,
228  *dest, *tag, pairedWith, commC, &request);
229 }
230 
231 void tls_ampi_isend_(void* buf, void* shadowbuf,
232  int *count,
233  MPI_Fint *datatypeF, MPI_Fint *shadowdatatypeF,
234  int *dest,
235  int *tag,
236  int *pairedWithF,
237  int *commF,
238  MPI_Fint *requestF,
239  int *err_code) {
240  MPI_Datatype datatype = MPI_Type_f2c(*datatypeF) ;
241  MPI_Request request = MPI_Request_f2c(*requestF);
242  MPI_Datatype shadowdatatype = MPI_Type_f2c(*shadowdatatypeF) ;
243  AMPI_PairedWith pairedWith = pairedWithTable[*pairedWithF] ;
244  MPI_Comm commC = MPI_Comm_f2c( *commF ) ;
245  *err_code = TLS_AMPI_Isend(buf, shadowbuf, *count, datatype, shadowdatatype,
246  *dest, *tag, pairedWith, commC, &request);
247  *requestF = MPI_Request_c2f(request);
248 }
249 
250 void fw_ampi_wait_(MPI_Fint *requestF, MPI_Fint *statusF, int* err_code) {
251  MPI_Request request = MPI_Request_f2c( *requestF );
252  if( statusF == MPI_F_STATUS_IGNORE ) {
253  *err_code = FW_AMPI_Wait( &request, MPI_STATUS_IGNORE );
254  } else if( statusF == MPI_F_STATUSES_IGNORE ) {
255  *err_code = FW_AMPI_Wait( &request, MPI_STATUSES_IGNORE );
256  } else {
257  MPI_Status status;
258  MPI_Status_f2c( statusF, &status );
259  *err_code = FW_AMPI_Wait( &request, &status );
260  MPI_Status_c2f( &status, statusF ) ;
261  }
262 }
263 
264 void bw_ampi_wait_(MPI_Fint *requestF, MPI_Fint *statusF, int* err_code) {
265  MPI_Request request = MPI_Request_f2c( *requestF );
266  *err_code = BW_AMPI_Wait( &request, MPI_STATUS_IGNORE );
267  *requestF = MPI_Request_c2f(request);
268 }
269 
270 void tls_ampi_wait_(MPI_Fint *requestF, MPI_Fint *statusF, int* err_code) {
271  MPI_Request request = MPI_Request_f2c( *requestF );
272  if( statusF == MPI_F_STATUS_IGNORE ) {
273  *err_code = TLS_AMPI_Wait( &request, MPI_STATUS_IGNORE );
274  }
275  else if( statusF == MPI_F_STATUSES_IGNORE ) {
276  *err_code = TLS_AMPI_Wait( &request, MPI_STATUSES_IGNORE );
277  }
278  else {
279  MPI_Status status;
280  MPI_Status_f2c( statusF, &status );
281  *err_code = TLS_AMPI_Wait( &request, &status );
282  MPI_Status_c2f( &status, statusF ) ;
283  }
284 }
285 
286 void fw_ampi_barrier_(int *commF, int* err_code) {
287  MPI_Comm commC = MPI_Comm_f2c( *commF ) ;
288  *err_code = FW_AMPI_Barrier(commC) ;
289 }
290 
291 void bw_ampi_barrier_(int *commF, int* err_code) {
292  MPI_Comm commC = MPI_Comm_f2c( *commF ) ;
293  *err_code = BW_AMPI_Barrier(commC) ;
294 }
295 
296 void tls_ampi_barrier_(int *commF, int* err_code) {
297  MPI_Comm commC = MPI_Comm_f2c( *commF ) ;
298  *err_code = TLS_AMPI_Barrier(commC) ;
299 }
300 
301 void fws_ampi_reduce_(void* sbuf, void* rbuf,
302  int *count,
303  MPI_Fint *datatypeF,
304  MPI_Fint *opF,
305  int *root,
306  int *commF,
307  int *err_code) {
308  MPI_Datatype datatype = MPI_Type_f2c(*datatypeF) ;
309  MPI_Op op = MPI_Op_f2c(*opF) ;
310  MPI_Comm commC = MPI_Comm_f2c( *commF ) ;
311  *err_code = FWS_AMPI_Reduce(sbuf, rbuf, *count, datatype,
312  op, *root, commC) ;
313 }
314 
315 void bws_ampi_reduce_(void* sbuf, void* sbufb,
316  void* rbuf, void* rbufb,
317  int *count,
318  MPI_Fint *datatypeF, MPI_Fint *datatypebF,
319  MPI_Fint *opF, void* uopbF,
320  int *root,
321  int *commF,
322  int *err_code) {
323  MPI_Datatype datatype = MPI_Type_f2c(*datatypeF) ;
324  MPI_Datatype datatypeb = MPI_Type_f2c(*datatypebF) ;
325  MPI_Op op = MPI_Op_f2c(*opF) ;
326  TLM_userFunctionF* uopb = 0 /*???(uopbF)*/ ;
327  MPI_Comm commC = MPI_Comm_f2c( *commF ) ;
328  *err_code = BWS_AMPI_Reduce(sbuf, sbufb,
329  rbuf, rbufb,
330  *count,
331  datatype, datatypeb,
332  op, uopb,
333  *root, commC) ;
334 }
335 
336 void tls_ampi_reduce_(void* sbuf, void* shadowsbuf,
337  void* rbuf, void* shadowrbuf,
338  int *count,
339  MPI_Fint *datatypeF, MPI_Fint *shadowdatatypeF,
340  MPI_Fint *opF, void* uopdF,
341  int *root,
342  int *commF,
343  int *err_code) {
344  MPI_Datatype datatype = MPI_Type_f2c(*datatypeF) ;
345  MPI_Datatype shadowdatatype = MPI_Type_f2c(*shadowdatatypeF) ;
346  MPI_Op op = MPI_Op_f2c(*opF) ;
347  TLM_userFunctionF* uopd = 0 /*???(uopdF)*/ ;
348  MPI_Comm commC = MPI_Comm_f2c( *commF ) ;
349  *err_code = TLS_AMPI_Reduce(sbuf, shadowsbuf,
350  rbuf, shadowrbuf,
351  *count,
352  datatype, shadowdatatype,
353  op, uopd,
354  *root, commC) ;
355 }