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