1 /*$Id: sbaijov.c,v 1.65 2001/08/06 21:15:42 bsmith Exp $*/ 2 3 /* 4 Routines to compute overlapping regions of a parallel MPI matrix. 5 Used for finding submatrices that were shared across processors. 6 */ 7 #include "src/mat/impls/sbaij/mpi/mpisbaij.h" 8 #include "petscbt.h" 9 10 static int MatIncreaseOverlap_MPISBAIJ_Once(Mat,int,IS *); 11 static int MatIncreaseOverlap_MPISBAIJ_Local(Mat,int *,int **); 12 static int MatIncreaseOverlap_MPISBAIJ_Receive(Mat,int,int **,int**,int*); 13 14 /* this function is sasme as MatCompressIndicesGeneral_MPIBAIJ -- should be removed! */ 15 #undef __FUNCT__ 16 #define __FUNCT__ "MatCompressIndicesGeneral_MPISBAIJ" 17 static int MatCompressIndicesGeneral_MPISBAIJ(Mat C,int imax,const IS is_in[],IS is_out[]) 18 { 19 Mat_MPISBAIJ *baij = (Mat_MPISBAIJ*)C->data; 20 int ierr,isz,bs = baij->bs,n,i,j,*idx,ival; 21 #if defined (PETSC_USE_CTABLE) 22 PetscTable gid1_lid1; 23 int tt, gid1, *nidx; 24 PetscTablePosition tpos; 25 #else 26 int Nbs,*nidx; 27 PetscBT table; 28 #endif 29 30 PetscFunctionBegin; 31 /* printf(" ...MatCompressIndicesGeneral_MPISBAIJ is called ...\n"); */ 32 #if defined (PETSC_USE_CTABLE) 33 ierr = PetscTableCreate(baij->mbs,&gid1_lid1);CHKERRQ(ierr); 34 #else 35 Nbs = baij->Nbs; 36 ierr = PetscMalloc((Nbs+1)*sizeof(int),&nidx);CHKERRQ(ierr); 37 ierr = PetscBTCreate(Nbs,table);CHKERRQ(ierr); 38 #endif 39 for (i=0; i<imax; i++) { 40 isz = 0; 41 #if defined (PETSC_USE_CTABLE) 42 ierr = PetscTableRemoveAll(gid1_lid1);CHKERRQ(ierr); 43 #else 44 ierr = PetscBTMemzero(Nbs,table);CHKERRQ(ierr); 45 #endif 46 ierr = ISGetIndices(is_in[i],&idx);CHKERRQ(ierr); 47 ierr = ISGetLocalSize(is_in[i],&n);CHKERRQ(ierr); 48 for (j=0; j<n ; j++) { 49 ival = idx[j]/bs; /* convert the indices into block indices */ 50 #if defined (PETSC_USE_CTABLE) 51 ierr = PetscTableFind(gid1_lid1,ival+1,&tt);CHKERRQ(ierr); 52 if (!tt) { 53 ierr = PetscTableAdd(gid1_lid1,ival+1,isz+1);CHKERRQ(ierr); 54 isz++; 55 } 56 #else 57 if (ival>Nbs) SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,"index greater than mat-dim"); 58 if(!PetscBTLookupSet(table,ival)) { nidx[isz++] = ival;} 59 #endif 60 } 61 ierr = ISRestoreIndices(is_in[i],&idx);CHKERRQ(ierr); 62 #if defined (PETSC_USE_CTABLE) 63 ierr = PetscMalloc((isz+1)*sizeof(int),&nidx);CHKERRQ(ierr); 64 ierr = PetscTableGetHeadPosition(gid1_lid1,&tpos);CHKERRQ(ierr); 65 j = 0; 66 while (tpos) { 67 ierr = PetscTableGetNext(gid1_lid1,&tpos,&gid1,&tt);CHKERRQ(ierr); 68 if (tt-- > isz) { SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,"index greater than array-dim"); } 69 nidx[tt] = gid1 - 1; 70 j++; 71 } 72 if (j != isz) { SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,"table error: jj != isz"); } 73 ierr = ISCreateGeneral(PETSC_COMM_SELF,isz,nidx,(is_out+i));CHKERRQ(ierr); 74 ierr = PetscFree(nidx);CHKERRQ(ierr); 75 #else 76 ierr = ISCreateGeneral(PETSC_COMM_SELF,isz,nidx,(is_out+i));CHKERRQ(ierr); 77 #endif 78 } 79 #if defined (PETSC_USE_CTABLE) 80 ierr = PetscTableDelete(gid1_lid1);CHKERRQ(ierr); 81 #else 82 ierr = PetscBTDestroy(table);CHKERRQ(ierr); 83 ierr = PetscFree(nidx);CHKERRQ(ierr); 84 #endif 85 PetscFunctionReturn(0); 86 } 87 88 #undef __FUNCT__ 89 #define __FUNCT__ "MatCompressIndicesSorted_MPISBAIJ" 90 static int MatCompressIndicesSorted_MPISBAIJ(Mat C,int imax,const IS is_in[],IS is_out[]) 91 { 92 Mat_MPISBAIJ *baij = (Mat_MPISBAIJ*)C->data; 93 int ierr,bs=baij->bs,i,j,k,val,n,*idx,*nidx,*idx_local; 94 PetscTruth flg; 95 #if defined (PETSC_USE_CTABLE) 96 int maxsz; 97 #else 98 int Nbs=baij->Nbs; 99 #endif 100 PetscFunctionBegin; 101 printf(" ... MatCompressIndicesSorted_MPISBAIJ is called ...\n"); 102 for (i=0; i<imax; i++) { 103 ierr = ISSorted(is_in[i],&flg);CHKERRQ(ierr); 104 if (!flg) SETERRQ(PETSC_ERR_ARG_WRONGSTATE,"Indices are not sorted"); 105 } 106 #if defined (PETSC_USE_CTABLE) 107 /* Now check max size */ 108 for (i=0,maxsz=0; i<imax; i++) { 109 ierr = ISGetIndices(is_in[i],&idx);CHKERRQ(ierr); 110 ierr = ISGetLocalSize(is_in[i],&n);CHKERRQ(ierr); 111 if (n%bs !=0) SETERRQ(1,"Indices are not block ordered"); 112 n = n/bs; /* The reduced index size */ 113 if (n > maxsz) maxsz = n; 114 } 115 ierr = PetscMalloc((maxsz+1)*sizeof(int),&nidx);CHKERRQ(ierr); 116 #else 117 ierr = PetscMalloc((Nbs+1)*sizeof(int),&nidx);CHKERRQ(ierr); 118 #endif 119 /* Now check if the indices are in block order */ 120 for (i=0; i<imax; i++) { 121 ierr = ISGetIndices(is_in[i],&idx);CHKERRQ(ierr); 122 ierr = ISGetLocalSize(is_in[i],&n);CHKERRQ(ierr); 123 if (n%bs !=0) SETERRQ(1,"Indices are not block ordered"); 124 125 n = n/bs; /* The reduced index size */ 126 idx_local = idx; 127 for (j=0; j<n ; j++) { 128 val = idx_local[0]; 129 if (val%bs != 0) SETERRQ(1,"Indices are not block ordered"); 130 for (k=0; k<bs; k++) { 131 if (val+k != idx_local[k]) SETERRQ(1,"Indices are not block ordered"); 132 } 133 nidx[j] = val/bs; 134 idx_local +=bs; 135 } 136 ierr = ISRestoreIndices(is_in[i],&idx);CHKERRQ(ierr); 137 ierr = ISCreateGeneral(PETSC_COMM_SELF,n,nidx,(is_out+i));CHKERRQ(ierr); 138 } 139 ierr = PetscFree(nidx);CHKERRQ(ierr); 140 141 PetscFunctionReturn(0); 142 } 143 144 #undef __FUNCT__ 145 #define __FUNCT__ "MatExpandIndices_MPISBAIJ" 146 static int MatExpandIndices_MPISBAIJ(Mat C,int imax,const IS is_in[],IS is_out[]) 147 { 148 Mat_MPISBAIJ *baij = (Mat_MPISBAIJ*)C->data; 149 int ierr,bs = baij->bs,n,i,j,k,*idx,*nidx; 150 #if defined (PETSC_USE_CTABLE) 151 int maxsz; 152 #else 153 int Nbs = baij->Nbs; 154 #endif 155 156 PetscFunctionBegin; 157 /* printf(" ... MatExpandIndices_MPISBAIJ is called ...\n"); */ 158 #if defined (PETSC_USE_CTABLE) 159 /* Now check max size */ 160 for (i=0,maxsz=0; i<imax; i++) { 161 ierr = ISGetIndices(is_in[i],&idx);CHKERRQ(ierr); 162 ierr = ISGetLocalSize(is_in[i],&n);CHKERRQ(ierr); 163 if (n*bs > maxsz) maxsz = n*bs; 164 } 165 ierr = PetscMalloc((maxsz+1)*sizeof(int),&nidx);CHKERRQ(ierr); 166 #else 167 ierr = PetscMalloc((Nbs*bs+1)*sizeof(int),&nidx);CHKERRQ(ierr); 168 #endif 169 170 for (i=0; i<imax; i++) { 171 ierr = ISGetIndices(is_in[i],&idx);CHKERRQ(ierr); 172 ierr = ISGetLocalSize(is_in[i],&n);CHKERRQ(ierr); 173 for (j=0; j<n ; ++j){ 174 for (k=0; k<bs; k++) 175 nidx[j*bs+k] = idx[j]*bs+k; 176 } 177 ierr = ISRestoreIndices(is_in[i],&idx);CHKERRQ(ierr); 178 ierr = ISCreateGeneral(PETSC_COMM_SELF,n*bs,nidx,is_out+i);CHKERRQ(ierr); 179 } 180 ierr = PetscFree(nidx);CHKERRQ(ierr); 181 PetscFunctionReturn(0); 182 } 183 184 185 #undef __FUNCT__ 186 #define __FUNCT__ "MatIncreaseOverlap_MPISBAIJ" 187 int MatIncreaseOverlap_MPISBAIJ(Mat C,int is_max,IS is[],int ov) 188 { 189 int i,ierr; 190 IS *is_new; 191 192 PetscFunctionBegin; 193 ierr = PetscMalloc(is_max*sizeof(IS),&is_new);CHKERRQ(ierr); 194 /* Convert the indices into block format */ 195 ierr = MatCompressIndicesGeneral_MPISBAIJ(C,is_max,is,is_new);CHKERRQ(ierr); 196 if (ov < 0){ SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,"Negative overlap specified\n");} 197 for (i=0; i<ov; ++i) { 198 ierr = MatIncreaseOverlap_MPISBAIJ_Once(C,is_max,is_new);CHKERRQ(ierr); 199 } 200 for (i=0; i<is_max; i++) {ierr = ISDestroy(is[i]);CHKERRQ(ierr);} 201 ierr = MatExpandIndices_MPISBAIJ(C,is_max,is_new,is);CHKERRQ(ierr); 202 for (i=0; i<is_max; i++) {ierr = ISDestroy(is_new[i]);CHKERRQ(ierr);} 203 ierr = PetscFree(is_new);CHKERRQ(ierr); 204 PetscFunctionReturn(0); 205 } 206 207 #undef __FUNCT__ 208 #define __FUNCT__ "MatIncreaseOverlap_MPISBAIJ_Once" 209 static int MatIncreaseOverlap_MPISBAIJ_Once(Mat C,int is_max,IS is[]) 210 { 211 Mat_MPISBAIJ *c = (Mat_MPISBAIJ*)C->data; 212 int **idx,*n,len,*idx_i; 213 int size,rank,Mbs,i,j,k,ierr,nrqs,msz,*outdat,*indat; 214 int tag1,tag2,flag,proc_id; 215 MPI_Comm comm; 216 MPI_Request *s_waits1,*s_waits2,r_req; 217 MPI_Status *s_status,r_status; 218 219 PetscFunctionBegin; 220 221 comm = C->comm; 222 size = c->size; 223 rank = c->rank; 224 Mbs = c->Mbs; 225 226 /* 1. Send is[] to all other processors */ 227 /*--------------------------------------*/ 228 /* This processor sends its is[] to all other processors in the format: 229 outdat[0] = is_max, no of is in this processor 230 outdat[1] = n[0], size of is[0] 231 ... 232 outdat[is_max] = n[is_max-1], size of is[is_max-1] 233 outdat[is_max + 1] = data(is[0]) 234 ... 235 outdat[is_max+1+sum(n[k]), k=0,...,i-1] = data(is[i]) 236 ... 237 */ 238 ierr = PetscObjectGetNewTag((PetscObject)C,&tag1);CHKERRQ(ierr); 239 ierr = PetscObjectGetNewTag((PetscObject)C,&tag2);CHKERRQ(ierr); 240 printf(" [%d] tags: %d, %d\n",rank,tag1,tag2); 241 242 len = (is_max+1)*sizeof(int*)+ (is_max)*sizeof(int); 243 ierr = PetscMalloc(len,&idx);CHKERRQ(ierr); 244 n = (int*)(idx + is_max); 245 246 /* Allocate Memory for outgoing messages */ 247 len = 1 + is_max; 248 for (i=0; i<is_max; i++) { 249 ierr = ISGetIndices(is[i],&idx[i]);CHKERRQ(ierr); 250 ierr = ISGetLocalSize(is[i],&n[i]);CHKERRQ(ierr); 251 len += n[i]; 252 } 253 ierr = PetscMalloc(len*sizeof(int),&outdat);CHKERRQ(ierr); 254 255 /* Form the outgoing messages */ 256 outdat[0] = is_max; 257 for (i=0; i<is_max; i++) { 258 outdat[i+1] = n[i]; 259 } 260 k = is_max + 1; 261 for (i=0; i<is_max; i++) { /* for is[i] */ 262 idx_i = idx[i]; 263 for (j=0; j<n[i]; j++){ 264 outdat[k] = *(idx_i); 265 /* if (!rank) printf(" outdat[%d] = %d\n",k,outdat[k] ); */ 266 k++; idx_i++; 267 } 268 /* printf(" [%d] n[%d]=%d, k: %d, \n",rank,i,n[i],k); */ 269 } 270 if (k != len) SETERRQ3(1,"[%d] Error on forming the outgoing messages: k %d != len %d",rank,k,len); 271 272 /* Now post the sends */ 273 ierr = PetscMalloc(size*sizeof(MPI_Request),&s_waits1);CHKERRQ(ierr); 274 275 k = 0; 276 for (proc_id=0; proc_id<size; ++proc_id) { /* send outdat to processor [proc_id] */ 277 if (proc_id != rank){ 278 ierr = MPI_Isend(outdat,len,MPI_INT,proc_id,tag1,comm,s_waits1+k);CHKERRQ(ierr); 279 printf(" [%d] send %d msg to [%d] \n",rank,len,proc_id); 280 k++; 281 } 282 } 283 284 /* 2. Do local work on this processor's is[] */ 285 /*-------------------------------------------*/ 286 int *nidx,*nidx_i; 287 ierr = MatIncreaseOverlap_MPISBAIJ_Local(C,outdat,&nidx);CHKERRQ(ierr); 288 289 for (i=0; i<is_max; i++){ 290 ierr = ISRestoreIndices(is[i],idx+i);CHKERRQ(ierr); 291 ierr = ISDestroy(is[i]);CHKERRQ(ierr); 292 } 293 294 /* 3. Receive other's is[] and process. Then send back */ 295 /*----------------------------------------------------*/ 296 /* Send is done */ 297 nrqs = size-1; 298 ierr = PetscMalloc(size*sizeof(MPI_Status),&s_status);CHKERRQ(ierr); 299 ierr = MPI_Waitall(nrqs,s_waits1,s_status);CHKERRQ(ierr); 300 301 /* save n[i] */ 302 for (i=0; i<is_max; i++){ 303 n[i] = outdat[1+i]; 304 } 305 ierr = PetscFree(outdat);CHKERRQ(ierr); 306 ierr = PetscMalloc(size*sizeof(MPI_Request),&s_waits2);CHKERRQ(ierr); 307 k = 0; 308 do { 309 /* Receive messages */ 310 ierr = MPI_Iprobe(MPI_ANY_SOURCE,tag1,comm,&flag,&r_status); 311 if (flag){ 312 ierr = MPI_Get_count(&r_status,MPI_INT,&len); 313 proc_id = r_status.MPI_SOURCE; 314 ierr = PetscMalloc(len*sizeof(int),&indat);CHKERRQ(ierr); 315 ierr = MPI_Irecv(indat,len,MPI_INT,proc_id,r_status.MPI_TAG,comm,&r_req); 316 printf(" [%d] recv %d msg from [%d]\n",rank,len,proc_id); 317 318 /* Process messages -- not done yet */ 319 len = indat[0]; 320 ierr = PetscMalloc(len*sizeof(int),&outdat);CHKERRQ(ierr); 321 for (i=0; i<len; i++){outdat[i] = indat[i+1];} 322 323 /* Send messages back */ 324 printf(" [%d] send %d msg back to [%d] \n",rank,len,proc_id); 325 ierr = MPI_Isend(outdat,len,MPI_INT,proc_id,tag2,comm,&s_waits2[k]);CHKERRQ(ierr); 326 327 k++; 328 ierr = PetscFree(outdat);CHKERRQ(ierr); 329 ierr = PetscFree(indat);CHKERRQ(ierr); 330 } 331 } while (k < nrqs); 332 333 /* 4. Receive work done on other processors, then process */ 334 /*--------------------------------------------------------*/ 335 ierr = MPI_Waitall(nrqs,s_waits2,s_status);CHKERRQ(ierr); 336 k = 0; 337 do { 338 /* Receive messages */ 339 ierr = MPI_Iprobe(MPI_ANY_SOURCE,tag2,comm,&flag,&r_status); 340 if (flag){ 341 ierr = MPI_Get_count(&r_status,MPI_INT,&len); 342 proc_id = r_status.MPI_SOURCE; 343 ierr = ierr = PetscMalloc(len*sizeof(int),&indat);CHKERRQ(ierr); 344 ierr = MPI_Irecv(indat,len,MPI_INT,proc_id,r_status.MPI_TAG,comm,&r_req); 345 printf(" [%d] recv %d msg from [%d]\n",rank,len,proc_id); 346 347 /* Process messages -- not done yet */ 348 349 350 k++; 351 ierr = PetscFree(indat);CHKERRQ(ierr); 352 } 353 } while (k < nrqs); 354 355 /* 5. Create new is[] */ 356 /*--------------------*/ 357 for (i=0; i<is_max; i++) { 358 nidx_i = nidx+i*Mbs; 359 ierr = ISCreateGeneral(PETSC_COMM_SELF,n[i],nidx_i,is+i);CHKERRQ(ierr); 360 } 361 ierr = PetscFree(nidx);CHKERRQ(ierr); 362 ierr = PetscFree(idx);CHKERRQ(ierr); 363 ierr = PetscFree(s_waits1);CHKERRQ(ierr); 364 ierr = PetscFree(s_waits2);CHKERRQ(ierr); 365 ierr = PetscFree(s_status);CHKERRQ(ierr); 366 PetscFunctionReturn(0); 367 } 368 369 #undef __FUNCT__ 370 #define __FUNCT__ "MatIncreaseOverlap_MPISBAIJ_Local" 371 /* 372 MatIncreaseOverlap_MPISBAIJ_Local - Called by MatIncreaseOverlap, to do 373 the work on the local processor. 374 375 Inputs: 376 C - MAT_MPISBAIJ; 377 data - holds is[] in the format: 378 data[0] = is_max, no of is 379 data[1] = size of is[0] 380 ... 381 data[is_max] = size of is[is_max-1] 382 data[is_max + 1] = is[0] array 383 ... 384 data[is_max+1+sum(n[k]), k=0,...,i-1] = is[i] array 385 ... 386 387 Output: 388 data_new - holds new is[] in the same format as data 389 */ 390 static int MatIncreaseOverlap_MPISBAIJ_Local(Mat C,int *data,int **data_new) 391 { 392 Mat_MPISBAIJ *c = (Mat_MPISBAIJ*)C->data; 393 Mat_SeqSBAIJ *a = (Mat_SeqSBAIJ*)(c->A)->data; 394 Mat_SeqBAIJ *b = (Mat_SeqBAIJ*)(c->B)->data; 395 int ierr,row,mbs,Mbs,*nidx,*nidx_i,col,isz,isz0,*ai,*aj,bs,*bi,*bj,*garray,rstart,l; 396 int a_start,a_end,b_start,b_end,i,j,k,is_max,*idx_i,n; 397 PetscBT table; 398 PetscBT table0; 399 400 PetscFunctionBegin; 401 Mbs = c->Mbs; mbs = a->mbs; bs = a->bs; 402 ai = a->i; aj = a->j; 403 bi = b->i; bj = b->j; 404 garray = c->garray; 405 rstart = c->rstart; 406 is_max = data[0]; 407 408 ierr = PetscMalloc(is_max*Mbs*sizeof(int),&nidx);CHKERRQ(ierr); 409 ierr = PetscBTCreate(Mbs,table0);CHKERRQ(ierr); 410 ierr = PetscBTCreate(Mbs,table);CHKERRQ(ierr); 411 412 idx_i = data + is_max + 1; /* ptr to is[0] array */ 413 for (i=0; i<is_max; i++) { /* for each is */ 414 isz = 0; 415 ierr = PetscBTMemzero(Mbs,table);CHKERRQ(ierr); 416 nidx_i = nidx+i*Mbs; /* holds new is[i] array */ 417 n = data[1+i]; /* size of is[i] */ 418 419 /* Enter these into the temp arrays i.e mark table[row], enter row into new index */ 420 for (j=0; j<n; j++){ 421 col = idx_i[j]; 422 if (col >= Mbs) SETERRQ2(PETSC_ERR_ARG_OUTOFRANGE,"index col %d >= Mbs %d",col,Mbs); 423 if(!PetscBTLookupSet(table,col)) { nidx_i[isz++] = col;} 424 } 425 426 k = 0; 427 /* set table0 for lookup */ 428 ierr = PetscBTMemzero(mbs,table0);CHKERRQ(ierr); 429 for (l=k; l<isz; l++) PetscBTSet(table0,nidx_i[l]); 430 431 isz0 = isz; /* length of nidx_i[] before updating */ 432 for (row=0; row<mbs; row++){ 433 a_start = ai[row]; a_end = ai[row+1]; 434 b_start = bi[row]; b_end = bi[row+1]; 435 if (PetscBTLookup(table0,row+rstart)){ /* row is on nidx_i - row search: collect all col in this row */ 436 /* printf(" [%d] is[%d] row %d is on nidx_i\n",rank,i,row+rstart); */ 437 for (l = a_start; l<a_end ; l++){ /* Amat */ 438 col = aj[l] + rstart; 439 if (!PetscBTLookupSet(table,col)) {nidx_i[isz++] = col;} 440 } 441 for (l = b_start; l<b_end ; l++){ /* Bmat */ 442 col = garray[bj[l]]; 443 if (!PetscBTLookupSet(table,col)) {nidx_i[isz++] = col;} 444 } 445 k++; 446 if (k >= isz0) break; /* for (row=0; row<mbs; row++) */ 447 } else { /* row is not on nidx_i - col serach: add row onto nidx_i if there is a col in nidx_i */ 448 for (l = a_start; l<a_end ; l++){ /* Amat */ 449 col = aj[l] + rstart; 450 if (PetscBTLookup(table0,col)){ 451 if (!PetscBTLookupSet(table,row+rstart)) {nidx_i[isz++] = row+rstart;} 452 break; /* for l = start; l<end ; l++) */ 453 } 454 } 455 for (l = b_start; l<b_end ; l++){ /* Bmat */ 456 col = garray[bj[l]]; 457 if (PetscBTLookup(table0,col)){ 458 if (!PetscBTLookupSet(table,row+rstart)) {nidx_i[isz++] = row+rstart;} 459 break; /* for l = start; l<end ; l++) */ 460 } 461 } 462 } 463 } /* for (row=0; row<mbs; row++) */ 464 465 if (i < is_max - 1){ 466 idx_i += n; /* ptr to is[i+1] array */ 467 } 468 data[1+i] = isz; 469 } /* /* for each is */ 470 *data_new = nidx; 471 ierr = PetscBTDestroy(table);CHKERRQ(ierr); 472 ierr = PetscBTDestroy(table0);CHKERRQ(ierr); 473 PetscFunctionReturn(0); 474 } 475 #undef __FUNCT__ 476 #define __FUNCT__ "MatIncreaseOverlap_MPISBAIJ_Receive" 477 /* 478 MatIncreaseOverlap_MPISBAIJ_Receive - Process the recieved messages, 479 and return the output 480 481 Input: 482 C - the matrix 483 nrqr - no of messages being processed. 484 rbuf - an array of pointers to the recieved requests 485 486 Output: 487 xdata - array of messages to be sent back 488 isz1 - size of each message 489 490 For better efficiency perhaps we should malloc seperately each xdata[i], 491 then if a remalloc is required we need only copy the data for that one row 492 rather then all previous rows as it is now where a single large chunck of 493 memory is used. 494 495 */ 496 static int MatIncreaseOverlap_MPISBAIJ_Receive(Mat C,int nrqr,int **rbuf,int **xdata,int * isz1) 497 { 498 Mat_MPISBAIJ *c = (Mat_MPISBAIJ*)C->data; 499 Mat A = c->A,B = c->B; 500 Mat_SeqSBAIJ *a = (Mat_SeqSBAIJ*)A->data; 501 Mat_SeqBAIJ *b = (Mat_SeqBAIJ*)B->data; 502 int rstart,cstart,*ai,*aj,*bi,*bj,*garray,i,j,k; 503 int row,total_sz,ct,ct1,ct2,ct3,mem_estimate,oct2,l,start,end; 504 int val,max1,max2,rank,Mbs,no_malloc =0,*tmp,new_estimate,ctr; 505 int *rbuf_i,kmax,rbuf_0,ierr; 506 PetscBT xtable; 507 508 PetscFunctionBegin; 509 rank = c->rank; 510 Mbs = c->Mbs; 511 rstart = c->rstart; 512 cstart = c->cstart; 513 ai = a->i; 514 aj = a->j; 515 bi = b->i; 516 bj = b->j; 517 garray = c->garray; 518 519 520 for (i=0,ct=0,total_sz=0; i<nrqr; ++i) { 521 rbuf_i = rbuf[i]; 522 rbuf_0 = rbuf_i[0]; 523 ct += rbuf_0; 524 for (j=1; j<=rbuf_0; j++) { total_sz += rbuf_i[2*j]; } 525 } 526 527 if (c->Mbs) max1 = ct*(a->nz +b->nz)/c->Mbs; 528 else max1 = 1; 529 mem_estimate = 3*((total_sz > max1 ? total_sz : max1)+1); 530 ierr = PetscMalloc(mem_estimate*sizeof(int),&xdata[0]);CHKERRQ(ierr); 531 ++no_malloc; 532 ierr = PetscBTCreate(Mbs,xtable);CHKERRQ(ierr); 533 ierr = PetscMemzero(isz1,nrqr*sizeof(int));CHKERRQ(ierr); 534 535 ct3 = 0; 536 for (i=0; i<nrqr; i++) { /* for easch mesg from proc i */ 537 rbuf_i = rbuf[i]; 538 rbuf_0 = rbuf_i[0]; 539 ct1 = 2*rbuf_0+1; 540 ct2 = ct1; 541 ct3 += ct1; 542 for (j=1; j<=rbuf_0; j++) { /* for each IS from proc i*/ 543 ierr = PetscBTMemzero(Mbs,xtable);CHKERRQ(ierr); 544 oct2 = ct2; 545 kmax = rbuf_i[2*j]; 546 for (k=0; k<kmax; k++,ct1++) { 547 row = rbuf_i[ct1]; 548 if (!PetscBTLookupSet(xtable,row)) { 549 if (!(ct3 < mem_estimate)) { 550 new_estimate = (int)(1.5*mem_estimate)+1; 551 ierr = PetscMalloc(new_estimate * sizeof(int),&tmp);CHKERRQ(ierr); 552 ierr = PetscMemcpy(tmp,xdata[0],mem_estimate*sizeof(int));CHKERRQ(ierr); 553 ierr = PetscFree(xdata[0]);CHKERRQ(ierr); 554 xdata[0] = tmp; 555 mem_estimate = new_estimate; ++no_malloc; 556 for (ctr=1; ctr<=i; ctr++) { xdata[ctr] = xdata[ctr-1] + isz1[ctr-1];} 557 } 558 xdata[i][ct2++] = row; 559 ct3++; 560 } 561 } 562 for (k=oct2,max2=ct2; k<max2; k++) { 563 row = xdata[i][k] - rstart; 564 start = ai[row]; 565 end = ai[row+1]; 566 for (l=start; l<end; l++) { 567 val = aj[l] + cstart; 568 if (!PetscBTLookupSet(xtable,val)) { 569 if (!(ct3 < mem_estimate)) { 570 new_estimate = (int)(1.5*mem_estimate)+1; 571 ierr = PetscMalloc(new_estimate * sizeof(int),&tmp);CHKERRQ(ierr); 572 ierr = PetscMemcpy(tmp,xdata[0],mem_estimate*sizeof(int));CHKERRQ(ierr); 573 ierr = PetscFree(xdata[0]);CHKERRQ(ierr); 574 xdata[0] = tmp; 575 mem_estimate = new_estimate; ++no_malloc; 576 for (ctr=1; ctr<=i; ctr++) { xdata[ctr] = xdata[ctr-1] + isz1[ctr-1];} 577 } 578 xdata[i][ct2++] = val; 579 ct3++; 580 } 581 } 582 start = bi[row]; 583 end = bi[row+1]; 584 for (l=start; l<end; l++) { 585 val = garray[bj[l]]; 586 if (!PetscBTLookupSet(xtable,val)) { 587 if (!(ct3 < mem_estimate)) { 588 new_estimate = (int)(1.5*mem_estimate)+1; 589 ierr = PetscMalloc(new_estimate * sizeof(int),&tmp);CHKERRQ(ierr); 590 ierr = PetscMemcpy(tmp,xdata[0],mem_estimate*sizeof(int));CHKERRQ(ierr); 591 ierr = PetscFree(xdata[0]);CHKERRQ(ierr); 592 xdata[0] = tmp; 593 mem_estimate = new_estimate; ++no_malloc; 594 for (ctr =1; ctr <=i; ctr++) { xdata[ctr] = xdata[ctr-1] + isz1[ctr-1];} 595 } 596 xdata[i][ct2++] = val; 597 ct3++; 598 } 599 } 600 } 601 /* Update the header*/ 602 xdata[i][2*j] = ct2 - oct2; /* Undo the vector isz1 and use only a var*/ 603 xdata[i][2*j-1] = rbuf_i[2*j-1]; 604 } 605 xdata[i][0] = rbuf_0; 606 xdata[i+1] = xdata[i] + ct2; 607 isz1[i] = ct2; /* size of each message */ 608 } 609 ierr = PetscBTDestroy(xtable);CHKERRQ(ierr); 610 PetscLogInfo(0,"MatIncreaseOverlap_MPISBAIJ:[%d] Allocated %d bytes, required %d, no of mallocs = %d\n",rank,mem_estimate,ct3,no_malloc); 611 PetscFunctionReturn(0); 612 } 613 614 615