1 2 /* 3 Routines to compute overlapping regions of a parallel MPI matrix 4 and to find submatrices that were shared across processors. 5 */ 6 #include <../src/mat/impls/baij/mpi/mpibaij.h> 7 #include <petscbt.h> 8 9 static PetscErrorCode MatIncreaseOverlap_MPIBAIJ_Local(Mat, PetscInt, char **, PetscInt *, PetscInt **); 10 static PetscErrorCode MatIncreaseOverlap_MPIBAIJ_Receive(Mat, PetscInt, PetscInt **, PetscInt **, PetscInt *); 11 extern PetscErrorCode MatGetRow_MPIBAIJ(Mat, PetscInt, PetscInt *, PetscInt **, PetscScalar **); 12 extern PetscErrorCode MatRestoreRow_MPIBAIJ(Mat, PetscInt, PetscInt *, PetscInt **, PetscScalar **); 13 14 PetscErrorCode MatIncreaseOverlap_MPIBAIJ(Mat C, PetscInt imax, IS is[], PetscInt ov) 15 { 16 PetscInt i, N = C->cmap->N, bs = C->rmap->bs; 17 IS *is_new; 18 19 PetscFunctionBegin; 20 PetscCall(PetscMalloc1(imax, &is_new)); 21 /* Convert the indices into block format */ 22 PetscCall(ISCompressIndicesGeneral(N, C->rmap->n, bs, imax, is, is_new)); 23 PetscCheck(ov >= 0, PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Negative overlap specified"); 24 for (i = 0; i < ov; ++i) PetscCall(MatIncreaseOverlap_MPIBAIJ_Once(C, imax, is_new)); 25 for (i = 0; i < imax; i++) PetscCall(ISDestroy(&is[i])); 26 PetscCall(ISExpandIndicesGeneral(N, N, bs, imax, is_new, is)); 27 for (i = 0; i < imax; i++) PetscCall(ISDestroy(&is_new[i])); 28 PetscCall(PetscFree(is_new)); 29 PetscFunctionReturn(PETSC_SUCCESS); 30 } 31 32 /* 33 Sample message format: 34 If a processor A wants processor B to process some elements corresponding 35 to index sets is[1], is[5] 36 mesg [0] = 2 (no of index sets in the mesg) 37 ----------- 38 mesg [1] = 1 => is[1] 39 mesg [2] = sizeof(is[1]); 40 ----------- 41 mesg [5] = 5 => is[5] 42 mesg [6] = sizeof(is[5]); 43 ----------- 44 mesg [7] 45 mesg [n] data(is[1]) 46 ----------- 47 mesg[n+1] 48 mesg[m] data(is[5]) 49 ----------- 50 51 Notes: 52 nrqs - no of requests sent (or to be sent out) 53 nrqr - no of requests received (which have to be or which have been processed) 54 */ 55 PetscErrorCode MatIncreaseOverlap_MPIBAIJ_Once(Mat C, PetscInt imax, IS is[]) 56 { 57 Mat_MPIBAIJ *c = (Mat_MPIBAIJ *)C->data; 58 const PetscInt **idx, *idx_i; 59 PetscInt *n, *w3, *w4, **data, len; 60 PetscMPIInt size, rank, tag1, tag2, *w2, *w1, nrqr; 61 PetscInt Mbs, i, j, k, **rbuf, row, nrqs, msz, **outdat, **ptr; 62 PetscInt *ctr, *pa, *tmp, *isz, *isz1, **xdata, **rbuf2, *d_p; 63 PetscMPIInt *onodes1, *olengths1, *onodes2, *olengths2, proc = -1; 64 PetscBT *table; 65 MPI_Comm comm, *iscomms; 66 MPI_Request *s_waits1, *r_waits1, *s_waits2, *r_waits2; 67 char *t_p; 68 69 PetscFunctionBegin; 70 PetscCall(PetscObjectGetComm((PetscObject)C, &comm)); 71 size = c->size; 72 rank = c->rank; 73 Mbs = c->Mbs; 74 75 PetscCall(PetscObjectGetNewTag((PetscObject)C, &tag1)); 76 PetscCall(PetscObjectGetNewTag((PetscObject)C, &tag2)); 77 78 PetscCall(PetscMalloc2(imax + 1, (PetscInt ***)&idx, imax, &n)); 79 80 for (i = 0; i < imax; i++) { 81 PetscCall(ISGetIndices(is[i], &idx[i])); 82 PetscCall(ISGetLocalSize(is[i], &n[i])); 83 } 84 85 /* evaluate communication - mesg to who,length of mesg, and buffer space 86 required. Based on this, buffers are allocated, and data copied into them*/ 87 PetscCall(PetscCalloc4(size, &w1, size, &w2, size, &w3, size, &w4)); 88 for (i = 0; i < imax; i++) { 89 PetscCall(PetscArrayzero(w4, size)); /* initialise work vector*/ 90 idx_i = idx[i]; 91 len = n[i]; 92 for (j = 0; j < len; j++) { 93 row = idx_i[j]; 94 PetscCheck(row >= 0, PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Index set cannot have negative entries"); 95 PetscCall(PetscLayoutFindOwner(C->rmap, row * C->rmap->bs, &proc)); 96 w4[proc]++; 97 } 98 for (j = 0; j < size; j++) { 99 if (w4[j]) { 100 w1[j] += w4[j]; 101 w3[j]++; 102 } 103 } 104 } 105 106 nrqs = 0; /* no of outgoing messages */ 107 msz = 0; /* total mesg length (for all proc */ 108 w1[rank] = 0; /* no mesg sent to itself */ 109 w3[rank] = 0; 110 for (i = 0; i < size; i++) { 111 if (w1[i]) { 112 w2[i] = 1; 113 nrqs++; 114 } /* there exists a message to proc i */ 115 } 116 /* pa - is list of processors to communicate with */ 117 PetscCall(PetscMalloc1(nrqs, &pa)); 118 for (i = 0, j = 0; i < size; i++) { 119 if (w1[i]) { 120 pa[j] = i; 121 j++; 122 } 123 } 124 125 /* Each message would have a header = 1 + 2*(no of IS) + data */ 126 for (i = 0; i < nrqs; i++) { 127 j = pa[i]; 128 w1[j] += w2[j] + 2 * w3[j]; 129 msz += w1[j]; 130 } 131 132 /* Determine the number of messages to expect, their lengths, from from-ids */ 133 PetscCall(PetscGatherNumberOfMessages(comm, w2, w1, &nrqr)); 134 PetscCall(PetscGatherMessageLengths(comm, nrqs, nrqr, w1, &onodes1, &olengths1)); 135 136 /* Now post the Irecvs corresponding to these messages */ 137 PetscCall(PetscPostIrecvInt(comm, tag1, nrqr, onodes1, olengths1, &rbuf, &r_waits1)); 138 139 /* Allocate Memory for outgoing messages */ 140 PetscCall(PetscMalloc4(size, &outdat, size, &ptr, msz, &tmp, size, &ctr)); 141 PetscCall(PetscArrayzero(outdat, size)); 142 PetscCall(PetscArrayzero(ptr, size)); 143 { 144 PetscInt *iptr = tmp, ict = 0; 145 for (i = 0; i < nrqs; i++) { 146 j = pa[i]; 147 iptr += ict; 148 outdat[j] = iptr; 149 ict = w1[j]; 150 } 151 } 152 153 /* Form the outgoing messages */ 154 /*plug in the headers*/ 155 for (i = 0; i < nrqs; i++) { 156 j = pa[i]; 157 outdat[j][0] = 0; 158 PetscCall(PetscArrayzero(outdat[j] + 1, 2 * w3[j])); 159 ptr[j] = outdat[j] + 2 * w3[j] + 1; 160 } 161 162 /* Memory for doing local proc's work*/ 163 { 164 PetscCall(PetscCalloc5(imax, &table, imax, &data, imax, &isz, Mbs * imax, &d_p, (Mbs / PETSC_BITS_PER_BYTE + 1) * imax, &t_p)); 165 166 for (i = 0; i < imax; i++) { 167 table[i] = t_p + (Mbs / PETSC_BITS_PER_BYTE + 1) * i; 168 data[i] = d_p + (Mbs)*i; 169 } 170 } 171 172 /* Parse the IS and update local tables and the outgoing buf with the data*/ 173 { 174 PetscInt n_i, *data_i, isz_i, *outdat_j, ctr_j; 175 PetscBT table_i; 176 177 for (i = 0; i < imax; i++) { 178 PetscCall(PetscArrayzero(ctr, size)); 179 n_i = n[i]; 180 table_i = table[i]; 181 idx_i = idx[i]; 182 data_i = data[i]; 183 isz_i = isz[i]; 184 for (j = 0; j < n_i; j++) { /* parse the indices of each IS */ 185 row = idx_i[j]; 186 PetscCall(PetscLayoutFindOwner(C->rmap, row * C->rmap->bs, &proc)); 187 if (proc != rank) { /* copy to the outgoing buffer */ 188 ctr[proc]++; 189 *ptr[proc] = row; 190 ptr[proc]++; 191 } else { /* Update the local table */ 192 if (!PetscBTLookupSet(table_i, row)) data_i[isz_i++] = row; 193 } 194 } 195 /* Update the headers for the current IS */ 196 for (j = 0; j < size; j++) { /* Can Optimise this loop by using pa[] */ 197 if ((ctr_j = ctr[j])) { 198 outdat_j = outdat[j]; 199 k = ++outdat_j[0]; 200 outdat_j[2 * k] = ctr_j; 201 outdat_j[2 * k - 1] = i; 202 } 203 } 204 isz[i] = isz_i; 205 } 206 } 207 208 /* Now post the sends */ 209 PetscCall(PetscMalloc1(nrqs, &s_waits1)); 210 for (i = 0; i < nrqs; ++i) { 211 j = pa[i]; 212 PetscCallMPI(MPI_Isend(outdat[j], w1[j], MPIU_INT, j, tag1, comm, s_waits1 + i)); 213 } 214 215 /* No longer need the original indices*/ 216 for (i = 0; i < imax; ++i) PetscCall(ISRestoreIndices(is[i], idx + i)); 217 PetscCall(PetscFree2(*(PetscInt ***)&idx, n)); 218 219 PetscCall(PetscMalloc1(imax, &iscomms)); 220 for (i = 0; i < imax; ++i) { 221 PetscCall(PetscCommDuplicate(PetscObjectComm((PetscObject)is[i]), &iscomms[i], NULL)); 222 PetscCall(ISDestroy(&is[i])); 223 } 224 225 /* Do Local work*/ 226 PetscCall(MatIncreaseOverlap_MPIBAIJ_Local(C, imax, table, isz, data)); 227 228 /* Receive messages*/ 229 PetscCallMPI(MPI_Waitall(nrqr, r_waits1, MPI_STATUSES_IGNORE)); 230 PetscCallMPI(MPI_Waitall(nrqs, s_waits1, MPI_STATUSES_IGNORE)); 231 232 /* Phase 1 sends are complete - deallocate buffers */ 233 PetscCall(PetscFree4(outdat, ptr, tmp, ctr)); 234 PetscCall(PetscFree4(w1, w2, w3, w4)); 235 236 PetscCall(PetscMalloc1(nrqr, &xdata)); 237 PetscCall(PetscMalloc1(nrqr, &isz1)); 238 PetscCall(MatIncreaseOverlap_MPIBAIJ_Receive(C, nrqr, rbuf, xdata, isz1)); 239 if (rbuf) { 240 PetscCall(PetscFree(rbuf[0])); 241 PetscCall(PetscFree(rbuf)); 242 } 243 244 /* Send the data back*/ 245 /* Do a global reduction to know the buffer space req for incoming messages*/ 246 { 247 PetscMPIInt *rw1; 248 249 PetscCall(PetscCalloc1(size, &rw1)); 250 251 for (i = 0; i < nrqr; ++i) { 252 proc = onodes1[i]; 253 rw1[proc] = isz1[i]; 254 } 255 256 /* Determine the number of messages to expect, their lengths, from from-ids */ 257 PetscCall(PetscGatherMessageLengths(comm, nrqr, nrqs, rw1, &onodes2, &olengths2)); 258 PetscCall(PetscFree(rw1)); 259 } 260 /* Now post the Irecvs corresponding to these messages */ 261 PetscCall(PetscPostIrecvInt(comm, tag2, nrqs, onodes2, olengths2, &rbuf2, &r_waits2)); 262 263 /* Now post the sends */ 264 PetscCall(PetscMalloc1(nrqr, &s_waits2)); 265 for (i = 0; i < nrqr; ++i) { 266 j = onodes1[i]; 267 PetscCallMPI(MPI_Isend(xdata[i], isz1[i], MPIU_INT, j, tag2, comm, s_waits2 + i)); 268 } 269 270 PetscCall(PetscFree(onodes1)); 271 PetscCall(PetscFree(olengths1)); 272 273 /* receive work done on other processors*/ 274 { 275 PetscMPIInt idex; 276 PetscInt is_no, ct1, max, *rbuf2_i, isz_i, *data_i, jmax; 277 PetscBT table_i; 278 279 for (i = 0; i < nrqs; ++i) { 280 PetscCallMPI(MPI_Waitany(nrqs, r_waits2, &idex, MPI_STATUS_IGNORE)); 281 /* Process the message*/ 282 rbuf2_i = rbuf2[idex]; 283 ct1 = 2 * rbuf2_i[0] + 1; 284 jmax = rbuf2[idex][0]; 285 for (j = 1; j <= jmax; j++) { 286 max = rbuf2_i[2 * j]; 287 is_no = rbuf2_i[2 * j - 1]; 288 isz_i = isz[is_no]; 289 data_i = data[is_no]; 290 table_i = table[is_no]; 291 for (k = 0; k < max; k++, ct1++) { 292 row = rbuf2_i[ct1]; 293 if (!PetscBTLookupSet(table_i, row)) data_i[isz_i++] = row; 294 } 295 isz[is_no] = isz_i; 296 } 297 } 298 PetscCallMPI(MPI_Waitall(nrqr, s_waits2, MPI_STATUSES_IGNORE)); 299 } 300 301 for (i = 0; i < imax; ++i) { 302 PetscCall(ISCreateGeneral(iscomms[i], isz[i], data[i], PETSC_COPY_VALUES, is + i)); 303 PetscCall(PetscCommDestroy(&iscomms[i])); 304 } 305 306 PetscCall(PetscFree(iscomms)); 307 PetscCall(PetscFree(onodes2)); 308 PetscCall(PetscFree(olengths2)); 309 310 PetscCall(PetscFree(pa)); 311 if (rbuf2) { 312 PetscCall(PetscFree(rbuf2[0])); 313 PetscCall(PetscFree(rbuf2)); 314 } 315 PetscCall(PetscFree(s_waits1)); 316 PetscCall(PetscFree(r_waits1)); 317 PetscCall(PetscFree(s_waits2)); 318 PetscCall(PetscFree(r_waits2)); 319 PetscCall(PetscFree5(table, data, isz, d_p, t_p)); 320 if (xdata) { 321 PetscCall(PetscFree(xdata[0])); 322 PetscCall(PetscFree(xdata)); 323 } 324 PetscCall(PetscFree(isz1)); 325 PetscFunctionReturn(PETSC_SUCCESS); 326 } 327 328 /* 329 MatIncreaseOverlap_MPIBAIJ_Local - Called by MatincreaseOverlap, to do 330 the work on the local processor. 331 332 Inputs: 333 C - MAT_MPIBAIJ; 334 imax - total no of index sets processed at a time; 335 table - an array of char - size = Mbs bits. 336 337 Output: 338 isz - array containing the count of the solution elements corresponding 339 to each index set; 340 data - pointer to the solutions 341 */ 342 static PetscErrorCode MatIncreaseOverlap_MPIBAIJ_Local(Mat C, PetscInt imax, PetscBT *table, PetscInt *isz, PetscInt **data) 343 { 344 Mat_MPIBAIJ *c = (Mat_MPIBAIJ *)C->data; 345 Mat A = c->A, B = c->B; 346 Mat_SeqBAIJ *a = (Mat_SeqBAIJ *)A->data, *b = (Mat_SeqBAIJ *)B->data; 347 PetscInt start, end, val, max, rstart, cstart, *ai, *aj; 348 PetscInt *bi, *bj, *garray, i, j, k, row, *data_i, isz_i; 349 PetscBT table_i; 350 351 PetscFunctionBegin; 352 rstart = c->rstartbs; 353 cstart = c->cstartbs; 354 ai = a->i; 355 aj = a->j; 356 bi = b->i; 357 bj = b->j; 358 garray = c->garray; 359 360 for (i = 0; i < imax; i++) { 361 data_i = data[i]; 362 table_i = table[i]; 363 isz_i = isz[i]; 364 for (j = 0, max = isz[i]; j < max; j++) { 365 row = data_i[j] - rstart; 366 start = ai[row]; 367 end = ai[row + 1]; 368 for (k = start; k < end; k++) { /* Amat */ 369 val = aj[k] + cstart; 370 if (!PetscBTLookupSet(table_i, val)) data_i[isz_i++] = val; 371 } 372 start = bi[row]; 373 end = bi[row + 1]; 374 for (k = start; k < end; k++) { /* Bmat */ 375 val = garray[bj[k]]; 376 if (!PetscBTLookupSet(table_i, val)) data_i[isz_i++] = val; 377 } 378 } 379 isz[i] = isz_i; 380 } 381 PetscFunctionReturn(PETSC_SUCCESS); 382 } 383 /* 384 MatIncreaseOverlap_MPIBAIJ_Receive - Process the received messages, 385 and return the output 386 387 Input: 388 C - the matrix 389 nrqr - no of messages being processed. 390 rbuf - an array of pointers to the received requests 391 392 Output: 393 xdata - array of messages to be sent back 394 isz1 - size of each message 395 396 For better efficiency perhaps we should malloc separately each xdata[i], 397 then if a remalloc is required we need only copy the data for that one row 398 rather than all previous rows as it is now where a single large chunk of 399 memory is used. 400 401 */ 402 static PetscErrorCode MatIncreaseOverlap_MPIBAIJ_Receive(Mat C, PetscInt nrqr, PetscInt **rbuf, PetscInt **xdata, PetscInt *isz1) 403 { 404 Mat_MPIBAIJ *c = (Mat_MPIBAIJ *)C->data; 405 Mat A = c->A, B = c->B; 406 Mat_SeqBAIJ *a = (Mat_SeqBAIJ *)A->data, *b = (Mat_SeqBAIJ *)B->data; 407 PetscInt rstart, cstart, *ai, *aj, *bi, *bj, *garray, i, j, k; 408 PetscInt row, total_sz, ct, ct1, ct2, ct3, mem_estimate, oct2, l, start, end; 409 PetscInt val, max1, max2, Mbs, no_malloc = 0, *tmp, new_estimate, ctr; 410 PetscInt *rbuf_i, kmax, rbuf_0; 411 PetscBT xtable; 412 413 PetscFunctionBegin; 414 Mbs = c->Mbs; 415 rstart = c->rstartbs; 416 cstart = c->cstartbs; 417 ai = a->i; 418 aj = a->j; 419 bi = b->i; 420 bj = b->j; 421 garray = c->garray; 422 423 for (i = 0, ct = 0, total_sz = 0; i < nrqr; ++i) { 424 rbuf_i = rbuf[i]; 425 rbuf_0 = rbuf_i[0]; 426 ct += rbuf_0; 427 for (j = 1; j <= rbuf_0; j++) total_sz += rbuf_i[2 * j]; 428 } 429 430 if (c->Mbs) max1 = ct * (a->nz + b->nz) / c->Mbs; 431 else max1 = 1; 432 mem_estimate = 3 * ((total_sz > max1 ? total_sz : max1) + 1); 433 if (nrqr) { 434 PetscCall(PetscMalloc1(mem_estimate, &xdata[0])); 435 ++no_malloc; 436 } 437 PetscCall(PetscBTCreate(Mbs, &xtable)); 438 PetscCall(PetscArrayzero(isz1, nrqr)); 439 440 ct3 = 0; 441 for (i = 0; i < nrqr; i++) { /* for easch mesg from proc i */ 442 rbuf_i = rbuf[i]; 443 rbuf_0 = rbuf_i[0]; 444 ct1 = 2 * rbuf_0 + 1; 445 ct2 = ct1; 446 ct3 += ct1; 447 for (j = 1; j <= rbuf_0; j++) { /* for each IS from proc i*/ 448 PetscCall(PetscBTMemzero(Mbs, xtable)); 449 oct2 = ct2; 450 kmax = rbuf_i[2 * j]; 451 for (k = 0; k < kmax; k++, ct1++) { 452 row = rbuf_i[ct1]; 453 if (!PetscBTLookupSet(xtable, row)) { 454 if (!(ct3 < mem_estimate)) { 455 new_estimate = (PetscInt)(1.5 * mem_estimate) + 1; 456 PetscCall(PetscMalloc1(new_estimate, &tmp)); 457 PetscCall(PetscArraycpy(tmp, xdata[0], mem_estimate)); 458 PetscCall(PetscFree(xdata[0])); 459 xdata[0] = tmp; 460 mem_estimate = new_estimate; 461 ++no_malloc; 462 for (ctr = 1; ctr <= i; ctr++) xdata[ctr] = xdata[ctr - 1] + isz1[ctr - 1]; 463 } 464 xdata[i][ct2++] = row; 465 ct3++; 466 } 467 } 468 for (k = oct2, max2 = ct2; k < max2; k++) { 469 row = xdata[i][k] - rstart; 470 start = ai[row]; 471 end = ai[row + 1]; 472 for (l = start; l < end; l++) { 473 val = aj[l] + cstart; 474 if (!PetscBTLookupSet(xtable, val)) { 475 if (!(ct3 < mem_estimate)) { 476 new_estimate = (PetscInt)(1.5 * mem_estimate) + 1; 477 PetscCall(PetscMalloc1(new_estimate, &tmp)); 478 PetscCall(PetscArraycpy(tmp, xdata[0], mem_estimate)); 479 PetscCall(PetscFree(xdata[0])); 480 xdata[0] = tmp; 481 mem_estimate = new_estimate; 482 ++no_malloc; 483 for (ctr = 1; ctr <= i; ctr++) xdata[ctr] = xdata[ctr - 1] + isz1[ctr - 1]; 484 } 485 xdata[i][ct2++] = val; 486 ct3++; 487 } 488 } 489 start = bi[row]; 490 end = bi[row + 1]; 491 for (l = start; l < end; l++) { 492 val = garray[bj[l]]; 493 if (!PetscBTLookupSet(xtable, val)) { 494 if (!(ct3 < mem_estimate)) { 495 new_estimate = (PetscInt)(1.5 * mem_estimate) + 1; 496 PetscCall(PetscMalloc1(new_estimate, &tmp)); 497 PetscCall(PetscArraycpy(tmp, xdata[0], mem_estimate)); 498 PetscCall(PetscFree(xdata[0])); 499 xdata[0] = tmp; 500 mem_estimate = new_estimate; 501 ++no_malloc; 502 for (ctr = 1; ctr <= i; ctr++) xdata[ctr] = xdata[ctr - 1] + isz1[ctr - 1]; 503 } 504 xdata[i][ct2++] = val; 505 ct3++; 506 } 507 } 508 } 509 /* Update the header*/ 510 xdata[i][2 * j] = ct2 - oct2; /* Undo the vector isz1 and use only a var*/ 511 xdata[i][2 * j - 1] = rbuf_i[2 * j - 1]; 512 } 513 xdata[i][0] = rbuf_0; 514 if (i + 1 < nrqr) xdata[i + 1] = xdata[i] + ct2; 515 isz1[i] = ct2; /* size of each message */ 516 } 517 PetscCall(PetscBTDestroy(&xtable)); 518 PetscCall(PetscInfo(C, "Allocated %" PetscInt_FMT " bytes, required %" PetscInt_FMT ", no of mallocs = %" PetscInt_FMT "\n", mem_estimate, ct3, no_malloc)); 519 PetscFunctionReturn(PETSC_SUCCESS); 520 } 521 522 PetscErrorCode MatCreateSubMatrices_MPIBAIJ(Mat C, PetscInt ismax, const IS isrow[], const IS iscol[], MatReuse scall, Mat *submat[]) 523 { 524 IS *isrow_block, *iscol_block; 525 Mat_MPIBAIJ *c = (Mat_MPIBAIJ *)C->data; 526 PetscInt nmax, nstages_local, nstages, i, pos, max_no, N = C->cmap->N, bs = C->rmap->bs; 527 Mat_SeqBAIJ *subc; 528 Mat_SubSppt *smat; 529 530 PetscFunctionBegin; 531 /* The compression and expansion should be avoided. Doesn't point 532 out errors, might change the indices, hence buggey */ 533 PetscCall(PetscMalloc2(ismax + 1, &isrow_block, ismax + 1, &iscol_block)); 534 PetscCall(ISCompressIndicesGeneral(N, C->rmap->n, bs, ismax, isrow, isrow_block)); 535 PetscCall(ISCompressIndicesGeneral(N, C->cmap->n, bs, ismax, iscol, iscol_block)); 536 537 /* Determine the number of stages through which submatrices are done */ 538 if (!C->cmap->N) nmax = 20 * 1000000 / sizeof(PetscInt); 539 else nmax = 20 * 1000000 / (c->Nbs * sizeof(PetscInt)); 540 if (!nmax) nmax = 1; 541 542 if (scall == MAT_INITIAL_MATRIX) { 543 nstages_local = ismax / nmax + ((ismax % nmax) ? 1 : 0); /* local nstages */ 544 545 /* Make sure every processor loops through the nstages */ 546 PetscCall(MPIU_Allreduce(&nstages_local, &nstages, 1, MPIU_INT, MPI_MAX, PetscObjectComm((PetscObject)C))); 547 548 /* Allocate memory to hold all the submatrices and dummy submatrices */ 549 PetscCall(PetscCalloc1(ismax + nstages, submat)); 550 } else { /* MAT_REUSE_MATRIX */ 551 if (ismax) { 552 subc = (Mat_SeqBAIJ *)((*submat)[0]->data); 553 smat = subc->submatis1; 554 } else { /* (*submat)[0] is a dummy matrix */ 555 smat = (Mat_SubSppt *)(*submat)[0]->data; 556 } 557 PetscCheck(smat, PETSC_COMM_SELF, PETSC_ERR_ARG_NULL, "MatCreateSubMatrices(...,MAT_REUSE_MATRIX,...) requires submat"); 558 nstages = smat->nstages; 559 } 560 561 for (i = 0, pos = 0; i < nstages; i++) { 562 if (pos + nmax <= ismax) max_no = nmax; 563 else if (pos >= ismax) max_no = 0; 564 else max_no = ismax - pos; 565 566 PetscCall(MatCreateSubMatrices_MPIBAIJ_local(C, max_no, isrow_block + pos, iscol_block + pos, scall, *submat + pos)); 567 if (!max_no) { 568 if (scall == MAT_INITIAL_MATRIX) { /* submat[pos] is a dummy matrix */ 569 smat = (Mat_SubSppt *)(*submat)[pos]->data; 570 smat->nstages = nstages; 571 } 572 pos++; /* advance to next dummy matrix if any */ 573 } else pos += max_no; 574 } 575 576 if (scall == MAT_INITIAL_MATRIX && ismax) { 577 /* save nstages for reuse */ 578 subc = (Mat_SeqBAIJ *)((*submat)[0]->data); 579 smat = subc->submatis1; 580 smat->nstages = nstages; 581 } 582 583 for (i = 0; i < ismax; i++) { 584 PetscCall(ISDestroy(&isrow_block[i])); 585 PetscCall(ISDestroy(&iscol_block[i])); 586 } 587 PetscCall(PetscFree2(isrow_block, iscol_block)); 588 PetscFunctionReturn(PETSC_SUCCESS); 589 } 590 591 #if defined(PETSC_USE_CTABLE) 592 PetscErrorCode PetscGetProc(const PetscInt row, const PetscMPIInt size, const PetscInt proc_gnode[], PetscMPIInt *rank) 593 { 594 PetscInt nGlobalNd = proc_gnode[size]; 595 PetscMPIInt fproc; 596 597 PetscFunctionBegin; 598 PetscCall(PetscMPIIntCast((PetscInt)(((float)row * (float)size / (float)nGlobalNd + 0.5)), &fproc)); 599 if (fproc > size) fproc = size; 600 while (row < proc_gnode[fproc] || row >= proc_gnode[fproc + 1]) { 601 if (row < proc_gnode[fproc]) fproc--; 602 else fproc++; 603 } 604 *rank = fproc; 605 PetscFunctionReturn(PETSC_SUCCESS); 606 } 607 #endif 608 609 /* This code is used for BAIJ and SBAIJ matrices (unfortunate dependency) */ 610 PetscErrorCode MatCreateSubMatrices_MPIBAIJ_local(Mat C, PetscInt ismax, const IS isrow[], const IS iscol[], MatReuse scall, Mat *submats) 611 { 612 Mat_MPIBAIJ *c = (Mat_MPIBAIJ *)C->data; 613 Mat A = c->A; 614 Mat_SeqBAIJ *a = (Mat_SeqBAIJ *)A->data, *b = (Mat_SeqBAIJ *)c->B->data, *subc; 615 const PetscInt **icol, **irow; 616 PetscInt *nrow, *ncol, start; 617 PetscMPIInt rank, size, tag0, tag2, tag3, tag4, *w1, *w2, *w3, *w4, nrqr; 618 PetscInt **sbuf1, **sbuf2, *sbuf2_i, i, j, k, l, ct1, ct2, **rbuf1, row, proc = -1; 619 PetscInt nrqs = 0, msz, **ptr = NULL, *req_size = NULL, *ctr = NULL, *pa, *tmp = NULL, tcol; 620 PetscInt **rbuf3 = NULL, *req_source1 = NULL, *req_source2, **sbuf_aj, **rbuf2 = NULL, max1, max2; 621 PetscInt **lens, is_no, ncols, *cols, mat_i, *mat_j, tmp2, jmax; 622 #if defined(PETSC_USE_CTABLE) 623 PetscHMapI *cmap, cmap_i = NULL, *rmap, rmap_i; 624 #else 625 PetscInt **cmap, *cmap_i = NULL, **rmap, *rmap_i; 626 #endif 627 const PetscInt *irow_i, *icol_i; 628 PetscInt ctr_j, *sbuf1_j, *sbuf_aj_i, *rbuf1_i, kmax, *lens_i; 629 MPI_Request *s_waits1, *r_waits1, *s_waits2, *r_waits2, *r_waits3; 630 MPI_Request *r_waits4, *s_waits3, *s_waits4; 631 MPI_Comm comm; 632 PetscScalar **rbuf4, *rbuf4_i = NULL, **sbuf_aa, *vals, *mat_a = NULL, *imat_a = NULL, *sbuf_aa_i; 633 PetscMPIInt *onodes1, *olengths1, end; 634 PetscInt **row2proc, *row2proc_i, *imat_ilen, *imat_j, *imat_i; 635 Mat_SubSppt *smat_i; 636 PetscBool *issorted, colflag, iscsorted = PETSC_TRUE; 637 PetscInt *sbuf1_i, *rbuf2_i, *rbuf3_i, ilen; 638 PetscInt bs = C->rmap->bs, bs2 = c->bs2, rstart = c->rstartbs; 639 PetscBool ijonly = c->ijonly; /* private flag indicates only matrix data structures are requested */ 640 PetscInt nzA, nzB, *a_i = a->i, *b_i = b->i, *a_j = a->j, *b_j = b->j, ctmp, imark, *cworkA, *cworkB; 641 PetscScalar *vworkA = NULL, *vworkB = NULL, *a_a = a->a, *b_a = b->a; 642 PetscInt cstart = c->cstartbs, *bmap = c->garray; 643 PetscBool *allrows, *allcolumns; 644 645 PetscFunctionBegin; 646 PetscCall(PetscObjectGetComm((PetscObject)C, &comm)); 647 size = c->size; 648 rank = c->rank; 649 650 PetscCall(PetscMalloc5(ismax, &row2proc, ismax, &cmap, ismax, &rmap, ismax + 1, &allcolumns, ismax, &allrows)); 651 PetscCall(PetscMalloc5(ismax, (PetscInt ***)&irow, ismax, (PetscInt ***)&icol, ismax, &nrow, ismax, &ncol, ismax, &issorted)); 652 653 for (i = 0; i < ismax; i++) { 654 PetscCall(ISSorted(iscol[i], &issorted[i])); 655 if (!issorted[i]) iscsorted = issorted[i]; /* columns are not sorted! */ 656 PetscCall(ISSorted(isrow[i], &issorted[i])); 657 658 /* Check for special case: allcolumns */ 659 PetscCall(ISIdentity(iscol[i], &colflag)); 660 PetscCall(ISGetLocalSize(iscol[i], &ncol[i])); 661 662 if (colflag && ncol[i] == c->Nbs) { 663 allcolumns[i] = PETSC_TRUE; 664 icol[i] = NULL; 665 } else { 666 allcolumns[i] = PETSC_FALSE; 667 PetscCall(ISGetIndices(iscol[i], &icol[i])); 668 } 669 670 /* Check for special case: allrows */ 671 PetscCall(ISIdentity(isrow[i], &colflag)); 672 PetscCall(ISGetLocalSize(isrow[i], &nrow[i])); 673 if (colflag && nrow[i] == c->Mbs) { 674 allrows[i] = PETSC_TRUE; 675 irow[i] = NULL; 676 } else { 677 allrows[i] = PETSC_FALSE; 678 PetscCall(ISGetIndices(isrow[i], &irow[i])); 679 } 680 } 681 682 if (scall == MAT_REUSE_MATRIX) { 683 /* Assumes new rows are same length as the old rows */ 684 for (i = 0; i < ismax; i++) { 685 subc = (Mat_SeqBAIJ *)(submats[i]->data); 686 PetscCheck(subc->mbs == nrow[i] && subc->nbs == ncol[i], PETSC_COMM_SELF, PETSC_ERR_ARG_SIZ, "Cannot reuse matrix. wrong size"); 687 688 /* Initial matrix as if empty */ 689 PetscCall(PetscArrayzero(subc->ilen, subc->mbs)); 690 691 /* Initial matrix as if empty */ 692 submats[i]->factortype = C->factortype; 693 694 smat_i = subc->submatis1; 695 696 nrqs = smat_i->nrqs; 697 nrqr = smat_i->nrqr; 698 rbuf1 = smat_i->rbuf1; 699 rbuf2 = smat_i->rbuf2; 700 rbuf3 = smat_i->rbuf3; 701 req_source2 = smat_i->req_source2; 702 703 sbuf1 = smat_i->sbuf1; 704 sbuf2 = smat_i->sbuf2; 705 ptr = smat_i->ptr; 706 tmp = smat_i->tmp; 707 ctr = smat_i->ctr; 708 709 pa = smat_i->pa; 710 req_size = smat_i->req_size; 711 req_source1 = smat_i->req_source1; 712 713 allcolumns[i] = smat_i->allcolumns; 714 allrows[i] = smat_i->allrows; 715 row2proc[i] = smat_i->row2proc; 716 rmap[i] = smat_i->rmap; 717 cmap[i] = smat_i->cmap; 718 } 719 720 if (!ismax) { /* Get dummy submatrices and retrieve struct submatis1 */ 721 PetscCheck(submats[0], PETSC_COMM_SELF, PETSC_ERR_ARG_NULL, "submats are null, cannot reuse"); 722 smat_i = (Mat_SubSppt *)submats[0]->data; 723 724 nrqs = smat_i->nrqs; 725 nrqr = smat_i->nrqr; 726 rbuf1 = smat_i->rbuf1; 727 rbuf2 = smat_i->rbuf2; 728 rbuf3 = smat_i->rbuf3; 729 req_source2 = smat_i->req_source2; 730 731 sbuf1 = smat_i->sbuf1; 732 sbuf2 = smat_i->sbuf2; 733 ptr = smat_i->ptr; 734 tmp = smat_i->tmp; 735 ctr = smat_i->ctr; 736 737 pa = smat_i->pa; 738 req_size = smat_i->req_size; 739 req_source1 = smat_i->req_source1; 740 741 allcolumns[0] = PETSC_FALSE; 742 } 743 } else { /* scall == MAT_INITIAL_MATRIX */ 744 /* Get some new tags to keep the communication clean */ 745 PetscCall(PetscObjectGetNewTag((PetscObject)C, &tag2)); 746 PetscCall(PetscObjectGetNewTag((PetscObject)C, &tag3)); 747 748 /* evaluate communication - mesg to who, length of mesg, and buffer space 749 required. Based on this, buffers are allocated, and data copied into them*/ 750 PetscCall(PetscCalloc4(size, &w1, size, &w2, size, &w3, size, &w4)); /* mesg size, initialize work vectors */ 751 752 for (i = 0; i < ismax; i++) { 753 jmax = nrow[i]; 754 irow_i = irow[i]; 755 756 PetscCall(PetscMalloc1(jmax, &row2proc_i)); 757 row2proc[i] = row2proc_i; 758 759 if (issorted[i]) proc = 0; 760 for (j = 0; j < jmax; j++) { 761 if (!issorted[i]) proc = 0; 762 if (allrows[i]) row = j; 763 else row = irow_i[j]; 764 765 while (row >= c->rangebs[proc + 1]) proc++; 766 w4[proc]++; 767 row2proc_i[j] = proc; /* map row index to proc */ 768 } 769 for (j = 0; j < size; j++) { 770 if (w4[j]) { 771 w1[j] += w4[j]; 772 w3[j]++; 773 w4[j] = 0; 774 } 775 } 776 } 777 778 nrqs = 0; /* no of outgoing messages */ 779 msz = 0; /* total mesg length (for all procs) */ 780 w1[rank] = 0; /* no mesg sent to self */ 781 w3[rank] = 0; 782 for (i = 0; i < size; i++) { 783 if (w1[i]) { 784 w2[i] = 1; 785 nrqs++; 786 } /* there exists a message to proc i */ 787 } 788 PetscCall(PetscMalloc1(nrqs, &pa)); /*(proc -array)*/ 789 for (i = 0, j = 0; i < size; i++) { 790 if (w1[i]) { 791 pa[j] = i; 792 j++; 793 } 794 } 795 796 /* Each message would have a header = 1 + 2*(no of IS) + data */ 797 for (i = 0; i < nrqs; i++) { 798 j = pa[i]; 799 w1[j] += w2[j] + 2 * w3[j]; 800 msz += w1[j]; 801 } 802 PetscCall(PetscInfo(0, "Number of outgoing messages %" PetscInt_FMT " Total message length %" PetscInt_FMT "\n", nrqs, msz)); 803 804 /* Determine the number of messages to expect, their lengths, from from-ids */ 805 PetscCall(PetscGatherNumberOfMessages(comm, w2, w1, &nrqr)); 806 PetscCall(PetscGatherMessageLengths(comm, nrqs, nrqr, w1, &onodes1, &olengths1)); 807 808 /* Now post the Irecvs corresponding to these messages */ 809 PetscCall(PetscObjectGetNewTag((PetscObject)C, &tag0)); 810 PetscCall(PetscPostIrecvInt(comm, tag0, nrqr, onodes1, olengths1, &rbuf1, &r_waits1)); 811 812 /* Allocate Memory for outgoing messages */ 813 PetscCall(PetscMalloc4(size, &sbuf1, size, &ptr, 2 * msz, &tmp, size, &ctr)); 814 PetscCall(PetscArrayzero(sbuf1, size)); 815 PetscCall(PetscArrayzero(ptr, size)); 816 817 { 818 PetscInt *iptr = tmp; 819 k = 0; 820 for (i = 0; i < nrqs; i++) { 821 j = pa[i]; 822 iptr += k; 823 sbuf1[j] = iptr; 824 k = w1[j]; 825 } 826 } 827 828 /* Form the outgoing messages. Initialize the header space */ 829 for (i = 0; i < nrqs; i++) { 830 j = pa[i]; 831 sbuf1[j][0] = 0; 832 PetscCall(PetscArrayzero(sbuf1[j] + 1, 2 * w3[j])); 833 ptr[j] = sbuf1[j] + 2 * w3[j] + 1; 834 } 835 836 /* Parse the isrow and copy data into outbuf */ 837 for (i = 0; i < ismax; i++) { 838 row2proc_i = row2proc[i]; 839 PetscCall(PetscArrayzero(ctr, size)); 840 irow_i = irow[i]; 841 jmax = nrow[i]; 842 for (j = 0; j < jmax; j++) { /* parse the indices of each IS */ 843 proc = row2proc_i[j]; 844 if (allrows[i]) row = j; 845 else row = irow_i[j]; 846 847 if (proc != rank) { /* copy to the outgoing buf*/ 848 ctr[proc]++; 849 *ptr[proc] = row; 850 ptr[proc]++; 851 } 852 } 853 /* Update the headers for the current IS */ 854 for (j = 0; j < size; j++) { /* Can Optimise this loop too */ 855 if ((ctr_j = ctr[j])) { 856 sbuf1_j = sbuf1[j]; 857 k = ++sbuf1_j[0]; 858 sbuf1_j[2 * k] = ctr_j; 859 sbuf1_j[2 * k - 1] = i; 860 } 861 } 862 } 863 864 /* Now post the sends */ 865 PetscCall(PetscMalloc1(nrqs, &s_waits1)); 866 for (i = 0; i < nrqs; ++i) { 867 j = pa[i]; 868 PetscCallMPI(MPI_Isend(sbuf1[j], w1[j], MPIU_INT, j, tag0, comm, s_waits1 + i)); 869 } 870 871 /* Post Receives to capture the buffer size */ 872 PetscCall(PetscMalloc1(nrqs, &r_waits2)); 873 PetscCall(PetscMalloc3(nrqs, &req_source2, nrqs, &rbuf2, nrqs, &rbuf3)); 874 if (nrqs) rbuf2[0] = tmp + msz; 875 for (i = 1; i < nrqs; ++i) rbuf2[i] = rbuf2[i - 1] + w1[pa[i - 1]]; 876 for (i = 0; i < nrqs; ++i) { 877 j = pa[i]; 878 PetscCallMPI(MPI_Irecv(rbuf2[i], w1[j], MPIU_INT, j, tag2, comm, r_waits2 + i)); 879 } 880 881 /* Send to other procs the buf size they should allocate */ 882 /* Receive messages*/ 883 PetscCall(PetscMalloc1(nrqr, &s_waits2)); 884 PetscCall(PetscMalloc3(nrqr, &sbuf2, nrqr, &req_size, nrqr, &req_source1)); 885 886 PetscCallMPI(MPI_Waitall(nrqr, r_waits1, MPI_STATUSES_IGNORE)); 887 for (i = 0; i < nrqr; ++i) { 888 req_size[i] = 0; 889 rbuf1_i = rbuf1[i]; 890 start = 2 * rbuf1_i[0] + 1; 891 end = olengths1[i]; 892 PetscCall(PetscMalloc1(end, &sbuf2[i])); 893 sbuf2_i = sbuf2[i]; 894 for (j = start; j < end; j++) { 895 row = rbuf1_i[j] - rstart; 896 ncols = a_i[row + 1] - a_i[row] + b_i[row + 1] - b_i[row]; 897 sbuf2_i[j] = ncols; 898 req_size[i] += ncols; 899 } 900 req_source1[i] = onodes1[i]; 901 /* form the header */ 902 sbuf2_i[0] = req_size[i]; 903 for (j = 1; j < start; j++) sbuf2_i[j] = rbuf1_i[j]; 904 905 PetscCallMPI(MPI_Isend(sbuf2_i, end, MPIU_INT, req_source1[i], tag2, comm, s_waits2 + i)); 906 } 907 908 PetscCall(PetscFree(onodes1)); 909 PetscCall(PetscFree(olengths1)); 910 911 PetscCall(PetscFree(r_waits1)); 912 PetscCall(PetscFree4(w1, w2, w3, w4)); 913 914 /* Receive messages*/ 915 PetscCall(PetscMalloc1(nrqs, &r_waits3)); 916 917 PetscCallMPI(MPI_Waitall(nrqs, r_waits2, MPI_STATUSES_IGNORE)); 918 for (i = 0; i < nrqs; ++i) { 919 PetscCall(PetscMalloc1(rbuf2[i][0], &rbuf3[i])); 920 req_source2[i] = pa[i]; 921 PetscCallMPI(MPI_Irecv(rbuf3[i], rbuf2[i][0], MPIU_INT, req_source2[i], tag3, comm, r_waits3 + i)); 922 } 923 PetscCall(PetscFree(r_waits2)); 924 925 /* Wait on sends1 and sends2 */ 926 PetscCallMPI(MPI_Waitall(nrqs, s_waits1, MPI_STATUSES_IGNORE)); 927 PetscCallMPI(MPI_Waitall(nrqr, s_waits2, MPI_STATUSES_IGNORE)); 928 PetscCall(PetscFree(s_waits1)); 929 PetscCall(PetscFree(s_waits2)); 930 931 /* Now allocate sending buffers for a->j, and send them off */ 932 PetscCall(PetscMalloc1(nrqr, &sbuf_aj)); 933 for (i = 0, j = 0; i < nrqr; i++) j += req_size[i]; 934 if (nrqr) PetscCall(PetscMalloc1(j, &sbuf_aj[0])); 935 for (i = 1; i < nrqr; i++) sbuf_aj[i] = sbuf_aj[i - 1] + req_size[i - 1]; 936 937 PetscCall(PetscMalloc1(nrqr, &s_waits3)); 938 { 939 for (i = 0; i < nrqr; i++) { 940 rbuf1_i = rbuf1[i]; 941 sbuf_aj_i = sbuf_aj[i]; 942 ct1 = 2 * rbuf1_i[0] + 1; 943 ct2 = 0; 944 for (j = 1, max1 = rbuf1_i[0]; j <= max1; j++) { 945 kmax = rbuf1[i][2 * j]; 946 for (k = 0; k < kmax; k++, ct1++) { 947 row = rbuf1_i[ct1] - rstart; 948 nzA = a_i[row + 1] - a_i[row]; 949 nzB = b_i[row + 1] - b_i[row]; 950 ncols = nzA + nzB; 951 cworkA = a_j + a_i[row]; 952 cworkB = b_j + b_i[row]; 953 954 /* load the column indices for this row into cols */ 955 cols = sbuf_aj_i + ct2; 956 for (l = 0; l < nzB; l++) { 957 if ((ctmp = bmap[cworkB[l]]) < cstart) cols[l] = ctmp; 958 else break; 959 } 960 imark = l; 961 for (l = 0; l < nzA; l++) cols[imark + l] = cstart + cworkA[l]; 962 for (l = imark; l < nzB; l++) cols[nzA + l] = bmap[cworkB[l]]; 963 ct2 += ncols; 964 } 965 } 966 PetscCallMPI(MPI_Isend(sbuf_aj_i, req_size[i], MPIU_INT, req_source1[i], tag3, comm, s_waits3 + i)); 967 } 968 } 969 970 /* create col map: global col of C -> local col of submatrices */ 971 #if defined(PETSC_USE_CTABLE) 972 for (i = 0; i < ismax; i++) { 973 if (!allcolumns[i]) { 974 PetscCall(PetscHMapICreateWithSize(ncol[i], cmap + i)); 975 976 jmax = ncol[i]; 977 icol_i = icol[i]; 978 cmap_i = cmap[i]; 979 for (j = 0; j < jmax; j++) PetscCall(PetscHMapISet(cmap[i], icol_i[j] + 1, j + 1)); 980 } else cmap[i] = NULL; 981 } 982 #else 983 for (i = 0; i < ismax; i++) { 984 if (!allcolumns[i]) { 985 PetscCall(PetscCalloc1(c->Nbs, &cmap[i])); 986 jmax = ncol[i]; 987 icol_i = icol[i]; 988 cmap_i = cmap[i]; 989 for (j = 0; j < jmax; j++) cmap_i[icol_i[j]] = j + 1; 990 } else cmap[i] = NULL; 991 } 992 #endif 993 994 /* Create lens which is required for MatCreate... */ 995 for (i = 0, j = 0; i < ismax; i++) j += nrow[i]; 996 PetscCall(PetscMalloc1(ismax, &lens)); 997 998 if (ismax) PetscCall(PetscCalloc1(j, &lens[0])); 999 for (i = 1; i < ismax; i++) lens[i] = lens[i - 1] + nrow[i - 1]; 1000 1001 /* Update lens from local data */ 1002 for (i = 0; i < ismax; i++) { 1003 row2proc_i = row2proc[i]; 1004 jmax = nrow[i]; 1005 if (!allcolumns[i]) cmap_i = cmap[i]; 1006 irow_i = irow[i]; 1007 lens_i = lens[i]; 1008 for (j = 0; j < jmax; j++) { 1009 if (allrows[i]) row = j; 1010 else row = irow_i[j]; /* global blocked row of C */ 1011 1012 proc = row2proc_i[j]; 1013 if (proc == rank) { 1014 /* Get indices from matA and then from matB */ 1015 #if defined(PETSC_USE_CTABLE) 1016 PetscInt tt; 1017 #endif 1018 row = row - rstart; 1019 nzA = a_i[row + 1] - a_i[row]; 1020 nzB = b_i[row + 1] - b_i[row]; 1021 cworkA = a_j + a_i[row]; 1022 cworkB = b_j + b_i[row]; 1023 1024 if (!allcolumns[i]) { 1025 #if defined(PETSC_USE_CTABLE) 1026 for (k = 0; k < nzA; k++) { 1027 PetscCall(PetscHMapIGetWithDefault(cmap_i, cstart + cworkA[k] + 1, 0, &tt)); 1028 if (tt) lens_i[j]++; 1029 } 1030 for (k = 0; k < nzB; k++) { 1031 PetscCall(PetscHMapIGetWithDefault(cmap_i, bmap[cworkB[k]] + 1, 0, &tt)); 1032 if (tt) lens_i[j]++; 1033 } 1034 1035 #else 1036 for (k = 0; k < nzA; k++) { 1037 if (cmap_i[cstart + cworkA[k]]) lens_i[j]++; 1038 } 1039 for (k = 0; k < nzB; k++) { 1040 if (cmap_i[bmap[cworkB[k]]]) lens_i[j]++; 1041 } 1042 #endif 1043 } else { /* allcolumns */ 1044 lens_i[j] = nzA + nzB; 1045 } 1046 } 1047 } 1048 } 1049 1050 /* Create row map: global row of C -> local row of submatrices */ 1051 for (i = 0; i < ismax; i++) { 1052 if (!allrows[i]) { 1053 #if defined(PETSC_USE_CTABLE) 1054 PetscCall(PetscHMapICreateWithSize(nrow[i], rmap + i)); 1055 irow_i = irow[i]; 1056 jmax = nrow[i]; 1057 for (j = 0; j < jmax; j++) { 1058 if (allrows[i]) { 1059 PetscCall(PetscHMapISet(rmap[i], j + 1, j + 1)); 1060 } else { 1061 PetscCall(PetscHMapISet(rmap[i], irow_i[j] + 1, j + 1)); 1062 } 1063 } 1064 #else 1065 PetscCall(PetscCalloc1(c->Mbs, &rmap[i])); 1066 rmap_i = rmap[i]; 1067 irow_i = irow[i]; 1068 jmax = nrow[i]; 1069 for (j = 0; j < jmax; j++) { 1070 if (allrows[i]) rmap_i[j] = j; 1071 else rmap_i[irow_i[j]] = j; 1072 } 1073 #endif 1074 } else rmap[i] = NULL; 1075 } 1076 1077 /* Update lens from offproc data */ 1078 { 1079 PetscInt *rbuf2_i, *rbuf3_i, *sbuf1_i; 1080 1081 PetscCallMPI(MPI_Waitall(nrqs, r_waits3, MPI_STATUSES_IGNORE)); 1082 for (tmp2 = 0; tmp2 < nrqs; tmp2++) { 1083 sbuf1_i = sbuf1[pa[tmp2]]; 1084 jmax = sbuf1_i[0]; 1085 ct1 = 2 * jmax + 1; 1086 ct2 = 0; 1087 rbuf2_i = rbuf2[tmp2]; 1088 rbuf3_i = rbuf3[tmp2]; 1089 for (j = 1; j <= jmax; j++) { 1090 is_no = sbuf1_i[2 * j - 1]; 1091 max1 = sbuf1_i[2 * j]; 1092 lens_i = lens[is_no]; 1093 if (!allcolumns[is_no]) cmap_i = cmap[is_no]; 1094 rmap_i = rmap[is_no]; 1095 for (k = 0; k < max1; k++, ct1++) { 1096 if (allrows[is_no]) { 1097 row = sbuf1_i[ct1]; 1098 } else { 1099 #if defined(PETSC_USE_CTABLE) 1100 PetscCall(PetscHMapIGetWithDefault(rmap_i, sbuf1_i[ct1] + 1, 0, &row)); 1101 row--; 1102 PetscCheck(row >= 0, PETSC_COMM_SELF, PETSC_ERR_PLIB, "row not found in table"); 1103 #else 1104 row = rmap_i[sbuf1_i[ct1]]; /* the val in the new matrix to be */ 1105 #endif 1106 } 1107 max2 = rbuf2_i[ct1]; 1108 for (l = 0; l < max2; l++, ct2++) { 1109 if (!allcolumns[is_no]) { 1110 #if defined(PETSC_USE_CTABLE) 1111 PetscCall(PetscHMapIGetWithDefault(cmap_i, rbuf3_i[ct2] + 1, 0, &tcol)); 1112 #else 1113 tcol = cmap_i[rbuf3_i[ct2]]; 1114 #endif 1115 if (tcol) lens_i[row]++; 1116 } else { /* allcolumns */ 1117 lens_i[row]++; /* lens_i[row] += max2 ? */ 1118 } 1119 } 1120 } 1121 } 1122 } 1123 } 1124 PetscCall(PetscFree(r_waits3)); 1125 PetscCallMPI(MPI_Waitall(nrqr, s_waits3, MPI_STATUSES_IGNORE)); 1126 PetscCall(PetscFree(s_waits3)); 1127 1128 /* Create the submatrices */ 1129 for (i = 0; i < ismax; i++) { 1130 PetscInt bs_tmp; 1131 if (ijonly) bs_tmp = 1; 1132 else bs_tmp = bs; 1133 1134 PetscCall(MatCreate(PETSC_COMM_SELF, submats + i)); 1135 PetscCall(MatSetSizes(submats[i], nrow[i] * bs_tmp, ncol[i] * bs_tmp, PETSC_DETERMINE, PETSC_DETERMINE)); 1136 1137 PetscCall(MatSetType(submats[i], ((PetscObject)A)->type_name)); 1138 PetscCall(MatSeqBAIJSetPreallocation(submats[i], bs_tmp, 0, lens[i])); 1139 PetscCall(MatSeqSBAIJSetPreallocation(submats[i], bs_tmp, 0, lens[i])); /* this subroutine is used by SBAIJ routines */ 1140 1141 /* create struct Mat_SubSppt and attached it to submat */ 1142 PetscCall(PetscNew(&smat_i)); 1143 subc = (Mat_SeqBAIJ *)submats[i]->data; 1144 subc->submatis1 = smat_i; 1145 1146 smat_i->destroy = submats[i]->ops->destroy; 1147 submats[i]->ops->destroy = MatDestroySubMatrix_SeqBAIJ; 1148 submats[i]->factortype = C->factortype; 1149 1150 smat_i->id = i; 1151 smat_i->nrqs = nrqs; 1152 smat_i->nrqr = nrqr; 1153 smat_i->rbuf1 = rbuf1; 1154 smat_i->rbuf2 = rbuf2; 1155 smat_i->rbuf3 = rbuf3; 1156 smat_i->sbuf2 = sbuf2; 1157 smat_i->req_source2 = req_source2; 1158 1159 smat_i->sbuf1 = sbuf1; 1160 smat_i->ptr = ptr; 1161 smat_i->tmp = tmp; 1162 smat_i->ctr = ctr; 1163 1164 smat_i->pa = pa; 1165 smat_i->req_size = req_size; 1166 smat_i->req_source1 = req_source1; 1167 1168 smat_i->allcolumns = allcolumns[i]; 1169 smat_i->allrows = allrows[i]; 1170 smat_i->singleis = PETSC_FALSE; 1171 smat_i->row2proc = row2proc[i]; 1172 smat_i->rmap = rmap[i]; 1173 smat_i->cmap = cmap[i]; 1174 } 1175 1176 if (!ismax) { /* Create dummy submats[0] for reuse struct subc */ 1177 PetscCall(MatCreate(PETSC_COMM_SELF, &submats[0])); 1178 PetscCall(MatSetSizes(submats[0], 0, 0, PETSC_DETERMINE, PETSC_DETERMINE)); 1179 PetscCall(MatSetType(submats[0], MATDUMMY)); 1180 1181 /* create struct Mat_SubSppt and attached it to submat */ 1182 PetscCall(PetscNew(&smat_i)); 1183 submats[0]->data = (void *)smat_i; 1184 1185 smat_i->destroy = submats[0]->ops->destroy; 1186 submats[0]->ops->destroy = MatDestroySubMatrix_Dummy; 1187 submats[0]->factortype = C->factortype; 1188 1189 smat_i->id = 0; 1190 smat_i->nrqs = nrqs; 1191 smat_i->nrqr = nrqr; 1192 smat_i->rbuf1 = rbuf1; 1193 smat_i->rbuf2 = rbuf2; 1194 smat_i->rbuf3 = rbuf3; 1195 smat_i->sbuf2 = sbuf2; 1196 smat_i->req_source2 = req_source2; 1197 1198 smat_i->sbuf1 = sbuf1; 1199 smat_i->ptr = ptr; 1200 smat_i->tmp = tmp; 1201 smat_i->ctr = ctr; 1202 1203 smat_i->pa = pa; 1204 smat_i->req_size = req_size; 1205 smat_i->req_source1 = req_source1; 1206 1207 smat_i->allcolumns = PETSC_FALSE; 1208 smat_i->singleis = PETSC_FALSE; 1209 smat_i->row2proc = NULL; 1210 smat_i->rmap = NULL; 1211 smat_i->cmap = NULL; 1212 } 1213 1214 if (ismax) PetscCall(PetscFree(lens[0])); 1215 PetscCall(PetscFree(lens)); 1216 if (sbuf_aj) { 1217 PetscCall(PetscFree(sbuf_aj[0])); 1218 PetscCall(PetscFree(sbuf_aj)); 1219 } 1220 1221 } /* endof scall == MAT_INITIAL_MATRIX */ 1222 1223 /* Post recv matrix values */ 1224 if (!ijonly) { 1225 PetscCall(PetscObjectGetNewTag((PetscObject)C, &tag4)); 1226 PetscCall(PetscMalloc1(nrqs, &rbuf4)); 1227 PetscCall(PetscMalloc1(nrqs, &r_waits4)); 1228 for (i = 0; i < nrqs; ++i) { 1229 PetscCall(PetscMalloc1(rbuf2[i][0] * bs2, &rbuf4[i])); 1230 PetscCallMPI(MPI_Irecv(rbuf4[i], rbuf2[i][0] * bs2, MPIU_SCALAR, req_source2[i], tag4, comm, r_waits4 + i)); 1231 } 1232 1233 /* Allocate sending buffers for a->a, and send them off */ 1234 PetscCall(PetscMalloc1(nrqr, &sbuf_aa)); 1235 for (i = 0, j = 0; i < nrqr; i++) j += req_size[i]; 1236 1237 if (nrqr) PetscCall(PetscMalloc1(j * bs2, &sbuf_aa[0])); 1238 for (i = 1; i < nrqr; i++) sbuf_aa[i] = sbuf_aa[i - 1] + req_size[i - 1] * bs2; 1239 1240 PetscCall(PetscMalloc1(nrqr, &s_waits4)); 1241 1242 for (i = 0; i < nrqr; i++) { 1243 rbuf1_i = rbuf1[i]; 1244 sbuf_aa_i = sbuf_aa[i]; 1245 ct1 = 2 * rbuf1_i[0] + 1; 1246 ct2 = 0; 1247 for (j = 1, max1 = rbuf1_i[0]; j <= max1; j++) { 1248 kmax = rbuf1_i[2 * j]; 1249 for (k = 0; k < kmax; k++, ct1++) { 1250 row = rbuf1_i[ct1] - rstart; 1251 nzA = a_i[row + 1] - a_i[row]; 1252 nzB = b_i[row + 1] - b_i[row]; 1253 ncols = nzA + nzB; 1254 cworkB = b_j + b_i[row]; 1255 vworkA = a_a + a_i[row] * bs2; 1256 vworkB = b_a + b_i[row] * bs2; 1257 1258 /* load the column values for this row into vals*/ 1259 vals = sbuf_aa_i + ct2 * bs2; 1260 for (l = 0; l < nzB; l++) { 1261 if ((bmap[cworkB[l]]) < cstart) { 1262 PetscCall(PetscArraycpy(vals + l * bs2, vworkB + l * bs2, bs2)); 1263 } else break; 1264 } 1265 imark = l; 1266 for (l = 0; l < nzA; l++) PetscCall(PetscArraycpy(vals + (imark + l) * bs2, vworkA + l * bs2, bs2)); 1267 for (l = imark; l < nzB; l++) PetscCall(PetscArraycpy(vals + (nzA + l) * bs2, vworkB + l * bs2, bs2)); 1268 1269 ct2 += ncols; 1270 } 1271 } 1272 PetscCallMPI(MPI_Isend(sbuf_aa_i, req_size[i] * bs2, MPIU_SCALAR, req_source1[i], tag4, comm, s_waits4 + i)); 1273 } 1274 } 1275 1276 /* Assemble the matrices */ 1277 /* First assemble the local rows */ 1278 for (i = 0; i < ismax; i++) { 1279 row2proc_i = row2proc[i]; 1280 subc = (Mat_SeqBAIJ *)submats[i]->data; 1281 imat_ilen = subc->ilen; 1282 imat_j = subc->j; 1283 imat_i = subc->i; 1284 imat_a = subc->a; 1285 1286 if (!allcolumns[i]) cmap_i = cmap[i]; 1287 rmap_i = rmap[i]; 1288 irow_i = irow[i]; 1289 jmax = nrow[i]; 1290 for (j = 0; j < jmax; j++) { 1291 if (allrows[i]) row = j; 1292 else row = irow_i[j]; 1293 proc = row2proc_i[j]; 1294 1295 if (proc == rank) { 1296 row = row - rstart; 1297 nzA = a_i[row + 1] - a_i[row]; 1298 nzB = b_i[row + 1] - b_i[row]; 1299 cworkA = a_j + a_i[row]; 1300 cworkB = b_j + b_i[row]; 1301 if (!ijonly) { 1302 vworkA = a_a + a_i[row] * bs2; 1303 vworkB = b_a + b_i[row] * bs2; 1304 } 1305 1306 if (allrows[i]) { 1307 row = row + rstart; 1308 } else { 1309 #if defined(PETSC_USE_CTABLE) 1310 PetscCall(PetscHMapIGetWithDefault(rmap_i, row + rstart + 1, 0, &row)); 1311 row--; 1312 1313 PetscCheck(row >= 0, PETSC_COMM_SELF, PETSC_ERR_PLIB, "row not found in table"); 1314 #else 1315 row = rmap_i[row + rstart]; 1316 #endif 1317 } 1318 mat_i = imat_i[row]; 1319 if (!ijonly) mat_a = imat_a + mat_i * bs2; 1320 mat_j = imat_j + mat_i; 1321 ilen = imat_ilen[row]; 1322 1323 /* load the column indices for this row into cols*/ 1324 if (!allcolumns[i]) { 1325 for (l = 0; l < nzB; l++) { 1326 if ((ctmp = bmap[cworkB[l]]) < cstart) { 1327 #if defined(PETSC_USE_CTABLE) 1328 PetscCall(PetscHMapIGetWithDefault(cmap_i, ctmp + 1, 0, &tcol)); 1329 if (tcol) { 1330 #else 1331 if ((tcol = cmap_i[ctmp])) { 1332 #endif 1333 *mat_j++ = tcol - 1; 1334 PetscCall(PetscArraycpy(mat_a, vworkB + l * bs2, bs2)); 1335 mat_a += bs2; 1336 ilen++; 1337 } 1338 } else break; 1339 } 1340 imark = l; 1341 for (l = 0; l < nzA; l++) { 1342 #if defined(PETSC_USE_CTABLE) 1343 PetscCall(PetscHMapIGetWithDefault(cmap_i, cstart + cworkA[l] + 1, 0, &tcol)); 1344 if (tcol) { 1345 #else 1346 if ((tcol = cmap_i[cstart + cworkA[l]])) { 1347 #endif 1348 *mat_j++ = tcol - 1; 1349 if (!ijonly) { 1350 PetscCall(PetscArraycpy(mat_a, vworkA + l * bs2, bs2)); 1351 mat_a += bs2; 1352 } 1353 ilen++; 1354 } 1355 } 1356 for (l = imark; l < nzB; l++) { 1357 #if defined(PETSC_USE_CTABLE) 1358 PetscCall(PetscHMapIGetWithDefault(cmap_i, bmap[cworkB[l]] + 1, 0, &tcol)); 1359 if (tcol) { 1360 #else 1361 if ((tcol = cmap_i[bmap[cworkB[l]]])) { 1362 #endif 1363 *mat_j++ = tcol - 1; 1364 if (!ijonly) { 1365 PetscCall(PetscArraycpy(mat_a, vworkB + l * bs2, bs2)); 1366 mat_a += bs2; 1367 } 1368 ilen++; 1369 } 1370 } 1371 } else { /* allcolumns */ 1372 for (l = 0; l < nzB; l++) { 1373 if ((ctmp = bmap[cworkB[l]]) < cstart) { 1374 *mat_j++ = ctmp; 1375 PetscCall(PetscArraycpy(mat_a, vworkB + l * bs2, bs2)); 1376 mat_a += bs2; 1377 ilen++; 1378 } else break; 1379 } 1380 imark = l; 1381 for (l = 0; l < nzA; l++) { 1382 *mat_j++ = cstart + cworkA[l]; 1383 if (!ijonly) { 1384 PetscCall(PetscArraycpy(mat_a, vworkA + l * bs2, bs2)); 1385 mat_a += bs2; 1386 } 1387 ilen++; 1388 } 1389 for (l = imark; l < nzB; l++) { 1390 *mat_j++ = bmap[cworkB[l]]; 1391 if (!ijonly) { 1392 PetscCall(PetscArraycpy(mat_a, vworkB + l * bs2, bs2)); 1393 mat_a += bs2; 1394 } 1395 ilen++; 1396 } 1397 } 1398 imat_ilen[row] = ilen; 1399 } 1400 } 1401 } 1402 1403 /* Now assemble the off proc rows */ 1404 if (!ijonly) PetscCallMPI(MPI_Waitall(nrqs, r_waits4, MPI_STATUSES_IGNORE)); 1405 for (tmp2 = 0; tmp2 < nrqs; tmp2++) { 1406 sbuf1_i = sbuf1[pa[tmp2]]; 1407 jmax = sbuf1_i[0]; 1408 ct1 = 2 * jmax + 1; 1409 ct2 = 0; 1410 rbuf2_i = rbuf2[tmp2]; 1411 rbuf3_i = rbuf3[tmp2]; 1412 if (!ijonly) rbuf4_i = rbuf4[tmp2]; 1413 for (j = 1; j <= jmax; j++) { 1414 is_no = sbuf1_i[2 * j - 1]; 1415 rmap_i = rmap[is_no]; 1416 if (!allcolumns[is_no]) cmap_i = cmap[is_no]; 1417 subc = (Mat_SeqBAIJ *)submats[is_no]->data; 1418 imat_ilen = subc->ilen; 1419 imat_j = subc->j; 1420 imat_i = subc->i; 1421 if (!ijonly) imat_a = subc->a; 1422 max1 = sbuf1_i[2 * j]; 1423 for (k = 0; k < max1; k++, ct1++) { /* for each recved block row */ 1424 row = sbuf1_i[ct1]; 1425 1426 if (allrows[is_no]) { 1427 row = sbuf1_i[ct1]; 1428 } else { 1429 #if defined(PETSC_USE_CTABLE) 1430 PetscCall(PetscHMapIGetWithDefault(rmap_i, row + 1, 0, &row)); 1431 row--; 1432 PetscCheck(row >= 0, PETSC_COMM_SELF, PETSC_ERR_PLIB, "row not found in table"); 1433 #else 1434 row = rmap_i[row]; 1435 #endif 1436 } 1437 ilen = imat_ilen[row]; 1438 mat_i = imat_i[row]; 1439 if (!ijonly) mat_a = imat_a + mat_i * bs2; 1440 mat_j = imat_j + mat_i; 1441 max2 = rbuf2_i[ct1]; 1442 if (!allcolumns[is_no]) { 1443 for (l = 0; l < max2; l++, ct2++) { 1444 #if defined(PETSC_USE_CTABLE) 1445 PetscCall(PetscHMapIGetWithDefault(cmap_i, rbuf3_i[ct2] + 1, 0, &tcol)); 1446 #else 1447 tcol = cmap_i[rbuf3_i[ct2]]; 1448 #endif 1449 if (tcol) { 1450 *mat_j++ = tcol - 1; 1451 if (!ijonly) { 1452 PetscCall(PetscArraycpy(mat_a, rbuf4_i + ct2 * bs2, bs2)); 1453 mat_a += bs2; 1454 } 1455 ilen++; 1456 } 1457 } 1458 } else { /* allcolumns */ 1459 for (l = 0; l < max2; l++, ct2++) { 1460 *mat_j++ = rbuf3_i[ct2]; /* same global column index of C */ 1461 if (!ijonly) { 1462 PetscCall(PetscArraycpy(mat_a, rbuf4_i + ct2 * bs2, bs2)); 1463 mat_a += bs2; 1464 } 1465 ilen++; 1466 } 1467 } 1468 imat_ilen[row] = ilen; 1469 } 1470 } 1471 } 1472 1473 if (!iscsorted) { /* sort column indices of the rows */ 1474 MatScalar *work; 1475 1476 PetscCall(PetscMalloc1(bs2, &work)); 1477 for (i = 0; i < ismax; i++) { 1478 subc = (Mat_SeqBAIJ *)submats[i]->data; 1479 imat_ilen = subc->ilen; 1480 imat_j = subc->j; 1481 imat_i = subc->i; 1482 if (!ijonly) imat_a = subc->a; 1483 if (allcolumns[i]) continue; 1484 1485 jmax = nrow[i]; 1486 for (j = 0; j < jmax; j++) { 1487 mat_i = imat_i[j]; 1488 mat_j = imat_j + mat_i; 1489 ilen = imat_ilen[j]; 1490 if (ijonly) { 1491 PetscCall(PetscSortInt(ilen, mat_j)); 1492 } else { 1493 mat_a = imat_a + mat_i * bs2; 1494 PetscCall(PetscSortIntWithDataArray(ilen, mat_j, mat_a, bs2 * sizeof(MatScalar), work)); 1495 } 1496 } 1497 } 1498 PetscCall(PetscFree(work)); 1499 } 1500 1501 if (!ijonly) { 1502 PetscCall(PetscFree(r_waits4)); 1503 PetscCallMPI(MPI_Waitall(nrqr, s_waits4, MPI_STATUSES_IGNORE)); 1504 PetscCall(PetscFree(s_waits4)); 1505 } 1506 1507 /* Restore the indices */ 1508 for (i = 0; i < ismax; i++) { 1509 if (!allrows[i]) PetscCall(ISRestoreIndices(isrow[i], irow + i)); 1510 if (!allcolumns[i]) PetscCall(ISRestoreIndices(iscol[i], icol + i)); 1511 } 1512 1513 for (i = 0; i < ismax; i++) { 1514 PetscCall(MatAssemblyBegin(submats[i], MAT_FINAL_ASSEMBLY)); 1515 PetscCall(MatAssemblyEnd(submats[i], MAT_FINAL_ASSEMBLY)); 1516 } 1517 1518 PetscCall(PetscFree5(*(PetscInt ***)&irow, *(PetscInt ***)&icol, nrow, ncol, issorted)); 1519 PetscCall(PetscFree5(row2proc, cmap, rmap, allcolumns, allrows)); 1520 1521 if (!ijonly) { 1522 if (sbuf_aa) { 1523 PetscCall(PetscFree(sbuf_aa[0])); 1524 PetscCall(PetscFree(sbuf_aa)); 1525 } 1526 1527 for (i = 0; i < nrqs; ++i) PetscCall(PetscFree(rbuf4[i])); 1528 PetscCall(PetscFree(rbuf4)); 1529 } 1530 c->ijonly = PETSC_FALSE; /* set back to the default */ 1531 PetscFunctionReturn(PETSC_SUCCESS); 1532 } 1533