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
     }
   }
}


void Paso_Coupler_allocBuffer(Paso_Coupler* coupler,dim_t block_size)
{
    Paso_MPIInfo *mpi_info = coupler->mpi_info;  
    if ( (coupler->send_buffer !=NULL) || (coupler->recv_buffer!=NULL) ) {
        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, 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 parallel omp 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	ksteube	1313
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
103			void Paso_Coupler_allocBuffer(Paso_Coupler* coupler,dim_t block_size)
104			{
105			Paso_MPIInfo *mpi_info = coupler->mpi_info;
106			if ( (coupler->send_buffer !=NULL) \|\| (coupler->recv_buffer!=NULL) ) {
107			Paso_setError(SYSTEM_ERROR,"Paso_Coupler_allocBuffer: coupler are still in use.");
108			return;
109			}
110			coupler->block_size=block_size;
111			if (coupler->mpi_info->size>1) {
112			coupler->send_buffer=MEMALLOC(coupler->send->numSharedComponents * coupler->block_size,double);
113			coupler->recv_buffer=MEMALLOC(coupler->recv->numSharedComponents * coupler->block_size,double);
114			if (Paso_checkPtr(coupler->send_buffer) \|\| Paso_checkPtr(coupler->recv_buffer) ) {
115			TMPMEMFREE(coupler->send_buffer);
116			TMPMEMFREE(coupler->recv_buffer);
117			}
118			}
119			return;
120			}
121			void Paso_Coupler_freeBuffer(Paso_Coupler* coupler)
122			{
123
124			if (coupler->mpi_info->size>1) {
125			MEMFREE(coupler->send_buffer);
126			MEMFREE(coupler->recv_buffer);
127			}
128			return;
129			}
130
131			void Paso_Coupler_startCollect(Paso_Coupler* coupler, double* in)
132			{
133			Paso_MPIInfo *mpi_info = coupler->mpi_info;
134			dim_t block_size=coupler->block_size;
135			size_t block_size_size=block_size*sizeof(double);
136			dim_t i,j;
137			if ( mpi_info->size>1) {
138			/* start reveiving input */
139			#pragma omp master
140			{
141			for (i=0; i< coupler->recv->numNeighbors; ++i) {
142			#ifdef PASO_MPI
143			MPI_Irecv(&(coupler->recv_buffer[coupler->recv->offsetInShared[i] * block_size]),
144			(coupler->recv->offsetInShared[i+1]- coupler->recv->offsetInShared[i])*block_size,
145			MPI_DOUBLE,
146			coupler->recv->neighbor[i],
147			mpi_info->msg_tag_counter+coupler->recv->neighbor[i],
148			mpi_info->comm,
149			&(coupler->mpi_requests[i]));
150			#endif
151
152			}
153			}
154			/* collect values into buffer */
155			#pragma parallel omp for private(i)
156			for (i=0; i < coupler->send->numSharedComponents;++i) {
157			memcpy(&(coupler->send_buffer[(block_size)i]),&(in[ block_size coupler->send->shared[i]]), block_size_size);
158			}
159			/* send buffer out */
160			#pragma omp master
161			{
162			for (i=0; i< coupler->send->numNeighbors; ++i) {
163			#ifdef PASO_MPI
164			MPI_Issend(&(coupler->send_buffer[coupler->send->offsetInShared[i] * block_size]),
165			(coupler->send->offsetInShared[i+1]- coupler->send->offsetInShared[i])*block_size,
166			MPI_DOUBLE,
167			coupler->send->neighbor[i],
168			mpi_info->msg_tag_counter+mpi_info->rank,
169			mpi_info->comm,
170			&(coupler->mpi_requests[i+ coupler->recv->numNeighbors]));
171			#endif
172			}
173			}
174			mpi_info->msg_tag_counter+mpi_info->size;
175			}
176			}
177
178			double* Paso_Coupler_finishCollect(Paso_Coupler* coupler)
179			{
180			Paso_MPIInfo *mpi_info = coupler->mpi_info;
181			if ( mpi_info->size>1) {
182			/* wait for receive */
183			#pragma omp master
184			{
185			#ifdef PASO_MPI
186			MPI_Waitall(coupler->recv->numNeighbors+coupler->send->numNeighbors,
187			coupler->mpi_requests,
188			coupler->mpi_stati);
189			#endif
190			}
191			}
192			return coupler->recv_buffer;
193			}
194
195			Paso_Coupler* Paso_Coupler_unroll(Paso_Coupler* in, index_t block_size) {
196			Paso_SharedComponents new_send_shcomp=NULL, new_recv_shcomp=NULL;
197			Paso_Coupler *out=NULL;
198			if (Paso_noError()) {
199			if (block_size>1) {
200			new_send_shcomp=Paso_SharedComponents_alloc(in->send->numNeighbors,
201			in->send->neighbor,
202			in->send->shared,
203			in->send->offsetInShared,
204			block_size,0,in->mpi_info);
205
206			new_recv_shcomp=Paso_SharedComponents_alloc(in->recv->numNeighbors,
207			in->recv->neighbor,
208			in->recv->shared,
209			in->recv->offsetInShared,
210			block_size,0,in->mpi_info);
211			} else {
212			new_send_shcomp=Paso_SharedComponents_getReference(in->send);
213			new_recv_shcomp=Paso_SharedComponents_getReference(in->recv);
214			}
215			if (Paso_noError()) out=Paso_Coupler_alloc(new_send_shcomp,new_recv_shcomp);
216			}
217			Paso_SharedComponents_free(new_send_shcomp);
218			Paso_SharedComponents_free(new_recv_shcomp);
219			if (Paso_noError()) {
220			return out;
221			} else {
222			Paso_Coupler_free(out);
223			return NULL;
224			}
225
226			}
227