paso/src/Coupler.c


/* $Id: Coupler.c 1306 2007-09-18 05:51:09Z ksteube $ */

/*******************************************************
 *
 *           Copyright 2003-2007 by ACceSS MNRF
 *       Copyright 2007 by University of Queensland
 *
 *                http://esscc.uq.edu.au
 *        Primary Business: Queensland, Australia
 *  Licensed under the Open Software License version 3.0
 *     http://www.opensource.org/licenses/osl-3.0.php
 *
 *******************************************************/

/**************************************************************/

/* Paso: Coupler organizes the coupling with in a pattern/matrix   */
/*       across processors                                         */

/**************************************************************/
 
/* Author: gross@access.edu.au */

/**************************************************************/

#include "Coupler.h"

/**************************************************************/

/* allocates a Coupler  */


/**************************************************************/


Paso_Coupler* Paso_Coupler_alloc(Paso_SharedComponents* send,
                                 Paso_SharedComponents* recv)
{
  Paso_Coupler*out=NULL;
  Paso_resetError();
  out=MEMALLOC(1,Paso_Coupler);
  if ( send->mpi_info != recv->mpi_info ) {
     Paso_setError(SYSTEM_ERROR,"Paso_Coupler_alloc: send and recv mpi communicator don't match.");
     return NULL;
  }
  if (!Paso_checkPtr(out)) {
      out->send=Paso_SharedComponents_getReference(send);
      out->send_buffer=NULL;
      out->recv= Paso_SharedComponents_getReference(recv);
      out->recv_buffer=NULL;
      out->mpi_requests=NULL;
      out->mpi_stati=NULL;
      out->mpi_info = Paso_MPIInfo_getReference(send->mpi_info);
      out->reference_counter=1;
      
      #ifdef PASO_MPI
         out->mpi_requests=MEMALLOC(send->numNeighbors+recv->numNeighbors,MPI_Request);
         out->mpi_stati=MEMALLOC(send->numNeighbors+recv->numNeighbors,MPI_Status);
         Paso_checkPtr(out->mpi_requests);
         Paso_checkPtr(out->mpi_stati);
      #endif
  }
  if (Paso_noError()) {
     return out;
  } else {
     Paso_Coupler_free(out);
     return NULL;
  }
}

/* returns a reference to in */

Paso_Coupler* Paso_Coupler_getReference(Paso_Coupler* in) {
     if (in!=NULL) {
        ++(in->reference_counter);
     }
     return in;
}
  
/* deallocates a Coupler: */

void Paso_Coupler_free(Paso_Coupler* in) {
  if (in!=NULL) {
     in->reference_counter--;
     if (in->reference_counter<=0) {
        Paso_SharedComponents_free(in->send);
        MEMFREE(in->send_buffer);
        Paso_SharedComponents_free(in->recv);
        MEMFREE(in->recv_buffer);
        MEMFREE(in->mpi_requests);
        MEMFREE(in->mpi_stati);
        Paso_MPIInfo_free(in->mpi_info);
        MEMFREE(in);
        #ifdef Paso_TRACE
        printf("Paso_Coupler_dealloc: system matrix pattern as been deallocated.\n");
        #endif
     }
   }
}

bool_t Paso_Coupler_bufferIsAllocated(Paso_Coupler* coupler) {
  return ( (coupler->send_buffer !=NULL) || (coupler->recv_buffer!=NULL) );
}

void Paso_Coupler_allocBuffer(Paso_Coupler* coupler,dim_t block_size)
{
    Paso_MPIInfo *mpi_info = coupler->mpi_info;  
    if (Paso_Coupler_bufferIsAllocated(coupler))  {
        Paso_setError(SYSTEM_ERROR,"Paso_Coupler_allocBuffer: coupler are still in use.");
        return;
    }
    coupler->block_size=block_size;
    if (coupler->mpi_info->size>1) {
        coupler->send_buffer=MEMALLOC(coupler->send->numSharedComponents * coupler->block_size,double);
        coupler->recv_buffer=MEMALLOC(coupler->recv->numSharedComponents * coupler->block_size,double);
        if (Paso_checkPtr(coupler->send_buffer) || Paso_checkPtr(coupler->recv_buffer) ) {
              TMPMEMFREE(coupler->send_buffer);
              TMPMEMFREE(coupler->recv_buffer);
        }
    }
    return;
}
void Paso_Coupler_freeBuffer(Paso_Coupler* coupler) 
{

  if (coupler->mpi_info->size>1) {
     MEMFREE(coupler->send_buffer);
     MEMFREE(coupler->recv_buffer);
  }
  return;
}

void Paso_Coupler_startCollect(Paso_Coupler* coupler,const double* in)
{
  Paso_MPIInfo *mpi_info = coupler->mpi_info;  
  dim_t block_size=coupler->block_size;
  size_t block_size_size=block_size*sizeof(double);
  dim_t i,j;
  if ( mpi_info->size>1) {
     /* start reveiving input */
     #pragma omp master 
     {
        for (i=0; i< coupler->recv->numNeighbors; ++i) {
            #ifdef PASO_MPI
            MPI_Irecv(&(coupler->recv_buffer[coupler->recv->offsetInShared[i] *  block_size]),
                      (coupler->recv->offsetInShared[i+1]- coupler->recv->offsetInShared[i])*block_size,
                      MPI_DOUBLE,
                      coupler->recv->neighbor[i], 
                      mpi_info->msg_tag_counter+coupler->recv->neighbor[i],
                      mpi_info->comm,
                      &(coupler->mpi_requests[i]));
            #endif

        }
     }
     /* collect values into buffer */
     #pragma omp parallel for private(i)
     for (i=0; i < coupler->send->numSharedComponents;++i) {
        memcpy(&(coupler->send_buffer[(block_size)*i]),&(in[ block_size * coupler->send->shared[i]]), block_size_size);
     }
     /* send buffer out */
     #pragma omp master 
     {
        for (i=0; i< coupler->send->numNeighbors; ++i) {
             #ifdef PASO_MPI
             MPI_Issend(&(coupler->send_buffer[coupler->send->offsetInShared[i] *  block_size]),
                        (coupler->send->offsetInShared[i+1]- coupler->send->offsetInShared[i])*block_size,
                        MPI_DOUBLE,
                        coupler->send->neighbor[i], 
                        mpi_info->msg_tag_counter+mpi_info->rank,
                        mpi_info->comm,
                        &(coupler->mpi_requests[i+ coupler->recv->numNeighbors]));
             #endif 
        }
     }
     mpi_info->msg_tag_counter+=mpi_info->size;
  }
}

double* Paso_Coupler_finishCollect(Paso_Coupler* coupler)
{
  Paso_MPIInfo *mpi_info = coupler->mpi_info;  
  if ( mpi_info->size>1) {
     /* wait for receive */
     #pragma omp master 
     {
        #ifdef PASO_MPI
        MPI_Waitall(coupler->recv->numNeighbors+coupler->send->numNeighbors,
                    coupler->mpi_requests,
                    coupler->mpi_stati);
        #endif
     }
  }
  return coupler->recv_buffer;
}

Paso_Coupler* Paso_Coupler_unroll(Paso_Coupler* in, index_t block_size) {
     Paso_SharedComponents *new_send_shcomp=NULL, *new_recv_shcomp=NULL;
     Paso_Coupler *out=NULL;
     if (Paso_noError()) {
        if (block_size>1) {
            new_send_shcomp=Paso_SharedComponents_alloc(in->send->numNeighbors,
                                                        in->send->neighbor,
                                                        in->send->shared,
                                                        in->send->offsetInShared,
                                                        block_size,0,in->mpi_info);

            new_recv_shcomp=Paso_SharedComponents_alloc(in->recv->numNeighbors,
                                                        in->recv->neighbor,
                                                        in->recv->shared,
                                                        in->recv->offsetInShared,
                                                        block_size,0,in->mpi_info);
        } else {
            new_send_shcomp=Paso_SharedComponents_getReference(in->send);
            new_recv_shcomp=Paso_SharedComponents_getReference(in->recv);
        }
        if (Paso_noError()) out=Paso_Coupler_alloc(new_send_shcomp,new_recv_shcomp);
     }
     Paso_SharedComponents_free(new_send_shcomp);
     Paso_SharedComponents_free(new_recv_shcomp);
     if (Paso_noError()) {
          return out;
     } else {
          Paso_Coupler_free(out);
          return NULL;
     } 

}

1
2	/* $Id: Coupler.c 1306 2007-09-18 05:51:09Z ksteube $ */
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	/**************************************************************/
17
18	/* Paso: Coupler organizes the coupling with in a pattern/matrix */
19	/* across processors */
20
21	/**************************************************************/
22
23	/* Author: gross@access.edu.au */
24
25	/**************************************************************/
26
27	#include "Coupler.h"
28
29	/**************************************************************/
30
31	/* allocates a Coupler */
32
33
34	/**************************************************************/
35
36
37	Paso_Coupler* Paso_Coupler_alloc(Paso_SharedComponents* send,
38	Paso_SharedComponents* recv)
39	{
40	Paso_Coupler*out=NULL;
41	Paso_resetError();
42	out=MEMALLOC(1,Paso_Coupler);
43	if ( send->mpi_info != recv->mpi_info ) {
44	Paso_setError(SYSTEM_ERROR,"Paso_Coupler_alloc: send and recv mpi communicator don't match.");
45	return NULL;
46	}
47	if (!Paso_checkPtr(out)) {
48	out->send=Paso_SharedComponents_getReference(send);
49	out->send_buffer=NULL;
50	out->recv= Paso_SharedComponents_getReference(recv);
51	out->recv_buffer=NULL;
52	out->mpi_requests=NULL;
53	out->mpi_stati=NULL;
54	out->mpi_info = Paso_MPIInfo_getReference(send->mpi_info);
55	out->reference_counter=1;
56
57	#ifdef PASO_MPI
58	out->mpi_requests=MEMALLOC(send->numNeighbors+recv->numNeighbors,MPI_Request);
59	out->mpi_stati=MEMALLOC(send->numNeighbors+recv->numNeighbors,MPI_Status);
60	Paso_checkPtr(out->mpi_requests);
61	Paso_checkPtr(out->mpi_stati);
62	#endif
63	}
64	if (Paso_noError()) {
65	return out;
66	} else {
67	Paso_Coupler_free(out);
68	return NULL;
69	}
70	}
71
72	/* returns a reference to in */
73
74	Paso_Coupler* Paso_Coupler_getReference(Paso_Coupler* in) {
75	if (in!=NULL) {
76	++(in->reference_counter);
77	}
78	return in;
79	}
80
81	/* deallocates a Coupler: */
82
83	void Paso_Coupler_free(Paso_Coupler* in) {
84	if (in!=NULL) {
85	in->reference_counter--;
86	if (in->reference_counter<=0) {
87	Paso_SharedComponents_free(in->send);
88	MEMFREE(in->send_buffer);
89	Paso_SharedComponents_free(in->recv);
90	MEMFREE(in->recv_buffer);
91	MEMFREE(in->mpi_requests);
92	MEMFREE(in->mpi_stati);
93	Paso_MPIInfo_free(in->mpi_info);
94	MEMFREE(in);
95	#ifdef Paso_TRACE
96	printf("Paso_Coupler_dealloc: system matrix pattern as been deallocated.\n");
97	#endif
98	}
99	}
100	}
101
102	bool_t Paso_Coupler_bufferIsAllocated(Paso_Coupler* coupler) {
103	return ( (coupler->send_buffer !=NULL) \|\| (coupler->recv_buffer!=NULL) );
104	}
105
106	void Paso_Coupler_allocBuffer(Paso_Coupler* coupler,dim_t block_size)
107	{
108	Paso_MPIInfo *mpi_info = coupler->mpi_info;
109	if (Paso_Coupler_bufferIsAllocated(coupler)) {
110	Paso_setError(SYSTEM_ERROR,"Paso_Coupler_allocBuffer: coupler are still in use.");
111	return;
112	}
113	coupler->block_size=block_size;
114	if (coupler->mpi_info->size>1) {
115	coupler->send_buffer=MEMALLOC(coupler->send->numSharedComponents * coupler->block_size,double);
116	coupler->recv_buffer=MEMALLOC(coupler->recv->numSharedComponents * coupler->block_size,double);
117	if (Paso_checkPtr(coupler->send_buffer) \|\| Paso_checkPtr(coupler->recv_buffer) ) {
118	TMPMEMFREE(coupler->send_buffer);
119	TMPMEMFREE(coupler->recv_buffer);
120	}
121	}
122	return;
123	}
124	void Paso_Coupler_freeBuffer(Paso_Coupler* coupler)
125	{
126
127	if (coupler->mpi_info->size>1) {
128	MEMFREE(coupler->send_buffer);
129	MEMFREE(coupler->recv_buffer);
130	}
131	return;
132	}
133
134	void Paso_Coupler_startCollect(Paso_Coupler* coupler,const double* in)
135	{
136	Paso_MPIInfo *mpi_info = coupler->mpi_info;
137	dim_t block_size=coupler->block_size;
138	size_t block_size_size=block_size*sizeof(double);
139	dim_t i,j;
140	if ( mpi_info->size>1) {
141	/* start reveiving input */
142	#pragma omp master
143	{
144	for (i=0; i< coupler->recv->numNeighbors; ++i) {
145	#ifdef PASO_MPI
146	MPI_Irecv(&(coupler->recv_buffer[coupler->recv->offsetInShared[i] * block_size]),
147	(coupler->recv->offsetInShared[i+1]- coupler->recv->offsetInShared[i])*block_size,
148	MPI_DOUBLE,
149	coupler->recv->neighbor[i],
150	mpi_info->msg_tag_counter+coupler->recv->neighbor[i],
151	mpi_info->comm,
152	&(coupler->mpi_requests[i]));
153	#endif
154
155	}
156	}
157	/* collect values into buffer */
158	#pragma omp parallel for private(i)
159	for (i=0; i < coupler->send->numSharedComponents;++i) {
160	memcpy(&(coupler->send_buffer[(block_size)i]),&(in[ block_size coupler->send->shared[i]]), block_size_size);
161	}
162	/* send buffer out */
163	#pragma omp master
164	{
165	for (i=0; i< coupler->send->numNeighbors; ++i) {
166	#ifdef PASO_MPI
167	MPI_Issend(&(coupler->send_buffer[coupler->send->offsetInShared[i] * block_size]),
168	(coupler->send->offsetInShared[i+1]- coupler->send->offsetInShared[i])*block_size,
169	MPI_DOUBLE,
170	coupler->send->neighbor[i],
171	mpi_info->msg_tag_counter+mpi_info->rank,
172	mpi_info->comm,
173	&(coupler->mpi_requests[i+ coupler->recv->numNeighbors]));
174	#endif
175	}
176	}
177	mpi_info->msg_tag_counter+=mpi_info->size;
178	}
179	}
180
181	double* Paso_Coupler_finishCollect(Paso_Coupler* coupler)
182	{
183	Paso_MPIInfo *mpi_info = coupler->mpi_info;
184	if ( mpi_info->size>1) {
185	/* wait for receive */
186	#pragma omp master
187	{
188	#ifdef PASO_MPI
189	MPI_Waitall(coupler->recv->numNeighbors+coupler->send->numNeighbors,
190	coupler->mpi_requests,
191	coupler->mpi_stati);
192	#endif
193	}
194	}
195	return coupler->recv_buffer;
196	}
197
198	Paso_Coupler* Paso_Coupler_unroll(Paso_Coupler* in, index_t block_size) {
199	Paso_SharedComponents new_send_shcomp=NULL, new_recv_shcomp=NULL;
200	Paso_Coupler *out=NULL;
201	if (Paso_noError()) {
202	if (block_size>1) {
203	new_send_shcomp=Paso_SharedComponents_alloc(in->send->numNeighbors,
204	in->send->neighbor,
205	in->send->shared,
206	in->send->offsetInShared,
207	block_size,0,in->mpi_info);
208
209	new_recv_shcomp=Paso_SharedComponents_alloc(in->recv->numNeighbors,
210	in->recv->neighbor,
211	in->recv->shared,
212	in->recv->offsetInShared,
213	block_size,0,in->mpi_info);
214	} else {
215	new_send_shcomp=Paso_SharedComponents_getReference(in->send);
216	new_recv_shcomp=Paso_SharedComponents_getReference(in->recv);
217	}
218	if (Paso_noError()) out=Paso_Coupler_alloc(new_send_shcomp,new_recv_shcomp);
219	}
220	Paso_SharedComponents_free(new_send_shcomp);
221	Paso_SharedComponents_free(new_recv_shcomp);
222	if (Paso_noError()) {
223	return out;
224	} else {
225	Paso_Coupler_free(out);
226	return NULL;
227	}
228
229	}
230