/[escript]/trunk/paso/src/Paso_MPI.c
ViewVC logotype

Contents of /trunk/paso/src/Paso_MPI.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1738 - (show annotations)
Fri Aug 29 05:06:45 2008 UTC (11 years, 1 month ago) by gross
File MIME type: text/plain
File size: 4575 byte(s)
some changes improving the robustness for MPI if the elements/processor is small
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

  ViewVC Help
Powered by ViewVC 1.1.26