/[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 1628 - (show annotations)
Fri Jul 11 13:12:46 2008 UTC (11 years, 3 months ago) by phornby
File MIME type: text/plain
File size: 4430 byte(s)

Merge in /branches/windows_from_1456_trunk_1620_merged_in branch.

You will find a preserved pre-merge trunk in tags under tags/trunk_at_1625.
That will be useful for diffing & checking on my stupidity.

Here is a list of the conflicts and their resolution at this
point in time.


=================================================================================
(LLWS == looks like white space).

finley/src/Assemble_addToSystemMatrix.c - resolve to branch - unused var. may be wrong.....
finley/src/CPPAdapter/SystemMatrixAdapter.cpp - resolve to branch - LLWS
finley/src/CPPAdapter/MeshAdapter.cpp - resolve to branch - LLWS
paso/src/PCG.c - resolve to branch - unused var fixes.
paso/src/SolverFCT.c - resolve to branch - LLWS
paso/src/FGMRES.c - resolve to branch - LLWS
paso/src/Common.h - resolve to trunk version. It's omp.h's include... not sure it's needed,
but for the sake of saftey.....
paso/src/Functions.c - resolve to branch version, indentation/tab removal and return error
on bad unimplemented Paso_FunctionCall.
paso/src/SolverFCT_solve.c - resolve to branch version, unused vars
paso/src/SparseMatrix_MatrixVector.c - resolve to branch version, unused vars.
escript/src/Utils.cpp - resloved to branch, needs WinSock2.h
escript/src/DataExpanded.cpp - resolved to branch version - LLWS
escript/src/DataFactory.cpp - resolve to branch version
=================================================================================

This currently passes tests on linux (debian), but is not checked on windows or Altix yet.

This checkin is to make a trunk I can check out for windows to do tests on it.

Known outstanding problem is in the operator=() method of exceptions
causing warning messages on the intel compilers.

May the God of doughnuts have mercy on my soul.


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 #include <string.h>
19
20
21 #include "Paso_MPI.h"
22
23
24 /* allocate memory for an mpi_comm, and find the communicator details */
25 Paso_MPIInfo* Paso_MPIInfo_alloc( MPI_Comm comm )
26 {
27 #ifdef PASO_MPI
28 int error;
29 #endif
30
31 Paso_MPIInfo *out=NULL;
32
33 out = MEMALLOC( 1, Paso_MPIInfo );
34
35 out->reference_counter = 0;
36 out->msg_tag_counter = 0;
37 #ifdef PASO_MPI
38 error = MPI_Comm_rank( comm, &out->rank )==MPI_SUCCESS && MPI_Comm_size( comm, &out->size )==MPI_SUCCESS;
39 if( !error ) {
40 Paso_setError( PASO_MPI_ERROR, "Paso_MPIInfo_alloc : error finding comm rank/size" );
41 }
42
43 out->comm = comm;
44 #else
45 out->rank=0;
46 out->size=1;
47 out->comm=-1;
48 #endif
49 out->reference_counter++;
50
51 return out;
52 }
53
54 /* free memory for an mpi_comm */
55 void Paso_MPIInfo_free( Paso_MPIInfo *in )
56 {
57 if( in && !(--in->reference_counter) )
58 MEMFREE( in );
59 }
60
61 Paso_MPIInfo *Paso_MPIInfo_getReference( Paso_MPIInfo* in )
62 {
63 if (in!=NULL)
64 ++(in->reference_counter);
65
66 return in;
67 }
68 /* N = #CPUs, k is a CPU number but out of range or even negative. Return a CPU number in 0...n-1. */
69 index_t Paso_MPIInfo_mod(index_t n, index_t k)
70 {
71 index_t q, out=0;
72 if (n>1) {
73 q=k/n;
74 if (k>0) {
75 out=k-n*q;
76 } else if (k<0) {
77 out=k-n*(q-1);
78 }
79 }
80 return out;
81 }
82
83 void Paso_MPIInfo_Split( Paso_MPIInfo *mpi_info, dim_t N, dim_t* local_N,index_t* offset)
84 {
85 int rest=0;
86 int s=mpi_info->size;
87 int r=mpi_info->rank;
88 *local_N=N/s;
89 rest=N-(*local_N)*s;
90 if (r<rest) {
91 (*local_N)++;
92 (*offset)=(*local_N)*r;
93 } else {
94 (*offset)=(*local_N)*r+rest;
95 }
96 }
97
98
99 dim_t Paso_MPIInfo_setDistribution(Paso_MPIInfo* mpi_info ,index_t min_id,index_t max_id,index_t* distribution) {
100 int rest=0, p;
101 dim_t out;
102 int s=mpi_info->size;
103 dim_t N=max_id-min_id+1;
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 } else {
118 return local_N+1;
119 }
120 }
121
122 /* checks that there is no error accross all processes in a communicator */
123 /* NOTE : does not make guarentee consistency of error string on each process */
124 bool_t Paso_MPIInfo_noError( Paso_MPIInfo *mpi_info )
125 {
126 int errorLocal = 0;
127 int errorGlobal= 0;
128 errorLocal= Paso_noError() ? 0 : 1;
129 if (mpi_info->size>1) {
130 #ifdef PASO_MPI
131 #if 1 /* ksteube disable error checking during benchmarking activities */
132 MPI_Allreduce( &errorLocal, &errorGlobal, 1, MPI_INT, MPI_MAX, mpi_info->comm );
133 #else
134 errorGlobal=errorLocal;
135 #endif
136 #else
137 errorGlobal=errorLocal;
138 #endif
139 /* take care of the case where the error was on another processor */
140 if( (errorLocal==0) && (errorGlobal==1) ) {
141 Paso_setError( PASO_MPI_ERROR, "Paso_MPI_noError() : there was an error on another MPI process" );
142 }
143 }
144 return (errorGlobal==0);
145 }
146
147
148 /**************************************************
149 WRAPPERS
150 **************************************************/
151
152 int Paso_MPIInfo_initialized( void )
153 {
154 int error=0, initialised=0;
155
156 #ifdef PASO_MPI
157 error = MPI_Initialized( &initialised );
158 if( error!=MPI_SUCCESS )
159 Paso_setError( PASO_MPI_ERROR, "mpi_initialised : MPI error" );
160 return initialised;
161 #else
162 return TRUE;
163 #endif
164 }
165
166 /* Append MPI rank to file name if multiple MPI processes */
167 char *Paso_MPI_appendRankToFileName(const char *fileName, int mpi_size, int mpi_rank) {
168 /* Make plenty of room for the mpi_rank number and terminating '\0' */
169 char *newFileName = TMPMEMALLOC(strlen(fileName)+20,char);
170 strncpy(newFileName, fileName, strlen(fileName)+1);
171 if (mpi_size>1) sprintf(newFileName+strlen(newFileName), ".%04d", mpi_rank);
172 return(newFileName);
173 }
174

  ViewVC Help
Powered by ViewVC 1.1.26