/[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 1388 - (hide annotations)
Fri Jan 11 07:45:58 2008 UTC (11 years, 9 months ago) by trankine
File MIME type: text/plain
File size: 4306 byte(s)
And get the *(&(*&(* name right
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 ksteube 1343 #include <string.h>
19 bcumming 731
20    
21 ksteube 1312 #include "Paso_MPI.h"
22 bcumming 731
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 ksteube 1312 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 bcumming 731
40 ksteube 1312 out->comm = comm;
41     #else
42     out->rank=0;
43     out->size=1;
44     out->comm=-1;
45     #endif
46 bcumming 731 out->reference_counter++;
47    
48     return out;
49     }
50    
51     /* free memory for an mpi_comm */
52 ksteube 1312 void Paso_MPIInfo_free( Paso_MPIInfo *in )
53 bcumming 731 {
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 ksteube 1312 /* 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 bcumming 731
80 ksteube 1312 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 bcumming 731 /**************************************************
146     WRAPPERS
147     **************************************************/
148    
149 ksteube 1312 int Paso_MPIInfo_initialized( void )
150 bcumming 731 {
151     int error=0, initialised=0;
152    
153 ksteube 1312 #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 bcumming 731 }
162 ksteube 1343
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 ksteube 1347 char *newFileName = TMPMEMALLOC(4096,char);
166 ksteube 1343 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