/[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 1387 - (show annotations)
Fri Jan 11 07:45:26 2008 UTC (11 years, 9 months ago) by trankine
Original Path: temp/paso/src/Paso_MPI.c
File MIME type: text/plain
File size: 4306 byte(s)
Restore the trunk that existed before the windows changes were committed to the (now moved to branches) old trunk.
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 int error;
28 Paso_MPIInfo *out=NULL;
29
30 out = MEMALLOC( 1, Paso_MPIInfo );
31
32 out->reference_counter = 0;
33 out->msg_tag_counter = 0;
34 #ifdef PASO_MPI
35 error = MPI_Comm_rank( comm, &out->rank )==MPI_SUCCESS && MPI_Comm_size( comm, &out->size )==MPI_SUCCESS;
36 if( !error ) {
37 Paso_setError( PASO_MPI_ERROR, "Paso_MPIInfo_alloc : error finding comm rank/size" );
38 }
39
40 out->comm = comm;
41 #else
42 out->rank=0;
43 out->size=1;
44 out->comm=-1;
45 #endif
46 out->reference_counter++;
47
48 return out;
49 }
50
51 /* free memory for an mpi_comm */
52 void Paso_MPIInfo_free( Paso_MPIInfo *in )
53 {
54 if( in && !(--in->reference_counter) )
55 MEMFREE( in );
56 }
57
58 Paso_MPIInfo *Paso_MPIInfo_getReference( Paso_MPIInfo* in )
59 {
60 if (in!=NULL)
61 ++(in->reference_counter);
62
63 return in;
64 }
65 /* N = #CPUs, k is a CPU number but out of range or even negative. Return a CPU number in 0...n-1. */
66 index_t Paso_MPIInfo_mod(index_t n, index_t k)
67 {
68 index_t q, out=0;
69 if (n>1) {
70 q=k/n;
71 if (k>0) {
72 out=k-n*q;
73 } else if (k<0) {
74 out=k-n*(q-1);
75 }
76 }
77 return out;
78 }
79
80 void Paso_MPIInfo_Split( Paso_MPIInfo *mpi_info, dim_t N, dim_t* local_N,index_t* offset)
81 {
82 int rest=0;
83 int s=mpi_info->size;
84 int r=mpi_info->rank;
85 *local_N=N/s;
86 rest=N-(*local_N)*s;
87 if (r<rest) {
88 (*local_N)++;
89 (*offset)=(*local_N)*r;
90 } else {
91 (*offset)=(*local_N)*r+rest;
92 }
93 }
94
95
96 dim_t Paso_MPIInfo_setDistribution(Paso_MPIInfo* mpi_info ,index_t min_id,index_t max_id,index_t* distribution) {
97 int rest=0, p;
98 dim_t out;
99 int s=mpi_info->size;
100 dim_t N=max_id-min_id+1;
101 int local_N=N/s;
102 rest=N-local_N*s;
103 for (p=0; p<s; ++p) {
104 if (p<rest) {
105 distribution[p]=min_id+(local_N+1)*p;
106 out=local_N+1;
107 } else {
108 distribution[p]=min_id+rest+local_N*p;
109 }
110 }
111 distribution[s]=max_id+1;
112 if (rest==0) {
113 return local_N;
114 } else {
115 return local_N+1;
116 }
117 }
118
119 /* checks that there is no error accross all processes in a communicator */
120 /* NOTE : does not make guarentee consistency of error string on each process */
121 bool_t Paso_MPIInfo_noError( Paso_MPIInfo *mpi_info )
122 {
123 int errorLocal = 0;
124 int errorGlobal= 0;
125 errorLocal= Paso_noError() ? 0 : 1;
126 if (mpi_info->size>1) {
127 #ifdef PASO_MPI
128 #if 1 /* ksteube disable error checking during benchmarking activities */
129 MPI_Allreduce( &errorLocal, &errorGlobal, 1, MPI_INT, MPI_MAX, mpi_info->comm );
130 #else
131 errorGlobal=errorLocal;
132 #endif
133 #else
134 errorGlobal=errorLocal;
135 #endif
136 /* take care of the case where the error was on another processor */
137 if( (errorLocal==0) && (errorGlobal==1) ) {
138 Paso_setError( PASO_MPI_ERROR, "Paso_MPI_noError() : there was an error on another MPI process" );
139 }
140 }
141 return (errorGlobal==0);
142 }
143
144
145 /**************************************************
146 WRAPPERS
147 **************************************************/
148
149 int Paso_MPIInfo_initialized( void )
150 {
151 int error=0, initialised=0;
152
153 #ifdef PASO_MPI
154 error = MPI_Initialized( &initialised );
155 if( error!=MPI_SUCCESS )
156 Paso_setError( PASO_MPI_ERROR, "mpi_initialised : MPI error" );
157 return initialised;
158 #else
159 return TRUE;
160 #endif
161 }
162
163 /* Append MPI rank to file name if multiple MPI processes */
164 char *Paso_MPI_appendRankToFileName(char *fileName, int mpi_size, int mpi_rank) {
165 char *newFileName = TMPMEMALLOC(4096,char);
166 strncpy(newFileName, fileName, strlen(fileName)+1);
167 if (mpi_size>1) sprintf(newFileName+strlen(newFileName), ".%04d", mpi_rank);
168 return(newFileName);
169 }
170

  ViewVC Help
Powered by ViewVC 1.1.26