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/userIF/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 #ifdef AMPI_FORTRANCOMPATIBLE
30  MPI_Fint adouble;
31  MPI_Fint areal;
32 #endif
33  *err_code = AMPI_Init_NT(0, 0);
34 #ifdef AMPI_FORTRANCOMPATIBLE
35  adtool_ampi_fortransetuptypes_(&adouble, &areal);
36  AMPI_ADOUBLE_PRECISION=MPI_Type_f2c(adouble);
37  AMPI_AREAL=MPI_Type_f2c(areal);
38 #endif
39 }
40 
41 void ampi_finalize_nt_(int* err_code) {
42  *err_code = AMPI_Finalize_NT();
43 }
44 
45 void ampi_comm_rank_(MPI_Fint *commF, int *rank, int* err_code) {
46  MPI_Comm commC = MPI_Comm_f2c( *commF ) ;
47  *err_code = MPI_Comm_rank(commC, rank);
48 }
49 
50 void ampi_recv_(void* buf,
51  int *count,
52  MPI_Fint *datatypeF,
53  int *src,
54  int *tag,
55  int *pairedWithF,
56  int *commF,
57  int *status,
58  int *err_code) {
59  MPI_Datatype datatype = MPI_Type_f2c(*datatypeF) ;
60  AMPI_PairedWith pairedWith = pairedWithTable[*pairedWithF] ;
61  MPI_Comm commC = MPI_Comm_f2c( *commF ) ;
62  *err_code = AMPI_Recv(buf, *count, datatype,
63  *src, *tag, pairedWith, commC,
64  (MPI_Status*)status);
65 }
66 
67 void ampi_send_(void* buf,
68  int *count,
69  MPI_Fint *datatypeF,
70  int *dest,
71  int *tag,
72  int *pairedWithF,
73  int *commF,
74  int *err_code) {
75  MPI_Datatype datatype = MPI_Type_f2c(*datatypeF) ;
76  AMPI_PairedWith pairedWith = pairedWithTable[*pairedWithF] ;
77  MPI_Comm commC = MPI_Comm_f2c(*commF) ;
78  *err_code = AMPI_Send(buf, *count, datatype,
79  *dest, *tag, pairedWith, commC);
80 }
81 
82 void ampi_irecv_(void* buf,
83  int *count,
84  MPI_Fint *datatypeF,
85  int *source,
86  int *tag,
87  int *pairedWithF,
88  int *commF,
89  MPI_Fint *requestF,
90  int *err_code){
91  MPI_Datatype datatype = MPI_Type_f2c(*datatypeF) ;
92  MPI_Request request = MPI_Request_f2c(*requestF);
93  AMPI_PairedWith pairedWith = pairedWithTable[*pairedWithF] ;
94  MPI_Comm commC = MPI_Comm_f2c( *commF ) ;
95  *err_code = AMPI_Irecv(buf, *count, datatype,
96  *source, *tag, pairedWith, commC,
97  &request);
98  *requestF = MPI_Request_c2f(request);
99 }
100 
101 void ampi_isend_(void* buf,
102  int *count,
103  MPI_Fint *datatypeF,
104  int *dest,
105  int *tag,
106  int *pairedWithF,
107  int *commF,
108  MPI_Fint *requestF,
109  int *err_code) {
110  MPI_Datatype datatype = MPI_Type_f2c(*datatypeF) ;
111  MPI_Request request = MPI_Request_f2c(*requestF);
112  AMPI_PairedWith pairedWith = pairedWithTable[*pairedWithF] ;
113  MPI_Comm commC = MPI_Comm_f2c( *commF ) ;
114  *err_code = AMPI_Isend(buf, *count, datatype,
115  *dest, *tag, pairedWith, commC,
116  &request);
117  *requestF = MPI_Request_c2f(request);
118 }
119 
120 void ampi_wait_( MPI_Fint *requestF, MPI_Fint *statusF, int* err_code) {
121  MPI_Request request;
122  request = MPI_Request_f2c( *requestF );
123  if( statusF == MPI_F_STATUS_IGNORE ) {
124  *err_code = AMPI_Wait( &request, MPI_STATUS_IGNORE );
125  }
126  else if( statusF == MPI_F_STATUSES_IGNORE ) {
127  *err_code = AMPI_Wait( &request, MPI_STATUSES_IGNORE );
128  }
129  else {
130  MPI_Status status;
131  MPI_Status_f2c( statusF, &status );
132  *err_code = AMPI_Wait( &request, &status );
133  MPI_Status_c2f( &status, statusF ) ;
134  }
135 }
136