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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1312 - (hide annotations)
Mon Sep 24 06:18:44 2007 UTC (12 years, 1 month 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 ksteube 1312
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 bcumming 731 #include <stdlib.h>
17     #include <stdio.h>
18    
19    
20 ksteube 1312 #include "Paso_MPI.h"
21 bcumming 731
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 ksteube 1312 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 bcumming 731
39 ksteube 1312 out->comm = comm;
40     #else
41     out->rank=0;
42     out->size=1;
43     out->comm=-1;
44     #endif
45 bcumming 731 out->reference_counter++;
46    
47     return out;
48     }
49    
50     /* free memory for an mpi_comm */
51 ksteube 1312 void Paso_MPIInfo_free( Paso_MPIInfo *in )
52 bcumming 731 {
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 ksteube 1312 /* 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 bcumming 731
79 ksteube 1312 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 bcumming 731 /**************************************************
145     WRAPPERS
146     **************************************************/
147    
148 ksteube 1312 int Paso_MPIInfo_initialized( void )
149 bcumming 731 {
150     int error=0, initialised=0;
151    
152 ksteube 1312 #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 bcumming 731 }

  ViewVC Help
Powered by ViewVC 1.1.26