| 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 |
|
Parent Directory
| 
Revision Log