1 #define PETSCMAT_DLL 2 3 #include "src/mat/matimpl.h" 4 5 /* 6 The input to the stash is ALWAYS in MatScalar precision, and the 7 internal storage and output is also in MatScalar. 8 */ 9 #define DEFAULT_STASH_SIZE 10000 10 11 /* 12 MatStashCreate_Private - Creates a stash,currently used for all the parallel 13 matrix implementations. The stash is where elements of a matrix destined 14 to be stored on other processors are kept until matrix assembly is done. 15 16 This is a simple minded stash. Simply adds entries to end of stash. 17 18 Input Parameters: 19 comm - communicator, required for scatters. 20 bs - stash block size. used when stashing blocks of values 21 22 Output Parameters: 23 stash - the newly created stash 24 */ 25 #undef __FUNCT__ 26 #define __FUNCT__ "MatStashCreate_Private" 27 PetscErrorCode MatStashCreate_Private(MPI_Comm comm,PetscInt bs,MatStash *stash) 28 { 29 PetscErrorCode ierr; 30 PetscInt max,*opt,nopt; 31 PetscTruth flg; 32 33 PetscFunctionBegin; 34 /* Require 2 tags,get the second using PetscCommGetNewTag() */ 35 stash->comm = comm; 36 ierr = PetscCommGetNewTag(stash->comm,&stash->tag1);CHKERRQ(ierr); 37 ierr = PetscCommGetNewTag(stash->comm,&stash->tag2);CHKERRQ(ierr); 38 ierr = MPI_Comm_size(stash->comm,&stash->size);CHKERRQ(ierr); 39 ierr = MPI_Comm_rank(stash->comm,&stash->rank);CHKERRQ(ierr); 40 41 nopt = stash->size; 42 ierr = PetscMalloc(nopt*sizeof(PetscInt),&opt);CHKERRQ(ierr); 43 ierr = PetscOptionsGetIntArray(PETSC_NULL,"-matstash_initial_size",opt,&nopt,&flg);CHKERRQ(ierr); 44 if (flg) { 45 if (nopt == 1) max = opt[0]; 46 else if (nopt == stash->size) max = opt[stash->rank]; 47 else if (stash->rank < nopt) max = opt[stash->rank]; 48 else max = 0; /* Use default */ 49 stash->umax = max; 50 } else { 51 stash->umax = 0; 52 } 53 ierr = PetscFree(opt);CHKERRQ(ierr); 54 if (bs <= 0) bs = 1; 55 56 stash->bs = bs; 57 stash->nmax = 0; 58 stash->oldnmax = 0; 59 stash->n = 0; 60 stash->reallocs = -1; 61 stash->idx = 0; 62 stash->idy = 0; 63 stash->array = 0; 64 65 stash->send_waits = 0; 66 stash->recv_waits = 0; 67 stash->send_status = 0; 68 stash->nsends = 0; 69 stash->nrecvs = 0; 70 stash->svalues = 0; 71 stash->rvalues = 0; 72 stash->rindices = 0; 73 stash->nprocs = 0; 74 stash->nprocessed = 0; 75 PetscFunctionReturn(0); 76 } 77 78 /* 79 MatStashDestroy_Private - Destroy the stash 80 */ 81 #undef __FUNCT__ 82 #define __FUNCT__ "MatStashDestroy_Private" 83 PetscErrorCode MatStashDestroy_Private(MatStash *stash) 84 { 85 PetscErrorCode ierr; 86 87 PetscFunctionBegin; 88 if (stash->array) { 89 ierr = PetscFree(stash->array);CHKERRQ(ierr); 90 stash->array = 0; 91 } 92 PetscFunctionReturn(0); 93 } 94 95 /* 96 MatStashScatterEnd_Private - This is called as the fial stage of 97 scatter. The final stages of messagepassing is done here, and 98 all the memory used for messagepassing is cleanedu up. This 99 routine also resets the stash, and deallocates the memory used 100 for the stash. It also keeps track of the current memory usage 101 so that the same value can be used the next time through. 102 */ 103 #undef __FUNCT__ 104 #define __FUNCT__ "MatStashScatterEnd_Private" 105 PetscErrorCode MatStashScatterEnd_Private(MatStash *stash) 106 { 107 PetscErrorCode ierr; 108 int nsends=stash->nsends,bs2,oldnmax; 109 MPI_Status *send_status; 110 111 PetscFunctionBegin; 112 /* wait on sends */ 113 if (nsends) { 114 ierr = PetscMalloc(2*nsends*sizeof(MPI_Status),&send_status);CHKERRQ(ierr); 115 ierr = MPI_Waitall(2*nsends,stash->send_waits,send_status);CHKERRQ(ierr); 116 ierr = PetscFree(send_status);CHKERRQ(ierr); 117 } 118 119 /* Now update nmaxold to be app 10% more than max n used, this way the 120 wastage of space is reduced the next time this stash is used. 121 Also update the oldmax, only if it increases */ 122 if (stash->n) { 123 bs2 = stash->bs*stash->bs; 124 oldnmax = ((int)(stash->n * 1.1) + 5)*bs2; 125 if (oldnmax > stash->oldnmax) stash->oldnmax = oldnmax; 126 } 127 128 stash->nmax = 0; 129 stash->n = 0; 130 stash->reallocs = -1; 131 stash->nprocessed = 0; 132 133 if (stash->array) { 134 ierr = PetscFree(stash->array);CHKERRQ(ierr); 135 stash->array = 0; 136 stash->idx = 0; 137 stash->idy = 0; 138 } 139 if (stash->send_waits) { 140 ierr = PetscFree(stash->send_waits);CHKERRQ(ierr); 141 stash->send_waits = 0; 142 } 143 if (stash->recv_waits) { 144 ierr = PetscFree(stash->recv_waits);CHKERRQ(ierr); 145 stash->recv_waits = 0; 146 } 147 if (stash->svalues) { 148 ierr = PetscFree(stash->svalues);CHKERRQ(ierr); 149 stash->svalues = 0; 150 } 151 if (stash->rvalues) { 152 ierr = PetscFree(stash->rvalues);CHKERRQ(ierr); 153 stash->rvalues = 0; 154 } 155 if (stash->rindices) { 156 ierr = PetscFree(stash->rindices);CHKERRQ(ierr); 157 stash->rindices = 0; 158 } 159 if (stash->nprocs) { 160 ierr = PetscFree(stash->nprocs);CHKERRQ(ierr); 161 stash->nprocs = 0; 162 } 163 164 PetscFunctionReturn(0); 165 } 166 167 /* 168 MatStashGetInfo_Private - Gets the relavant statistics of the stash 169 170 Input Parameters: 171 stash - the stash 172 nstash - the size of the stash. Indicates the number of values stored. 173 reallocs - the number of additional mallocs incurred. 174 175 */ 176 #undef __FUNCT__ 177 #define __FUNCT__ "MatStashGetInfo_Private" 178 PetscErrorCode MatStashGetInfo_Private(MatStash *stash,PetscInt *nstash,PetscInt *reallocs) 179 { 180 PetscInt bs2 = stash->bs*stash->bs; 181 182 PetscFunctionBegin; 183 if (nstash) *nstash = stash->n*bs2; 184 if (reallocs) { 185 if (stash->reallocs < 0) *reallocs = 0; 186 else *reallocs = stash->reallocs; 187 } 188 PetscFunctionReturn(0); 189 } 190 191 192 /* 193 MatStashSetInitialSize_Private - Sets the initial size of the stash 194 195 Input Parameters: 196 stash - the stash 197 max - the value that is used as the max size of the stash. 198 this value is used while allocating memory. 199 */ 200 #undef __FUNCT__ 201 #define __FUNCT__ "MatStashSetInitialSize_Private" 202 PetscErrorCode MatStashSetInitialSize_Private(MatStash *stash,PetscInt max) 203 { 204 PetscFunctionBegin; 205 stash->umax = max; 206 PetscFunctionReturn(0); 207 } 208 209 /* MatStashExpand_Private - Expand the stash. This function is called 210 when the space in the stash is not sufficient to add the new values 211 being inserted into the stash. 212 213 Input Parameters: 214 stash - the stash 215 incr - the minimum increase requested 216 217 Notes: 218 This routine doubles the currently used memory. 219 */ 220 #undef __FUNCT__ 221 #define __FUNCT__ "MatStashExpand_Private" 222 static PetscErrorCode MatStashExpand_Private(MatStash *stash,PetscInt incr) 223 { 224 PetscErrorCode ierr; 225 PetscInt *n_idx,*n_idy,newnmax,bs2; 226 MatScalar *n_array; 227 228 PetscFunctionBegin; 229 /* allocate a larger stash */ 230 bs2 = stash->bs*stash->bs; 231 if (!stash->oldnmax && !stash->nmax) { /* new stash */ 232 if (stash->umax) newnmax = stash->umax/bs2; 233 else newnmax = DEFAULT_STASH_SIZE/bs2; 234 } else if (!stash->nmax) { /* resuing stash */ 235 if (stash->umax > stash->oldnmax) newnmax = stash->umax/bs2; 236 else newnmax = stash->oldnmax/bs2; 237 } else newnmax = stash->nmax*2; 238 if (newnmax < (stash->nmax + incr)) newnmax += 2*incr; 239 240 ierr = PetscMalloc((newnmax)*(2*sizeof(PetscInt)+bs2*sizeof(MatScalar)),&n_array);CHKERRQ(ierr); 241 n_idx = (PetscInt*)(n_array + bs2*newnmax); 242 n_idy = (PetscInt*)(n_idx + newnmax); 243 ierr = PetscMemcpy(n_array,stash->array,bs2*stash->nmax*sizeof(MatScalar));CHKERRQ(ierr); 244 ierr = PetscMemcpy(n_idx,stash->idx,stash->nmax*sizeof(PetscInt));CHKERRQ(ierr); 245 ierr = PetscMemcpy(n_idy,stash->idy,stash->nmax*sizeof(PetscInt));CHKERRQ(ierr); 246 if (stash->array) {ierr = PetscFree(stash->array);CHKERRQ(ierr);} 247 stash->array = n_array; 248 stash->idx = n_idx; 249 stash->idy = n_idy; 250 stash->nmax = newnmax; 251 stash->reallocs++; 252 PetscFunctionReturn(0); 253 } 254 /* 255 MatStashValuesRow_Private - inserts values into the stash. This function 256 expects the values to be roworiented. Multiple columns belong to the same row 257 can be inserted with a single call to this function. 258 259 Input Parameters: 260 stash - the stash 261 row - the global row correspoiding to the values 262 n - the number of elements inserted. All elements belong to the above row. 263 idxn - the global column indices corresponding to each of the values. 264 values - the values inserted 265 */ 266 #undef __FUNCT__ 267 #define __FUNCT__ "MatStashValuesRow_Private" 268 PetscErrorCode MatStashValuesRow_Private(MatStash *stash,PetscInt row,PetscInt n,const PetscInt idxn[],const MatScalar values[]) 269 { 270 PetscErrorCode ierr; 271 PetscInt i; 272 273 PetscFunctionBegin; 274 /* Check and see if we have sufficient memory */ 275 if ((stash->n + n) > stash->nmax) { 276 ierr = MatStashExpand_Private(stash,n);CHKERRQ(ierr); 277 } 278 for (i=0; i<n; i++) { 279 stash->idx[stash->n] = row; 280 stash->idy[stash->n] = idxn[i]; 281 stash->array[stash->n] = values[i]; 282 stash->n++; 283 } 284 PetscFunctionReturn(0); 285 } 286 /* 287 MatStashValuesCol_Private - inserts values into the stash. This function 288 expects the values to be columnoriented. Multiple columns belong to the same row 289 can be inserted with a single call to this function. 290 291 Input Parameters: 292 stash - the stash 293 row - the global row correspoiding to the values 294 n - the number of elements inserted. All elements belong to the above row. 295 idxn - the global column indices corresponding to each of the values. 296 values - the values inserted 297 stepval - the consecutive values are sepated by a distance of stepval. 298 this happens because the input is columnoriented. 299 */ 300 #undef __FUNCT__ 301 #define __FUNCT__ "MatStashValuesCol_Private" 302 PetscErrorCode MatStashValuesCol_Private(MatStash *stash,PetscInt row,PetscInt n,const PetscInt idxn[],const MatScalar values[],PetscInt stepval) 303 { 304 PetscErrorCode ierr; 305 PetscInt i; 306 307 PetscFunctionBegin; 308 /* Check and see if we have sufficient memory */ 309 if ((stash->n + n) > stash->nmax) { 310 ierr = MatStashExpand_Private(stash,n);CHKERRQ(ierr); 311 } 312 for (i=0; i<n; i++) { 313 stash->idx[stash->n] = row; 314 stash->idy[stash->n] = idxn[i]; 315 stash->array[stash->n] = values[i*stepval]; 316 stash->n++; 317 } 318 PetscFunctionReturn(0); 319 } 320 321 /* 322 MatStashValuesRowBlocked_Private - inserts blocks of values into the stash. 323 This function expects the values to be roworiented. Multiple columns belong 324 to the same block-row can be inserted with a single call to this function. 325 This function extracts the sub-block of values based on the dimensions of 326 the original input block, and the row,col values corresponding to the blocks. 327 328 Input Parameters: 329 stash - the stash 330 row - the global block-row correspoiding to the values 331 n - the number of elements inserted. All elements belong to the above row. 332 idxn - the global block-column indices corresponding to each of the blocks of 333 values. Each block is of size bs*bs. 334 values - the values inserted 335 rmax - the number of block-rows in the original block. 336 cmax - the number of block-columsn on the original block. 337 idx - the index of the current block-row in the original block. 338 */ 339 #undef __FUNCT__ 340 #define __FUNCT__ "MatStashValuesRowBlocked_Private" 341 PetscErrorCode MatStashValuesRowBlocked_Private(MatStash *stash,PetscInt row,PetscInt n,const PetscInt idxn[],const MatScalar values[],PetscInt rmax,PetscInt cmax,PetscInt idx) 342 { 343 PetscErrorCode ierr; 344 PetscInt i,j,k,bs2,bs=stash->bs; 345 const MatScalar *vals; 346 MatScalar *array; 347 348 PetscFunctionBegin; 349 bs2 = bs*bs; 350 if ((stash->n+n) > stash->nmax) { 351 ierr = MatStashExpand_Private(stash,n);CHKERRQ(ierr); 352 } 353 for (i=0; i<n; i++) { 354 stash->idx[stash->n] = row; 355 stash->idy[stash->n] = idxn[i]; 356 /* Now copy over the block of values. Store the values column oriented. 357 This enables inserting multiple blocks belonging to a row with a single 358 funtion call */ 359 array = stash->array + bs2*stash->n; 360 vals = values + idx*bs2*n + bs*i; 361 for (j=0; j<bs; j++) { 362 for (k=0; k<bs; k++) {array[k*bs] = vals[k];} 363 array += 1; 364 vals += cmax*bs; 365 } 366 stash->n++; 367 } 368 PetscFunctionReturn(0); 369 } 370 371 /* 372 MatStashValuesColBlocked_Private - inserts blocks of values into the stash. 373 This function expects the values to be roworiented. Multiple columns belong 374 to the same block-row can be inserted with a single call to this function. 375 This function extracts the sub-block of values based on the dimensions of 376 the original input block, and the row,col values corresponding to the blocks. 377 378 Input Parameters: 379 stash - the stash 380 row - the global block-row correspoiding to the values 381 n - the number of elements inserted. All elements belong to the above row. 382 idxn - the global block-column indices corresponding to each of the blocks of 383 values. Each block is of size bs*bs. 384 values - the values inserted 385 rmax - the number of block-rows in the original block. 386 cmax - the number of block-columsn on the original block. 387 idx - the index of the current block-row in the original block. 388 */ 389 #undef __FUNCT__ 390 #define __FUNCT__ "MatStashValuesColBlocked_Private" 391 PetscErrorCode MatStashValuesColBlocked_Private(MatStash *stash,PetscInt row,PetscInt n,const PetscInt idxn[],const MatScalar values[],PetscInt rmax,PetscInt cmax,PetscInt idx) 392 { 393 PetscErrorCode ierr; 394 PetscInt i,j,k,bs2,bs=stash->bs; 395 const MatScalar *vals; 396 MatScalar *array; 397 398 PetscFunctionBegin; 399 bs2 = bs*bs; 400 if ((stash->n+n) > stash->nmax) { 401 ierr = MatStashExpand_Private(stash,n);CHKERRQ(ierr); 402 } 403 for (i=0; i<n; i++) { 404 stash->idx[stash->n] = row; 405 stash->idy[stash->n] = idxn[i]; 406 /* Now copy over the block of values. Store the values column oriented. 407 This enables inserting multiple blocks belonging to a row with a single 408 funtion call */ 409 array = stash->array + bs2*stash->n; 410 vals = values + idx*bs + bs2*rmax*i; 411 for (j=0; j<bs; j++) { 412 for (k=0; k<bs; k++) {array[k] = vals[k];} 413 array += bs; 414 vals += rmax*bs; 415 } 416 stash->n++; 417 } 418 PetscFunctionReturn(0); 419 } 420 /* 421 MatStashScatterBegin_Private - Initiates the transfer of values to the 422 correct owners. This function goes through the stash, and check the 423 owners of each stashed value, and sends the values off to the owner 424 processors. 425 426 Input Parameters: 427 stash - the stash 428 owners - an array of size 'no-of-procs' which gives the ownership range 429 for each node. 430 431 Notes: The 'owners' array in the cased of the blocked-stash has the 432 ranges specified blocked global indices, and for the regular stash in 433 the proper global indices. 434 */ 435 #undef __FUNCT__ 436 #define __FUNCT__ "MatStashScatterBegin_Private" 437 PetscErrorCode MatStashScatterBegin_Private(MatStash *stash,PetscInt *owners) 438 { 439 PetscInt *owner,*startv,*starti,tag1=stash->tag1,tag2=stash->tag2,bs2; 440 PetscInt size=stash->size,*nprocs,*nlengths,nsends,nreceives; 441 PetscErrorCode ierr; 442 PetscInt count,*sindices,**rindices,i,j,idx,lastidx; 443 MatScalar **rvalues,*svalues; 444 MPI_Comm comm = stash->comm; 445 MPI_Request *send_waits,*recv_waits,*recv_waits1,*recv_waits2; 446 447 PetscFunctionBegin; 448 449 bs2 = stash->bs*stash->bs; 450 /* first count number of contributors to each processor */ 451 ierr = PetscMalloc(2*size*sizeof(PetscInt),&nprocs);CHKERRQ(ierr); 452 ierr = PetscMemzero(nprocs,2*size*sizeof(PetscInt));CHKERRQ(ierr); 453 ierr = PetscMalloc((stash->n+1)*sizeof(PetscInt),&owner);CHKERRQ(ierr); 454 455 nlengths = nprocs+size; 456 j = 0; 457 lastidx = -1; 458 for (i=0; i<stash->n; i++) { 459 /* if indices are NOT locally sorted, need to start search at the beginning */ 460 if (lastidx > (idx = stash->idx[i])) j = 0; 461 lastidx = idx; 462 for (; j<size; j++) { 463 if (idx >= owners[j] && idx < owners[j+1]) { 464 nlengths[j]++; owner[i] = j; break; 465 } 466 } 467 } 468 /* Now check what procs get messages - and compute nsends. */ 469 for (i=0, nsends=0 ; i<size; i++) { 470 if (nlengths[i]) { nprocs[i] = 1; nsends ++;} 471 } 472 473 { int *onodes,*olengths; 474 /* Determine the number of messages to expect, their lengths, from from-ids */ 475 ierr = PetscGatherNumberOfMessages(comm,nprocs,nlengths,&nreceives);CHKERRQ(ierr); 476 ierr = PetscGatherMessageLengths(comm,nsends,nreceives,nlengths,&onodes,&olengths);CHKERRQ(ierr); 477 /* since clubbing row,col - lengths are multiplied by 2 */ 478 for (i=0; i<nreceives; i++) olengths[i] *=2; 479 ierr = PetscPostIrecvInt(comm,tag1,nreceives,onodes,olengths,&rindices,&recv_waits1);CHKERRQ(ierr); 480 /* values are size 'bs2' lengths (and remove earlier factor 2 */ 481 for (i=0; i<nreceives; i++) olengths[i] = olengths[i]*bs2/2; 482 ierr = PetscPostIrecvScalar(comm,tag2,nreceives,onodes,olengths,&rvalues,&recv_waits2);CHKERRQ(ierr); 483 ierr = PetscFree(onodes);CHKERRQ(ierr); 484 ierr = PetscFree(olengths);CHKERRQ(ierr); 485 } 486 487 /* do sends: 488 1) starts[i] gives the starting index in svalues for stuff going to 489 the ith processor 490 */ 491 ierr = PetscMalloc((stash->n+1)*(bs2*sizeof(MatScalar)+2*sizeof(PetscInt)),&svalues);CHKERRQ(ierr); 492 sindices = (PetscInt*)(svalues + bs2*stash->n); 493 ierr = PetscMalloc(2*(nsends+1)*sizeof(MPI_Request),&send_waits);CHKERRQ(ierr); 494 ierr = PetscMalloc(2*size*sizeof(PetscInt),&startv);CHKERRQ(ierr); 495 starti = startv + size; 496 /* use 2 sends the first with all_a, the next with all_i and all_j */ 497 startv[0] = 0; starti[0] = 0; 498 for (i=1; i<size; i++) { 499 startv[i] = startv[i-1] + nlengths[i-1]; 500 starti[i] = starti[i-1] + nlengths[i-1]*2; 501 } 502 for (i=0; i<stash->n; i++) { 503 j = owner[i]; 504 if (bs2 == 1) { 505 svalues[startv[j]] = stash->array[i]; 506 } else { 507 PetscInt k; 508 MatScalar *buf1,*buf2; 509 buf1 = svalues+bs2*startv[j]; 510 buf2 = stash->array+bs2*i; 511 for (k=0; k<bs2; k++){ buf1[k] = buf2[k]; } 512 } 513 sindices[starti[j]] = stash->idx[i]; 514 sindices[starti[j]+nlengths[j]] = stash->idy[i]; 515 startv[j]++; 516 starti[j]++; 517 } 518 startv[0] = 0; 519 for (i=1; i<size; i++) { startv[i] = startv[i-1] + nlengths[i-1];} 520 521 for (i=0,count=0; i<size; i++) { 522 if (nprocs[i]) { 523 ierr = MPI_Isend(sindices+2*startv[i],2*nlengths[i],MPIU_INT,i,tag1,comm,send_waits+count++);CHKERRQ(ierr); 524 ierr = MPI_Isend(svalues+bs2*startv[i],bs2*nlengths[i],MPIU_MATSCALAR,i,tag2,comm,send_waits+count++);CHKERRQ(ierr); 525 } 526 } 527 #if defined(PETSC_USE_DEBUG) 528 ierr = PetscLogInfo((0,"MatStashScatterBegin_Private: No of messages: %d \n",nsends));CHKERRQ(ierr); 529 for (i=0; i<size; i++) { 530 if (nprocs[i]) { 531 ierr = PetscLogInfo((0,"MatStashScatterBegin_Private: Mesg_to: %d: size: %d \n",i,nlengths[i]*bs2*sizeof(MatScalar)+2*sizeof(PetscInt)));CHKERRQ(ierr); 532 } 533 } 534 #endif 535 ierr = PetscFree(owner);CHKERRQ(ierr); 536 ierr = PetscFree(startv);CHKERRQ(ierr); 537 /* This memory is reused in scatter end for a different purpose*/ 538 for (i=0; i<2*size; i++) nprocs[i] = -1; 539 stash->nprocs = nprocs; 540 541 /* recv_waits need to be contiguous for MatStashScatterGetMesg_Private() */ 542 ierr = PetscMalloc((nreceives+1)*2*sizeof(MPI_Request),&recv_waits);CHKERRQ(ierr); 543 544 for (i=0; i<nreceives; i++) { 545 recv_waits[2*i] = recv_waits1[i]; 546 recv_waits[2*i+1] = recv_waits2[i]; 547 } 548 stash->recv_waits = recv_waits; 549 ierr = PetscFree(recv_waits1);CHKERRQ(ierr); 550 ierr = PetscFree(recv_waits2);CHKERRQ(ierr); 551 552 stash->svalues = svalues; stash->rvalues = rvalues; 553 stash->rindices = rindices; stash->send_waits = send_waits; 554 stash->nsends = nsends; stash->nrecvs = nreceives; 555 PetscFunctionReturn(0); 556 } 557 558 /* 559 MatStashScatterGetMesg_Private - This function waits on the receives posted 560 in the function MatStashScatterBegin_Private() and returns one message at 561 a time to the calling function. If no messages are left, it indicates this 562 by setting flg = 0, else it sets flg = 1. 563 564 Input Parameters: 565 stash - the stash 566 567 Output Parameters: 568 nvals - the number of entries in the current message. 569 rows - an array of row indices (or blocked indices) corresponding to the values 570 cols - an array of columnindices (or blocked indices) corresponding to the values 571 vals - the values 572 flg - 0 indicates no more message left, and the current call has no values associated. 573 1 indicates that the current call successfully received a message, and the 574 other output parameters nvals,rows,cols,vals are set appropriately. 575 */ 576 #undef __FUNCT__ 577 #define __FUNCT__ "MatStashScatterGetMesg_Private" 578 PetscErrorCode MatStashScatterGetMesg_Private(MatStash *stash,PetscMPIInt *nvals,PetscInt **rows,PetscInt** cols,MatScalar **vals,PetscInt *flg) 579 { 580 PetscErrorCode ierr; 581 PetscMPIInt i; 582 PetscInt *flg_v,i1,i2,bs2; 583 MPI_Status recv_status; 584 PetscTruth match_found = PETSC_FALSE; 585 586 PetscFunctionBegin; 587 588 *flg = 0; /* When a message is discovered this is reset to 1 */ 589 /* Return if no more messages to process */ 590 if (stash->nprocessed == stash->nrecvs) { PetscFunctionReturn(0); } 591 592 flg_v = stash->nprocs; 593 bs2 = stash->bs*stash->bs; 594 /* If a matching pair of receieves are found, process them, and return the data to 595 the calling function. Until then keep receiving messages */ 596 while (!match_found) { 597 ierr = MPI_Waitany(2*stash->nrecvs,stash->recv_waits,&i,&recv_status);CHKERRQ(ierr); 598 /* Now pack the received message into a structure which is useable by others */ 599 if (i % 2) { 600 ierr = MPI_Get_count(&recv_status,MPIU_MATSCALAR,nvals);CHKERRQ(ierr); 601 flg_v[2*recv_status.MPI_SOURCE] = i/2; 602 *nvals = *nvals/bs2; 603 } else { 604 ierr = MPI_Get_count(&recv_status,MPIU_INT,nvals);CHKERRQ(ierr); 605 flg_v[2*recv_status.MPI_SOURCE+1] = i/2; 606 *nvals = *nvals/2; /* This message has both row indices and col indices */ 607 } 608 609 /* Check if we have both the messages from this proc */ 610 i1 = flg_v[2*recv_status.MPI_SOURCE]; 611 i2 = flg_v[2*recv_status.MPI_SOURCE+1]; 612 if (i1 != -1 && i2 != -1) { 613 *rows = stash->rindices[i2]; 614 *cols = *rows + *nvals; 615 *vals = stash->rvalues[i1]; 616 *flg = 1; 617 stash->nprocessed ++; 618 match_found = PETSC_TRUE; 619 } 620 } 621 PetscFunctionReturn(0); 622 } 623