1 #ifndef lint 2 static char vcid[] = "$Id: aij.c,v 1.133 1996/01/08 17:41:34 bsmith Exp balay $"; 3 #endif 4 5 /* 6 Defines the basic matrix operations for the AIJ (compressed row) 7 matrix storage format. 8 */ 9 #include "aij.h" 10 #include "vec/vecimpl.h" 11 #include "inline/spops.h" 12 13 extern int MatToSymmetricIJ_SeqAIJ(Mat_SeqAIJ*,int**,int**); 14 15 static int MatGetReordering_SeqAIJ(Mat A,MatOrdering type,IS *rperm, IS *cperm) 16 { 17 Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data; 18 int ierr, *ia, *ja,n,*idx,i; 19 /*Viewer V1, V2;*/ 20 21 if (!a->assembled) SETERRQ(1,"MatGetReordering_SeqAIJ:Not for unassembled matrix"); 22 23 /* 24 this is tacky: In the future when we have written special factorization 25 and solve routines for the identity permutation we should use a 26 stride index set instead of the general one. 27 */ 28 if (type == ORDER_NATURAL) { 29 n = a->n; 30 idx = (int *) PetscMalloc( n*sizeof(int) ); CHKPTRQ(idx); 31 for ( i=0; i<n; i++ ) idx[i] = i; 32 ierr = ISCreateSeq(MPI_COMM_SELF,n,idx,rperm); CHKERRQ(ierr); 33 ierr = ISCreateSeq(MPI_COMM_SELF,n,idx,cperm); CHKERRQ(ierr); 34 PetscFree(idx); 35 ISSetPermutation(*rperm); 36 ISSetPermutation(*cperm); 37 ISSetIdentity(*rperm); 38 ISSetIdentity(*cperm); 39 return 0; 40 } 41 42 ierr = MatToSymmetricIJ_SeqAIJ( a, &ia, &ja ); CHKERRQ(ierr); 43 ierr = MatGetReordering_IJ(a->n,ia,ja,type,rperm,cperm); CHKERRQ(ierr); 44 /* ISView(*rperm, STDOUT_VIEWER_SELF);*/ 45 46 /*ViewerFileOpenASCII(MPI_COMM_SELF,"row_is_orig", &V1); 47 ViewerFileOpenASCII(MPI_COMM_SELF,"col_is_orig", &V2); 48 ISView(*rperm,V1); 49 ISView(*cperm,V2); 50 ViewerDestroy(V1); 51 ViewerDestroy(V2);*/ 52 53 PetscFree(ia); PetscFree(ja); 54 return 0; 55 } 56 57 #define CHUNKSIZE 10 58 59 /* This version has row oriented v */ 60 static int MatSetValues_SeqAIJ(Mat A,int m,int *im,int n,int *in,Scalar *v,InsertMode is) 61 { 62 Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data; 63 int *rp,k,low,high,t,ii,row,nrow,i,col,l,rmax, N, sorted = a->sorted; 64 int *imax = a->imax, *ai = a->i, *ailen = a->ilen,roworiented = a->roworiented; 65 int *aj = a->j, nonew = a->nonew,shift = a->indexshift; 66 Scalar *ap,value, *aa = a->a; 67 68 for ( k=0; k<m; k++ ) { /* loop over added rows */ 69 row = im[k]; 70 if (row < 0) SETERRQ(1,"MatSetValues_SeqAIJ:Negative row"); 71 if (row >= a->m) SETERRQ(1,"MatSetValues_SeqAIJ:Row too large"); 72 rp = aj + ai[row] + shift; ap = aa + ai[row] + shift; 73 rmax = imax[row]; nrow = ailen[row]; 74 low = 0; 75 for ( l=0; l<n; l++ ) { /* loop over added columns */ 76 if (in[l] < 0) SETERRQ(1,"MatSetValues_SeqAIJ:Negative column"); 77 if (in[l] >= a->n) SETERRQ(1,"MatSetValues_SeqAIJ:Column too large"); 78 col = in[l] - shift; 79 if (roworiented) { 80 value = *v++; 81 } 82 else { 83 value = v[k + l*m]; 84 } 85 if (!sorted) low = 0; high = nrow; 86 while (high-low > 5) { 87 t = (low+high)/2; 88 if (rp[t] > col) high = t; 89 else low = t; 90 } 91 for ( i=low; i<high; i++ ) { 92 if (rp[i] > col) break; 93 if (rp[i] == col) { 94 if (is == ADD_VALUES) ap[i] += value; 95 else ap[i] = value; 96 goto noinsert; 97 } 98 } 99 if (nonew) goto noinsert; 100 if (nrow >= rmax) { 101 /* there is no extra room in row, therefore enlarge */ 102 int new_nz = ai[a->m] + CHUNKSIZE,len,*new_i,*new_j; 103 Scalar *new_a; 104 105 /* malloc new storage space */ 106 len = new_nz*(sizeof(int)+sizeof(Scalar))+(a->m+1)*sizeof(int); 107 new_a = (Scalar *) PetscMalloc( len ); CHKPTRQ(new_a); 108 new_j = (int *) (new_a + new_nz); 109 new_i = new_j + new_nz; 110 111 /* copy over old data into new slots */ 112 for ( ii=0; ii<row+1; ii++ ) {new_i[ii] = ai[ii];} 113 for ( ii=row+1; ii<a->m+1; ii++ ) {new_i[ii] = ai[ii]+CHUNKSIZE;} 114 PetscMemcpy(new_j,aj,(ai[row]+nrow+shift)*sizeof(int)); 115 len = (new_nz - CHUNKSIZE - ai[row] - nrow - shift); 116 PetscMemcpy(new_j+ai[row]+shift+nrow+CHUNKSIZE,aj+ai[row]+shift+nrow, 117 len*sizeof(int)); 118 PetscMemcpy(new_a,aa,(ai[row]+nrow+shift)*sizeof(Scalar)); 119 PetscMemcpy(new_a+ai[row]+shift+nrow+CHUNKSIZE,aa+ai[row]+shift+nrow, 120 len*sizeof(Scalar)); 121 /* free up old matrix storage */ 122 PetscFree(a->a); 123 if (!a->singlemalloc) {PetscFree(a->i);PetscFree(a->j);} 124 aa = a->a = new_a; ai = a->i = new_i; aj = a->j = new_j; 125 a->singlemalloc = 1; 126 127 rp = aj + ai[row] + shift; ap = aa + ai[row] + shift; 128 rmax = imax[row] = imax[row] + CHUNKSIZE; 129 PLogObjectMemory(A,CHUNKSIZE*(sizeof(int) + sizeof(Scalar))); 130 a->maxnz += CHUNKSIZE; 131 } 132 N = nrow++ - 1; a->nz++; 133 /* shift up all the later entries in this row */ 134 for ( ii=N; ii>=i; ii-- ) { 135 rp[ii+1] = rp[ii]; 136 ap[ii+1] = ap[ii]; 137 } 138 rp[i] = col; 139 ap[i] = value; 140 noinsert:; 141 low = i + 1; 142 } 143 ailen[row] = nrow; 144 } 145 return 0; 146 } 147 148 static int MatGetValues_SeqAIJ(Mat A,int m,int *im,int n,int *in,Scalar *v) 149 { 150 Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data; 151 int *rp, k, low, high, t, row, nrow, i, col, l, *aj = a->j; 152 int *ai = a->i, *ailen = a->ilen, shift = a->indexshift; 153 Scalar *ap, *aa = a->a, zero = 0.0; 154 155 if (!a->assembled) SETERRQ(1,"MatGetValues_SeqAIJ:Not for unassembled matrix"); 156 for ( k=0; k<m; k++ ) { /* loop over rows */ 157 row = im[k]; 158 if (row < 0) SETERRQ(1,"MatGetValues_SeqAIJ:Negative row"); 159 if (row >= a->m) SETERRQ(1,"MatGetValues_SeqAIJ:Row too large"); 160 rp = aj + ai[row] + shift; ap = aa + ai[row] + shift; 161 nrow = ailen[row]; 162 for ( l=0; l<n; l++ ) { /* loop over columns */ 163 if (in[l] < 0) SETERRQ(1,"MatGetValues_SeqAIJ:Negative column"); 164 if (in[l] >= a->n) SETERRQ(1,"MatGetValues_SeqAIJ:Column too large"); 165 col = in[l] - shift; 166 high = nrow; low = 0; /* assume unsorted */ 167 while (high-low > 5) { 168 t = (low+high)/2; 169 if (rp[t] > col) high = t; 170 else low = t; 171 } 172 for ( i=low; i<high; i++ ) { 173 if (rp[i] > col) break; 174 if (rp[i] == col) { 175 *v++ = ap[i]; 176 goto finished; 177 } 178 } 179 *v++ = zero; 180 finished:; 181 } 182 } 183 return 0; 184 } 185 186 #include "draw.h" 187 #include "pinclude/pviewer.h" 188 #include "sysio.h" 189 190 static int MatView_SeqAIJ_Binary(Mat A,Viewer viewer) 191 { 192 Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data; 193 int i, fd, *col_lens, ierr; 194 195 ierr = ViewerFileGetDescriptor_Private(viewer,&fd); CHKERRQ(ierr); 196 col_lens = (int *) PetscMalloc( (4+a->m)*sizeof(int) ); CHKPTRQ(col_lens); 197 col_lens[0] = MAT_COOKIE; 198 col_lens[1] = a->m; 199 col_lens[2] = a->n; 200 col_lens[3] = a->nz; 201 202 /* store lengths of each row and write (including header) to file */ 203 for ( i=0; i<a->m; i++ ) { 204 col_lens[4+i] = a->i[i+1] - a->i[i]; 205 } 206 ierr = SYWrite(fd,col_lens,4+a->m,SYINT,1); CHKERRQ(ierr); 207 PetscFree(col_lens); 208 209 /* store column indices (zero start index) */ 210 if (a->indexshift) { 211 for ( i=0; i<a->nz; i++ ) a->j[i]--; 212 } 213 ierr = SYWrite(fd,a->j,a->nz,SYINT,0); CHKERRQ(ierr); 214 if (a->indexshift) { 215 for ( i=0; i<a->nz; i++ ) a->j[i]++; 216 } 217 218 /* store nonzero values */ 219 ierr = SYWrite(fd,a->a,a->nz,SYSCALAR,0); CHKERRQ(ierr); 220 return 0; 221 } 222 223 static int MatView_SeqAIJ_ASCII(Mat A,Viewer viewer) 224 { 225 Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data; 226 int ierr, i,j, m = a->m, shift = a->indexshift,format; 227 FILE *fd; 228 char *outputname; 229 230 ierr = ViewerFileGetPointer_Private(viewer,&fd); CHKERRQ(ierr); 231 ierr = ViewerFileGetOutputname_Private(viewer,&outputname); CHKERRQ(ierr); 232 ierr = ViewerFileGetFormat_Private(viewer,&format); 233 if (format == FILE_FORMAT_INFO) { 234 /* no need to print additional information */ ; 235 } 236 else if (format == FILE_FORMAT_MATLAB) { 237 int nz, nzalloc, mem; 238 MatGetInfo(A,MAT_LOCAL,&nz,&nzalloc,&mem); 239 fprintf(fd,"%% Size = %d %d \n",m,a->n); 240 fprintf(fd,"%% Nonzeros = %d \n",nz); 241 fprintf(fd,"zzz = zeros(%d,3);\n",nz); 242 fprintf(fd,"zzz = [\n"); 243 244 for (i=0; i<m; i++) { 245 for ( j=a->i[i]+shift; j<a->i[i+1]+shift; j++ ) { 246 #if defined(PETSC_COMPLEX) 247 fprintf(fd,"%d %d %18.16e %18.16e \n",i+1,a->j[j],real(a->a[j]), 248 imag(a->a[j])); 249 #else 250 fprintf(fd,"%d %d %18.16e\n", i+1, a->j[j], a->a[j]); 251 #endif 252 } 253 } 254 fprintf(fd,"];\n %s = spconvert(zzz);\n",outputname); 255 } 256 else { 257 for ( i=0; i<m; i++ ) { 258 fprintf(fd,"row %d:",i); 259 for ( j=a->i[i]+shift; j<a->i[i+1]+shift; j++ ) { 260 #if defined(PETSC_COMPLEX) 261 if (imag(a->a[j]) != 0.0) { 262 fprintf(fd," %d %g + %g i",a->j[j]+shift,real(a->a[j]),imag(a->a[j])); 263 } 264 else { 265 fprintf(fd," %d %g ",a->j[j]+shift,real(a->a[j])); 266 } 267 #else 268 fprintf(fd," %d %g ",a->j[j]+shift,a->a[j]); 269 #endif 270 } 271 fprintf(fd,"\n"); 272 } 273 } 274 fflush(fd); 275 return 0; 276 } 277 278 static int MatView_SeqAIJ_Draw(Mat A,Viewer viewer) 279 { 280 Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data; 281 int ierr, i,j, m = a->m, shift = a->indexshift,pause,color; 282 double xl,yl,xr,yr,w,h,xc,yc,scale = 1.0,x_l,x_r,y_l,y_r; 283 Draw draw = (Draw) viewer; 284 DrawButton button; 285 286 xr = a->n; yr = a->m; h = yr/10.0; w = xr/10.0; 287 xr += w; yr += h; xl = -w; yl = -h; 288 ierr = DrawSetCoordinates(draw,xl,yl,xr,yr); CHKERRQ(ierr); 289 /* loop over matrix elements drawing boxes */ 290 color = DRAW_BLUE; 291 for ( i=0; i<m; i++ ) { 292 y_l = m - i - 1.0; y_r = y_l + 1.0; 293 for ( j=a->i[i]+shift; j<a->i[i+1]+shift; j++ ) { 294 x_l = a->j[j] + shift; x_r = x_l + 1.0; 295 #if defined(PETSC_COMPLEX) 296 if (real(a->a[j]) >= 0.) continue; 297 #else 298 if (a->a[j] >= 0.) continue; 299 #endif 300 DrawRectangle(draw,x_l,y_l,x_r,y_r,color,color,color,color); 301 } 302 } 303 color = DRAW_CYAN; 304 for ( i=0; i<m; i++ ) { 305 y_l = m - i - 1.0; y_r = y_l + 1.0; 306 for ( j=a->i[i]+shift; j<a->i[i+1]+shift; j++ ) { 307 x_l = a->j[j] + shift; x_r = x_l + 1.0; 308 if (a->a[j] != 0.) continue; 309 DrawRectangle(draw,x_l,y_l,x_r,y_r,color,color,color,color); 310 } 311 } 312 color = DRAW_RED; 313 for ( i=0; i<m; i++ ) { 314 y_l = m - i - 1.0; y_r = y_l + 1.0; 315 for ( j=a->i[i]+shift; j<a->i[i+1]+shift; j++ ) { 316 x_l = a->j[j] + shift; x_r = x_l + 1.0; 317 #if defined(PETSC_COMPLEX) 318 if (real(a->a[j]) <= 0.) continue; 319 #else 320 if (a->a[j] <= 0.) continue; 321 #endif 322 DrawRectangle(draw,x_l,y_l,x_r,y_r,color,color,color,color); 323 } 324 } 325 DrawFlush(draw); 326 DrawGetPause(draw,&pause); 327 if (pause >= 0) { PetscSleep(pause); return 0;} 328 329 /* allow the matrix to zoom or shrink */ 330 ierr = DrawGetMouseButton(draw,&button,&xc,&yc,0,0); 331 while (button != BUTTON_RIGHT) { 332 DrawClear(draw); 333 if (button == BUTTON_LEFT) scale = .5; 334 else if (button == BUTTON_CENTER) scale = 2.; 335 xl = scale*(xl + w - xc) + xc - w*scale; 336 xr = scale*(xr - w - xc) + xc + w*scale; 337 yl = scale*(yl + h - yc) + yc - h*scale; 338 yr = scale*(yr - h - yc) + yc + h*scale; 339 w *= scale; h *= scale; 340 ierr = DrawSetCoordinates(draw,xl,yl,xr,yr); CHKERRQ(ierr); 341 color = DRAW_BLUE; 342 for ( i=0; i<m; i++ ) { 343 y_l = m - i - 1.0; y_r = y_l + 1.0; 344 for ( j=a->i[i]+shift; j<a->i[i+1]+shift; j++ ) { 345 x_l = a->j[j] + shift; x_r = x_l + 1.0; 346 #if defined(PETSC_COMPLEX) 347 if (real(a->a[j]) >= 0.) continue; 348 #else 349 if (a->a[j] >= 0.) continue; 350 #endif 351 DrawRectangle(draw,x_l,y_l,x_r,y_r,color,color,color,color); 352 } 353 } 354 color = DRAW_CYAN; 355 for ( i=0; i<m; i++ ) { 356 y_l = m - i - 1.0; y_r = y_l + 1.0; 357 for ( j=a->i[i]+shift; j<a->i[i+1]+shift; j++ ) { 358 x_l = a->j[j] + shift; x_r = x_l + 1.0; 359 if (a->a[j] != 0.) continue; 360 DrawRectangle(draw,x_l,y_l,x_r,y_r,color,color,color,color); 361 } 362 } 363 color = DRAW_RED; 364 for ( i=0; i<m; i++ ) { 365 y_l = m - i - 1.0; y_r = y_l + 1.0; 366 for ( j=a->i[i]+shift; j<a->i[i+1]+shift; j++ ) { 367 x_l = a->j[j] + shift; x_r = x_l + 1.0; 368 #if defined(PETSC_COMPLEX) 369 if (real(a->a[j]) <= 0.) continue; 370 #else 371 if (a->a[j] <= 0.) continue; 372 #endif 373 DrawRectangle(draw,x_l,y_l,x_r,y_r,color,color,color,color); 374 } 375 } 376 ierr = DrawGetMouseButton(draw,&button,&xc,&yc,0,0); 377 } 378 return 0; 379 } 380 381 static int MatView_SeqAIJ(PetscObject obj,Viewer viewer) 382 { 383 Mat A = (Mat) obj; 384 Mat_SeqAIJ *a = (Mat_SeqAIJ*) A->data; 385 PetscObject vobj = (PetscObject) viewer; 386 387 if (!a->assembled) SETERRQ(1,"MatView_SeqAIJ:Not for unassembled matrix"); 388 if (!viewer) { 389 viewer = STDOUT_VIEWER_SELF; vobj = (PetscObject) viewer; 390 } 391 if (vobj->cookie == VIEWER_COOKIE) { 392 if (vobj->type == MATLAB_VIEWER) { 393 return ViewerMatlabPutSparse_Private(viewer,a->m,a->n,a->nz,a->a,a->i,a->j); 394 } 395 else if (vobj->type == ASCII_FILE_VIEWER || vobj->type == ASCII_FILES_VIEWER){ 396 return MatView_SeqAIJ_ASCII(A,viewer); 397 } 398 else if (vobj->type == BINARY_FILE_VIEWER) { 399 return MatView_SeqAIJ_Binary(A,viewer); 400 } 401 } 402 else if (vobj->cookie == DRAW_COOKIE) { 403 if (vobj->type == NULLWINDOW) return 0; 404 else return MatView_SeqAIJ_Draw(A,viewer); 405 } 406 return 0; 407 } 408 int Mat_AIJ_CheckInode(Mat); 409 static int MatAssemblyEnd_SeqAIJ(Mat A,MatAssemblyType mode) 410 { 411 Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data; 412 int fshift = 0,i,j,*ai = a->i, *aj = a->j, *imax = a->imax,ierr; 413 int m = a->m, *ip, N, *ailen = a->ilen,shift = a->indexshift; 414 Scalar *aa = a->a, *ap; 415 416 if (mode == FLUSH_ASSEMBLY) return 0; 417 418 for ( i=1; i<m; i++ ) { 419 /* move each row back by the amount of empty slots (fshift) before it*/ 420 fshift += imax[i-1] - ailen[i-1]; 421 if (fshift) { 422 ip = aj + ai[i] + shift; ap = aa + ai[i] + shift; 423 N = ailen[i]; 424 for ( j=0; j<N; j++ ) { 425 ip[j-fshift] = ip[j]; 426 ap[j-fshift] = ap[j]; 427 } 428 } 429 ai[i] = ai[i-1] + ailen[i-1]; 430 } 431 if (m) { 432 fshift += imax[m-1] - ailen[m-1]; 433 ai[m] = ai[m-1] + ailen[m-1]; 434 } 435 /* reset ilen and imax for each row */ 436 for ( i=0; i<m; i++ ) { 437 ailen[i] = imax[i] = ai[i+1] - ai[i]; 438 } 439 a->nz = ai[m] + shift; 440 441 /* diagonals may have moved, so kill the diagonal pointers */ 442 if (fshift && a->diag) { 443 PetscFree(a->diag); 444 PLogObjectMemory(A,-(m+1)*sizeof(int)); 445 a->diag = 0; 446 } 447 /* check out for identical nodes. If found, use inode functions */ 448 ierr = Mat_AIJ_CheckInode(A); CHKERRQ(ierr); 449 a->assembled = 1; 450 return 0; 451 } 452 453 static int MatZeroEntries_SeqAIJ(Mat A) 454 { 455 Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data; 456 PetscMemzero(a->a,(a->i[a->m]+a->indexshift)*sizeof(Scalar)); 457 return 0; 458 } 459 460 int MatDestroy_SeqAIJ(PetscObject obj) 461 { 462 Mat A = (Mat) obj; 463 Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data; 464 465 #if defined(PETSC_LOG) 466 PLogObjectState(obj,"Rows=%d, Cols=%d, NZ=%d",a->m,a->n,a->nz); 467 #endif 468 PetscFree(a->a); 469 if (!a->singlemalloc) { PetscFree(a->i); PetscFree(a->j);} 470 if (a->diag) PetscFree(a->diag); 471 if (a->ilen) PetscFree(a->ilen); 472 if (a->imax) PetscFree(a->imax); 473 if (a->solve_work) PetscFree(a->solve_work); 474 if (a->inode.size) PetscFree(a->inode.size); 475 PetscFree(a); 476 PLogObjectDestroy(A); 477 PetscHeaderDestroy(A); 478 return 0; 479 } 480 481 static int MatCompress_SeqAIJ(Mat A) 482 { 483 return 0; 484 } 485 486 static int MatSetOption_SeqAIJ(Mat A,MatOption op) 487 { 488 Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data; 489 if (op == ROW_ORIENTED) a->roworiented = 1; 490 else if (op == COLUMN_ORIENTED) a->roworiented = 0; 491 else if (op == COLUMNS_SORTED) a->sorted = 1; 492 else if (op == NO_NEW_NONZERO_LOCATIONS) a->nonew = 1; 493 else if (op == YES_NEW_NONZERO_LOCATIONS) a->nonew = 0; 494 else if (op == ROWS_SORTED || 495 op == SYMMETRIC_MATRIX || 496 op == STRUCTURALLY_SYMMETRIC_MATRIX || 497 op == YES_NEW_DIAGONALS) 498 PLogInfo((PetscObject)A,"Info:MatSetOption_SeqAIJ:Option ignored\n"); 499 else if (op == NO_NEW_DIAGONALS) 500 {SETERRQ(PETSC_ERR_SUP,"MatSetOption_SeqAIJ:NO_NEW_DIAGONALS");} 501 else if (op == INODE_LIMIT_1) a->inode.limit = 1; 502 else if (op == INODE_LIMIT_2) a->inode.limit = 2; 503 else if (op == INODE_LIMIT_3) a->inode.limit = 3; 504 else if (op == INODE_LIMIT_4) a->inode.limit = 4; 505 else if (op == INODE_LIMIT_5) a->inode.limit = 5; 506 else 507 {SETERRQ(PETSC_ERR_SUP,"MatSetOption_SeqAIJ:unknown option");} 508 return 0; 509 } 510 511 static int MatGetDiagonal_SeqAIJ(Mat A,Vec v) 512 { 513 Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data; 514 int i,j, n,shift = a->indexshift; 515 Scalar *x, zero = 0.0; 516 517 if (!a->assembled) SETERRQ(1,"MatGetDiagonal_SeqAIJ:Not for unassembled matrix"); 518 VecSet(&zero,v); 519 VecGetArray(v,&x); VecGetLocalSize(v,&n); 520 if (n != a->m) SETERRQ(1,"MatGetDiagonal_SeqAIJ:Nonconforming matrix and vector"); 521 for ( i=0; i<a->m; i++ ) { 522 for ( j=a->i[i]+shift; j<a->i[i+1]+shift; j++ ) { 523 if (a->j[j]+shift == i) { 524 x[i] = a->a[j]; 525 break; 526 } 527 } 528 } 529 return 0; 530 } 531 532 /* -------------------------------------------------------*/ 533 /* Should check that shapes of vectors and matrices match */ 534 /* -------------------------------------------------------*/ 535 static int MatMultTrans_SeqAIJ(Mat A,Vec xx,Vec yy) 536 { 537 Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data; 538 Scalar *x, *y, *v, alpha; 539 int m = a->m, n, i, *idx, shift = a->indexshift; 540 541 if (!a->assembled) SETERRQ(1,"MatMultTrans_SeqAIJ:Not for unassembled matrix"); 542 VecGetArray(xx,&x); VecGetArray(yy,&y); 543 PetscMemzero(y,a->n*sizeof(Scalar)); 544 y = y + shift; /* shift for Fortran start by 1 indexing */ 545 for ( i=0; i<m; i++ ) { 546 idx = a->j + a->i[i] + shift; 547 v = a->a + a->i[i] + shift; 548 n = a->i[i+1] - a->i[i]; 549 alpha = x[i]; 550 while (n-->0) {y[*idx++] += alpha * *v++;} 551 } 552 PLogFlops(2*a->nz - a->n); 553 return 0; 554 } 555 556 static int MatMultTransAdd_SeqAIJ(Mat A,Vec xx,Vec zz,Vec yy) 557 { 558 Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data; 559 Scalar *x, *y, *v, alpha; 560 int m = a->m, n, i, *idx,shift = a->indexshift; 561 562 if (!a->assembled) SETERRQ(1,"MatMultTransAdd_SeqAIJ:Not for unassembled matrix"); 563 VecGetArray(xx,&x); VecGetArray(yy,&y); 564 if (zz != yy) VecCopy(zz,yy); 565 y = y + shift; /* shift for Fortran start by 1 indexing */ 566 for ( i=0; i<m; i++ ) { 567 idx = a->j + a->i[i] + shift; 568 v = a->a + a->i[i] + shift; 569 n = a->i[i+1] - a->i[i]; 570 alpha = x[i]; 571 while (n-->0) {y[*idx++] += alpha * *v++;} 572 } 573 return 0; 574 } 575 576 static int MatMult_SeqAIJ(Mat A,Vec xx,Vec yy) 577 { 578 Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data; 579 Scalar *x, *y, *v, sum; 580 int m = a->m, n, i, *idx, shift = a->indexshift,*ii; 581 582 if (!a->assembled) SETERRQ(1,"MatMult_SeqAIJ:Not for unassembled matrix"); 583 VecGetArray(xx,&x); VecGetArray(yy,&y); 584 x = x + shift; /* shift for Fortran start by 1 indexing */ 585 idx = a->j; 586 v = a->a; 587 ii = a->i; 588 for ( i=0; i<m; i++ ) { 589 n = ii[1] - ii[0]; ii++; 590 sum = 0.0; 591 /* SPARSEDENSEDOT(sum,x,v,idx,n); */ 592 /* for ( j=n-1; j>-1; j--) sum += v[j]*x[idx[j]]; */ 593 while (n--) sum += *v++ * x[*idx++]; 594 y[i] = sum; 595 } 596 PLogFlops(2*a->nz - m); 597 return 0; 598 } 599 600 static int MatMultAdd_SeqAIJ(Mat A,Vec xx,Vec yy,Vec zz) 601 { 602 Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data; 603 Scalar *x, *y, *z, *v, sum; 604 int m = a->m, n, i, *idx, shift = a->indexshift,*ii; 605 606 if (!a->assembled) SETERRQ(1,"MatMultAdd_SeqAIJ:Not for unassembled matrix"); 607 VecGetArray(xx,&x); VecGetArray(yy,&y); VecGetArray(zz,&z); 608 x = x + shift; /* shift for Fortran start by 1 indexing */ 609 idx = a->j; 610 v = a->a; 611 ii = a->i; 612 for ( i=0; i<m; i++ ) { 613 n = ii[1] - ii[0]; ii++; 614 sum = y[i]; 615 /* SPARSEDENSEDOT(sum,x,v,idx,n); */ 616 while (n--) sum += *v++ * x[*idx++]; 617 z[i] = sum; 618 } 619 PLogFlops(2*a->nz); 620 return 0; 621 } 622 623 /* 624 Adds diagonal pointers to sparse matrix structure. 625 */ 626 627 int MatMarkDiag_SeqAIJ(Mat A) 628 { 629 Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data; 630 int i,j, *diag, m = a->m,shift = a->indexshift; 631 632 if (!a->assembled) SETERRQ(1,"MatMarkDiag_SeqAIJ:unassembled matrix"); 633 diag = (int *) PetscMalloc( (m+1)*sizeof(int)); CHKPTRQ(diag); 634 PLogObjectMemory(A,(m+1)*sizeof(int)); 635 for ( i=0; i<a->m; i++ ) { 636 for ( j=a->i[i]+shift; j<a->i[i+1]+shift; j++ ) { 637 if (a->j[j]+shift == i) { 638 diag[i] = j - shift; 639 break; 640 } 641 } 642 } 643 a->diag = diag; 644 return 0; 645 } 646 647 static int MatRelax_SeqAIJ(Mat A,Vec bb,double omega,MatSORType flag, 648 double fshift,int its,Vec xx) 649 { 650 Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data; 651 Scalar *x, *b, *bs, d, *xs, sum, *v = a->a,*t,scale,*ts, *xb; 652 int ierr, *idx, *diag,n = a->n, m = a->m, i, shift = a->indexshift; 653 654 VecGetArray(xx,&x); VecGetArray(bb,&b); 655 if (!a->diag) {if ((ierr = MatMarkDiag_SeqAIJ(A))) return ierr;} 656 diag = a->diag; 657 xs = x + shift; /* shifted by one for index start of a or a->j*/ 658 if (flag == SOR_APPLY_UPPER) { 659 /* apply ( U + D/omega) to the vector */ 660 bs = b + shift; 661 for ( i=0; i<m; i++ ) { 662 d = fshift + a->a[diag[i] + shift]; 663 n = a->i[i+1] - diag[i] - 1; 664 idx = a->j + diag[i] + (!shift); 665 v = a->a + diag[i] + (!shift); 666 sum = b[i]*d/omega; 667 SPARSEDENSEDOT(sum,bs,v,idx,n); 668 x[i] = sum; 669 } 670 return 0; 671 } 672 if (flag == SOR_APPLY_LOWER) { 673 SETERRQ(1,"MatRelax_SeqAIJ:SOR_APPLY_LOWER is not done"); 674 } 675 else if (flag & SOR_EISENSTAT) { 676 /* Let A = L + U + D; where L is lower trianglar, 677 U is upper triangular, E is diagonal; This routine applies 678 679 (L + E)^{-1} A (U + E)^{-1} 680 681 to a vector efficiently using Eisenstat's trick. This is for 682 the case of SSOR preconditioner, so E is D/omega where omega 683 is the relaxation factor. 684 */ 685 t = (Scalar *) PetscMalloc( m*sizeof(Scalar) ); CHKPTRQ(t); 686 scale = (2.0/omega) - 1.0; 687 688 /* x = (E + U)^{-1} b */ 689 for ( i=m-1; i>=0; i-- ) { 690 d = fshift + a->a[diag[i] + shift]; 691 n = a->i[i+1] - diag[i] - 1; 692 idx = a->j + diag[i] + (!shift); 693 v = a->a + diag[i] + (!shift); 694 sum = b[i]; 695 SPARSEDENSEMDOT(sum,xs,v,idx,n); 696 x[i] = omega*(sum/d); 697 } 698 699 /* t = b - (2*E - D)x */ 700 v = a->a; 701 for ( i=0; i<m; i++ ) { t[i] = b[i] - scale*(v[*diag++ + shift])*x[i]; } 702 703 /* t = (E + L)^{-1}t */ 704 ts = t + shift; /* shifted by one for index start of a or a->j*/ 705 diag = a->diag; 706 for ( i=0; i<m; i++ ) { 707 d = fshift + a->a[diag[i]+shift]; 708 n = diag[i] - a->i[i]; 709 idx = a->j + a->i[i] + shift; 710 v = a->a + a->i[i] + shift; 711 sum = t[i]; 712 SPARSEDENSEMDOT(sum,ts,v,idx,n); 713 t[i] = omega*(sum/d); 714 } 715 716 /* x = x + t */ 717 for ( i=0; i<m; i++ ) { x[i] += t[i]; } 718 PetscFree(t); 719 return 0; 720 } 721 if (flag & SOR_ZERO_INITIAL_GUESS) { 722 if (flag & SOR_FORWARD_SWEEP || flag & SOR_LOCAL_FORWARD_SWEEP){ 723 for ( i=0; i<m; i++ ) { 724 d = fshift + a->a[diag[i]+shift]; 725 n = diag[i] - a->i[i]; 726 idx = a->j + a->i[i] + shift; 727 v = a->a + a->i[i] + shift; 728 sum = b[i]; 729 SPARSEDENSEMDOT(sum,xs,v,idx,n); 730 x[i] = omega*(sum/d); 731 } 732 xb = x; 733 } 734 else xb = b; 735 if ((flag & SOR_FORWARD_SWEEP || flag & SOR_LOCAL_FORWARD_SWEEP) && 736 (flag & SOR_BACKWARD_SWEEP || flag & SOR_LOCAL_BACKWARD_SWEEP)) { 737 for ( i=0; i<m; i++ ) { 738 x[i] *= a->a[diag[i]+shift]; 739 } 740 } 741 if (flag & SOR_BACKWARD_SWEEP || flag & SOR_LOCAL_BACKWARD_SWEEP){ 742 for ( i=m-1; i>=0; i-- ) { 743 d = fshift + a->a[diag[i] + shift]; 744 n = a->i[i+1] - diag[i] - 1; 745 idx = a->j + diag[i] + (!shift); 746 v = a->a + diag[i] + (!shift); 747 sum = xb[i]; 748 SPARSEDENSEMDOT(sum,xs,v,idx,n); 749 x[i] = omega*(sum/d); 750 } 751 } 752 its--; 753 } 754 while (its--) { 755 if (flag & SOR_FORWARD_SWEEP || flag & SOR_LOCAL_FORWARD_SWEEP){ 756 for ( i=0; i<m; i++ ) { 757 d = fshift + a->a[diag[i]+shift]; 758 n = a->i[i+1] - a->i[i]; 759 idx = a->j + a->i[i] + shift; 760 v = a->a + a->i[i] + shift; 761 sum = b[i]; 762 SPARSEDENSEMDOT(sum,xs,v,idx,n); 763 x[i] = (1. - omega)*x[i] + omega*(sum/d + x[i]); 764 } 765 } 766 if (flag & SOR_BACKWARD_SWEEP || flag & SOR_LOCAL_BACKWARD_SWEEP){ 767 for ( i=m-1; i>=0; i-- ) { 768 d = fshift + a->a[diag[i] + shift]; 769 n = a->i[i+1] - a->i[i]; 770 idx = a->j + a->i[i] + shift; 771 v = a->a + a->i[i] + shift; 772 sum = b[i]; 773 SPARSEDENSEMDOT(sum,xs,v,idx,n); 774 x[i] = (1. - omega)*x[i] + omega*(sum/d + x[i]); 775 } 776 } 777 } 778 return 0; 779 } 780 781 static int MatGetInfo_SeqAIJ(Mat A,MatInfoType flag,int *nz,int *nzalloc,int *mem) 782 { 783 Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data; 784 *nz = a->nz; 785 *nzalloc = a->maxnz; 786 *mem = (int)A->mem; 787 return 0; 788 } 789 790 extern int MatLUFactorSymbolic_SeqAIJ(Mat,IS,IS,double,Mat*); 791 extern int MatLUFactorNumeric_SeqAIJ(Mat,Mat*); 792 extern int MatLUFactor_SeqAIJ(Mat,IS,IS,double); 793 extern int MatSolve_SeqAIJ(Mat,Vec,Vec); 794 extern int MatSolveAdd_SeqAIJ(Mat,Vec,Vec,Vec); 795 extern int MatSolveTrans_SeqAIJ(Mat,Vec,Vec); 796 extern int MatSolveTransAdd_SeqAIJ(Mat,Vec,Vec,Vec); 797 798 static int MatZeroRows_SeqAIJ(Mat A,IS is,Scalar *diag) 799 { 800 Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data; 801 int i,ierr,N, *rows,m = a->m - 1,shift = a->indexshift; 802 803 ierr = ISGetLocalSize(is,&N); CHKERRQ(ierr); 804 ierr = ISGetIndices(is,&rows); CHKERRQ(ierr); 805 if (diag) { 806 for ( i=0; i<N; i++ ) { 807 if (rows[i] < 0 || rows[i] > m) SETERRQ(1,"MatZeroRows_SeqAIJ:row out of range"); 808 if (a->ilen[rows[i]] > 0) { /* in case row was completely empty */ 809 a->ilen[rows[i]] = 1; 810 a->a[a->i[rows[i]]+shift] = *diag; 811 a->j[a->i[rows[i]]+shift] = rows[i]+shift; 812 } 813 else { 814 ierr = MatSetValues_SeqAIJ(A,1,&rows[i],1,&rows[i],diag,INSERT_VALUES); 815 CHKERRQ(ierr); 816 } 817 } 818 } 819 else { 820 for ( i=0; i<N; i++ ) { 821 if (rows[i] < 0 || rows[i] > m) SETERRQ(1,"MatZeroRows_SeqAIJ:row out of range"); 822 a->ilen[rows[i]] = 0; 823 } 824 } 825 ISRestoreIndices(is,&rows); 826 ierr = MatAssemblyBegin(A,FINAL_ASSEMBLY); CHKERRQ(ierr); 827 ierr = MatAssemblyEnd(A,FINAL_ASSEMBLY); CHKERRQ(ierr); 828 return 0; 829 } 830 831 static int MatGetSize_SeqAIJ(Mat A,int *m,int *n) 832 { 833 Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data; 834 *m = a->m; *n = a->n; 835 return 0; 836 } 837 838 static int MatGetOwnershipRange_SeqAIJ(Mat A,int *m,int *n) 839 { 840 Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data; 841 *m = 0; *n = a->m; 842 return 0; 843 } 844 static int MatGetRow_SeqAIJ(Mat A,int row,int *nz,int **idx,Scalar **v) 845 { 846 Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data; 847 int *itmp,i,ierr,shift = a->indexshift; 848 849 if (row < 0 || row >= a->m) SETERRQ(1,"MatGetRow_SeqAIJ:Row out of range"); 850 851 if (!a->assembled) { 852 ierr = MatAssemblyBegin(A,FINAL_ASSEMBLY); CHKERRQ(ierr); 853 ierr = MatAssemblyEnd(A,FINAL_ASSEMBLY); CHKERRQ(ierr); 854 } 855 *nz = a->i[row+1] - a->i[row]; 856 if (v) *v = a->a + a->i[row] + shift; 857 if (idx) { 858 if (*nz) { 859 itmp = a->j + a->i[row] + shift; 860 *idx = (int *) PetscMalloc( (*nz)*sizeof(int) ); CHKPTRQ(*idx); 861 for ( i=0; i<(*nz); i++ ) {(*idx)[i] = itmp[i] + shift;} 862 } 863 else *idx = 0; 864 } 865 return 0; 866 } 867 868 static int MatRestoreRow_SeqAIJ(Mat A,int row,int *nz,int **idx,Scalar **v) 869 { 870 if (idx) {if (*idx) PetscFree(*idx);} 871 return 0; 872 } 873 874 static int MatNorm_SeqAIJ(Mat A,NormType type,double *norm) 875 { 876 Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data; 877 Scalar *v = a->a; 878 double sum = 0.0; 879 int i, j,shift = a->indexshift; 880 881 if (!a->assembled) SETERRQ(1,"MatNorm_SeqAIJ:Not for unassembled matrix"); 882 if (type == NORM_FROBENIUS) { 883 for (i=0; i<a->nz; i++ ) { 884 #if defined(PETSC_COMPLEX) 885 sum += real(conj(*v)*(*v)); v++; 886 #else 887 sum += (*v)*(*v); v++; 888 #endif 889 } 890 *norm = sqrt(sum); 891 } 892 else if (type == NORM_1) { 893 double *tmp; 894 int *jj = a->j; 895 tmp = (double *) PetscMalloc( a->n*sizeof(double) ); CHKPTRQ(tmp); 896 PetscMemzero(tmp,a->n*sizeof(double)); 897 *norm = 0.0; 898 for ( j=0; j<a->nz; j++ ) { 899 tmp[*jj++ + shift] += PetscAbsScalar(*v); v++; 900 } 901 for ( j=0; j<a->n; j++ ) { 902 if (tmp[j] > *norm) *norm = tmp[j]; 903 } 904 PetscFree(tmp); 905 } 906 else if (type == NORM_INFINITY) { 907 *norm = 0.0; 908 for ( j=0; j<a->m; j++ ) { 909 v = a->a + a->i[j] + shift; 910 sum = 0.0; 911 for ( i=0; i<a->i[j+1]-a->i[j]; i++ ) { 912 sum += PetscAbsScalar(*v); v++; 913 } 914 if (sum > *norm) *norm = sum; 915 } 916 } 917 else { 918 SETERRQ(1,"MatNorm_SeqAIJ:No support for two norm yet"); 919 } 920 return 0; 921 } 922 923 static int MatTranspose_SeqAIJ(Mat A,Mat *B) 924 { 925 Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data; 926 Mat C; 927 int i, ierr, *aj = a->j, *ai = a->i, m = a->m, len, *col; 928 int shift = a->indexshift; 929 Scalar *array = a->a; 930 931 if (!B && m != a->n) SETERRQ(1,"MatTranspose_SeqAIJ:Not for rectangular mat in place"); 932 col = (int *) PetscMalloc((1+a->n)*sizeof(int)); CHKPTRQ(col); 933 PetscMemzero(col,(1+a->n)*sizeof(int)); 934 if (shift) { 935 for ( i=0; i<ai[m]-1; i++ ) aj[i] -= 1; 936 } 937 for ( i=0; i<ai[m]+shift; i++ ) col[aj[i]] += 1; 938 ierr = MatCreateSeqAIJ(A->comm,a->n,m,0,col,&C); CHKERRQ(ierr); 939 PetscFree(col); 940 for ( i=0; i<m; i++ ) { 941 len = ai[i+1]-ai[i]; 942 ierr = MatSetValues(C,len,aj,1,&i,array,INSERT_VALUES); CHKERRQ(ierr); 943 array += len; aj += len; 944 } 945 if (shift) { 946 for ( i=0; i<ai[m]-1; i++ ) aj[i] += 1; 947 } 948 949 ierr = MatAssemblyBegin(C,FINAL_ASSEMBLY); CHKERRQ(ierr); 950 ierr = MatAssemblyEnd(C,FINAL_ASSEMBLY); CHKERRQ(ierr); 951 952 if (B) { 953 *B = C; 954 } else { 955 /* This isn't really an in-place transpose */ 956 PetscFree(a->a); 957 if (!a->singlemalloc) {PetscFree(a->i); PetscFree(a->j);} 958 if (a->diag) PetscFree(a->diag); 959 if (a->ilen) PetscFree(a->ilen); 960 if (a->imax) PetscFree(a->imax); 961 if (a->solve_work) PetscFree(a->solve_work); 962 PetscFree(a); 963 PetscMemcpy(A,C,sizeof(struct _Mat)); 964 PetscHeaderDestroy(C); 965 } 966 return 0; 967 } 968 969 static int MatScale_SeqAIJ(Mat A,Vec ll,Vec rr) 970 { 971 Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data; 972 Scalar *l,*r,x,*v; 973 int i,j,m = a->m, n = a->n, M, nz = a->nz, *jj,shift = a->indexshift; 974 975 if (!a->assembled) SETERRQ(1,"MatScale_SeqAIJ:Not for unassembled matrix"); 976 if (ll) { 977 VecGetArray(ll,&l); VecGetSize(ll,&m); 978 if (m != a->m) SETERRQ(1,"MatScale_SeqAIJ:Left scaling vector wrong length"); 979 v = a->a; 980 for ( i=0; i<m; i++ ) { 981 x = l[i]; 982 M = a->i[i+1] - a->i[i]; 983 for ( j=0; j<M; j++ ) { (*v++) *= x;} 984 } 985 } 986 if (rr) { 987 VecGetArray(rr,&r); VecGetSize(rr,&n); 988 if (n != a->n) SETERRQ(1,"MatScale_SeqAIJ:Right scaling vector wrong length"); 989 v = a->a; jj = a->j; 990 for ( i=0; i<nz; i++ ) { 991 (*v++) *= r[*jj++ + shift]; 992 } 993 } 994 return 0; 995 } 996 997 static int MatGetSubMatrix_SeqAIJ(Mat A,IS isrow,IS iscol,MatGetSubMatrixCall scall,Mat *B) 998 { 999 Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data,*c; 1000 int nznew, *smap, i, k, kstart, kend, ierr, oldcols = a->n,*lens; 1001 register int sum,lensi; 1002 int *irow, *icol, nrows, ncols, *cwork, shift = a->indexshift,*ssmap; 1003 int first,step,*starts,*j_new,*i_new,*aj = a->j, *ai = a->i,ii,*ailen = a->ilen; 1004 Scalar *vwork,*a_new; 1005 Mat C; 1006 1007 if (!a->assembled) SETERRQ(1,"MatGetSubMatrix_SeqAIJ:Not for unassembled matrix"); 1008 ierr = ISGetIndices(isrow,&irow); CHKERRQ(ierr); 1009 ierr = ISGetSize(isrow,&nrows); CHKERRQ(ierr); 1010 ierr = ISGetSize(iscol,&ncols); CHKERRQ(ierr); 1011 1012 if (ISStrideGetInfo(iscol,&first,&step) && step == 1) { 1013 /* special case of contiguous rows */ 1014 lens = (int *) PetscMalloc((2*ncols+1)*sizeof(int)); CHKPTRQ(lens); 1015 starts = lens + ncols; 1016 /* loop over new rows determining lens and starting points */ 1017 for (i=0; i<nrows; i++) { 1018 kstart = ai[irow[i]]+shift; 1019 kend = kstart + ailen[irow[i]]; 1020 for ( k=kstart; k<kend; k++ ) { 1021 if (aj[k]+shift >= first) { 1022 starts[i] = k; 1023 break; 1024 } 1025 } 1026 sum = 0; 1027 while (k < kend) { 1028 if (aj[k++]+shift >= first+ncols) break; 1029 sum++; 1030 } 1031 lens[i] = sum; 1032 } 1033 /* create submatrix */ 1034 if (scall == MAT_REUSE_MATRIX) { 1035 int n_cols,n_rows; 1036 ierr = MatGetSize(*B,&n_rows,&n_cols); CHKERRQ(ierr); 1037 if (n_rows != nrows || n_cols != ncols) SETERRQ(1,"MatGetSubMatrix_SeqAIJ:"); 1038 ierr = MatZeroEntries(*B); CHKERRQ(ierr); 1039 C = *B; 1040 } 1041 else { 1042 ierr = MatCreateSeqAIJ(A->comm,nrows,ncols,0,lens,&C);CHKERRQ(ierr); 1043 } 1044 c = (Mat_SeqAIJ*) C->data; 1045 1046 /* loop over rows inserting into submatrix */ 1047 a_new = c->a; 1048 j_new = c->j; 1049 i_new = c->i; 1050 i_new[0] = -shift; 1051 for (i=0; i<nrows; i++) { 1052 ii = starts[i]; 1053 lensi = lens[i]; 1054 for ( k=0; k<lensi; k++ ) { 1055 *j_new++ = aj[ii+k] - first; 1056 } 1057 PetscMemcpy(a_new,a->a + starts[i],lensi*sizeof(Scalar)); 1058 a_new += lensi; 1059 i_new[i+1] = i_new[i] + lensi; 1060 c->ilen[i] = lensi; 1061 } 1062 PetscFree(lens); 1063 } 1064 else { 1065 ierr = ISGetIndices(iscol,&icol); CHKERRQ(ierr); 1066 smap = (int *) PetscMalloc((1+oldcols)*sizeof(int)); CHKPTRQ(smap); 1067 ssmap = smap + shift; 1068 cwork = (int *) PetscMalloc((1+nrows+ncols)*sizeof(int)); CHKPTRQ(cwork); 1069 lens = cwork + ncols; 1070 vwork = (Scalar *) PetscMalloc((1+ncols)*sizeof(Scalar)); CHKPTRQ(vwork); 1071 PetscMemzero(smap,oldcols*sizeof(int)); 1072 for ( i=0; i<ncols; i++ ) smap[icol[i]] = i+1; 1073 /* determine lens of each row */ 1074 for (i=0; i<nrows; i++) { 1075 kstart = ai[irow[i]]+shift; 1076 kend = kstart + a->ilen[irow[i]]; 1077 lens[i] = 0; 1078 for ( k=kstart; k<kend; k++ ) { 1079 if (ssmap[aj[k]]) { 1080 lens[i]++; 1081 } 1082 } 1083 } 1084 /* Create and fill new matrix */ 1085 if (scall == MAT_REUSE_MATRIX) { 1086 int n_cols,n_rows; 1087 ierr = MatGetSize(*B,&n_rows,&n_cols); CHKERRQ(ierr); 1088 if (n_rows != nrows || n_cols != ncols) SETERRQ(1,"MatGetSubMatrix_SeqAIJ:"); 1089 ierr = MatZeroEntries(*B); CHKERRQ(ierr); 1090 C = *B; 1091 } 1092 else { 1093 ierr = MatCreateSeqAIJ(A->comm,nrows,ncols,0,lens,&C);CHKERRQ(ierr); 1094 } 1095 for (i=0; i<nrows; i++) { 1096 nznew = 0; 1097 kstart = ai[irow[i]]+shift; 1098 kend = kstart + a->ilen[irow[i]]; 1099 for ( k=kstart; k<kend; k++ ) { 1100 if (ssmap[a->j[k]]) { 1101 cwork[nznew] = ssmap[a->j[k]] - 1; 1102 vwork[nznew++] = a->a[k]; 1103 } 1104 } 1105 ierr = MatSetValues(C,1,&i,nznew,cwork,vwork,INSERT_VALUES); CHKERRQ(ierr); 1106 } 1107 /* Free work space */ 1108 ierr = ISRestoreIndices(iscol,&icol); CHKERRQ(ierr); 1109 PetscFree(smap); PetscFree(cwork); PetscFree(vwork); 1110 } 1111 ierr = MatAssemblyBegin(C,FINAL_ASSEMBLY); CHKERRQ(ierr); 1112 ierr = MatAssemblyEnd(C,FINAL_ASSEMBLY); CHKERRQ(ierr); 1113 1114 ierr = ISRestoreIndices(isrow,&irow); CHKERRQ(ierr); 1115 *B = C; 1116 return 0; 1117 } 1118 1119 /* 1120 note: This can only work for identity for row and col. It would 1121 be good to check this and otherwise generate an error. 1122 */ 1123 static int MatILUFactor_SeqAIJ(Mat inA,IS row,IS col,double efill,int fill) 1124 { 1125 Mat_SeqAIJ *a = (Mat_SeqAIJ *) inA->data; 1126 int ierr; 1127 Mat outA; 1128 1129 if (fill != 0) SETERRQ(1,"MatILUFactor_SeqAIJ:Only fill=0 supported"); 1130 1131 outA = inA; 1132 inA->factor = FACTOR_LU; 1133 a->row = row; 1134 a->col = col; 1135 1136 a->solve_work = (Scalar *) PetscMalloc( (a->m+1)*sizeof(Scalar)); CHKPTRQ(a->solve_work); 1137 1138 if (!a->diag) { 1139 ierr = MatMarkDiag_SeqAIJ(inA); CHKERRQ(ierr); 1140 } 1141 ierr = MatLUFactorNumeric_SeqAIJ(inA,&outA); CHKERRQ(ierr); 1142 return 0; 1143 } 1144 1145 static int MatGetSubMatrices_SeqAIJ(Mat A,int n, IS *irow,IS *icol,MatGetSubMatrixCall scall, 1146 Mat **B) 1147 { 1148 int ierr,i; 1149 1150 if (scall == MAT_INITIAL_MATRIX) { 1151 *B = (Mat *) PetscMalloc( (n+1)*sizeof(Mat) ); CHKPTRQ(*B); 1152 } 1153 1154 for ( i=0; i<n; i++ ) { 1155 ierr = MatGetSubMatrix(A,irow[i],icol[i],scall,&(*B)[i]); CHKERRQ(ierr); 1156 } 1157 return 0; 1158 } 1159 1160 static int MatIncreaseOverlap_SeqAIJ(Mat A, int n, IS *is, int ov) 1161 { 1162 int i,m,*idx,ierr; 1163 1164 for ( i=0; i<n; i++ ) { 1165 ierr = ISGetIndices(is[i],&idx); CHKERRQ(ierr); 1166 ISGetLocalSize(is[i],&m); 1167 } 1168 SETERRQ(1,"MatIncreaseOverlap_SeqAIJ:Not implemented"); 1169 } 1170 1171 int MatPrintHelp_SeqAIJ(Mat A) 1172 { 1173 static int called = 0; 1174 MPI_Comm comm = A->comm; 1175 1176 if (called) return 0; else called = 1; 1177 MPIU_printf(comm," Options for MATSEQAIJ and MATMPIAIJ matrix formats (the defaults):\n"); 1178 MPIU_printf(comm," -mat_lu_pivotthreshold <threshold>\n"); 1179 MPIU_printf(comm," -mat_aij_oneindex - internal indices begin at 1 instead of the default 0.\n"); 1180 MPIU_printf(comm," -mat_aij_no_inode - Do not use inodes\n"); 1181 MPIU_printf(comm," -mat_aij_inode_limit <limit> - Set inode limit (max limit=5)\n"); 1182 #if defined(HAVE_ESSL) 1183 MPIU_printf(comm," -mat_aij_essl - Use IBM sparse LU factorization and solve.\n"); 1184 #endif 1185 return 0; 1186 } 1187 /* -------------------------------------------------------------------*/ 1188 static struct _MatOps MatOps = {MatSetValues_SeqAIJ, 1189 MatGetRow_SeqAIJ,MatRestoreRow_SeqAIJ, 1190 MatMult_SeqAIJ,MatMultAdd_SeqAIJ, 1191 MatMultTrans_SeqAIJ,MatMultTransAdd_SeqAIJ, 1192 MatSolve_SeqAIJ,MatSolveAdd_SeqAIJ, 1193 MatSolveTrans_SeqAIJ,MatSolveTransAdd_SeqAIJ, 1194 MatLUFactor_SeqAIJ,0, 1195 MatRelax_SeqAIJ, 1196 MatTranspose_SeqAIJ, 1197 MatGetInfo_SeqAIJ,0, 1198 MatGetDiagonal_SeqAIJ,MatScale_SeqAIJ,MatNorm_SeqAIJ, 1199 0,MatAssemblyEnd_SeqAIJ, 1200 MatCompress_SeqAIJ, 1201 MatSetOption_SeqAIJ,MatZeroEntries_SeqAIJ,MatZeroRows_SeqAIJ, 1202 MatGetReordering_SeqAIJ, 1203 MatLUFactorSymbolic_SeqAIJ,MatLUFactorNumeric_SeqAIJ,0,0, 1204 MatGetSize_SeqAIJ,MatGetSize_SeqAIJ,MatGetOwnershipRange_SeqAIJ, 1205 MatILUFactorSymbolic_SeqAIJ,0, 1206 0,0,MatConvert_SeqAIJ, 1207 MatGetSubMatrix_SeqAIJ,0, 1208 MatConvertSameType_SeqAIJ,0,0, 1209 MatILUFactor_SeqAIJ,0,0, 1210 MatGetSubMatrices_SeqAIJ,MatIncreaseOverlap_SeqAIJ, 1211 MatGetValues_SeqAIJ,0, 1212 MatPrintHelp_SeqAIJ}; 1213 1214 extern int MatUseSuperLU_SeqAIJ(Mat); 1215 extern int MatUseEssl_SeqAIJ(Mat); 1216 extern int MatUseDXML_SeqAIJ(Mat); 1217 1218 /*@C 1219 MatCreateSeqAIJ - Creates a sparse matrix in AIJ (compressed row) format 1220 (the default uniprocessor PETSc format). 1221 1222 Input Parameters: 1223 . comm - MPI communicator, set to MPI_COMM_SELF 1224 . m - number of rows 1225 . n - number of columns 1226 . nz - number of nonzeros per row (same for all rows) 1227 . nzz - number of nonzeros per row or null (possibly different for each row) 1228 1229 Output Parameter: 1230 . A - the matrix 1231 1232 Notes: 1233 The AIJ format (also called the Yale sparse matrix format or 1234 compressed row storage), is fully compatible with standard Fortran 77 1235 storage. That is, the stored row and column indices can begin at 1236 either one (as in Fortran) or zero. See the users manual for details. 1237 1238 Specify the preallocated storage with either nz or nnz (not both). 1239 Set nz=PETSC_DEFAULT and nnz=PETSC_NULL for PETSc to control dynamic memory 1240 allocation. 1241 1242 By default, this format uses inodes (identical nodes) when possible, to 1243 improve numerical efficiency of Matrix vector products and solves. We 1244 search for consecutive rows with the same nonzero structure, thereby 1245 reusing matrix information to achieve increased efficiency. 1246 1247 Options Database Keys: 1248 $ -mat_aij_no_inode - Do not use inodes 1249 $ -mat_aij_inode_limit <limit> - Set inode limit (max limit=5) 1250 $ -mat_aij_oneindex - Internally using indexing starting at 1 rather then zero. 1251 . Note: You still index entries starting at 0! 1252 1253 .seealso: MatCreate(), MatCreateMPIAIJ(), MatSetValues() 1254 @*/ 1255 int MatCreateSeqAIJ(MPI_Comm comm,int m,int n,int nz,int *nnz, Mat *A) 1256 { 1257 Mat B; 1258 Mat_SeqAIJ *b; 1259 int i,len,ierr, flg; 1260 1261 *A = 0; 1262 PetscHeaderCreate(B,_Mat,MAT_COOKIE,MATSEQAIJ,comm); 1263 PLogObjectCreate(B); 1264 B->data = (void *) (b = PetscNew(Mat_SeqAIJ)); CHKPTRQ(b); 1265 PetscMemcpy(&B->ops,&MatOps,sizeof(struct _MatOps)); 1266 B->destroy = MatDestroy_SeqAIJ; 1267 B->view = MatView_SeqAIJ; 1268 B->factor = 0; 1269 B->lupivotthreshold = 1.0; 1270 ierr = OptionsGetDouble(PETSC_NULL,"-mat_lu_pivotthreshold",&B->lupivotthreshold, \ 1271 &flg); CHKERRQ(ierr); 1272 b->row = 0; 1273 b->col = 0; 1274 b->indexshift = 0; 1275 ierr = OptionsHasName(PETSC_NULL,"-mat_aij_oneindex", &flg); CHKERRQ(ierr); 1276 if (flg) b->indexshift = -1; 1277 1278 b->m = m; 1279 b->n = n; 1280 b->imax = (int *) PetscMalloc( (m+1)*sizeof(int) ); CHKPTRQ(b->imax); 1281 if (nnz == PETSC_NULL) { 1282 if (nz == PETSC_DEFAULT) nz = 10; 1283 else if (nz <= 0) nz = 1; 1284 for ( i=0; i<m; i++ ) b->imax[i] = nz; 1285 nz = nz*m; 1286 } 1287 else { 1288 nz = 0; 1289 for ( i=0; i<m; i++ ) {b->imax[i] = nnz[i]; nz += nnz[i];} 1290 } 1291 1292 /* allocate the matrix space */ 1293 len = nz*(sizeof(int) + sizeof(Scalar)) + (b->m+1)*sizeof(int); 1294 b->a = (Scalar *) PetscMalloc( len ); CHKPTRQ(b->a); 1295 b->j = (int *) (b->a + nz); 1296 PetscMemzero(b->j,nz*sizeof(int)); 1297 b->i = b->j + nz; 1298 b->singlemalloc = 1; 1299 1300 b->i[0] = -b->indexshift; 1301 for (i=1; i<m+1; i++) { 1302 b->i[i] = b->i[i-1] + b->imax[i-1]; 1303 } 1304 1305 /* b->ilen will count nonzeros in each row so far. */ 1306 b->ilen = (int *) PetscMalloc((m+1)*sizeof(int)); 1307 PLogObjectMemory(B,len+2*(m+1)*sizeof(int)+sizeof(struct _Mat)+sizeof(Mat_SeqAIJ)); 1308 for ( i=0; i<b->m; i++ ) { b->ilen[i] = 0;} 1309 1310 b->nz = 0; 1311 b->maxnz = nz; 1312 b->sorted = 0; 1313 b->roworiented = 1; 1314 b->nonew = 0; 1315 b->diag = 0; 1316 b->assembled = 0; 1317 b->solve_work = 0; 1318 b->spptr = 0; 1319 b->inode.node_count = 0; 1320 b->inode.size = 0; 1321 b->inode.limit = 5; 1322 b->inode.max_limit = 5; 1323 1324 *A = B; 1325 ierr = OptionsHasName(PETSC_NULL,"-mat_aij_superlu", &flg); CHKERRQ(ierr); 1326 if (flg) { ierr = MatUseSuperLU_SeqAIJ(B); CHKERRQ(ierr); } 1327 ierr = OptionsHasName(PETSC_NULL,"-mat_aij_essl", &flg); CHKERRQ(ierr); 1328 if (flg) { ierr = MatUseEssl_SeqAIJ(B); CHKERRQ(ierr); } 1329 ierr = OptionsHasName(PETSC_NULL,"-mat_aij_dxml", &flg); CHKERRQ(ierr); 1330 if (flg) { 1331 if (!b->indexshift) SETERRQ(1,"MatCreateSeqAIJ:need -mat_aij_oneindex with -mat_aij_dxml"); 1332 ierr = MatUseDXML_SeqAIJ(B); CHKERRQ(ierr); 1333 } 1334 ierr = OptionsHasName(PETSC_NULL,"-help", &flg); CHKERRQ(ierr); 1335 if (flg) {ierr = MatPrintHelp(B); CHKERRQ(ierr); } 1336 return 0; 1337 } 1338 1339 int MatConvertSameType_SeqAIJ(Mat A,Mat *B,int cpvalues) 1340 { 1341 Mat C; 1342 Mat_SeqAIJ *c,*a = (Mat_SeqAIJ *) A->data; 1343 int i,len, m = a->m,shift = a->indexshift; 1344 1345 *B = 0; 1346 if (!a->assembled) SETERRQ(1,"MatConvertSameType_SeqAIJ:Cannot copy unassembled matrix"); 1347 PetscHeaderCreate(C,_Mat,MAT_COOKIE,MATSEQAIJ,A->comm); 1348 PLogObjectCreate(C); 1349 C->data = (void *) (c = PetscNew(Mat_SeqAIJ)); CHKPTRQ(c); 1350 PetscMemcpy(&C->ops,&A->ops,sizeof(struct _MatOps)); 1351 C->destroy = MatDestroy_SeqAIJ; 1352 C->view = MatView_SeqAIJ; 1353 C->factor = A->factor; 1354 c->row = 0; 1355 c->col = 0; 1356 c->indexshift = shift; 1357 1358 c->m = a->m; 1359 c->n = a->n; 1360 1361 c->imax = (int *) PetscMalloc((m+1)*sizeof(int)); CHKPTRQ(c->imax); 1362 c->ilen = (int *) PetscMalloc((m+1)*sizeof(int)); CHKPTRQ(c->ilen); 1363 for ( i=0; i<m; i++ ) { 1364 c->imax[i] = a->imax[i]; 1365 c->ilen[i] = a->ilen[i]; 1366 } 1367 1368 /* allocate the matrix space */ 1369 c->singlemalloc = 1; 1370 len = (m+1)*sizeof(int)+(a->i[m])*(sizeof(Scalar)+sizeof(int)); 1371 c->a = (Scalar *) PetscMalloc( len ); CHKPTRQ(c->a); 1372 c->j = (int *) (c->a + a->i[m] + shift); 1373 c->i = c->j + a->i[m] + shift; 1374 PetscMemcpy(c->i,a->i,(m+1)*sizeof(int)); 1375 if (m > 0) { 1376 PetscMemcpy(c->j,a->j,(a->i[m]+shift)*sizeof(int)); 1377 if (cpvalues == COPY_VALUES) { 1378 PetscMemcpy(c->a,a->a,(a->i[m]+shift)*sizeof(Scalar)); 1379 } 1380 } 1381 1382 PLogObjectMemory(C,len+2*(m+1)*sizeof(int)+sizeof(struct _Mat)+sizeof(Mat_SeqAIJ)); 1383 c->sorted = a->sorted; 1384 c->roworiented = a->roworiented; 1385 c->nonew = a->nonew; 1386 1387 if (a->diag) { 1388 c->diag = (int *) PetscMalloc( (m+1)*sizeof(int) ); CHKPTRQ(c->diag); 1389 PLogObjectMemory(C,(m+1)*sizeof(int)); 1390 for ( i=0; i<m; i++ ) { 1391 c->diag[i] = a->diag[i]; 1392 } 1393 } 1394 else c->diag = 0; 1395 c->inode.limit = a->inode.limit; 1396 c->inode.max_limit = a->inode.max_limit; 1397 if (a->inode.size){ 1398 c->inode.size = (int *) PetscMalloc( m *sizeof(int) ); CHKPTRQ(c->inode.size); 1399 c->inode.node_count = a->inode.node_count; 1400 PetscMemcpy( c->inode.size, a->inode.size, m*sizeof(int)); 1401 } else { 1402 c->inode.size = 0; 1403 c->inode.node_count = 0; 1404 } 1405 c->assembled = 1; 1406 c->nz = a->nz; 1407 c->maxnz = a->maxnz; 1408 c->solve_work = 0; 1409 c->spptr = 0; /* Dangerous -I'm throwing away a->spptr */ 1410 1411 *B = C; 1412 return 0; 1413 } 1414 1415 int MatLoad_SeqAIJ(Viewer bview,MatType type,Mat *A) 1416 { 1417 Mat_SeqAIJ *a; 1418 Mat B; 1419 int i, nz, ierr, fd, header[4],size,*rowlengths = 0,M,N,shift; 1420 PetscObject vobj = (PetscObject) bview; 1421 MPI_Comm comm = vobj->comm; 1422 1423 MPI_Comm_size(comm,&size); 1424 if (size > 1) SETERRQ(1,"MatLoad_SeqAIJ:view must have one processor"); 1425 ierr = ViewerFileGetDescriptor_Private(bview,&fd); CHKERRQ(ierr); 1426 ierr = SYRead(fd,header,4,SYINT); CHKERRQ(ierr); 1427 if (header[0] != MAT_COOKIE) SETERRQ(1,"MatLoad_SeqAIJ:not matrix object in file"); 1428 M = header[1]; N = header[2]; nz = header[3]; 1429 1430 /* read in row lengths */ 1431 rowlengths = (int*) PetscMalloc( M*sizeof(int) ); CHKPTRQ(rowlengths); 1432 ierr = SYRead(fd,rowlengths,M,SYINT); CHKERRQ(ierr); 1433 1434 /* create our matrix */ 1435 ierr = MatCreateSeqAIJ(comm,M,N,0,rowlengths,A); CHKERRQ(ierr); 1436 B = *A; 1437 a = (Mat_SeqAIJ *) B->data; 1438 shift = a->indexshift; 1439 1440 /* read in column indices and adjust for Fortran indexing*/ 1441 ierr = SYRead(fd,a->j,nz,SYINT); CHKERRQ(ierr); 1442 if (shift) { 1443 for ( i=0; i<nz; i++ ) { 1444 a->j[i] += 1; 1445 } 1446 } 1447 1448 /* read in nonzero values */ 1449 ierr = SYRead(fd,a->a,nz,SYSCALAR); CHKERRQ(ierr); 1450 1451 /* set matrix "i" values */ 1452 a->i[0] = -shift; 1453 for ( i=1; i<= M; i++ ) { 1454 a->i[i] = a->i[i-1] + rowlengths[i-1]; 1455 a->ilen[i-1] = rowlengths[i-1]; 1456 } 1457 PetscFree(rowlengths); 1458 1459 ierr = MatAssemblyBegin(B,FINAL_ASSEMBLY); CHKERRQ(ierr); 1460 ierr = MatAssemblyEnd(B,FINAL_ASSEMBLY); CHKERRQ(ierr); 1461 return 0; 1462 } 1463 1464 1465 1466