1 |
|
2 |
/* $Id$ */ |
3 |
|
4 |
/******************************************************* |
5 |
* |
6 |
* Copyright 2003-2007 by ACceSS MNRF |
7 |
* Copyright 2007 by University of Queensland |
8 |
* |
9 |
* http://esscc.uq.edu.au |
10 |
* Primary Business: Queensland, Australia |
11 |
* Licensed under the Open Software License version 3.0 |
12 |
* http://www.opensource.org/licenses/osl-3.0.php |
13 |
* |
14 |
*******************************************************/ |
15 |
|
16 |
#include <stdlib.h> |
17 |
#include <stdio.h> |
18 |
#include <string.h> |
19 |
|
20 |
|
21 |
#include "Paso_MPI.h" |
22 |
|
23 |
|
24 |
/* allocate memory for an mpi_comm, and find the communicator details */ |
25 |
Paso_MPIInfo* Paso_MPIInfo_alloc( MPI_Comm comm ) |
26 |
{ |
27 |
#ifdef PASO_MPI |
28 |
int error; |
29 |
#endif |
30 |
|
31 |
Paso_MPIInfo *out=NULL; |
32 |
|
33 |
out = MEMALLOC( 1, Paso_MPIInfo ); |
34 |
|
35 |
out->reference_counter = 0; |
36 |
out->msg_tag_counter = 0; |
37 |
#ifdef PASO_MPI |
38 |
error = MPI_Comm_rank( comm, &out->rank )==MPI_SUCCESS && MPI_Comm_size( comm, &out->size )==MPI_SUCCESS; |
39 |
if( !error ) { |
40 |
Paso_setError( PASO_MPI_ERROR, "Paso_MPIInfo_alloc : error finding comm rank/size" ); |
41 |
} |
42 |
|
43 |
out->comm = comm; |
44 |
#else |
45 |
out->rank=0; |
46 |
out->size=1; |
47 |
out->comm=-1; |
48 |
#endif |
49 |
out->reference_counter++; |
50 |
|
51 |
return out; |
52 |
} |
53 |
|
54 |
/* free memory for an mpi_comm */ |
55 |
void Paso_MPIInfo_free( Paso_MPIInfo *in ) |
56 |
{ |
57 |
if( in && !(--in->reference_counter) ) |
58 |
MEMFREE( in ); |
59 |
} |
60 |
|
61 |
Paso_MPIInfo *Paso_MPIInfo_getReference( Paso_MPIInfo* in ) |
62 |
{ |
63 |
if (in!=NULL) |
64 |
++(in->reference_counter); |
65 |
|
66 |
return in; |
67 |
} |
68 |
/* N = #CPUs, k is a CPU number but out of range or even negative. Return a CPU number in 0...n-1. */ |
69 |
index_t Paso_MPIInfo_mod(index_t n, index_t k) |
70 |
{ |
71 |
index_t q, out=0; |
72 |
if (n>1) { |
73 |
q=k/n; |
74 |
if (k>0) { |
75 |
out=k-n*q; |
76 |
} else if (k<0) { |
77 |
out=k-n*(q-1); |
78 |
} |
79 |
} |
80 |
return out; |
81 |
} |
82 |
|
83 |
void Paso_MPIInfo_Split( Paso_MPIInfo *mpi_info, dim_t N, dim_t* local_N,index_t* offset) |
84 |
{ |
85 |
int rest=0; |
86 |
int s=mpi_info->size; |
87 |
int r=mpi_info->rank; |
88 |
*local_N=N/s; |
89 |
rest=N-(*local_N)*s; |
90 |
if (r<rest) { |
91 |
(*local_N)++; |
92 |
(*offset)=(*local_N)*r; |
93 |
} else { |
94 |
(*offset)=(*local_N)*r+rest; |
95 |
} |
96 |
} |
97 |
|
98 |
|
99 |
dim_t Paso_MPIInfo_setDistribution(Paso_MPIInfo* mpi_info ,index_t min_id,index_t max_id,index_t* distribution) { |
100 |
int rest=0, p; |
101 |
dim_t out; |
102 |
int s=mpi_info->size; |
103 |
dim_t N=max_id-min_id+1; |
104 |
if (N>0) { |
105 |
int local_N=N/s; |
106 |
rest=N-local_N*s; |
107 |
for (p=0; p<s; ++p) { |
108 |
if (p<rest) { |
109 |
distribution[p]=min_id+(local_N+1)*p; |
110 |
out=local_N+1; |
111 |
} else { |
112 |
distribution[p]=min_id+rest+local_N*p; |
113 |
} |
114 |
} |
115 |
distribution[s]=max_id+1; |
116 |
if (rest==0) { |
117 |
return local_N; |
118 |
} else { |
119 |
return local_N+1; |
120 |
} |
121 |
} else { |
122 |
for (p=0; p<s+1; ++p) distribution[p]=min_id; |
123 |
return 0; |
124 |
} |
125 |
} |
126 |
|
127 |
/* checks that there is no error accross all processes in a communicator */ |
128 |
/* NOTE : does not make guarentee consistency of error string on each process */ |
129 |
bool_t Paso_MPIInfo_noError( Paso_MPIInfo *mpi_info ) |
130 |
{ |
131 |
int errorLocal = 0; |
132 |
int errorGlobal= 0; |
133 |
errorLocal= Paso_noError() ? 0 : 1; |
134 |
if (mpi_info->size>1) { |
135 |
#ifdef PASO_MPI |
136 |
#if 1 /* ksteube disable error checking during benchmarking activities */ |
137 |
MPI_Allreduce( &errorLocal, &errorGlobal, 1, MPI_INT, MPI_MAX, mpi_info->comm ); |
138 |
#else |
139 |
errorGlobal=errorLocal; |
140 |
#endif |
141 |
#else |
142 |
errorGlobal=errorLocal; |
143 |
#endif |
144 |
/* take care of the case where the error was on another processor */ |
145 |
if( (errorLocal==0) && (errorGlobal==1) ) { |
146 |
Paso_setError( PASO_MPI_ERROR, "Paso_MPI_noError() : there was an error on another MPI process" ); |
147 |
} |
148 |
} |
149 |
return (errorGlobal==0); |
150 |
} |
151 |
|
152 |
|
153 |
/************************************************** |
154 |
WRAPPERS |
155 |
**************************************************/ |
156 |
|
157 |
int Paso_MPIInfo_initialized( void ) |
158 |
{ |
159 |
int error=0, initialised=0; |
160 |
|
161 |
#ifdef PASO_MPI |
162 |
error = MPI_Initialized( &initialised ); |
163 |
if( error!=MPI_SUCCESS ) |
164 |
Paso_setError( PASO_MPI_ERROR, "mpi_initialised : MPI error" ); |
165 |
return initialised; |
166 |
#else |
167 |
return TRUE; |
168 |
#endif |
169 |
} |
170 |
|
171 |
/* Append MPI rank to file name if multiple MPI processes */ |
172 |
char *Paso_MPI_appendRankToFileName(const char *fileName, int mpi_size, int mpi_rank) { |
173 |
/* Make plenty of room for the mpi_rank number and terminating '\0' */ |
174 |
char *newFileName = TMPMEMALLOC(strlen(fileName)+20,char); |
175 |
strncpy(newFileName, fileName, strlen(fileName)+1); |
176 |
if (mpi_size>1) sprintf(newFileName+strlen(newFileName), ".%04d", mpi_rank); |
177 |
return(newFileName); |
178 |
} |
179 |
|