/[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 1312 - (show annotations)
Mon Sep 24 06:18:44 2007 UTC (12 years, 5 months ago) by ksteube
File MIME type: text/plain
File size: 3937 byte(s)
The MPI branch is hereby closed. All future work should be in trunk.

Previously in revision 1295 I merged the latest changes to trunk into trunk-mpi-branch.
In this revision I copied all files from trunk-mpi-branch over the corresponding
trunk files. I did not use 'svn merge', it was a copy.

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
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 int error;
27 Paso_MPIInfo *out=NULL;
28
29 out = MEMALLOC( 1, Paso_MPIInfo );
30
31 out->reference_counter = 0;
32 out->msg_tag_counter = 0;
33 #ifdef PASO_MPI
34 error = MPI_Comm_rank( comm, &out->rank )==MPI_SUCCESS && MPI_Comm_size( comm, &out->size )==MPI_SUCCESS;
35 if( !error ) {
36 Paso_setError( PASO_MPI_ERROR, "Paso_MPIInfo_alloc : error finding comm rank/size" );
37 }
38
39 out->comm = comm;
40 #else
41 out->rank=0;
42 out->size=1;
43 out->comm=-1;
44 #endif
45 out->reference_counter++;
46
47 return out;
48 }
49
50 /* free memory for an mpi_comm */
51 void Paso_MPIInfo_free( Paso_MPIInfo *in )
52 {
53 if( in && !(--in->reference_counter) )
54 MEMFREE( in );
55 }
56
57 Paso_MPIInfo *Paso_MPIInfo_getReference( Paso_MPIInfo* in )
58 {
59 if (in!=NULL)
60 ++(in->reference_counter);
61
62 return in;
63 }
64 /* N = #CPUs, k is a CPU number but out of range or even negative. Return a CPU number in 0...n-1. */
65 index_t Paso_MPIInfo_mod(index_t n, index_t k)
66 {
67 index_t q, out=0;
68 if (n>1) {
69 q=k/n;
70 if (k>0) {
71 out=k-n*q;
72 } else if (k<0) {
73 out=k-n*(q-1);
74 }
75 }
76 return out;
77 }
78
79 void Paso_MPIInfo_Split( Paso_MPIInfo *mpi_info, dim_t N, dim_t* local_N,index_t* offset)
80 {
81 int rest=0;
82 int s=mpi_info->size;
83 int r=mpi_info->rank;
84 *local_N=N/s;
85 rest=N-(*local_N)*s;
86 if (r<rest) {
87 (*local_N)++;
88 (*offset)=(*local_N)*r;
89 } else {
90 (*offset)=(*local_N)*r+rest;
91 }
92 }
93
94
95 dim_t Paso_MPIInfo_setDistribution(Paso_MPIInfo* mpi_info ,index_t min_id,index_t max_id,index_t* distribution) {
96 int rest=0, p;
97 dim_t out;
98 int s=mpi_info->size;
99 dim_t N=max_id-min_id+1;
100 int local_N=N/s;
101 rest=N-local_N*s;
102 for (p=0; p<s; ++p) {
103 if (p<rest) {
104 distribution[p]=min_id+(local_N+1)*p;
105 out=local_N+1;
106 } else {
107 distribution[p]=min_id+rest+local_N*p;
108 }
109 }
110 distribution[s]=max_id+1;
111 if (rest==0) {
112 return local_N;
113 } else {
114 return local_N+1;
115 }
116 }
117
118 /* checks that there is no error accross all processes in a communicator */
119 /* NOTE : does not make guarentee consistency of error string on each process */
120 bool_t Paso_MPIInfo_noError( Paso_MPIInfo *mpi_info )
121 {
122 int errorLocal = 0;
123 int errorGlobal= 0;
124 errorLocal= Paso_noError() ? 0 : 1;
125 if (mpi_info->size>1) {
126 #ifdef PASO_MPI
127 #if 1 /* ksteube disable error checking during benchmarking activities */
128 MPI_Allreduce( &errorLocal, &errorGlobal, 1, MPI_INT, MPI_MAX, mpi_info->comm );
129 #else
130 errorGlobal=errorLocal;
131 #endif
132 #else
133 errorGlobal=errorLocal;
134 #endif
135 /* take care of the case where the error was on another processor */
136 if( (errorLocal==0) && (errorGlobal==1) ) {
137 Paso_setError( PASO_MPI_ERROR, "Paso_MPI_noError() : there was an error on another MPI process" );
138 }
139 }
140 return (errorGlobal==0);
141 }
142
143
144 /**************************************************
145 WRAPPERS
146 **************************************************/
147
148 int Paso_MPIInfo_initialized( void )
149 {
150 int error=0, initialised=0;
151
152 #ifdef PASO_MPI
153 error = MPI_Initialized( &initialised );
154 if( error!=MPI_SUCCESS )
155 Paso_setError( PASO_MPI_ERROR, "mpi_initialised : MPI error" );
156 return initialised;
157 #else
158 return TRUE;
159 #endif
160 }

  ViewVC Help
Powered by ViewVC 1.1.26