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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1553 - (hide annotations)
Thu May 8 09:38:07 2008 UTC (11 years, 7 months ago) by gross
File MIME type: text/plain
File size: 8667 byte(s)
some small bugs fixed to get MPI going with the modification. MPI version of BiCGStab added.
1 ksteube 1313 /* $Id: Coupler.c 1306 2007-09-18 05:51:09Z ksteube $ */
2    
3     /*******************************************************
4     *
5     * Copyright 2003-2007 by ACceSS MNRF
6     * Copyright 2007 by University of Queensland
7     *
8     * http://esscc.uq.edu.au
9     * Primary Business: Queensland, Australia
10     * Licensed under the Open Software License version 3.0
11     * http://www.opensource.org/licenses/osl-3.0.php
12     *
13 gross 1552 **************************************************************
14     *
15     * Paso: Connector and Coupler organizes the coupling with in a pattern/matrix
16     * across processors
17     *
18     **************************************************************
19     *
20     * Author: gross@access.edu.au
21     *
22     **************************************************************/
23 ksteube 1313
24 gross 1552 #include "Coupler.h"
25 ksteube 1313
26 gross 1552 /*************************************************************
27     *
28     * allocates a Connector
29     *
30     **************************************************************/
31 ksteube 1313
32 gross 1552 Paso_Connector* Paso_Connector_alloc(Paso_SharedComponents* send,
33     Paso_SharedComponents* recv)
34     {
35     Paso_Connector*out=NULL;
36     Paso_resetError();
37     out=MEMALLOC(1,Paso_Connector);
38     if ( send->mpi_info != recv->mpi_info ) {
39     Paso_setError(SYSTEM_ERROR,"Paso_Coupler_alloc: send and recv mpi communicator don't match.");
40     return NULL;
41     }
42     if (!Paso_checkPtr(out)) {
43     out->send=Paso_SharedComponents_getReference(send);
44     out->recv= Paso_SharedComponents_getReference(recv);
45     out->mpi_info = Paso_MPIInfo_getReference(send->mpi_info);
46     out->reference_counter=1;
47     }
48     if (Paso_noError()) {
49     return out;
50     } else {
51     Paso_Connector_free(out);
52     return NULL;
53     }
54     }
55 ksteube 1313
56 gross 1552 /* returns a reference to Connector */
57 ksteube 1313
58 gross 1552 Paso_Connector* Paso_Connector_getReference(Paso_Connector* in) {
59     if (in!=NULL) {
60     ++(in->reference_counter);
61     }
62     return in;
63     }
64    
65     /* deallocates a Connector: */
66 ksteube 1313
67 gross 1552 void Paso_Connector_free(Paso_Connector* in) {
68     if (in!=NULL) {
69     in->reference_counter--;
70     if (in->reference_counter<=0) {
71     Paso_SharedComponents_free(in->send);
72     Paso_SharedComponents_free(in->recv);
73     Paso_MPIInfo_free(in->mpi_info);
74     #ifdef Paso_TRACE
75     printf("Paso_Coupler_dealloc: system matrix pattern as been deallocated.\n");
76     #endif
77     }
78     }
79     }
80 ksteube 1313
81 gross 1552 Paso_Connector* Paso_Connector_copy(Paso_Connector* in) {
82     return Paso_Connector_unroll(in,1);
83     }
84 ksteube 1313
85 gross 1552 Paso_Connector* Paso_Connector_unroll(Paso_Connector* in, index_t block_size) {
86     Paso_SharedComponents *new_send_shcomp=NULL, *new_recv_shcomp=NULL;
87     Paso_Connector *out=NULL;
88     if (Paso_noError()) {
89     if (block_size>1) {
90     new_send_shcomp=Paso_SharedComponents_alloc(in->send->numNeighbors,
91     in->send->neighbor,
92     in->send->shared,
93     in->send->offsetInShared,
94     block_size,0,in->mpi_info);
95 ksteube 1313
96 gross 1552 new_recv_shcomp=Paso_SharedComponents_alloc(in->recv->numNeighbors,
97     in->recv->neighbor,
98     in->recv->shared,
99     in->recv->offsetInShared,
100     block_size,0,in->mpi_info);
101     } else {
102     new_send_shcomp=Paso_SharedComponents_getReference(in->send);
103     new_recv_shcomp=Paso_SharedComponents_getReference(in->recv);
104     }
105     if (Paso_noError()) out=Paso_Connector_alloc(new_send_shcomp,new_recv_shcomp);
106     }
107     Paso_SharedComponents_free(new_send_shcomp);
108     Paso_SharedComponents_free(new_recv_shcomp);
109     if (Paso_noError()) {
110     return out;
111     } else {
112     Paso_Connector_free(out);
113     return NULL;
114     }
115     }
116     /*************************************************************
117     *
118     * allocates a Connector
119     *
120     **************************************************************/
121 ksteube 1313
122 gross 1552 Paso_Coupler* Paso_Coupler_alloc(Paso_Connector* connector, dim_t block_size)
123 ksteube 1313 {
124 gross 1552 Paso_MPIInfo *mpi_info = connector->mpi_info;
125 ksteube 1313 Paso_Coupler*out=NULL;
126     Paso_resetError();
127     out=MEMALLOC(1,Paso_Coupler);
128     if (!Paso_checkPtr(out)) {
129 gross 1552 out->block_size=block_size;
130     out->connector=Paso_Connector_getReference(connector);
131 ksteube 1313 out->send_buffer=NULL;
132     out->recv_buffer=NULL;
133     out->mpi_requests=NULL;
134     out->mpi_stati=NULL;
135 gross 1552 out->mpi_info = Paso_MPIInfo_getReference(mpi_info);
136 ksteube 1313 out->reference_counter=1;
137    
138     #ifdef PASO_MPI
139 gross 1552 out->mpi_requests=MEMALLOC(connector->send->numNeighbors+connector->recv->numNeighbors,MPI_Request);
140     out->mpi_stati=MEMALLOC(connector->send->numNeighbors+connector->recv->numNeighbors,MPI_Status);
141 ksteube 1313 Paso_checkPtr(out->mpi_requests);
142     Paso_checkPtr(out->mpi_stati);
143     #endif
144 gross 1552 if (mpi_info->size>1) {
145     out->send_buffer=MEMALLOC(connector->send->numSharedComponents * block_size,double);
146     out->recv_buffer=MEMALLOC(connector->recv->numSharedComponents * block_size,double);
147     Paso_checkPtr(out->send_buffer);
148     Paso_checkPtr(out->recv_buffer);
149     }
150 ksteube 1313 }
151     if (Paso_noError()) {
152     return out;
153     } else {
154     Paso_Coupler_free(out);
155     return NULL;
156     }
157     }
158    
159 gross 1552 /* returns a reference to Coupler */
160 ksteube 1313
161     Paso_Coupler* Paso_Coupler_getReference(Paso_Coupler* in) {
162     if (in!=NULL) {
163     ++(in->reference_counter);
164     }
165     return in;
166     }
167    
168     /* deallocates a Coupler: */
169    
170     void Paso_Coupler_free(Paso_Coupler* in) {
171     if (in!=NULL) {
172     in->reference_counter--;
173     if (in->reference_counter<=0) {
174 gross 1552 Paso_Connector_free(in->connector);
175 ksteube 1313 MEMFREE(in->send_buffer);
176     MEMFREE(in->recv_buffer);
177     MEMFREE(in->mpi_requests);
178     MEMFREE(in->mpi_stati);
179     Paso_MPIInfo_free(in->mpi_info);
180     MEMFREE(in);
181     #ifdef Paso_TRACE
182     printf("Paso_Coupler_dealloc: system matrix pattern as been deallocated.\n");
183     #endif
184     }
185     }
186     }
187    
188    
189 gross 1407 void Paso_Coupler_startCollect(Paso_Coupler* coupler,const double* in)
190 ksteube 1313 {
191     Paso_MPIInfo *mpi_info = coupler->mpi_info;
192     dim_t block_size=coupler->block_size;
193     size_t block_size_size=block_size*sizeof(double);
194     dim_t i,j;
195     if ( mpi_info->size>1) {
196     /* start reveiving input */
197     #pragma omp master
198     {
199 gross 1552 for (i=0; i< coupler->connector->recv->numNeighbors; ++i) {
200 ksteube 1313 #ifdef PASO_MPI
201 gross 1552 MPI_Irecv(&(coupler->recv_buffer[coupler->connector->recv->offsetInShared[i] * block_size]),
202     (coupler->connector->recv->offsetInShared[i+1]- coupler->connector->recv->offsetInShared[i])*block_size,
203 ksteube 1313 MPI_DOUBLE,
204 gross 1552 coupler->connector->recv->neighbor[i],
205 gross 1553 mpi_info->msg_tag_counter+coupler->connector->recv->neighbor[i],
206 ksteube 1313 mpi_info->comm,
207     &(coupler->mpi_requests[i]));
208     #endif
209    
210     }
211     }
212     /* collect values into buffer */
213 gross 1374 #pragma omp parallel for private(i)
214 gross 1552 for (i=0; i < coupler->connector->send->numSharedComponents;++i) {
215     memcpy(&(coupler->send_buffer[(block_size)*i]),&(in[ block_size * coupler->connector->send->shared[i]]), block_size_size);
216 ksteube 1313 }
217     /* send buffer out */
218     #pragma omp master
219     {
220 gross 1552 for (i=0; i< coupler->connector->send->numNeighbors; ++i) {
221 ksteube 1313 #ifdef PASO_MPI
222 gross 1553 MPI_Issend(&(coupler->send_buffer[coupler->connector->send->offsetInShared[i] * block_size]),
223 gross 1552 (coupler->connector->send->offsetInShared[i+1]- coupler->connector->send->offsetInShared[i])*block_size,
224 ksteube 1313 MPI_DOUBLE,
225 gross 1552 coupler->connector->send->neighbor[i],
226 ksteube 1313 mpi_info->msg_tag_counter+mpi_info->rank,
227     mpi_info->comm,
228 gross 1553 &(coupler->mpi_requests[i+ coupler->connector->recv->numNeighbors]));
229 ksteube 1313 #endif
230     }
231     }
232 gross 1413 mpi_info->msg_tag_counter+=mpi_info->size;
233 ksteube 1313 }
234     }
235    
236     double* Paso_Coupler_finishCollect(Paso_Coupler* coupler)
237     {
238     Paso_MPIInfo *mpi_info = coupler->mpi_info;
239     if ( mpi_info->size>1) {
240     /* wait for receive */
241     #pragma omp master
242     {
243     #ifdef PASO_MPI
244 gross 1552 MPI_Waitall(coupler->connector->recv->numNeighbors+coupler->connector->send->numNeighbors,
245 ksteube 1313 coupler->mpi_requests,
246     coupler->mpi_stati);
247     #endif
248     }
249     }
250     return coupler->recv_buffer;
251     }

  ViewVC Help
Powered by ViewVC 1.1.26