/[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 1981 - (show annotations)
Thu Nov 6 05:27:33 2008 UTC (11 years ago) by jfenwick
File MIME type: text/plain
File size: 4542 byte(s)
More warning removal.

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

  ViewVC Help
Powered by ViewVC 1.1.26