/[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 2126 - (hide annotations)
Thu Dec 4 00:13:03 2008 UTC (10 years, 10 months ago) by ksteube
File MIME type: text/plain
File size: 4297 byte(s)
fixed a logic mess I had made in Paso_MPIInfo_noError()

1 ksteube 1312
2     /*******************************************************
3 ksteube 1811 *
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 ksteube 1312
14 ksteube 1811
15 bcumming 731 #include <stdlib.h>
16     #include <stdio.h>
17 ksteube 1343 #include <string.h>
18 bcumming 731
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 phornby 1628 #ifdef PASO_MPI
27     int error;
28     #endif
29    
30 bcumming 731 Paso_MPIInfo *out=NULL;
31    
32     out = MEMALLOC( 1, Paso_MPIInfo );
33    
34     out->reference_counter = 0;
35 ksteube 1312 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 bcumming 731
42 ksteube 1312 out->comm = comm;
43     #else
44     out->rank=0;
45     out->size=1;
46     out->comm=-1;
47     #endif
48 bcumming 731 out->reference_counter++;
49    
50     return out;
51     }
52    
53     /* free memory for an mpi_comm */
54 ksteube 1312 void Paso_MPIInfo_free( Paso_MPIInfo *in )
55 bcumming 731 {
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 ksteube 1312 /* 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 bcumming 731
82 ksteube 1312 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 gross 1738 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 ksteube 1312 } else {
118 gross 1738 return local_N+1;
119 ksteube 1312 }
120 gross 1738 } else {
121     for (p=0; p<s+1; ++p) distribution[p]=min_id;
122     return 0;
123     }
124 ksteube 1312 }
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 ksteube 2126 int errorLocal = Paso_noError() ? 0 : 1;
131     int errorGlobal = errorLocal;
132     #if 0
133     #ifdef PASO_MPI
134 ksteube 1312 if (mpi_info->size>1) {
135     MPI_Allreduce( &errorLocal, &errorGlobal, 1, MPI_INT, MPI_MAX, mpi_info->comm );
136 ksteube 2126 }
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 ksteube 1312 #endif
141 ksteube 2126 #endif
142 ksteube 1312 return (errorGlobal==0);
143     }
144    
145 bcumming 731 /**************************************************
146     WRAPPERS
147     **************************************************/
148    
149 ksteube 1312 int Paso_MPIInfo_initialized( void )
150 bcumming 731 {
151 ksteube 1312 #ifdef PASO_MPI
152 jfenwick 1981 int error=0, initialised=0;
153 ksteube 1312 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 }
161 ksteube 1343
162     /* Append MPI rank to file name if multiple MPI processes */
163 phornby 1628 char *Paso_MPI_appendRankToFileName(const char *fileName, int mpi_size, int mpi_rank) {
164     /* Make plenty of room for the mpi_rank number and terminating '\0' */
165     char *newFileName = TMPMEMALLOC(strlen(fileName)+20,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