1 /*
2 * Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
3 * Copyright (C) 2011-2011 - DIGITEO - Sylvestre LEDRU
4 *
5 * Copyright (C) 2012 - 2016 - Scilab Enterprises
6 *
7 * This file is hereby licensed under the terms of the GNU GPL v2.0,
8 * pursuant to article 5.3.4 of the CeCILL v.2.1.
9 * This file was originally licensed under the terms of the CeCILL v2.1,
10 * and continues to be available under such terms.
11 * For more information, see the COPYING file which you should have received
12 * along with this program.
13 *
14 */
15 #include <stdio.h>
16 #include <mpi.h>
17 #include "api_scilab.h"
18 #include "gw_mpi.h"
19 #include "sci_mpi.h"
20 #include "Scierror.h"
21 #include "localization.h"
22 #include "sci_malloc.h"
23 #include "deserialization.h"
24 #include "getOptionalComm.h"
25
sci_mpi_irecv(char * fname,void * pvApiCtx)26 int sci_mpi_irecv(char *fname, void* pvApiCtx)
27 {
28 SciErr sciErr;
29 int iRet = 0;
30 int *piBuffer = NULL;
31 int iBufferSize = 0;
32
33 int *piAddr1 = NULL;
34 int *piAddr2 = NULL;
35 int *piAddr3 = NULL;
36 double Tag = 0;
37 double Rank = 0;
38 int iRequestID = 0;
39 double dblRequestID = 0;
40 MPI_Status status;
41 MPI_Comm comm = NULL;
42
43 CheckInputArgument(pvApiCtx, 3, 4);
44 CheckOutputArgument(pvApiCtx, 0, 1);
45
46 // if no optional "comm" is given, return MPI_COMM_WORLD
47 comm = getOptionalComm(pvApiCtx);
48 if (comm == NULL)
49 {
50 Scierror(999, _("%s: Wrong type for input argument #%s: An MPI communicator expected.\n"), fname, "comm");
51 return 0;
52 }
53
54 if (comm == MPI_COMM_NULL)
55 {
56 AssignOutputVariable(pvApiCtx, 1) = 0;
57 ReturnArguments(pvApiCtx);
58 return 0;
59 }
60
61 //Rank
62 sciErr = getVarAddressFromPosition(pvApiCtx, 1, &piAddr1);
63 if (sciErr.iErr)
64 {
65 printError(&sciErr, 0);
66 Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 1);
67 return 0;
68 }
69
70 if (getScalarDouble(pvApiCtx, piAddr1, &Rank))
71 {
72 Scierror(999, _("%s: Wrong type for input argument #%d: A scalar integer value expected.\n"), fname, 1);
73 return 0;
74 }
75
76 //Tag
77 sciErr = getVarAddressFromPosition(pvApiCtx, 2, &piAddr2);
78 if (sciErr.iErr)
79 {
80 printError(&sciErr, 0);
81 Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 2);
82 return 0;
83 }
84
85 if (getScalarDouble(pvApiCtx, piAddr2, &Tag))
86 {
87 Scierror(999, _("%s: Wrong type for input argument #%d: A scalar integer value expected.\n"), fname, 2);
88 return 0;
89 }
90
91
92 // Request
93 sciErr = getVarAddressFromPosition(pvApiCtx, 3, &piAddr3);
94 if (sciErr.iErr)
95 {
96 printError(&sciErr, 0);
97 Scierror(999, _("%s: Can not read input argument #%d.\n"), fname, 3);
98 return 0;
99 }
100
101 if (getScalarDouble(pvApiCtx, piAddr3, &dblRequestID))
102 {
103 Scierror(999, _("%s: Wrong type for input argument #%d: A scalar integer value expected.\n"), fname, 3);
104 return 0;
105 }
106
107 iRequestID = (int)dblRequestID;
108 if (iRequestID < 0)
109 {
110 Scierror(999, _("%s: Wrong values for input argument #%d: Positive value expected.\n"), fname, 3);
111 return 0;
112 }
113
114 iRet = MPI_Probe((int)Rank, (int)Tag, comm, &status);
115 if (iRet != MPI_SUCCESS)
116 {
117 char error_string[MPI_MAX_ERROR_STRING];
118 int length_of_error_string;
119 MPI_Error_string(iRet, error_string, &length_of_error_string);
120 Scierror(999, _("%s: MPI_Probe failed. Rank %d / Tag %d: %s\n"), fname, Rank, Tag, error_string);
121 return 0;
122 }
123
124 iRet = MPI_Get_count(&status, MPI_INT, &iBufferSize);
125 if (iRet != MPI_SUCCESS)
126 {
127 char error_string[MPI_MAX_ERROR_STRING];
128 int length_of_error_string;
129 MPI_Error_string(iRet, error_string, &length_of_error_string);
130 Scierror(999, _("%s: MPI_Get_count failed. Rank %d / Tag %d: %s\n"), fname, Rank, Tag, error_string);
131 return 0;
132 }
133
134 piBuffer = (int *)MALLOC(sizeof(int) * iBufferSize);
135 if (piBuffer == NULL)
136 {
137 Scierror(999, "%s: Could not create the received variable.\n", fname);
138 return 0;
139 }
140
141 iRet = MPI_Irecv(piBuffer, iBufferSize, MPI_INT, (int)Rank, (int)Tag, comm, &request[iRequestID]);
142 if (iRet != MPI_SUCCESS)
143 {
144 char error_string[MPI_MAX_ERROR_STRING];
145 int length_of_error_string;
146 MPI_Error_string(iRet, error_string, &length_of_error_string);
147 Scierror(999, _("%s: MPI_Irecv failed. Rank %d / Tag %d: %s\n"), fname, Rank, Tag, error_string);
148 return 0;
149 }
150
151 /* Store the pointer piBuffer */
152 listRequestPointer[iRequestID] = piBuffer;
153 listRequestPointerSize[iRequestID] = iBufferSize;
154
155 AssignOutputVariable(pvApiCtx, 1) = 0;
156 ReturnArguments(pvApiCtx);
157 return 0;
158 }
159
160