예제 #1
0
hypre_ParCSRCommMultiHandle *
hypre_ParCSRCommMultiHandleCreate (HYPRE_Int 	               job,
			           hypre_ParCSRCommPkg *comm_pkg,
                                   void                *send_data, 
                                   void                *recv_data, 
				   HYPRE_Int                 num_vecs )
{
   HYPRE_Int                  num_sends = hypre_ParCSRCommPkgNumSends(comm_pkg);
   HYPRE_Int                  num_recvs = hypre_ParCSRCommPkgNumRecvs(comm_pkg);
   MPI_Comm             comm      = hypre_ParCSRCommPkgComm(comm_pkg);

   hypre_ParCSRCommMultiHandle *comm_handle;
   HYPRE_Int                         num_requests;
   hypre_MPI_Request                 *requests;

   HYPRE_Int                  i, j;
   HYPRE_Int			my_id, num_procs;
   HYPRE_Int			ip, vec_start, vec_len;
                  
   /*--------------------------------------------------------------------
    * hypre_Initialize sets up a communication handle,
    * posts receives and initiates sends. It always requires num_sends, 
    * num_recvs, recv_procs and send_procs to be set in comm_pkg.
    * There are different options for job:
    * job = 1 : is used to initialize communication exchange for the parts
    *		of vector needed to perform a Matvec,  it requires send_data 
    *		and recv_data to be doubles, recv_vec_starts and 
    *		send_map_starts need to be set in comm_pkg.
    * job = 2 : is used to initialize communication exchange for the parts
    *		of vector needed to perform a MatvecT,  it requires send_data 
    *		and recv_data to be doubles, recv_vec_starts and 
    *		send_map_starts need to be set in comm_pkg.
    *--------------------------------------------------------------------*/

   num_requests = num_sends + num_recvs;
   requests = hypre_CTAlloc(hypre_MPI_Request, num_requests);
 
   hypre_MPI_Comm_size(comm,&num_procs);
   hypre_MPI_Comm_rank(comm,&my_id);

   j = 0;
   switch (job)
   {
      case  1:
      {
	 double *d_send_data = (double *) send_data;
	 double *d_recv_data = (double *) recv_data;
   	 for (i = 0; i < num_recvs; i++)
   	 {
      	    ip = hypre_ParCSRCommPkgRecvProc(comm_pkg, i); 
      	    vec_start = hypre_ParCSRCommPkgRecvVecStart(comm_pkg,i);
      	    vec_len = hypre_ParCSRCommPkgRecvVecStart(comm_pkg,i+1)-vec_start;
      	    hypre_MPI_Irecv(&d_recv_data[vec_start*num_vecs], vec_len*num_vecs, 
                      hypre_MPI_DOUBLE, ip, 0, comm, &requests[j++]);
   	 }
   	 for (i = 0; i < num_sends; i++)
   	 {
	    vec_start = hypre_ParCSRCommPkgSendMapStart(comm_pkg, i);
	    vec_len = hypre_ParCSRCommPkgSendMapStart(comm_pkg, i+1)-vec_start;
      	    ip = hypre_ParCSRCommPkgSendProc(comm_pkg, i); 
   	    hypre_MPI_Isend(&d_send_data[vec_start*num_vecs], vec_len*num_vecs,
                      hypre_MPI_DOUBLE, ip, 0, comm, &requests[j++]);
   	 }
	 break;
      }
      case  2:
      {
 	 double *d_send_data = (double *) send_data;
	 double *d_recv_data = (double *) recv_data;
   	 for (i = 0; i < num_sends; i++)
   	 {
	    vec_start = hypre_ParCSRCommPkgSendMapStart(comm_pkg, i);
	    vec_len = hypre_ParCSRCommPkgSendMapStart(comm_pkg, i+1) - vec_start;
      	    ip = hypre_ParCSRCommPkgSendProc(comm_pkg, i); 
   	    hypre_MPI_Irecv(&d_recv_data[vec_start*num_vecs], vec_len*num_vecs,
                      hypre_MPI_DOUBLE, ip, 0, comm, &requests[j++]);
   	 }
   	 for (i = 0; i < num_recvs; i++)
   	 {
      	    ip = hypre_ParCSRCommPkgRecvProc(comm_pkg, i); 
      	    vec_start = hypre_ParCSRCommPkgRecvVecStart(comm_pkg,i);
      	    vec_len = hypre_ParCSRCommPkgRecvVecStart(comm_pkg,i+1)-vec_start;
      	    hypre_MPI_Isend(&d_send_data[vec_start*num_vecs], vec_len*num_vecs,
                      hypre_MPI_DOUBLE, ip, 0, comm, &requests[j++]);
   	 }
	 break;
      }
   }

   /*--------------------------------------------------------------------
    * set up comm_handle and return
    *--------------------------------------------------------------------*/

   comm_handle = hypre_CTAlloc(hypre_ParCSRCommMultiHandle, 1);

   hypre_ParCSRCommMultiHandleCommPkg(comm_handle)     = comm_pkg;
   hypre_ParCSRCommMultiHandleSendData(comm_handle)    = send_data;
   hypre_ParCSRCommMultiHandleRecvData(comm_handle)    = recv_data;
   hypre_ParCSRCommMultiHandleNumRequests(comm_handle) = num_requests;
   hypre_ParCSRCommMultiHandleRequests(comm_handle)    = requests;

   return (comm_handle);
}
예제 #2
0
hypre_ParCSRBooleanMatrix *
hypre_CSRBooleanMatrixToParCSRBooleanMatrix
( MPI_Comm comm, hypre_CSRBooleanMatrix *A,
  HYPRE_Int *row_starts, HYPRE_Int *col_starts )
{
   HYPRE_Int          global_data[2];
   HYPRE_Int          global_num_rows;
   HYPRE_Int          global_num_cols;
   HYPRE_Int          *local_num_rows;

   HYPRE_Int          num_procs, my_id;
   HYPRE_Int          *local_num_nonzeros;
   HYPRE_Int          num_nonzeros;
  
   HYPRE_Int          *a_i;
   HYPRE_Int          *a_j;
  
   hypre_CSRBooleanMatrix *local_A;

   hypre_MPI_Request  *requests;
   hypre_MPI_Status   *status, status0;
   hypre_MPI_Datatype *csr_matrix_datatypes;

   hypre_ParCSRBooleanMatrix *par_matrix;

   HYPRE_Int          first_col_diag;
   HYPRE_Int          last_col_diag;
 
   HYPRE_Int i, j, ind;

   hypre_MPI_Comm_rank(comm, &my_id);
   hypre_MPI_Comm_size(comm, &num_procs);

   if (my_id == 0) 
   {
        global_data[0] = hypre_CSRBooleanMatrix_Get_NRows(A);
        global_data[1] = hypre_CSRBooleanMatrix_Get_NCols(A);
        a_i = hypre_CSRBooleanMatrix_Get_I(A);
        a_j = hypre_CSRBooleanMatrix_Get_J(A);
   }
   hypre_MPI_Bcast(global_data,2,HYPRE_MPI_INT,0,comm);
   global_num_rows = global_data[0];
   global_num_cols = global_data[1];

   local_num_rows = hypre_CTAlloc(HYPRE_Int, num_procs);
   csr_matrix_datatypes = hypre_CTAlloc(hypre_MPI_Datatype, num_procs);

   par_matrix = hypre_ParCSRBooleanMatrixCreate (comm, global_num_rows,
        global_num_cols,row_starts,col_starts,0,0,0);

   row_starts = hypre_ParCSRBooleanMatrix_Get_RowStarts(par_matrix);
   col_starts = hypre_ParCSRBooleanMatrix_Get_ColStarts(par_matrix);

   for (i=0; i < num_procs; i++)
         local_num_rows[i] = row_starts[i+1] - row_starts[i];

   if (my_id == 0)
   {
        local_num_nonzeros = hypre_CTAlloc(HYPRE_Int, num_procs);
        for (i=0; i < num_procs-1; i++)
                local_num_nonzeros[i] = a_i[row_starts[i+1]] 
                                - a_i[row_starts[i]];
        local_num_nonzeros[num_procs-1] = a_i[global_num_rows] 
                                - a_i[row_starts[num_procs-1]];
   }
   hypre_MPI_Scatter(local_num_nonzeros,1,HYPRE_MPI_INT,&num_nonzeros,1,HYPRE_MPI_INT,0,comm);

   if (my_id == 0) num_nonzeros = local_num_nonzeros[0];

   local_A = hypre_CSRBooleanMatrixCreate(local_num_rows[my_id], global_num_cols,
                num_nonzeros);
   if (my_id == 0)
   {
        requests = hypre_CTAlloc (hypre_MPI_Request, num_procs-1);
        status = hypre_CTAlloc(hypre_MPI_Status, num_procs-1);
        j=0;
        for (i=1; i < num_procs; i++)
        {
                ind = a_i[row_starts[i]];
                hypre_BuildCSRBooleanMatrixMPIDataType(local_num_nonzeros[i], 
                        local_num_rows[i],
                        &a_i[row_starts[i]],
                        &a_j[ind],
                        &csr_matrix_datatypes[i]);
                hypre_MPI_Isend(hypre_MPI_BOTTOM, 1, csr_matrix_datatypes[i], i, 0, comm,
                        &requests[j++]);
                hypre_MPI_Type_free(&csr_matrix_datatypes[i]);
        }
        hypre_CSRBooleanMatrix_Get_I(local_A) = a_i;
        hypre_CSRBooleanMatrix_Get_J(local_A) = a_j;
        hypre_MPI_Waitall(num_procs-1,requests,status);
        hypre_TFree(requests);
        hypre_TFree(status);
        hypre_TFree(local_num_nonzeros);
    }
   else
   {
        hypre_CSRBooleanMatrixInitialize(local_A);
        hypre_BuildCSRBooleanMatrixMPIDataType(num_nonzeros, 
                        local_num_rows[my_id],
                        hypre_CSRBooleanMatrix_Get_I(local_A),
                        hypre_CSRBooleanMatrix_Get_J(local_A),
                        csr_matrix_datatypes);
        hypre_MPI_Recv(hypre_MPI_BOTTOM,1,csr_matrix_datatypes[0],0,0,comm,&status0);
        hypre_MPI_Type_free(csr_matrix_datatypes);
   }

   first_col_diag = col_starts[my_id];
   last_col_diag = col_starts[my_id+1]-1;

   BooleanGenerateDiagAndOffd(local_A, par_matrix, first_col_diag, last_col_diag);

   /* set pointers back to NULL before destroying */
   if (my_id == 0)
   {      
      hypre_CSRBooleanMatrix_Get_I(local_A) = NULL;
      hypre_CSRBooleanMatrix_Get_J(local_A) = NULL; 
   }      
   hypre_CSRBooleanMatrixDestroy(local_A);
   hypre_TFree(local_num_rows);
   hypre_TFree(csr_matrix_datatypes);

   return par_matrix;
}
예제 #3
0
hypre_Vector *
hypre_ParVectorToVectorAll (hypre_ParVector *par_v)
{
   MPI_Comm		comm = hypre_ParVectorComm(par_v);
   HYPRE_Int 			global_size = hypre_ParVectorGlobalSize(par_v);
#ifndef HYPRE_NO_GLOBAL_PARTITION
   HYPRE_Int 			*vec_starts = hypre_ParVectorPartitioning(par_v);
#endif
   hypre_Vector     	*local_vector = hypre_ParVectorLocalVector(par_v);
   HYPRE_Int  		num_procs, my_id;
   HYPRE_Int                  num_vectors = hypre_ParVectorNumVectors(par_v);
   hypre_Vector  	*vector;
   double		*vector_data;
   double		*local_data;
   HYPRE_Int 			local_size;
   hypre_MPI_Request		*requests;
   hypre_MPI_Status		*status;
   HYPRE_Int			i, j;
   HYPRE_Int			*used_procs;
   HYPRE_Int			num_types, num_requests;
   HYPRE_Int			vec_len, proc_id;

#ifdef HYPRE_NO_GLOBAL_PARTITION

   HYPRE_Int *new_vec_starts;
   
   HYPRE_Int num_contacts;
   HYPRE_Int contact_proc_list[1];
   HYPRE_Int contact_send_buf[1];
   HYPRE_Int contact_send_buf_starts[2];
   HYPRE_Int max_response_size;
   HYPRE_Int *response_recv_buf=NULL;
   HYPRE_Int *response_recv_buf_starts = NULL;
   hypre_DataExchangeResponse response_obj;
   hypre_ProcListElements send_proc_obj;
   
   HYPRE_Int *send_info = NULL;
   hypre_MPI_Status  status1;
   HYPRE_Int count, tag1 = 112, tag2 = 223;
   HYPRE_Int start;
   
#endif


   hypre_MPI_Comm_size(comm, &num_procs);
   hypre_MPI_Comm_rank(comm, &my_id);

#ifdef HYPRE_NO_GLOBAL_PARTITION

  local_size = hypre_ParVectorLastIndex(par_v) - 
     hypre_ParVectorFirstIndex(par_v) + 1;

 

/* determine procs which hold data of par_v and store ids in used_procs */
/* we need to do an exchange data for this.  If I own row then I will contact
   processor 0 with the endpoint of my local range */


   if (local_size > 0)
   {
      num_contacts = 1;
      contact_proc_list[0] = 0;
      contact_send_buf[0] =  hypre_ParVectorLastIndex(par_v);
      contact_send_buf_starts[0] = 0;
      contact_send_buf_starts[1] = 1;
   }
   else
   {
      num_contacts = 0;
      contact_send_buf_starts[0] = 0;
      contact_send_buf_starts[1] = 0;
   }

   /*build the response object*/
   /*send_proc_obj will  be for saving info from contacts */
   send_proc_obj.length = 0;
   send_proc_obj.storage_length = 10;
   send_proc_obj.id = hypre_CTAlloc(HYPRE_Int, send_proc_obj.storage_length);
   send_proc_obj.vec_starts = hypre_CTAlloc(HYPRE_Int, send_proc_obj.storage_length + 1); 
   send_proc_obj.vec_starts[0] = 0;
   send_proc_obj.element_storage_length = 10;
   send_proc_obj.elements = hypre_CTAlloc(HYPRE_Int, send_proc_obj.element_storage_length);

   max_response_size = 0; /* each response is null */
   response_obj.fill_response = hypre_FillResponseParToVectorAll;
   response_obj.data1 = NULL;
   response_obj.data2 = &send_proc_obj; /*this is where we keep info from contacts*/
  
   
   hypre_DataExchangeList(num_contacts, 
                          contact_proc_list, contact_send_buf, 
                          contact_send_buf_starts, sizeof(HYPRE_Int), 
                          sizeof(HYPRE_Int), &response_obj, 
                          max_response_size, 1,
                          comm, (void**) &response_recv_buf,	   
                          &response_recv_buf_starts);

 /* now processor 0 should have a list of ranges for processors that have rows -
      these are in send_proc_obj - it needs to create the new list of processors
      and also an array of vec starts - and send to those who own row*/
   if (my_id)
   {
      if (local_size)      
      {
         /* look for a message from processor 0 */         
         hypre_MPI_Probe(0, tag1, comm, &status1);
         hypre_MPI_Get_count(&status1, HYPRE_MPI_INT, &count);
         
         send_info = hypre_CTAlloc(HYPRE_Int, count);
         hypre_MPI_Recv(send_info, count, HYPRE_MPI_INT, 0, tag1, comm, &status1);

         /* now unpack */  
         num_types = send_info[0];
         used_procs =  hypre_CTAlloc(HYPRE_Int, num_types);  
         new_vec_starts = hypre_CTAlloc(HYPRE_Int, num_types+1);

         for (i=1; i<= num_types; i++)
         {
            used_procs[i-1] = send_info[i];
         }
         for (i=num_types+1; i< count; i++)
         {
            new_vec_starts[i-num_types-1] = send_info[i] ;
         }
      }
      else /* clean up and exit */
      {
         hypre_TFree(send_proc_obj.vec_starts);
         hypre_TFree(send_proc_obj.id);
         hypre_TFree(send_proc_obj.elements);
         if(response_recv_buf)        hypre_TFree(response_recv_buf);
         if(response_recv_buf_starts) hypre_TFree(response_recv_buf_starts);
         return NULL;
      }
   }
   else /* my_id ==0 */
   {
      num_types = send_proc_obj.length;
      used_procs =  hypre_CTAlloc(HYPRE_Int, num_types);  
      new_vec_starts = hypre_CTAlloc(HYPRE_Int, num_types+1);
      
      new_vec_starts[0] = 0;
      for (i=0; i< num_types; i++)
      {
         used_procs[i] = send_proc_obj.id[i];
         new_vec_starts[i+1] = send_proc_obj.elements[i]+1;
      }
      qsort0(used_procs, 0, num_types-1);
      qsort0(new_vec_starts, 0, num_types);
      /*now we need to put into an array to send */
      count =  2*num_types+2;
      send_info = hypre_CTAlloc(HYPRE_Int, count);
      send_info[0] = num_types;
      for (i=1; i<= num_types; i++)
      {
         send_info[i] = used_procs[i-1];
      }
      for (i=num_types+1; i< count; i++)
      {
         send_info[i] = new_vec_starts[i-num_types-1];
      }
      requests = hypre_CTAlloc(hypre_MPI_Request, num_types);
      status =  hypre_CTAlloc(hypre_MPI_Status, num_types);

      /* don't send to myself  - these are sorted so my id would be first*/
      start = 0;
      if (used_procs[0] == 0)
      {
         start = 1;
      }
   
      
      for (i=start; i < num_types; i++)
      {
         hypre_MPI_Isend(send_info, count, HYPRE_MPI_INT, used_procs[i], tag1, comm, &requests[i-start]);
      }
      hypre_MPI_Waitall(num_types-start, requests, status);

      hypre_TFree(status);
      hypre_TFree(requests);
   }

   /* clean up */
   hypre_TFree(send_proc_obj.vec_starts);
   hypre_TFree(send_proc_obj.id);
   hypre_TFree(send_proc_obj.elements);
   hypre_TFree(send_info);
   if(response_recv_buf)        hypre_TFree(response_recv_buf);
   if(response_recv_buf_starts) hypre_TFree(response_recv_buf_starts);

   /* now proc 0 can exit if it has no rows */
   if (!local_size) {
      hypre_TFree(used_procs);
      hypre_TFree(new_vec_starts);
      return NULL;
   }
   
   /* everyone left has rows and knows: new_vec_starts, num_types, and used_procs */

  /* this vector should be rather small */

   local_data = hypre_VectorData(local_vector);
   vector = hypre_SeqVectorCreate(global_size);
   hypre_VectorNumVectors(vector) = num_vectors;
   hypre_SeqVectorInitialize(vector);
   vector_data = hypre_VectorData(vector);

   num_requests = 2*num_types;

   requests = hypre_CTAlloc(hypre_MPI_Request, num_requests);
   status = hypre_CTAlloc(hypre_MPI_Status, num_requests);

/* initialize data exchange among used_procs and generate vector  - here we 
   send to ourself also*/
 
   j = 0;
   for (i = 0; i < num_types; i++)
   {
        proc_id = used_procs[i];
        vec_len = new_vec_starts[i+1] - new_vec_starts[i];
        hypre_MPI_Irecv(&vector_data[new_vec_starts[i]], num_vectors*vec_len, hypre_MPI_DOUBLE,
                                proc_id, tag2, comm, &requests[j++]);
   }
   for (i = 0; i < num_types; i++)
   {
        hypre_MPI_Isend(local_data, num_vectors*local_size, hypre_MPI_DOUBLE, used_procs[i],
                          tag2, comm, &requests[j++]);
   }
 
   hypre_MPI_Waitall(num_requests, requests, status);


   if (num_requests)
   {
   	hypre_TFree(requests);
   	hypre_TFree(status); 
        hypre_TFree(used_procs);
   }

   hypre_TFree(new_vec_starts);
   


#else
   local_size = vec_starts[my_id+1] - vec_starts[my_id];

/* if my_id contains no data, return NULL  */

   if (!local_size)
	return NULL;
 
   local_data = hypre_VectorData(local_vector);
   vector = hypre_SeqVectorCreate(global_size);
   hypre_VectorNumVectors(vector) = num_vectors;
   hypre_SeqVectorInitialize(vector);
   vector_data = hypre_VectorData(vector);

/* determine procs which hold data of par_v and store ids in used_procs */

   num_types = -1;
   for (i=0; i < num_procs; i++)
        if (vec_starts[i+1]-vec_starts[i])
                num_types++;
   num_requests = 2*num_types;
 
   used_procs = hypre_CTAlloc(HYPRE_Int, num_types);
   j = 0;
   for (i=0; i < num_procs; i++)
        if (vec_starts[i+1]-vec_starts[i] && i-my_id)
                used_procs[j++] = i;
 
   requests = hypre_CTAlloc(hypre_MPI_Request, num_requests);
   status = hypre_CTAlloc(hypre_MPI_Status, num_requests);

/* initialize data exchange among used_procs and generate vector */
 
   j = 0;
   for (i = 0; i < num_types; i++)
   {
        proc_id = used_procs[i];
        vec_len = vec_starts[proc_id+1] - vec_starts[proc_id];
        hypre_MPI_Irecv(&vector_data[vec_starts[proc_id]], num_vectors*vec_len, hypre_MPI_DOUBLE,
                                proc_id, 0, comm, &requests[j++]);
   }
   for (i = 0; i < num_types; i++)
   {
        hypre_MPI_Isend(local_data, num_vectors*local_size, hypre_MPI_DOUBLE, used_procs[i],
                          0, comm, &requests[j++]);
   }
 
   for (i=0; i < num_vectors*local_size; i++)
        vector_data[vec_starts[my_id]+i] = local_data[i];
 
   hypre_MPI_Waitall(num_requests, requests, status);

   if (num_requests)
   {
   	hypre_TFree(used_procs);
   	hypre_TFree(requests);
   	hypre_TFree(status); 
   }


#endif

   return vector;
}
예제 #4
0
HYPRE_Int hypre_DataExchangeList(HYPRE_Int num_contacts, 
                                 HYPRE_Int *contact_proc_list,
                                 void *contact_send_buf, 
                                 HYPRE_Int *contact_send_buf_starts,
                                 HYPRE_Int contact_obj_size, 
                                 HYPRE_Int response_obj_size,
                                 hypre_DataExchangeResponse *response_obj,
                                 HYPRE_Int max_response_size, 
                                 HYPRE_Int rnum, MPI_Comm comm,
                                 void **p_response_recv_buf, 
                                 HYPRE_Int **p_response_recv_buf_starts)
{
   /*-------------------------------------------
    *  parameters: 
    *   
    *    num_contacts              = how many procs to contact
    *    contact_proc_list         = list of processors to contact 
    *    contact_send_buf          = array of data to send
    *    contact_send_buf_starts   = index for contact_send_buf corresponding to 
    *                                contact_proc_list
    *    contact_obj_size          = sizeof() one obj in contact list  
   
    *    response_obj_size          = sizeof() one obj in response_recv_buf 
    *    response_obj              = this will give us the function we need to 
    *                                fill the reponse as well as 
    *                                any data we might need to accomplish that 
    *    max_response_size         = max size of a single response expected (do NOT
    *                                need to be an absolute upper bound)  
    *    rnum                      = two consequentive exchanges should have different 
    *                                rnums. Alternate rnum = 1 
    *                                and rnum=2  - these flags will be even (so odd
    *                                numbered tags could be used in calling code) 
    *    p_response_recv_buf       = where to receive the reponses - will be allocated 
    *                                in this function  
    *    p_response_recv_buf_starts  = index of p_response_buf corresponding to 
    *                                contact_buf_list - will be allocated here  

    *-------------------------------------------*/

   HYPRE_Int  num_procs, myid;
   HYPRE_Int  i;
   HYPRE_Int  terminate, responses_complete;
   HYPRE_Int  children_complete;
   HYPRE_Int  contact_flag;
   HYPRE_Int  proc;
   HYPRE_Int  contact_size;

   HYPRE_Int  size, post_size, copy_size;
   HYPRE_Int  total_size, count;      

   void *start_ptr = NULL, *index_ptr=NULL;
   HYPRE_Int  *int_ptr=NULL;  

   void *response_recv_buf = NULL;
   void *send_response_buf = NULL;

   HYPRE_Int  *response_recv_buf_starts = NULL;
   void *initial_recv_buf = NULL;  

   void *recv_contact_buf = NULL;
   HYPRE_Int  recv_contact_buf_size = 0;
   
   HYPRE_Int  response_message_size = 0;

   HYPRE_Int  overhead;
 
   HYPRE_Int  max_response_size_bytes;
   
   HYPRE_Int  max_response_total_bytes;
   
   void **post_array = NULL;  /*this must be set to null or realloc will crash */
   HYPRE_Int  post_array_storage = 0;
   HYPRE_Int  post_array_size = 0;
   HYPRE_Int   num_post_recvs =0;
   
   void **contact_ptrs = NULL, **response_ptrs=NULL, **post_ptrs=NULL;
   
   hypre_BinaryTree tree;

   hypre_MPI_Request *response_requests, *contact_requests;
   hypre_MPI_Status  *response_statuses, *contact_statuses;
   
   hypre_MPI_Request  *post_send_requests = NULL, *post_recv_requests = NULL;
   hypre_MPI_Status   *post_send_statuses = NULL, *post_recv_statuses = NULL;

   hypre_MPI_Request *term_requests, term_request1, request_parent;
   hypre_MPI_Status  *term_statuses, term_status1, status_parent;
   hypre_MPI_Status  status, fill_status;

   const HYPRE_Int contact_tag = 1000*rnum;
   const HYPRE_Int response_tag = 1002*rnum;
   const HYPRE_Int term_tag =  1004*rnum;  
   const HYPRE_Int post_tag = 1006*rnum;
   
   hypre_MPI_Comm_size(comm, &num_procs );
   hypre_MPI_Comm_rank(comm, &myid );

   /* ---------initializations ----------------*/ 

   /* if the response_obj_size or contact_obj_size is 0, set to sizeof(HYPRE_Int) */
   if (!response_obj_size) response_obj_size = sizeof(HYPRE_Int);
   if (!contact_obj_size) contact_obj_size = sizeof(HYPRE_Int);

   max_response_size_bytes = max_response_size*response_obj_size;
 
                   
   /* pre-allocate the max space for responding to contacts */
   overhead = ceil((HYPRE_Real) sizeof(HYPRE_Int)/response_obj_size); /*for appending an integer*/
   
   max_response_total_bytes = (max_response_size+overhead)*response_obj_size;

   response_obj->send_response_overhead = overhead;
   response_obj->send_response_storage = max_response_size;

   /*send_response_buf = hypre_MAlloc(max_response_total_bytes);*/
   send_response_buf = hypre_CAlloc(max_response_size+overhead, response_obj_size);
      
   /*allocate space for inital recv array for the responses - give each processor
     size max_response_size */

   initial_recv_buf = hypre_MAlloc(max_response_total_bytes*num_contacts);
   response_recv_buf_starts =   hypre_CTAlloc(HYPRE_Int, num_contacts+1);  

   contact_ptrs = hypre_TAlloc( void *, num_contacts);
   response_ptrs = hypre_TAlloc(void *, num_contacts);
   
   /*-------------SEND CONTACTS AND POST RECVS FOR RESPONSES---*/

   for (i=0; i<= num_contacts; i++)
   {
      response_recv_buf_starts[i] = i*(max_response_size+overhead);
   }
   
   /* Send "contact" messages to the list of processors and 
      pre-post receives to wait for their response*/

   responses_complete = 1;
   if (num_contacts > 0 )
   {
      responses_complete = 0;
      response_requests = hypre_CTAlloc(hypre_MPI_Request, num_contacts);
      response_statuses = hypre_CTAlloc(hypre_MPI_Status, num_contacts);
      contact_requests = hypre_CTAlloc(hypre_MPI_Request, num_contacts);
      contact_statuses = hypre_CTAlloc(hypre_MPI_Status, num_contacts);

      /* post receives - could be confirmation or data*/
      /* the size to post is max_response_total_bytes*/     
      
      for (i=0; i< num_contacts; i++) 
      {
         /* response_ptrs[i] =  initial_recv_buf + i*max_response_total_bytes ; */
         response_ptrs[i] = (void *)((char *) initial_recv_buf +
                                     i*max_response_total_bytes) ; 

         hypre_MPI_Irecv(response_ptrs[i], max_response_total_bytes,
                         hypre_MPI_BYTE, contact_proc_list[i], 
                         response_tag, comm, &response_requests[i]);
      }

      /* send out contact messages */
      start_ptr = contact_send_buf;
      for (i=0; i< num_contacts; i++) 
      {
         contact_ptrs[i] = start_ptr; 
         size =  contact_send_buf_starts[i+1] - contact_send_buf_starts[i]  ; 
         hypre_MPI_Isend(contact_ptrs[i], size*contact_obj_size,
                         hypre_MPI_BYTE, contact_proc_list[i], 
                         contact_tag, comm, &contact_requests[i]); 
         /*  start_ptr += (size*contact_obj_size); */        
         start_ptr = (void *) ((char *) start_ptr  + (size*contact_obj_size)); 
      }
   }

   /*------------BINARY TREE-----------------------*/

   /*Now let's find out our binary tree information and
     initialize for the termination check sweep */
   terminate = 1; /*indicates whether we can stop probing for contact */
   children_complete = 1;/*indicates whether we have recv. term messages 
                           from our children*/
 
   if (num_procs > 1)
   { 
      hypre_CreateBinaryTree(myid, num_procs, &tree);

      /* we will get a message from all of our children when they 
         have received responses for all of their contacts.  
         So post receives now */
   
      term_requests = hypre_CTAlloc(hypre_MPI_Request, tree.num_child); 
      term_statuses = hypre_CTAlloc(hypre_MPI_Status, tree.num_child);

      for (i=0; i< tree.num_child; i++) 
      {
	 hypre_MPI_Irecv(NULL, 0, HYPRE_MPI_INT, tree.child_id[i], term_tag, comm, 
                         &term_requests[i]);
      }

      terminate = 0;
 
      children_complete = 0;
   }
   else if (num_procs ==1 && num_contacts > 0 ) /* added 11/08 */
   {
      terminate = 0;
   }

   /*---------PROBE LOOP-----------------------------------------*/

   /*Look for incoming contact messages - don't know how many I will get!*/
  
   while (!terminate)
   {
      /* did I receive any contact messages? */
      hypre_MPI_Iprobe(hypre_MPI_ANY_SOURCE, contact_tag, comm,
                       &contact_flag, &status);

      while (contact_flag)
      {
         /* received contacts - from who and what do we do ?*/
         proc = status.hypre_MPI_SOURCE;
         hypre_MPI_Get_count(&status, hypre_MPI_BYTE, &contact_size);

         contact_size = contact_size/contact_obj_size;
         
         /*---------------FILL RESPONSE ------------------------*/

         /*first receive the contact buffer - then call a function
           to determine how to populate the send buffer for the reponse*/

         /* do we have enough space to recv it? */
         if(contact_size > recv_contact_buf_size) 
         {
            recv_contact_buf = hypre_ReAlloc(recv_contact_buf, 
                                             contact_obj_size*contact_size);
            recv_contact_buf_size = contact_size;
         } 

         /* this must be blocking - can't fill recv without the buffer*/         
         hypre_MPI_Recv(recv_contact_buf, contact_size*contact_obj_size,
                        hypre_MPI_BYTE, proc, contact_tag, comm, &fill_status);

         response_obj->fill_response(recv_contact_buf, contact_size, proc,
                                     response_obj, comm, &send_response_buf,
                                     &response_message_size );

         /* we need to append the size of the send obj */
         /* first we copy out any part that may be needed to send later so we don't overwrite */
         post_size = response_message_size - max_response_size; 
         if (post_size > 0) /*we will need to send the extra information later */   
         {
            /*hypre_printf("myid = %d, post_size = %d\n", myid, post_size);*/

            if (post_array_size == post_array_storage)
             
            {
               /* allocate room for more posts  - add 20*/
               post_array_storage += 20;       
               post_array = hypre_TReAlloc(post_array, void *, post_array_storage); 
               post_send_requests =
                  hypre_TReAlloc(post_send_requests, hypre_MPI_Request,
                                 post_array_storage);
            }
            /* allocate space for the data this post only*/
            /* this should not happen often (unless a poor max_size has been chosen)
               - so we will allocate space for the data as needed */
            size = post_size*response_obj_size;
            post_array[post_array_size] =  hypre_MAlloc(size); 
            /* index_ptr =  send_response_buf + max_response_size_bytes */;
            index_ptr = (void *) ((char *) send_response_buf +
                                  max_response_size_bytes);
               
            memcpy(post_array[post_array_size], index_ptr, size);
    
            /*now post any part of the message that is too long with a non-blocking
              send and a different tag */

            hypre_MPI_Isend(post_array[post_array_size], size,
                            hypre_MPI_BYTE, proc, post_tag, 
                            /*hypre_MPI_COMM_WORLD, */
                            comm,
                            &post_send_requests[post_array_size]); 

            post_array_size++;
         }

         /*now append the size information into the overhead storage */
         /* index_ptr =  send_response_buf + max_response_size_bytes; */
         index_ptr = (void *) ((char *) send_response_buf +
                               max_response_size_bytes);

         memcpy(index_ptr, &response_message_size, sizeof(HYPRE_Int));
         
         /*send the block of data that includes the overhead */        
         /* this is a blocking send - the recv has already been posted */
         hypre_MPI_Send(send_response_buf, max_response_total_bytes, 
                        hypre_MPI_BYTE, proc, response_tag, comm); 

         /*--------------------------------------------------------------*/
      
         /* look for any more contact messages*/
         hypre_MPI_Iprobe(hypre_MPI_ANY_SOURCE, contact_tag, comm,
                          &contact_flag, &status);
      }
    
      /* no more contact messages waiting - either 
         (1) check to see if we have received all of our response messages
         (2) participate in termination (check for messages from children)
         (3) participate in termination sweep (check for message from parent) */
    
      if (!responses_complete) 
      {
         hypre_MPI_Testall(num_contacts, response_requests, &responses_complete, 
                           response_statuses);
         if (responses_complete && num_procs == 1) terminate = 1; /*added 11/08 */

      }
      else if(!children_complete) /* have all of our children received all of their 
                                     response messages?*/
      {
         hypre_MPI_Testall(tree.num_child, term_requests, &children_complete, 
                           term_statuses);

         /* if we have gotten term messages from all of our children, send a term 
            message to our parent.  Then post a receive to hear back from parent */ 
	 if (children_complete & (myid > 0)) /*root does not have a parent*/ 
         {
            hypre_MPI_Isend(NULL, 0, HYPRE_MPI_INT, tree.parent_id, term_tag,
                            comm, &request_parent);
            
            hypre_MPI_Irecv(NULL, 0, HYPRE_MPI_INT, tree.parent_id, term_tag,
                            comm, &term_request1);
         }
      }
      else /*have we gotten a term message from our parent? */
      {
         if (myid == 0) /* root doesn't have a parent */
         {
            terminate = 1;
         } 
         else  
         {
            hypre_MPI_Test(&term_request1, &terminate, &term_status1);
         }  
         if (terminate) /*tell children to terminate */
	 {
            if (myid > 0 ) hypre_MPI_Wait(&request_parent, &status_parent);
            
	    for (i=0; i< tree.num_child; i++)
	    {  /*a blocking send  - recv has been posted already*/
	       hypre_MPI_Send(NULL, 0, HYPRE_MPI_INT, tree.child_id[i],
                              term_tag, comm);
	    }
	 }
      } 
   }
예제 #5
0
HYPRE_Int AmgCGCGraphAssemble (hypre_ParCSRMatrix *S,HYPRE_Int *vertexrange,HYPRE_Int *CF_marker,HYPRE_Int *CF_marker_offd,HYPRE_Int coarsen_type,
			 HYPRE_IJMatrix *ijG)
/* assemble a graph representing the connections between the grids
 * ================================================================================================
 * S : the strength matrix
 * vertexrange : the parallel layout of the candidate coarse grid vertices
 * CF_marker, CF_marker_offd : the coarse/fine markers 
 * coarsen_type : the coarsening type
 * ijG : the created graph
 * ================================================================================================*/
{
  HYPRE_Int ierr=0;
  HYPRE_Int i,/* ii,*/ip,j,jj,m,n,p;
  HYPRE_Int mpisize,mpirank;

  HYPRE_Real weight;

  MPI_Comm comm = hypre_ParCSRMatrixComm(S);
/*   hypre_MPI_Status status; */

  HYPRE_IJMatrix ijmatrix;
  hypre_CSRMatrix *S_diag = hypre_ParCSRMatrixDiag (S);
  hypre_CSRMatrix *S_offd = hypre_ParCSRMatrixOffd (S);
/*   HYPRE_Int *S_i = hypre_CSRMatrixI(S_diag); */
/*   HYPRE_Int *S_j = hypre_CSRMatrixJ(S_diag); */
  HYPRE_Int *S_offd_i = hypre_CSRMatrixI(S_offd);
  HYPRE_Int *S_offd_j = NULL;
  HYPRE_Int num_variables = hypre_CSRMatrixNumRows (S_diag);
  HYPRE_Int num_cols_offd = hypre_CSRMatrixNumCols (S_offd);
  HYPRE_Int *col_map_offd = hypre_ParCSRMatrixColMapOffd (S);
  HYPRE_Int pointrange_start,pointrange_end;
  HYPRE_Int *pointrange,*pointrange_nonlocal,*pointrange_strong=NULL;
  HYPRE_Int vertexrange_start,vertexrange_end;
  HYPRE_Int *vertexrange_strong= NULL;
  HYPRE_Int *vertexrange_nonlocal;
  HYPRE_Int num_recvs,num_recvs_strong;
  HYPRE_Int *recv_procs,*recv_procs_strong=NULL;
  HYPRE_Int /* *zeros,*rownz,*/*rownz_diag,*rownz_offd;
  HYPRE_Int nz;
  HYPRE_Int nlocal;
  HYPRE_Int one=1;

  hypre_ParCSRCommPkg    *comm_pkg    = hypre_ParCSRMatrixCommPkg (S);
 

  hypre_MPI_Comm_size (comm,&mpisize);
  hypre_MPI_Comm_rank (comm,&mpirank);

  /* determine neighbor processors */
  num_recvs = hypre_ParCSRCommPkgNumRecvs (comm_pkg);
  recv_procs = hypre_ParCSRCommPkgRecvProcs (comm_pkg);
  pointrange = hypre_ParCSRMatrixRowStarts (S);
  pointrange_nonlocal = hypre_CTAlloc  (HYPRE_Int, 2*num_recvs);
  vertexrange_nonlocal = hypre_CTAlloc (HYPRE_Int, 2*num_recvs);
#ifdef HYPRE_NO_GLOBAL_PARTITION
  {
    HYPRE_Int num_sends  =  hypre_ParCSRCommPkgNumSends (comm_pkg);
    HYPRE_Int *send_procs =  hypre_ParCSRCommPkgSendProcs (comm_pkg);
    HYPRE_Int *int_buf_data   = hypre_CTAlloc (HYPRE_Int,4*num_sends);
    HYPRE_Int *int_buf_data2  = int_buf_data + 2*num_sends;
    hypre_MPI_Request *sendrequest,*recvrequest;

    nlocal = vertexrange[1] - vertexrange[0];
    pointrange_start = pointrange[0];
    pointrange_end   = pointrange[1];
    vertexrange_start = vertexrange[0];
    vertexrange_end   = vertexrange[1];
    sendrequest = hypre_CTAlloc (hypre_MPI_Request,2*(num_sends+num_recvs));
    recvrequest = sendrequest+2*num_sends;

    for (i=0;i<num_recvs;i++) {
      hypre_MPI_Irecv (pointrange_nonlocal+2*i,2,HYPRE_MPI_INT,recv_procs[i],tag_pointrange,comm,&recvrequest[2*i]);
      hypre_MPI_Irecv (vertexrange_nonlocal+2*i,2,HYPRE_MPI_INT,recv_procs[i],tag_vertexrange,comm,&recvrequest[2*i+1]);
    }
    for (i=0;i<num_sends;i++) {
      int_buf_data[2*i] = pointrange_start;
      int_buf_data[2*i+1] = pointrange_end;
      int_buf_data2[2*i] = vertexrange_start;
      int_buf_data2[2*i+1] = vertexrange_end;
      hypre_MPI_Isend (int_buf_data+2*i,2,HYPRE_MPI_INT,send_procs[i],tag_pointrange,comm,&sendrequest[2*i]);
      hypre_MPI_Isend (int_buf_data2+2*i,2,HYPRE_MPI_INT,send_procs[i],tag_vertexrange,comm,&sendrequest[2*i+1]);
    }
    hypre_MPI_Waitall (2*(num_sends+num_recvs),sendrequest,hypre_MPI_STATUSES_IGNORE);
    hypre_TFree (int_buf_data);
    hypre_TFree (sendrequest);
  }
#else
  nlocal = vertexrange[mpirank+1] - vertexrange[mpirank];
  pointrange_start = pointrange[mpirank];
  pointrange_end   = pointrange[mpirank+1];
  vertexrange_start = vertexrange[mpirank];
  vertexrange_end   = vertexrange[mpirank+1];
  for (i=0;i<num_recvs;i++) {
    pointrange_nonlocal[2*i] = pointrange[recv_procs[i]];
    pointrange_nonlocal[2*i+1] = pointrange[recv_procs[i]+1];
    vertexrange_nonlocal[2*i] = vertexrange[recv_procs[i]];
    vertexrange_nonlocal[2*i+1] = vertexrange[recv_procs[i]+1];
  }  
#endif
  /* now we have the array recv_procs. However, it may contain too many entries as it is 
     inherited from A. We now have to determine the subset which contains only the
     strongly connected neighbors */
  if (num_cols_offd) {
    S_offd_j = hypre_CSRMatrixJ(S_offd);
  
    recv_procs_strong = hypre_CTAlloc (HYPRE_Int,num_recvs);
    memset (recv_procs_strong,0,num_recvs*sizeof(HYPRE_Int));
    /* don't forget to shorten the pointrange and vertexrange arrays accordingly */
    pointrange_strong = hypre_CTAlloc (HYPRE_Int,2*num_recvs);
    memset (pointrange_strong,0,2*num_recvs*sizeof(HYPRE_Int));
    vertexrange_strong = hypre_CTAlloc (HYPRE_Int,2*num_recvs);
    memset (vertexrange_strong,0,2*num_recvs*sizeof(HYPRE_Int));
    
    for (i=0;i<num_variables;i++)
      for (j=S_offd_i[i];j<S_offd_i[i+1];j++) {
	jj = col_map_offd[S_offd_j[j]];
	for (p=0;p<num_recvs;p++) /* S_offd_j is NOT sorted! */
	  if (jj >= pointrange_nonlocal[2*p] && jj < pointrange_nonlocal[2*p+1]) break;
#if 0
	hypre_printf ("Processor %d, remote point %d on processor %d\n",mpirank,jj,recv_procs[p]);
#endif
	recv_procs_strong [p]=1;
      }
    
    for (p=0,num_recvs_strong=0;p<num_recvs;p++) {
      if (recv_procs_strong[p]) {
	recv_procs_strong[num_recvs_strong]=recv_procs[p];
	pointrange_strong[2*num_recvs_strong] = pointrange_nonlocal[2*p];
	pointrange_strong[2*num_recvs_strong+1] = pointrange_nonlocal[2*p+1];
	vertexrange_strong[2*num_recvs_strong] = vertexrange_nonlocal[2*p];
	vertexrange_strong[2*num_recvs_strong+1] = vertexrange_nonlocal[2*p+1];
	num_recvs_strong++;
      }
    }
  }
  else num_recvs_strong=0;

  hypre_TFree (pointrange_nonlocal);
  hypre_TFree (vertexrange_nonlocal);

  rownz_diag = hypre_CTAlloc (HYPRE_Int,2*nlocal);
  rownz_offd = rownz_diag + nlocal;
  for (p=0,nz=0;p<num_recvs_strong;p++) {
    nz += vertexrange_strong[2*p+1]-vertexrange_strong[2*p];
  }
  for (m=0;m<nlocal;m++) {
    rownz_diag[m]=nlocal-1;
    rownz_offd[m]=nz;
  }
 
  
 
  HYPRE_IJMatrixCreate(comm, vertexrange_start, vertexrange_end-1, vertexrange_start, vertexrange_end-1, &ijmatrix);
  HYPRE_IJMatrixSetObjectType(ijmatrix, HYPRE_PARCSR);
  HYPRE_IJMatrixSetDiagOffdSizes (ijmatrix, rownz_diag, rownz_offd);
  HYPRE_IJMatrixInitialize(ijmatrix);
  hypre_TFree (rownz_diag);

  /* initialize graph */
  weight = -1;
  for (m=vertexrange_start;m<vertexrange_end;m++) {
    for (p=0;p<num_recvs_strong;p++) {
      for (n=vertexrange_strong[2*p];n<vertexrange_strong[2*p+1];n++) {
	ierr = HYPRE_IJMatrixAddToValues (ijmatrix,1,&one,&m,&n,&weight);
#if 0
	if (ierr) hypre_printf ("Processor %d: error %d while initializing graphs at (%d, %d)\n",mpirank,ierr,m,n);
#endif
      }
    }
  }
  
  /* weight graph */
  for (i=0;i<num_variables;i++) {

    for (j=S_offd_i[i];j<S_offd_i[i+1];j++) {
      jj = S_offd_j[j]; /* jj is not a global index!!! */
      /* determine processor */
      for (p=0;p<num_recvs_strong;p++) 
	if (col_map_offd[jj] >= pointrange_strong[2*p] && col_map_offd[jj] < pointrange_strong[2*p+1]) break;
      ip=recv_procs_strong[p];
      /* loop over all coarse grids constructed on this processor domain */
      for (m=vertexrange_start;m<vertexrange_end;m++) {
	/* loop over all coarse grids constructed on neighbor processor domain */
	for (n=vertexrange_strong[2*p];n<vertexrange_strong[2*p+1];n++) {
	  /* coarse grid counting inside gridpartition->local/gridpartition->nonlocal starts with one
	     while counting inside range starts with zero */
	  if (CF_marker[i]-1==m && CF_marker_offd[jj]-1==n)
	    /* C-C-coupling */
	    weight = -1;
	  else if ( (CF_marker[i]-1==m && (CF_marker_offd[jj]==0 || CF_marker_offd[jj]-1!=n) )
		   || ( (CF_marker[i]==0 || CF_marker[i]-1!=m) && CF_marker_offd[jj]-1==n ) )
	    /* C-F-coupling */
	    weight = 0;
	  else weight = -8; /* F-F-coupling */
	  ierr = HYPRE_IJMatrixAddToValues (ijmatrix,1,&one,&m,&n,&weight);
#if 0
	  if (ierr) hypre_printf ("Processor %d: error %d while adding %lf to entry (%d, %d)\n",mpirank,ierr,weight,m,n);
#endif
	}
      }
    }
  }

  /* assemble */
  HYPRE_IJMatrixAssemble (ijmatrix);
  /*if (num_recvs_strong) {*/
    hypre_TFree (recv_procs_strong); 
    hypre_TFree (pointrange_strong);
    hypre_TFree (vertexrange_strong);
  /*} */

  *ijG = ijmatrix;
  return (ierr);
}
예제 #6
0
hypre_ParVector *
hypre_VectorToParVector (MPI_Comm comm, hypre_Vector *v, HYPRE_Int *vec_starts)
{
   HYPRE_Int 			global_size;
   HYPRE_Int 			local_size;
   HYPRE_Int                  num_vectors;
   HYPRE_Int  		num_procs, my_id;
   HYPRE_Int                  global_vecstride, vecstride, idxstride;
   hypre_ParVector  	*par_vector;
   hypre_Vector     	*local_vector;
   double          	*v_data;
   double		*local_data;
   hypre_MPI_Request		*requests;
   hypre_MPI_Status		*status, status0;
   HYPRE_Int			i, j, k, p;

   hypre_MPI_Comm_size(comm,&num_procs);
   hypre_MPI_Comm_rank(comm,&my_id);

   if (my_id == 0)
   {
        global_size = hypre_VectorSize(v);
        v_data = hypre_VectorData(v);
        num_vectors = hypre_VectorNumVectors(v); /* for multivectors */
        global_vecstride = hypre_VectorVectorStride(v);

   }

   hypre_MPI_Bcast(&global_size,1,HYPRE_MPI_INT,0,comm);
   hypre_MPI_Bcast(&num_vectors,1,HYPRE_MPI_INT,0,comm);
   hypre_MPI_Bcast(&global_vecstride,1,HYPRE_MPI_INT,0,comm);

   if ( num_vectors==1 )
      par_vector = hypre_ParVectorCreate(comm, global_size, vec_starts);
   else
      par_vector = hypre_ParMultiVectorCreate(comm, global_size, vec_starts, num_vectors);

   vec_starts = hypre_ParVectorPartitioning(par_vector);

   local_size = vec_starts[my_id+1] - vec_starts[my_id];

   hypre_ParVectorInitialize(par_vector);
   local_vector = hypre_ParVectorLocalVector(par_vector);
   local_data = hypre_VectorData(local_vector);
   vecstride = hypre_VectorVectorStride(local_vector);
   idxstride = hypre_VectorIndexStride(local_vector);
   hypre_assert( idxstride==1 );  /* <<< so far only the only implemented multivector StorageMethod is 0 <<< */

   if (my_id == 0)
   {
	requests = hypre_CTAlloc(hypre_MPI_Request,num_vectors*(num_procs-1));
	status = hypre_CTAlloc(hypre_MPI_Status,num_vectors*(num_procs-1));
	k = 0;
	for ( p=1; p<num_procs; p++)
           for ( j=0; j<num_vectors; ++j )
           {
		hypre_MPI_Isend( &v_data[vec_starts[p]]+j*global_vecstride,
                          (vec_starts[p+1]-vec_starts[p]),
                          hypre_MPI_DOUBLE, p, 0, comm, &requests[k++] );
           }
        if ( num_vectors==1 )
        {
           for (i=0; i < local_size; i++)
              local_data[i] = v_data[i];
        }
        else
           for ( j=0; j<num_vectors; ++j )
           {
              for (i=0; i < local_size; i++)
                 local_data[i+j*vecstride] = v_data[i+j*global_vecstride];
           }
	hypre_MPI_Waitall(num_procs-1,requests, status);
	hypre_TFree(requests);
	hypre_TFree(status);
   }
   else
   {
      for ( j=0; j<num_vectors; ++j )
	hypre_MPI_Recv( local_data+j*vecstride, local_size, hypre_MPI_DOUBLE, 0, 0, comm,&status0 );
   }

   return par_vector;
}
예제 #7
0
파일: hypre_parcsr.cpp 프로젝트: jdahm/mfem
/* Based on hypre_ParCSRCommHandleCreate in hypre's par_csr_communication.c. The
   input variable job controls the communication type: 1=Matvec, 2=MatvecT. */
hypre_ParCSRCommHandle *
hypre_ParCSRCommHandleCreate_bool(HYPRE_Int            job,
                                  hypre_ParCSRCommPkg *comm_pkg,
                                  HYPRE_Bool          *send_data,
                                  HYPRE_Bool          *recv_data)
{
    HYPRE_Int                  num_sends = hypre_ParCSRCommPkgNumSends(comm_pkg);
    HYPRE_Int                  num_recvs = hypre_ParCSRCommPkgNumRecvs(comm_pkg);
    MPI_Comm                   comm      = hypre_ParCSRCommPkgComm(comm_pkg);

    hypre_ParCSRCommHandle    *comm_handle;
    HYPRE_Int                  num_requests;
    hypre_MPI_Request         *requests;

    HYPRE_Int                  i, j;
    HYPRE_Int                  my_id, num_procs;
    HYPRE_Int                  ip, vec_start, vec_len;

    num_requests = num_sends + num_recvs;
    requests = hypre_CTAlloc(hypre_MPI_Request, num_requests);

    hypre_MPI_Comm_size(comm, &num_procs);
    hypre_MPI_Comm_rank(comm, &my_id);

    j = 0;
    switch (job)
    {
    case  1:
    {
        HYPRE_Bool *d_send_data = (HYPRE_Bool *) send_data;
        HYPRE_Bool *d_recv_data = (HYPRE_Bool *) recv_data;
        for (i = 0; i < num_recvs; i++)
        {
            ip = hypre_ParCSRCommPkgRecvProc(comm_pkg, i);
            vec_start = hypre_ParCSRCommPkgRecvVecStart(comm_pkg, i);
            vec_len = hypre_ParCSRCommPkgRecvVecStart(comm_pkg, i+1)-vec_start;
            hypre_MPI_Irecv(&d_recv_data[vec_start], vec_len, HYPRE_MPI_BOOL,
                            ip, 0, comm, &requests[j++]);
        }
        for (i = 0; i < num_sends; i++)
        {
            vec_start = hypre_ParCSRCommPkgSendMapStart(comm_pkg, i);
            vec_len = hypre_ParCSRCommPkgSendMapStart(comm_pkg, i+1)-vec_start;
            ip = hypre_ParCSRCommPkgSendProc(comm_pkg, i);
            hypre_MPI_Isend(&d_send_data[vec_start], vec_len, HYPRE_MPI_BOOL,
                            ip, 0, comm, &requests[j++]);
        }
        break;
    }
    case  2:
    {
        HYPRE_Bool *d_send_data = (HYPRE_Bool *) send_data;
        HYPRE_Bool *d_recv_data = (HYPRE_Bool *) recv_data;
        for (i = 0; i < num_sends; i++)
        {
            vec_start = hypre_ParCSRCommPkgSendMapStart(comm_pkg, i);
            vec_len = hypre_ParCSRCommPkgSendMapStart(comm_pkg, i+1)-vec_start;
            ip = hypre_ParCSRCommPkgSendProc(comm_pkg, i);
            hypre_MPI_Irecv(&d_recv_data[vec_start], vec_len, HYPRE_MPI_BOOL,
                            ip, 0, comm, &requests[j++]);
        }
        for (i = 0; i < num_recvs; i++)
        {
            ip = hypre_ParCSRCommPkgRecvProc(comm_pkg, i);
            vec_start = hypre_ParCSRCommPkgRecvVecStart(comm_pkg, i);
            vec_len = hypre_ParCSRCommPkgRecvVecStart(comm_pkg, i+1)-vec_start;
            hypre_MPI_Isend(&d_send_data[vec_start], vec_len, HYPRE_MPI_BOOL,
                            ip, 0, comm, &requests[j++]);
        }
        break;
    }
    }
    /*--------------------------------------------------------------------
     * set up comm_handle and return
     *--------------------------------------------------------------------*/

    comm_handle = hypre_CTAlloc(hypre_ParCSRCommHandle, 1);

    hypre_ParCSRCommHandleCommPkg(comm_handle)     = comm_pkg;
    hypre_ParCSRCommHandleSendData(comm_handle)    = send_data;
    hypre_ParCSRCommHandleRecvData(comm_handle)    = recv_data;
    hypre_ParCSRCommHandleNumRequests(comm_handle) = num_requests;
    hypre_ParCSRCommHandleRequests(comm_handle)    = requests;

    return comm_handle;
}
예제 #8
0
HYPRE_Int
hypre_GenerateSendMapAndCommPkg(MPI_Comm comm, HYPRE_Int num_sends, HYPRE_Int num_recvs,
				HYPRE_Int *recv_procs, HYPRE_Int *send_procs,
				HYPRE_Int *recv_vec_starts, hypre_ParCSRMatrix *A)
{
   HYPRE_Int *send_map_starts;
   HYPRE_Int *send_map_elmts;
   HYPRE_Int i, j;
   HYPRE_Int num_requests = num_sends+num_recvs;
   hypre_MPI_Request *requests;
   hypre_MPI_Status *status;
   HYPRE_Int vec_len, vec_start;
   hypre_ParCSRCommPkg *comm_pkg;
   HYPRE_Int *col_map_offd = hypre_ParCSRMatrixColMapOffd(A);
   HYPRE_Int first_col_diag = hypre_ParCSRMatrixFirstColDiag(A);

/*--------------------------------------------------------------------------
 * generate send_map_starts and send_map_elmts
 *--------------------------------------------------------------------------*/
   requests = hypre_CTAlloc(hypre_MPI_Request,num_requests);
   status = hypre_CTAlloc(hypre_MPI_Status,num_requests);
   send_map_starts = hypre_CTAlloc(HYPRE_Int, num_sends+1);
   j = 0;
   for (i=0; i < num_sends; i++)
	hypre_MPI_Irecv(&send_map_starts[i+1],1,HYPRE_MPI_INT,send_procs[i],0,comm,
		&requests[j++]);

   for (i=0; i < num_recvs; i++)
   {
	vec_len = recv_vec_starts[i+1] - recv_vec_starts[i];
	hypre_MPI_Isend(&vec_len,1,HYPRE_MPI_INT, recv_procs[i],0,comm,&requests[j++]);
   }
   
   hypre_MPI_Waitall(j,requests,status);
 
   send_map_starts[0] = 0; 
   for (i=0; i < num_sends; i++)
	send_map_starts[i+1] += send_map_starts[i]; 

   send_map_elmts = hypre_CTAlloc(HYPRE_Int,send_map_starts[num_sends]);

   j = 0;
   for (i=0; i < num_sends; i++)
   {
	vec_start = send_map_starts[i];
	vec_len = send_map_starts[i+1]-vec_start;
	hypre_MPI_Irecv(&send_map_elmts[vec_start],vec_len,HYPRE_MPI_INT,
		send_procs[i],0,comm,&requests[j++]);
   }

   for (i=0; i < num_recvs; i++)
   {
	vec_start = recv_vec_starts[i];
	vec_len = recv_vec_starts[i+1] - vec_start;
	hypre_MPI_Isend(&col_map_offd[vec_start],vec_len,HYPRE_MPI_INT, 
		recv_procs[i],0,comm,&requests[j++]);
   }
   
   hypre_MPI_Waitall(j,requests,status);

   for (i=0; i < send_map_starts[num_sends]; i++)
	send_map_elmts[i] -= first_col_diag; 
	
   comm_pkg = hypre_CTAlloc(hypre_ParCSRCommPkg,1);

   hypre_ParCSRCommPkgComm(comm_pkg) = comm;
   hypre_ParCSRCommPkgNumSends(comm_pkg) = num_sends;
   hypre_ParCSRCommPkgNumRecvs(comm_pkg) = num_recvs;
   hypre_ParCSRCommPkgSendProcs(comm_pkg) = send_procs;
   hypre_ParCSRCommPkgRecvProcs(comm_pkg) = recv_procs;
   hypre_ParCSRCommPkgRecvVecStarts(comm_pkg) = recv_vec_starts;
   hypre_ParCSRCommPkgSendMapStarts(comm_pkg) = send_map_starts;
   hypre_ParCSRCommPkgSendMapElmts(comm_pkg) = send_map_elmts;

   hypre_TFree(status);
   hypre_TFree(requests);

   hypre_ParCSRMatrixCommPkg(A) = comm_pkg;
   return 0;
}
예제 #9
0
HYPRE_Int
hypre_GetCommPkgRTFromCommPkgA( hypre_ParCSRMatrix *RT,
			       	hypre_ParCSRMatrix *A,
			       	HYPRE_Int *fine_to_coarse_offd)
{
   MPI_Comm comm = hypre_ParCSRMatrixComm(RT);
   hypre_ParCSRCommPkg *comm_pkg_A = hypre_ParCSRMatrixCommPkg(A);
   HYPRE_Int num_recvs_A = hypre_ParCSRCommPkgNumRecvs(comm_pkg_A);
   HYPRE_Int *recv_procs_A = hypre_ParCSRCommPkgRecvProcs(comm_pkg_A);
   HYPRE_Int *recv_vec_starts_A = hypre_ParCSRCommPkgRecvVecStarts(comm_pkg_A);
   HYPRE_Int num_sends_A = hypre_ParCSRCommPkgNumSends(comm_pkg_A);
   HYPRE_Int *send_procs_A = hypre_ParCSRCommPkgSendProcs(comm_pkg_A);

   hypre_ParCSRCommPkg *comm_pkg;
   HYPRE_Int num_recvs_RT;
   HYPRE_Int *recv_procs_RT;   
   HYPRE_Int *recv_vec_starts_RT;   
   HYPRE_Int num_sends_RT;
   HYPRE_Int *send_procs_RT;   
   HYPRE_Int *send_map_starts_RT;   
   HYPRE_Int *send_map_elmts_RT;   

   HYPRE_Int *col_map_offd_RT = hypre_ParCSRMatrixColMapOffd(RT);
   HYPRE_Int num_cols_offd_RT = hypre_CSRMatrixNumCols( hypre_ParCSRMatrixOffd(RT));
   HYPRE_Int first_col_diag = hypre_ParCSRMatrixFirstColDiag(RT);

   HYPRE_Int i, j;
   HYPRE_Int vec_len, vec_start;
   HYPRE_Int num_procs, my_id;
   HYPRE_Int ierr = 0;
   HYPRE_Int num_requests;
   HYPRE_Int offd_col, proc_num;
 
   HYPRE_Int *proc_mark;
   HYPRE_Int *change_array;

   hypre_MPI_Request *requests;
   hypre_MPI_Status *status;

   hypre_MPI_Comm_size(comm,&num_procs);
   hypre_MPI_Comm_rank(comm,&my_id);

/*--------------------------------------------------------------------------
 * determine num_recvs, recv_procs and recv_vec_starts for RT
 *--------------------------------------------------------------------------*/

   proc_mark = hypre_CTAlloc(HYPRE_Int, num_recvs_A);

   for (i=0; i < num_recvs_A; i++)
                proc_mark[i] = 0;

   proc_num = 0;
   num_recvs_RT = 0;
   if (num_cols_offd_RT)
   {
      for (i=0; i < num_recvs_A; i++)
      {
         for (j=recv_vec_starts_A[i]; j<recv_vec_starts_A[i+1]; j++)
         {
            offd_col = col_map_offd_RT[proc_num];
            if (offd_col == j)
            {
                proc_mark[i]++;
                proc_num++;
                if (proc_num == num_cols_offd_RT) break;
            }
         }
         if (proc_mark[i]) num_recvs_RT++;
         if (proc_num == num_cols_offd_RT) break;
      }
   }

   for (i=0; i < num_cols_offd_RT; i++)
      col_map_offd_RT[i] = fine_to_coarse_offd[col_map_offd_RT[i]];
 
   recv_procs_RT = hypre_CTAlloc(HYPRE_Int,num_recvs_RT);
   recv_vec_starts_RT = hypre_CTAlloc(HYPRE_Int, num_recvs_RT+1);
 
   j = 0;
   recv_vec_starts_RT[0] = 0;
   for (i=0; i < num_recvs_A; i++)
        if (proc_mark[i])
        {
                recv_procs_RT[j] = recv_procs_A[i];
                recv_vec_starts_RT[j+1] = recv_vec_starts_RT[j]+proc_mark[i];
                j++;
        }

/*--------------------------------------------------------------------------
 * send num_changes to recv_procs_A and receive change_array from send_procs_A
 *--------------------------------------------------------------------------*/

   num_requests = num_recvs_A+num_sends_A;
   requests = hypre_CTAlloc(hypre_MPI_Request, num_requests);
   status = hypre_CTAlloc(hypre_MPI_Status, num_requests);

   change_array = hypre_CTAlloc(HYPRE_Int, num_sends_A);

   j = 0;
   for (i=0; i < num_sends_A; i++)
	hypre_MPI_Irecv(&change_array[i],1,HYPRE_MPI_INT,send_procs_A[i],0,comm,
		&requests[j++]);

   for (i=0; i < num_recvs_A; i++)
	hypre_MPI_Isend(&proc_mark[i],1,HYPRE_MPI_INT,recv_procs_A[i],0,comm,
		&requests[j++]);
   
   hypre_MPI_Waitall(num_requests,requests,status);

   hypre_TFree(proc_mark);
   
/*--------------------------------------------------------------------------
 * if change_array[i] is 0 , omit send_procs_A[i] in send_procs_RT
 *--------------------------------------------------------------------------*/

   num_sends_RT = 0;
   for (i=0; i < num_sends_A; i++)
      if (change_array[i]) 
      {
	 num_sends_RT++;
      }

   send_procs_RT = hypre_CTAlloc(HYPRE_Int, num_sends_RT);
   send_map_starts_RT = hypre_CTAlloc(HYPRE_Int, num_sends_RT+1);

   j = 0;
   send_map_starts_RT[0] = 0;
   for (i=0; i < num_sends_A; i++)
      if (change_array[i]) 
      {
	 send_procs_RT[j] = send_procs_A[i];
	 send_map_starts_RT[j+1] = send_map_starts_RT[j]+change_array[i];
	 j++;
      }

/*--------------------------------------------------------------------------
 * generate send_map_elmts
 *--------------------------------------------------------------------------*/

   send_map_elmts_RT = hypre_CTAlloc(HYPRE_Int,send_map_starts_RT[num_sends_RT]);

   j = 0;
   for (i=0; i < num_sends_RT; i++)
   {
	vec_start = send_map_starts_RT[i];
	vec_len = send_map_starts_RT[i+1]-vec_start;
	hypre_MPI_Irecv(&send_map_elmts_RT[vec_start],vec_len,HYPRE_MPI_INT,
		send_procs_RT[i],0,comm,&requests[j++]);
   }

   for (i=0; i < num_recvs_RT; i++)
   {
	vec_start = recv_vec_starts_RT[i];
	vec_len = recv_vec_starts_RT[i+1] - vec_start;
	hypre_MPI_Isend(&col_map_offd_RT[vec_start],vec_len,HYPRE_MPI_INT, 
		recv_procs_RT[i],0,comm,&requests[j++]);
   }
   
   hypre_MPI_Waitall(j,requests,status);

   for (i=0; i < send_map_starts_RT[num_sends_RT]; i++)
	send_map_elmts_RT[i] -= first_col_diag; 
	
   comm_pkg = hypre_CTAlloc(hypre_ParCSRCommPkg,1);

   hypre_ParCSRCommPkgComm(comm_pkg) = comm;
   hypre_ParCSRCommPkgNumSends(comm_pkg) = num_sends_RT;
   hypre_ParCSRCommPkgNumRecvs(comm_pkg) = num_recvs_RT;
   hypre_ParCSRCommPkgSendProcs(comm_pkg) = send_procs_RT;
   hypre_ParCSRCommPkgRecvProcs(comm_pkg) = recv_procs_RT;
   hypre_ParCSRCommPkgRecvVecStarts(comm_pkg) = recv_vec_starts_RT;
   hypre_ParCSRCommPkgSendMapStarts(comm_pkg) = send_map_starts_RT;
   hypre_ParCSRCommPkgSendMapElmts(comm_pkg) = send_map_elmts_RT;

   hypre_TFree(status);
   hypre_TFree(requests);

   hypre_ParCSRMatrixCommPkg(RT) = comm_pkg;
   hypre_TFree(change_array);

   return ierr;
}
예제 #10
0
void hypre_ParChordMatrix_RowStarts(
   hypre_ParChordMatrix *Ac, MPI_Comm comm,
   HYPRE_Int ** row_starts, HYPRE_Int * global_num_cols )
   /* This function computes the ParCSRMatrix-style row_starts from a chord matrix.
      It requires the the idofs of the chord matrix be partitioned among
      processors, so their numbering is monotonic with the processor number;
      see below.

      The algorithm: each proc. p knows its min & max global row & col numbers.
      Mins are first_index_rdof[p], first_index_idof[p]
      ***IF*** these were in proper order (see below),
      first_index_rdof[p] is row_starts[p].
      Add num_rdofs-1 to get the max, i.e. add num_rdofs
      to get row_starts[p+1] (IF the processors are ordered thus).
      Compute these, then broadcast to the other processors to form
      row_starts.
      (We also could get global_num_rows by an AllReduce num_idofs.)
      We get global_num_cols by taking the min and max over processors of
      the min and max col no.s on each processor.

      If the chord matrix is not ordered so the above will work, then we
      would need to to completely move matrices around sometimes, a very expensive
      operation.
      The problem is that the chord matrix format makes no assumptions about
      processor order, but the ParCSR format assumes that
      p<q => (local row numbers of p) < (local row numbers of q)
      Maybe instead I could change the global numbering scheme as part of this
      conversion.
      A closely related ordering-type problem to watch for: row_starts must be
      a partition for a ParCSRMatrix.  In a ChordMatrix, the struct itself
      makes no guarantees, but Panayot said, in essence, that row_starts will
      be a partition.
      col_starts should be NULL; later we shall let the Create function compute one.
   */
{
   HYPRE_Int * fis_idof = hypre_ParChordMatrixFirstindexIdof(Ac);
   HYPRE_Int * fis_rdof = hypre_ParChordMatrixFirstindexRdof(Ac);
   HYPRE_Int my_id, num_procs;
   HYPRE_Int num_idofs = hypre_ParChordMatrixNumIdofs(Ac);
   HYPRE_Int num_rdofs = hypre_ParChordMatrixNumRdofs(Ac);
   HYPRE_Int min_rdof, max_rdof, global_min_rdof, global_max_rdof;
   HYPRE_Int p, lens[2], lastlens[2];
   hypre_MPI_Status *status;
   hypre_MPI_Request *request;

   hypre_MPI_Comm_rank(comm, &my_id);
   hypre_MPI_Comm_size(comm, &num_procs);
   request = hypre_CTAlloc(hypre_MPI_Request, 1 );
   status = hypre_CTAlloc(hypre_MPI_Status, 1 );

   min_rdof = fis_rdof[my_id];
   max_rdof = min_rdof + num_rdofs;
   lens[0] = num_idofs;
   lens[1] = num_rdofs;

   /* row_starts (except last value */
   *row_starts = hypre_CTAlloc( HYPRE_Int, num_procs+1 );
   for ( p=0; p<num_procs; ++p ) {
      (*row_starts)[p] = fis_idof[p];
   }

   /* check that ordering and partitioning of rows is as expected
      (much is missing, and even then not perfect)... */
   if ( my_id<num_procs-1 )
      hypre_MPI_Isend( lens, 2, HYPRE_MPI_INT, my_id+1, 0, comm, request );
   if ( my_id>0 )
      hypre_MPI_Recv( lastlens, 2, HYPRE_MPI_INT, my_id-1, 0, comm, status );
   if ( my_id<num_procs-1 )
	hypre_MPI_Waitall( 1, request, status);
   if ( my_id>0 )
      hypre_assert( (*row_starts)[my_id] == (*row_starts)[my_id-1] + lastlens[0] );
   hypre_TFree( request );
   hypre_TFree( status );
      
   /* Get the upper bound for all the rows */
   hypre_MPI_Bcast( lens, 2, HYPRE_MPI_INT, num_procs-1, comm );
   (*row_starts)[num_procs] = (*row_starts)[num_procs-1] + lens[0];

   /* Global number of columns */
/*   hypre_MPI_Allreduce( &num_rdofs, global_num_cols, 1, HYPRE_MPI_INT, hypre_MPI_SUM, comm );*/
   hypre_MPI_Allreduce( &min_rdof, &global_min_rdof, 1, HYPRE_MPI_INT, hypre_MPI_MIN, comm );
   hypre_MPI_Allreduce( &max_rdof, &global_max_rdof, 1, HYPRE_MPI_INT, hypre_MPI_MAX, comm );
   *global_num_cols = global_max_rdof - global_min_rdof;
}
예제 #11
0
HYPRE_Int
hypre_ParCSRMatrixToParChordMatrix(
   hypre_ParCSRMatrix *Ap,
   MPI_Comm comm,
   hypre_ParChordMatrix **pAc )
{
   HYPRE_Int * row_starts = hypre_ParCSRMatrixRowStarts(Ap);
   HYPRE_Int * col_starts = hypre_ParCSRMatrixColStarts(Ap);
   hypre_CSRMatrix * diag = hypre_ParCSRMatrixDiag(Ap);
   hypre_CSRMatrix * offd = hypre_ParCSRMatrixOffd(Ap);
   HYPRE_Int * offd_j = hypre_CSRMatrixJ(offd);
   HYPRE_Int * diag_j = hypre_CSRMatrixJ(diag);
   HYPRE_Int * col_map_offd = hypre_ParCSRMatrixColMapOffd(Ap);
   HYPRE_Int first_col_diag = hypre_ParCSRMatrixFirstColDiag(Ap);

   hypre_ParChordMatrix * Ac;
   hypre_NumbersNode * rdofs, * offd_cols_me;
   hypre_NumbersNode ** offd_cols;
   HYPRE_Int ** offd_col_array;
   HYPRE_Int * len_offd_col_array, * offd_col_array_me;
   HYPRE_Int len_offd_col_array_me;
   HYPRE_Int num_idofs, num_rdofs, j_local, j_global, row_global;
   HYPRE_Int i, j, jj, p, pto, q, qto, my_id, my_q, row, ireq;
   HYPRE_Int num_inprocessors, num_toprocessors, num_procs, len_num_rdofs_toprocessor;
   HYPRE_Int *inprocessor, *toprocessor, *pcr, *qcr, *num_inchords, *chord, *chordto;
   HYPRE_Int *inproc, *toproc, *num_rdofs_toprocessor;
   HYPRE_Int **inchord_idof, **inchord_rdof, **rdof_toprocessor;
   double **inchord_data;
   double data;
   HYPRE_Int *first_index_idof, *first_index_rdof;
   hypre_MPI_Request * request;
   hypre_MPI_Status * status;

   hypre_MPI_Comm_rank(comm, &my_id);
   hypre_MPI_Comm_size(comm, &num_procs);
   num_idofs = row_starts[my_id+1] - row_starts[my_id];
   num_rdofs = col_starts[my_id+1] - col_starts[my_id];

   hypre_ParChordMatrixCreate( pAc, comm, num_idofs, num_rdofs );
   Ac = *pAc;

/* The following block sets Inprocessor:
   On each proc. my_id, we find the columns in the offd and diag blocks
   (global no.s).  The columns are rdofs (contrary to what I wrote in
   ChordMatrix.txt).
   For each such col/rdof r, find the proc. p which owns row/idof r.
   We set the temporary array pcr[p]=1 for such p.
   An MPI all-to-all will exchange such arrays so my_id's array qcr has
   qcr[q]=1 iff, on proc. q, pcr[my_id]=1.  In other words, qcr[q]=1 if
   my_id owns a row/idof i which is the same as a col/rdof owned by q.
   Collect all such q's into in the array Inprocessor.
   While constructing pcr, we also construct pj such that for any index jj
   into offd_j,offd_data, pj[jj] is the processor which owns jj as a row (idof)
   (the number jj is local to this processor).
   */
   pcr = hypre_CTAlloc( HYPRE_Int, num_procs );
   qcr = hypre_CTAlloc( HYPRE_Int, num_procs );
   for ( p=0; p<num_procs; ++p ) pcr[p]=0;
   for ( jj=0; jj<hypre_CSRMatrixNumNonzeros(offd); ++jj ) {
      j_local = offd_j[jj];
      j_global =  col_map_offd[j_local];
      for ( p=0; p<num_procs; ++p ) {
         if ( j_global >= row_starts[p] && j_global<row_starts[p+1] ) {
            pcr[p]=1;
/* not used yet...            pj[jj] = p;*/
            break;
         }
      }
   }
   /*   jjd = jj; ...not used yet */

   /* pcr[my_id] = 1; ...for square matrices (with nonzero diag block)
      this one line  would do the job of the following nested loop.
      For non-square matrices, the data distribution is too arbitrary. */
   for ( jj=0; jj<hypre_CSRMatrixNumNonzeros(diag); ++jj ) {
      j_local = diag_j[jj];
      j_global = j_local + first_col_diag;
      for ( p=0; p<num_procs; ++p ) {
         if ( j_global >= row_starts[p] && j_global<row_starts[p+1] ) {
            pcr[p]=1;
/* not used yet...            pj[jj+jjd] = p;*/
            break;
         }
      }
   }


   /* Now pcr[p]=1 iff my_id owns a col/rdof r which proc. p owns as a row/idof */
   hypre_MPI_Alltoall( pcr, 1, HYPRE_MPI_INT, qcr, 1, HYPRE_MPI_INT, comm );
   /* Now qcr[q]==1 if my_id owns a row/idof i which is a col/rdof of proc. q
    The array of such q's is the array Inprocessor. */

   num_inprocessors = 0;
   for ( q=0; q<num_procs; ++q ) if ( qcr[q]==1 ) ++num_inprocessors;
   inprocessor = hypre_CTAlloc( HYPRE_Int, num_inprocessors );
   p = 0;
   for ( q=0; q<num_procs; ++q ) if ( qcr[q]==1 ) inprocessor[ p++ ] = q;
   num_toprocessors = 0;
   for ( q=0; q<num_procs; ++q ) if ( pcr[q]==1 ) ++num_toprocessors;
   toprocessor = hypre_CTAlloc( HYPRE_Int, num_toprocessors );
   p = 0;
   for ( q=0; q<num_procs; ++q ) if ( pcr[q]==1 ) toprocessor[ p++ ] = q;

   hypre_ParChordMatrixNumInprocessors(Ac) = num_inprocessors;
   hypre_ParChordMatrixInprocessor(Ac) = inprocessor;
   hypre_ParChordMatrixNumToprocessors(Ac) = num_toprocessors;
   hypre_ParChordMatrixToprocessor(Ac) = toprocessor;
   hypre_TFree( qcr );

   /* FirstIndexIdof[p] is the global index of proc. p's row 0 */
   /* FirstIndexRdof[p] is the global index of proc. p's col 0 */
   /* Fir FirstIndexIdof, we copy the array row_starts rather than its pointers,
      because the chord matrix will think it's free to delete FirstIndexIdof */
   /* col_starts[p] contains the global index of the first column
      in the diag block of p.  But for first_index_rdof we want the global
      index of the first column in p (whether that's in the diag or offd block).
      So it's more involved than row/idof: we also check the offd block, and
      have to do a gather to get first_index_rdof for every proc. on every proc. */
   first_index_idof = hypre_CTAlloc( HYPRE_Int, num_procs+1 );
   first_index_rdof = hypre_CTAlloc( HYPRE_Int, num_procs+1 );
   for ( p=0; p<=num_procs; ++p ) {
      first_index_idof[p] = row_starts[p];
      first_index_rdof[p] = col_starts[p];
   };
   if ( hypre_CSRMatrixNumRows(offd) > 0  && hypre_CSRMatrixNumCols(offd) > 0 )
      first_index_rdof[my_id] =
         col_starts[my_id]<col_map_offd[0] ? col_starts[my_id] : col_map_offd[0];
   hypre_MPI_Allgather( &first_index_rdof[my_id], 1, HYPRE_MPI_INT,
                  first_index_rdof, 1, HYPRE_MPI_INT, comm );

   /* Set num_inchords: num_inchords[p] is no. chords on my_id connected to p.
      Set each chord (idof,jdof,data).
      We go through each matrix element in the diag block, find what processor
      owns its column no. as a row, then update num_inchords[p], inchord_idof[p],
      inchord_rdof[p], inchord_data[p].
   */

   inchord_idof = hypre_CTAlloc( HYPRE_Int*, num_inprocessors );
   inchord_rdof = hypre_CTAlloc( HYPRE_Int*, num_inprocessors );
   inchord_data = hypre_CTAlloc( double*, num_inprocessors );
   num_inchords = hypre_CTAlloc( HYPRE_Int, num_inprocessors );
   chord = hypre_CTAlloc( HYPRE_Int, num_inprocessors );
   chordto = hypre_CTAlloc( HYPRE_Int, num_toprocessors );
   num_rdofs = 0;
   for ( q=0; q<num_inprocessors; ++q ) num_inchords[q] = 0;
   my_q = -1;
   for ( q=0; q<num_inprocessors; ++q ) if ( inprocessor[q]==my_id ) my_q = q;
   hypre_assert( my_q>=0 );

   /* diag block: first count chords (from my_id to my_id),
      then set them from diag block's CSR data structure */
   num_idofs = hypre_CSRMatrixNumRows(diag);
   rdofs = hypre_NumbersNewNode();
   for ( row=0; row<hypre_CSRMatrixNumRows(diag); ++row ) {
      for ( i=hypre_CSRMatrixI(diag)[row]; i<hypre_CSRMatrixI(diag)[row+1]; ++i ) {
         j_local = hypre_CSRMatrixJ(diag)[i];
         hypre_NumbersEnter( rdofs, j_local );
         ++num_inchords[my_q];
      }
   };
   num_rdofs = hypre_NumbersNEntered( rdofs );
   inchord_idof[my_q] = hypre_CTAlloc( HYPRE_Int, num_inchords[my_q] );
   inchord_rdof[my_q] = hypre_CTAlloc( HYPRE_Int, num_inchords[my_q] );
   inchord_data[my_q] = hypre_CTAlloc( double, num_inchords[my_q] );
   chord[0] = 0;
   for ( row=0; row<hypre_CSRMatrixNumRows(diag); ++row ) {
      for ( i=hypre_CSRMatrixI(diag)[row]; i<hypre_CSRMatrixI(diag)[row+1]; ++i ) {
         j_local = hypre_CSRMatrixJ(diag)[i];
         data = hypre_CSRMatrixData(diag)[i];
         inchord_idof[my_q][chord[0]] = row;
         /* Here We need to convert from j_local - a column local to
            the diag of this proc., to a j which is local only to this
            processor - a column (rdof) numbering scheme to be shared by the
            diag and offd blocks...  */
         j_global = j_local + hypre_ParCSRMatrixColStarts(Ap)[my_q];
         j = j_global - first_index_rdof[my_q];
         inchord_rdof[my_q][chord[0]] = j;
         inchord_data[my_q][chord[0]] = data;
         hypre_assert( chord[0] < num_inchords[my_q] );
         ++chord[0];
      }
   };
   hypre_NumbersDeleteNode(rdofs);


   /* offd block: */

   /* >>> offd_cols_me duplicates rdofs */
   offd_cols_me = hypre_NumbersNewNode();
   for ( row=0; row<hypre_CSRMatrixNumRows(offd); ++row ) {
      for ( i=hypre_CSRMatrixI(offd)[row]; i<hypre_CSRMatrixI(offd)[row+1]; ++i ) {
         j_local = hypre_CSRMatrixJ(offd)[i];
         j_global =  col_map_offd[j_local];
         hypre_NumbersEnter( offd_cols_me, j_global );
      }
   }
   offd_col_array = hypre_CTAlloc( HYPRE_Int*, num_inprocessors );
   len_offd_col_array = hypre_CTAlloc( HYPRE_Int, num_inprocessors );
   offd_col_array_me = hypre_NumbersArray( offd_cols_me );
   len_offd_col_array_me = hypre_NumbersNEntered( offd_cols_me );
   request = hypre_CTAlloc(hypre_MPI_Request, 2*num_procs );
   ireq = 0;
   for ( q=0; q<num_inprocessors; ++q )
      hypre_MPI_Irecv( &len_offd_col_array[q], 1, HYPRE_MPI_INT,
                 inprocessor[q], 0, comm, &request[ireq++] );
   for ( p=0; p<num_procs; ++p ) if ( pcr[p]==1 ) {
      hypre_MPI_Isend( &len_offd_col_array_me, 1, HYPRE_MPI_INT, p, 0, comm, &request[ireq++] );
   }
   status = hypre_CTAlloc(hypre_MPI_Status, ireq );
   hypre_MPI_Waitall( ireq, request, status );
   hypre_TFree(status);
   ireq = 0;
   for ( q=0; q<num_inprocessors; ++q )
      offd_col_array[q] = hypre_CTAlloc( HYPRE_Int, len_offd_col_array[q] );
   for ( q=0; q<num_inprocessors; ++q )
      hypre_MPI_Irecv( offd_col_array[q], len_offd_col_array[q], HYPRE_MPI_INT,
                 inprocessor[q], 0, comm, &request[ireq++] );
   for ( p=0; p<num_procs; ++p ) if ( pcr[p]==1 ) {
      hypre_MPI_Isend( offd_col_array_me, len_offd_col_array_me,
                 HYPRE_MPI_INT, p, 0, comm, &request[ireq++] );
   }
   status = hypre_CTAlloc(hypre_MPI_Status, ireq );
   hypre_MPI_Waitall( ireq, request, status );
   hypre_TFree(request);
   hypre_TFree(status);
   offd_cols = hypre_CTAlloc( hypre_NumbersNode *, num_inprocessors );
   for ( q=0; q<num_inprocessors; ++q ) {
      offd_cols[q] = hypre_NumbersNewNode();
      for ( i=0; i<len_offd_col_array[q]; ++i )
         hypre_NumbersEnter( offd_cols[q], offd_col_array[q][i] );
   }

   len_num_rdofs_toprocessor = 1 + hypre_CSRMatrixI(offd)
      [hypre_CSRMatrixNumRows(offd)];
   inproc = hypre_CTAlloc( HYPRE_Int, len_num_rdofs_toprocessor );
   toproc = hypre_CTAlloc( HYPRE_Int, len_num_rdofs_toprocessor );
   num_rdofs_toprocessor = hypre_CTAlloc( HYPRE_Int, len_num_rdofs_toprocessor );
   for ( qto=0; qto<len_num_rdofs_toprocessor; ++qto ) {
      inproc[qto] = -1;
      toproc[qto] = -1;
      num_rdofs_toprocessor[qto] = 0;
   };
   rdofs = hypre_NumbersNewNode();
   for ( row=0; row<hypre_CSRMatrixNumRows(offd); ++row ) {
      for ( i=hypre_CSRMatrixI(offd)[row]; i<hypre_CSRMatrixI(offd)[row+1]; ++i ) {
         j_local = hypre_CSRMatrixJ(offd)[i];
         j_global =  col_map_offd[j_local];
         hypre_NumbersEnter( rdofs, j_local );
         
         /* TO DO: find faster ways to do the two processor lookups below.*/
         /* Find a processor p (local index q) from the inprocessor list,
            which owns the column(rdof) whichis the same as this processor's
            row(idof) row. Update num_inchords for p.
            Save q as inproc[i] for quick recall later.  It represents
            an inprocessor (not unique) connected to a chord i.
         */
         inproc[i] = -1;
         for ( q=0; q<num_inprocessors; ++q ) if (q!=my_q) {
            p = inprocessor[q];
            if ( hypre_NumbersQuery( offd_cols[q],
                                     row+hypre_ParCSRMatrixFirstRowIndex(Ap) )
                 == 1 ) {
               /* row is one of the offd columns of p */
               ++num_inchords[q];
               inproc[i] = q;
               break;
            }
         }
         if ( inproc[i]<0 ) {
            /* For square matrices, we would have found the column in some
               other processor's offd.  But for non-square matrices it could
               exist only in some other processor's diag...*/
            /* Note that all data in a diag block is stored.  We don't check
               whether the value of a data entry is zero. */
            for ( q=0; q<num_inprocessors; ++q ) if (q!=my_q) {
               p = inprocessor[q];
               row_global = row+hypre_ParCSRMatrixFirstRowIndex(Ap);
               if ( row_global>=col_starts[p] &&
                    row_global< col_starts[p+1] ) {
                  /* row is one of the diag columns of p */
                  ++num_inchords[q];
                  inproc[i] = q;
                  break;
               }
            }  
         }
         hypre_assert( inproc[i]>=0 );

         /* Find the processor pto (local index qto) from the toprocessor list,
            which owns the row(idof) which is the  same as this processor's
            column(rdof) j_global. Update num_rdofs_toprocessor for pto.
            Save pto as toproc[i] for quick recall later. It represents
            the toprocessor connected to a chord i. */
         for ( qto=0; qto<num_toprocessors; ++qto ) {
            pto = toprocessor[qto];
            if ( j_global >= row_starts[pto] && j_global<row_starts[pto+1] ) {
               hypre_assert( qto < len_num_rdofs_toprocessor );
               ++num_rdofs_toprocessor[qto];
               /* ... an overestimate, as if two chords share an rdof, that
                  rdof will be counted twice in num_rdofs_toprocessor.
                  It can be fixed up later.*/
               toproc[i] = qto;
               break;
            }
         }
      }
   };
   num_rdofs += hypre_NumbersNEntered(rdofs);
   hypre_NumbersDeleteNode(rdofs);

   for ( q=0; q<num_inprocessors; ++q ) if (q!=my_q) {
      inchord_idof[q] = hypre_CTAlloc( HYPRE_Int, num_inchords[q] );
      inchord_rdof[q] = hypre_CTAlloc( HYPRE_Int, num_inchords[q] );
      inchord_data[q] = hypre_CTAlloc( double, num_inchords[q] );
      chord[q] = 0;
   };