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

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

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 731 by bcumming, Mon May 15 04:09:52 2006 UTC revision 1343 by ksteube, Wed Nov 14 02:48:02 2007 UTC
# Line 1  Line 1 
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>  #include <stdlib.h>
17  #include <stdio.h>  #include <stdio.h>
18    #include <string.h>
19    
20    
21  #include "Paso.h"  #include "Paso_MPI.h"
22    
 #ifdef PASO_MPI  
23    
24  /* allocate memory for an mpi_comm, and find the communicator details */  /* allocate memory for an mpi_comm, and find the communicator details */
25  Paso_MPIInfo* Paso_MPIInfo_alloc( MPI_Comm comm )  Paso_MPIInfo* Paso_MPIInfo_alloc( MPI_Comm comm )
# Line 15  Paso_MPIInfo* Paso_MPIInfo_alloc( MPI_Co Line 30  Paso_MPIInfo* Paso_MPIInfo_alloc( MPI_Co
30    out = MEMALLOC( 1, Paso_MPIInfo );    out = MEMALLOC( 1, Paso_MPIInfo );
31        
32    out->reference_counter = 0;    out->reference_counter = 0;
33    error = MPI_Comm_rank( comm, &out->rank )==MPI_SUCCESS && MPI_Comm_size( comm, &out->size )==MPI_SUCCESS;    out->msg_tag_counter = 0;
34    if( !error ) {    #ifdef PASO_MPI
35      Paso_setError( PASO_MPI_ERROR, "Paso_MPIInfo_alloc : error finding comm rank/size" );       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;       out->comm = comm;
41      #else
42         out->rank=0;
43         out->size=1;
44         out->comm=-1;
45      #endif
46    out->reference_counter++;    out->reference_counter++;
47    
48    return out;    return out;
49  }  }
50    
51  /* free memory for an mpi_comm */  /* free memory for an mpi_comm */
52  void Paso_MPIInfo_dealloc( Paso_MPIInfo *in )  void Paso_MPIInfo_free( Paso_MPIInfo *in )
53  {  {
54    if( in && !(--in->reference_counter) )    if( in && !(--in->reference_counter) )
55      MEMFREE( in );      MEMFREE( in );
# Line 40  Paso_MPIInfo *Paso_MPIInfo_getReference( Line 62  Paso_MPIInfo *Paso_MPIInfo_getReference(
62        
63    return in;    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                   WRAPPERS
147  **************************************************/  **************************************************/
148    
149  int Paso_MPI_initialized( void )  int Paso_MPIInfo_initialized( void )
150  {  {
151    int error=0, initialised=0;    int error=0, initialised=0;
152    
153    error = MPI_Initialized( &initialised );    #ifdef PASO_MPI
154    if( error!=MPI_SUCCESS )       error = MPI_Initialized( &initialised );
155      Paso_setError( PASO_MPI_ERROR, "mpi_initialised : MPI error" );       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    return initialised;  /* 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[4096];
166      strncpy(newFileName, fileName, strlen(fileName)+1);
167      if (mpi_size>1) sprintf(newFileName+strlen(newFileName), ".%04d", mpi_rank);
168      return(newFileName);
169  }  }
170    
 #endif  

Legend:
Removed from v.731  
changed lines
  Added in v.1343

  ViewVC Help
Powered by ViewVC 1.1.26