1 #ifdef PETSC_RCS_HEADER 2 static char vcid[] = "$Id: dense.c,v 1.134 1997/12/01 01:54:20 bsmith Exp bsmith $"; 3 #endif 4 /* 5 Defines the basic matrix operations for sequential dense. 6 */ 7 8 #include "src/mat/impls/dense/seq/dense.h" 9 #include "pinclude/plapack.h" 10 #include "pinclude/pviewer.h" 11 12 #undef __FUNC__ 13 #define __FUNC__ "MatAXPY_SeqDense" 14 int MatAXPY_SeqDense(Scalar *alpha,Mat X,Mat Y) 15 { 16 Mat_SeqDense *x = (Mat_SeqDense*) X->data,*y = (Mat_SeqDense*) Y->data; 17 int N = x->m*x->n, one = 1; 18 19 PetscFunctionBegin; 20 BLaxpy_( &N, alpha, x->v, &one, y->v, &one ); 21 PLogFlops(2*N-1); 22 PetscFunctionReturn(0); 23 } 24 25 #undef __FUNC__ 26 #define __FUNC__ "MatGetInfo_SeqDense" 27 int MatGetInfo_SeqDense(Mat A,MatInfoType flag,MatInfo *info) 28 { 29 Mat_SeqDense *a = (Mat_SeqDense *) A->data; 30 int i,N = a->m*a->n,count = 0; 31 Scalar *v = a->v; 32 33 PetscFunctionBegin; 34 for ( i=0; i<N; i++ ) {if (*v != 0.0) count++; v++;} 35 36 info->rows_global = (double)a->m; 37 info->columns_global = (double)a->n; 38 info->rows_local = (double)a->m; 39 info->columns_local = (double)a->n; 40 info->block_size = 1.0; 41 info->nz_allocated = (double)N; 42 info->nz_used = (double)count; 43 info->nz_unneeded = (double)(N-count); 44 info->assemblies = (double)A->num_ass; 45 info->mallocs = 0; 46 info->memory = A->mem; 47 info->fill_ratio_given = 0; 48 info->fill_ratio_needed = 0; 49 info->factor_mallocs = 0; 50 51 PetscFunctionReturn(0); 52 } 53 54 #undef __FUNC__ 55 #define __FUNC__ "MatScale_SeqDense" 56 int MatScale_SeqDense(Scalar *alpha,Mat inA) 57 { 58 Mat_SeqDense *a = (Mat_SeqDense *) inA->data; 59 int one = 1, nz; 60 61 PetscFunctionBegin; 62 nz = a->m*a->n; 63 BLscal_( &nz, alpha, a->v, &one ); 64 PLogFlops(nz); 65 PetscFunctionReturn(0); 66 } 67 68 /* ---------------------------------------------------------------*/ 69 /* COMMENT: I have chosen to hide column permutation in the pivots, 70 rather than put it in the Mat->col slot.*/ 71 #undef __FUNC__ 72 #define __FUNC__ "MatLUFactor_SeqDense" 73 int MatLUFactor_SeqDense(Mat A,IS row,IS col,double f) 74 { 75 Mat_SeqDense *mat = (Mat_SeqDense *) A->data; 76 int info; 77 78 PetscFunctionBegin; 79 if (!mat->pivots) { 80 mat->pivots = (int *) PetscMalloc((mat->m+1)*sizeof(int));CHKPTRQ(mat->pivots); 81 PLogObjectMemory(A,mat->m*sizeof(int)); 82 } 83 LAgetrf_(&mat->m,&mat->n,mat->v,&mat->m,mat->pivots,&info); 84 if (info<0) SETERRQ(PETSC_ERR_LIB,0,"Bad argument to LU factorization"); 85 if (info>0) SETERRQ(PETSC_ERR_MAT_LU_ZRPVT,0,"Bad LU factorization"); 86 A->factor = FACTOR_LU; 87 PLogFlops((2*mat->n*mat->n*mat->n)/3); 88 PetscFunctionReturn(0); 89 } 90 91 #undef __FUNC__ 92 #define __FUNC__ "MatConvertSameType_SeqDense" 93 int MatConvertSameType_SeqDense(Mat A,Mat *newmat,int cpvalues) 94 { 95 Mat_SeqDense *mat = (Mat_SeqDense *) A->data, *l; 96 int ierr; 97 Mat newi; 98 99 PetscFunctionBegin; 100 ierr = MatCreateSeqDense(A->comm,mat->m,mat->n,PETSC_NULL,&newi); CHKERRQ(ierr); 101 l = (Mat_SeqDense *) newi->data; 102 if (cpvalues == COPY_VALUES) { 103 PetscMemcpy(l->v,mat->v,mat->m*mat->n*sizeof(Scalar)); 104 } 105 newi->assembled = PETSC_TRUE; 106 *newmat = newi; 107 PetscFunctionReturn(0); 108 } 109 110 #undef __FUNC__ 111 #define __FUNC__ "MatLUFactorSymbolic_SeqDense" 112 int MatLUFactorSymbolic_SeqDense(Mat A,IS row,IS col,double f,Mat *fact) 113 { 114 int ierr; 115 116 PetscFunctionBegin; 117 ierr = MatConvertSameType_SeqDense(A,fact,PETSC_FALSE);CHKERRQ(ierr); 118 PetscFunctionReturn(0); 119 } 120 121 #undef __FUNC__ 122 #define __FUNC__ "MatLUFactorNumeric_SeqDense" 123 int MatLUFactorNumeric_SeqDense(Mat A,Mat *fact) 124 { 125 Mat_SeqDense *mat = (Mat_SeqDense*) A->data, *l = (Mat_SeqDense*) (*fact)->data; 126 int ierr; 127 128 PetscFunctionBegin; 129 /* copy the numerical values */ 130 PetscMemcpy(l->v,mat->v,mat->m*mat->n*sizeof(Scalar)); 131 (*fact)->factor = 0; 132 ierr = MatLUFactor(*fact,0,0,1.0);CHKERRQ(ierr); 133 PetscFunctionReturn(0); 134 } 135 136 #undef __FUNC__ 137 #define __FUNC__ "MatCholeskyFactorSymbolic_SeqDense" 138 int MatCholeskyFactorSymbolic_SeqDense(Mat A,IS row,double f,Mat *fact) 139 { 140 int ierr; 141 142 PetscFunctionBegin; 143 ierr = MatConvert(A,MATSAME,fact);CHKERRQ(ierr); 144 PetscFunctionReturn(0); 145 } 146 147 #undef __FUNC__ 148 #define __FUNC__ "MatCholeskyFactorNumeric_SeqDense" 149 int MatCholeskyFactorNumeric_SeqDense(Mat A,Mat *fact) 150 { 151 int ierr; 152 153 PetscFunctionBegin; 154 ierr = MatCholeskyFactor(*fact,0,1.0);CHKERRQ(ierr); 155 PetscFunctionReturn(0); 156 } 157 158 #undef __FUNC__ 159 #define __FUNC__ "MatCholeskyFactor_SeqDense" 160 int MatCholeskyFactor_SeqDense(Mat A,IS perm,double f) 161 { 162 Mat_SeqDense *mat = (Mat_SeqDense *) A->data; 163 int info; 164 165 PetscFunctionBegin; 166 if (mat->pivots) { 167 PetscFree(mat->pivots); 168 PLogObjectMemory(A,-mat->m*sizeof(int)); 169 mat->pivots = 0; 170 } 171 LApotrf_("L",&mat->n,mat->v,&mat->m,&info); 172 if (info) SETERRQ(PETSC_ERR_MAT_CH_ZRPVT,0,"Bad factorization"); 173 A->factor = FACTOR_CHOLESKY; 174 PLogFlops((mat->n*mat->n*mat->n)/3); 175 PetscFunctionReturn(0); 176 } 177 178 #undef __FUNC__ 179 #define __FUNC__ "MatSolve_SeqDense" 180 int MatSolve_SeqDense(Mat A,Vec xx,Vec yy) 181 { 182 Mat_SeqDense *mat = (Mat_SeqDense *) A->data; 183 int one = 1, info, ierr; 184 Scalar *x, *y; 185 186 PetscFunctionBegin; 187 ierr = VecGetArray(xx,&x); CHKERRQ(ierr); ierr = VecGetArray(yy,&y); CHKERRQ(ierr); 188 PetscMemcpy(y,x,mat->m*sizeof(Scalar)); 189 if (A->factor == FACTOR_LU) { 190 LAgetrs_( "N", &mat->m, &one, mat->v, &mat->m, mat->pivots,y, &mat->m, &info ); 191 } 192 else if (A->factor == FACTOR_CHOLESKY){ 193 LApotrs_( "L", &mat->m, &one, mat->v, &mat->m,y, &mat->m, &info ); 194 } 195 else SETERRQ(PETSC_ERR_ARG_WRONGSTATE,0,"Matrix must be factored to solve"); 196 if (info) SETERRQ(PETSC_ERR_LIB,0,"MBad solve"); 197 PLogFlops(mat->n*mat->n - mat->n); 198 PetscFunctionReturn(0); 199 } 200 201 #undef __FUNC__ 202 #define __FUNC__ "MatSolveTrans_SeqDense" 203 int MatSolveTrans_SeqDense(Mat A,Vec xx,Vec yy) 204 { 205 Mat_SeqDense *mat = (Mat_SeqDense *) A->data; 206 int one = 1, info; 207 Scalar *x, *y; 208 209 PetscFunctionBegin; 210 VecGetArray(xx,&x); VecGetArray(yy,&y); 211 PetscMemcpy(y,x,mat->m*sizeof(Scalar)); 212 /* assume if pivots exist then use LU; else Cholesky */ 213 if (mat->pivots) { 214 LAgetrs_( "T", &mat->m, &one, mat->v, &mat->m, mat->pivots,y, &mat->m, &info ); 215 } 216 else { 217 LApotrs_( "L", &mat->m, &one, mat->v, &mat->m,y, &mat->m, &info ); 218 } 219 if (info) SETERRQ(PETSC_ERR_LIB,0,"Bad solve"); 220 PLogFlops(mat->n*mat->n - mat->n); 221 PetscFunctionReturn(0); 222 } 223 224 #undef __FUNC__ 225 #define __FUNC__ "MatSolveAdd_SeqDense" 226 int MatSolveAdd_SeqDense(Mat A,Vec xx,Vec zz,Vec yy) 227 { 228 Mat_SeqDense *mat = (Mat_SeqDense *) A->data; 229 int one = 1, info,ierr; 230 Scalar *x, *y, sone = 1.0; 231 Vec tmp = 0; 232 233 PetscFunctionBegin; 234 VecGetArray(xx,&x); VecGetArray(yy,&y); 235 if (yy == zz) { 236 ierr = VecDuplicate(yy,&tmp); CHKERRQ(ierr); 237 PLogObjectParent(A,tmp); 238 ierr = VecCopy(yy,tmp); CHKERRQ(ierr); 239 } 240 PetscMemcpy(y,x,mat->m*sizeof(Scalar)); 241 /* assume if pivots exist then use LU; else Cholesky */ 242 if (mat->pivots) { 243 LAgetrs_( "N", &mat->m, &one, mat->v, &mat->m, mat->pivots,y, &mat->m, &info ); 244 } else { 245 LApotrs_( "L", &mat->m, &one, mat->v, &mat->m,y, &mat->m, &info ); 246 } 247 if (info) SETERRQ(PETSC_ERR_LIB,0,"Bad solve"); 248 if (tmp) {ierr = VecAXPY(&sone,tmp,yy); CHKERRQ(ierr); ierr = VecDestroy(tmp);CHKERRQ(ierr);} 249 else {ierr = VecAXPY(&sone,zz,yy); CHKERRQ(ierr);} 250 PLogFlops(mat->n*mat->n - mat->n); 251 PetscFunctionReturn(0); 252 } 253 254 #undef __FUNC__ 255 #define __FUNC__ "MatSolveTransAdd_SeqDense" 256 int MatSolveTransAdd_SeqDense(Mat A,Vec xx,Vec zz, Vec yy) 257 { 258 Mat_SeqDense *mat = (Mat_SeqDense *) A->data; 259 int one = 1, info,ierr; 260 Scalar *x, *y, sone = 1.0; 261 Vec tmp; 262 263 PetscFunctionBegin; 264 VecGetArray(xx,&x); VecGetArray(yy,&y); 265 if (yy == zz) { 266 ierr = VecDuplicate(yy,&tmp); CHKERRQ(ierr); 267 PLogObjectParent(A,tmp); 268 ierr = VecCopy(yy,tmp); CHKERRQ(ierr); 269 } 270 PetscMemcpy(y,x,mat->m*sizeof(Scalar)); 271 /* assume if pivots exist then use LU; else Cholesky */ 272 if (mat->pivots) { 273 LAgetrs_( "T", &mat->m, &one, mat->v, &mat->m, mat->pivots,y, &mat->m, &info ); 274 } else { 275 LApotrs_( "L", &mat->m, &one, mat->v, &mat->m,y, &mat->m, &info ); 276 } 277 if (info) SETERRQ(PETSC_ERR_LIB,0,"Bad solve"); 278 if (tmp) { 279 ierr = VecAXPY(&sone,tmp,yy); CHKERRQ(ierr); 280 ierr = VecDestroy(tmp); CHKERRQ(ierr); 281 } else { 282 ierr = VecAXPY(&sone,zz,yy); CHKERRQ(ierr); 283 } 284 PLogFlops(mat->n*mat->n - mat->n); 285 PetscFunctionReturn(0); 286 } 287 /* ------------------------------------------------------------------*/ 288 #undef __FUNC__ 289 #define __FUNC__ "MatRelax_SeqDense" 290 int MatRelax_SeqDense(Mat A,Vec bb,double omega,MatSORType flag, 291 double shift,int its,Vec xx) 292 { 293 Mat_SeqDense *mat = (Mat_SeqDense *) A->data; 294 Scalar *x, *b, *v = mat->v, zero = 0.0, xt; 295 int o = 1,ierr, m = mat->m, i; 296 297 PetscFunctionBegin; 298 if (flag & SOR_ZERO_INITIAL_GUESS) { 299 /* this is a hack fix, should have another version without the second BLdot */ 300 ierr = VecSet(&zero,xx); CHKERRQ(ierr); 301 } 302 VecGetArray(xx,&x); VecGetArray(bb,&b); 303 while (its--) { 304 if (flag & SOR_FORWARD_SWEEP){ 305 for ( i=0; i<m; i++ ) { 306 #if defined(USE_PETSC_COMPLEX) 307 /* cannot use BLAS dot for complex because compiler/linker is 308 not happy about returning a double complex */ 309 int _i; 310 Scalar sum = b[i]; 311 for ( _i=0; _i<m; _i++ ) { 312 sum -= conj(v[i+_i*m])*x[_i]; 313 } 314 xt = sum; 315 #else 316 xt = b[i]-BLdot_(&m,v+i,&m,x,&o); 317 #endif 318 x[i] = (1. - omega)*x[i] + omega*(xt+v[i + i*m]*x[i])/(v[i + i*m]+shift); 319 } 320 } 321 if (flag & SOR_BACKWARD_SWEEP) { 322 for ( i=m-1; i>=0; i-- ) { 323 #if defined(USE_PETSC_COMPLEX) 324 /* cannot use BLAS dot for complex because compiler/linker is 325 not happy about returning a double complex */ 326 int _i; 327 Scalar sum = b[i]; 328 for ( _i=0; _i<m; _i++ ) { 329 sum -= conj(v[i+_i*m])*x[_i]; 330 } 331 xt = sum; 332 #else 333 xt = b[i]-BLdot_(&m,v+i,&m,x,&o); 334 #endif 335 x[i] = (1. - omega)*x[i] + omega*(xt+v[i + i*m]*x[i])/(v[i + i*m]+shift); 336 } 337 } 338 } 339 PetscFunctionReturn(0); 340 } 341 342 /* -----------------------------------------------------------------*/ 343 #undef __FUNC__ 344 #define __FUNC__ "MatMultTrans_SeqDense" 345 int MatMultTrans_SeqDense(Mat A,Vec xx,Vec yy) 346 { 347 Mat_SeqDense *mat = (Mat_SeqDense *) A->data; 348 Scalar *v = mat->v, *x, *y; 349 int _One=1;Scalar _DOne=1.0, _DZero=0.0; 350 351 PetscFunctionBegin; 352 VecGetArray(xx,&x), VecGetArray(yy,&y); 353 LAgemv_("T",&(mat->m),&(mat->n),&_DOne,v,&(mat->m),x,&_One,&_DZero,y,&_One); 354 PLogFlops(2*mat->m*mat->n - mat->n); 355 PetscFunctionReturn(0); 356 } 357 358 #undef __FUNC__ 359 #define __FUNC__ "MatMult_SeqDense" 360 int MatMult_SeqDense(Mat A,Vec xx,Vec yy) 361 { 362 Mat_SeqDense *mat = (Mat_SeqDense *) A->data; 363 Scalar *v = mat->v, *x, *y; 364 int _One=1;Scalar _DOne=1.0, _DZero=0.0; 365 366 PetscFunctionBegin; 367 VecGetArray(xx,&x); VecGetArray(yy,&y); 368 LAgemv_( "N", &(mat->m), &(mat->n), &_DOne, v, &(mat->m),x,&_One,&_DZero,y,&_One); 369 PLogFlops(2*mat->m*mat->n - mat->m); 370 PetscFunctionReturn(0); 371 } 372 373 #undef __FUNC__ 374 #define __FUNC__ "MatMultAdd_SeqDense" 375 int MatMultAdd_SeqDense(Mat A,Vec xx,Vec zz,Vec yy) 376 { 377 Mat_SeqDense *mat = (Mat_SeqDense *) A->data; 378 Scalar *v = mat->v, *x, *y, *z; 379 int _One=1; Scalar _DOne=1.0; 380 381 PetscFunctionBegin; 382 VecGetArray(xx,&x); VecGetArray(yy,&y); VecGetArray(zz,&z); 383 if (zz != yy) PetscMemcpy(y,z,mat->m*sizeof(Scalar)); 384 LAgemv_( "N", &(mat->m), &(mat->n),&_DOne,v,&(mat->m),x,&_One,&_DOne,y,&_One); 385 PLogFlops(2*mat->m*mat->n); 386 PetscFunctionReturn(0); 387 } 388 389 #undef __FUNC__ 390 #define __FUNC__ "MatMultTransAdd_SeqDense" 391 int MatMultTransAdd_SeqDense(Mat A,Vec xx,Vec zz,Vec yy) 392 { 393 Mat_SeqDense *mat = (Mat_SeqDense *) A->data; 394 Scalar *v = mat->v, *x, *y, *z; 395 int _One=1; 396 Scalar _DOne=1.0; 397 398 PetscFunctionBegin; 399 VecGetArray(xx,&x); VecGetArray(yy,&y); VecGetArray(zz,&z); 400 if (zz != yy) PetscMemcpy(y,z,mat->n*sizeof(Scalar)); 401 LAgemv_( "T", &(mat->m), &(mat->n), &_DOne, v, &(mat->m),x,&_One,&_DOne,y,&_One); 402 PLogFlops(2*mat->m*mat->n); 403 PetscFunctionReturn(0); 404 } 405 406 /* -----------------------------------------------------------------*/ 407 #undef __FUNC__ 408 #define __FUNC__ "MatGetRow_SeqDense" 409 int MatGetRow_SeqDense(Mat A,int row,int *ncols,int **cols,Scalar **vals) 410 { 411 Mat_SeqDense *mat = (Mat_SeqDense *) A->data; 412 Scalar *v; 413 int i; 414 415 PetscFunctionBegin; 416 *ncols = mat->n; 417 if (cols) { 418 *cols = (int *) PetscMalloc((mat->n+1)*sizeof(int)); CHKPTRQ(*cols); 419 for ( i=0; i<mat->n; i++ ) (*cols)[i] = i; 420 } 421 if (vals) { 422 *vals = (Scalar *) PetscMalloc((mat->n+1)*sizeof(Scalar)); CHKPTRQ(*vals); 423 v = mat->v + row; 424 for ( i=0; i<mat->n; i++ ) {(*vals)[i] = *v; v += mat->m;} 425 } 426 PetscFunctionReturn(0); 427 } 428 429 #undef __FUNC__ 430 #define __FUNC__ "MatRestoreRow_SeqDense" 431 int MatRestoreRow_SeqDense(Mat A,int row,int *ncols,int **cols,Scalar **vals) 432 { 433 if (cols) { PetscFree(*cols); } 434 if (vals) { PetscFree(*vals); } 435 PetscFunctionReturn(0); 436 } 437 /* ----------------------------------------------------------------*/ 438 #undef __FUNC__ 439 #define __FUNC__ "MatSetValues_SeqDense" 440 int MatSetValues_SeqDense(Mat A,int m,int *indexm,int n, 441 int *indexn,Scalar *v,InsertMode addv) 442 { 443 Mat_SeqDense *mat = (Mat_SeqDense *) A->data; 444 int i,j; 445 446 PetscFunctionBegin; 447 if (!mat->roworiented) { 448 if (addv == INSERT_VALUES) { 449 for ( j=0; j<n; j++ ) { 450 #if defined(USE_PETSC_BOPT_g) 451 if (indexn[j] < 0) SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,0,"Negative column"); 452 if (indexn[j] >= A->n) SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,0,"Column too large"); 453 #endif 454 for ( i=0; i<m; i++ ) { 455 #if defined(USE_PETSC_BOPT_g) 456 if (indexm[i] < 0) SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,0,"Negative row"); 457 if (indexm[i] >= A->m) SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,0,"Row too large"); 458 #endif 459 mat->v[indexn[j]*mat->m + indexm[i]] = *v++; 460 } 461 } 462 } else { 463 for ( j=0; j<n; j++ ) { 464 #if defined(USE_PETSC_BOPT_g) 465 if (indexn[j] < 0) SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,0,"Negative column"); 466 if (indexn[j] >= A->n) SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,0,"Column too large"); 467 #endif 468 for ( i=0; i<m; i++ ) { 469 #if defined(USE_PETSC_BOPT_g) 470 if (indexm[i] < 0) SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,0,"Negative row"); 471 if (indexm[i] >= A->m) SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,0,"Row too large"); 472 #endif 473 mat->v[indexn[j]*mat->m + indexm[i]] += *v++; 474 } 475 } 476 } 477 } else { 478 if (addv == INSERT_VALUES) { 479 for ( i=0; i<m; i++ ) { 480 #if defined(USE_PETSC_BOPT_g) 481 if (indexm[i] < 0) SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,0,"Negative row"); 482 if (indexm[i] >= A->m) SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,0,"Row too large"); 483 #endif 484 for ( j=0; j<n; j++ ) { 485 #if defined(USE_PETSC_BOPT_g) 486 if (indexn[j] < 0) SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,0,"Negative column"); 487 if (indexn[j] >= A->n) SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,0,"Column too large"); 488 #endif 489 mat->v[indexn[j]*mat->m + indexm[i]] = *v++; 490 } 491 } 492 } else { 493 for ( i=0; i<m; i++ ) { 494 #if defined(USE_PETSC_BOPT_g) 495 if (indexm[i] < 0) SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,0,"Negative row"); 496 if (indexm[i] >= A->m) SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,0,"Row too large"); 497 #endif 498 for ( j=0; j<n; j++ ) { 499 #if defined(USE_PETSC_BOPT_g) 500 if (indexn[j] < 0) SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,0,"Negative column"); 501 if (indexn[j] >= A->n) SETERRQ(PETSC_ERR_ARG_OUTOFRANGE,0,"Column too large"); 502 #endif 503 mat->v[indexn[j]*mat->m + indexm[i]] += *v++; 504 } 505 } 506 } 507 } 508 PetscFunctionReturn(0); 509 } 510 511 #undef __FUNC__ 512 #define __FUNC__ "MatGetValues_SeqDense" 513 int MatGetValues_SeqDense(Mat A,int m,int *indexm,int n,int *indexn,Scalar *v) 514 { 515 Mat_SeqDense *mat = (Mat_SeqDense *) A->data; 516 int i, j; 517 Scalar *vpt = v; 518 519 PetscFunctionBegin; 520 /* row-oriented output */ 521 for ( i=0; i<m; i++ ) { 522 for ( j=0; j<n; j++ ) { 523 *vpt++ = mat->v[indexn[j]*mat->m + indexm[i]]; 524 } 525 } 526 PetscFunctionReturn(0); 527 } 528 529 /* -----------------------------------------------------------------*/ 530 531 #include "sys.h" 532 533 #undef __FUNC__ 534 #define __FUNC__ "MatLoad_SeqDense" 535 int MatLoad_SeqDense(Viewer viewer,MatType type,Mat *A) 536 { 537 Mat_SeqDense *a; 538 Mat B; 539 int *scols, i, j, nz, ierr, fd, header[4], size; 540 int *rowlengths = 0, M, N, *cols; 541 Scalar *vals, *svals, *v; 542 MPI_Comm comm = ((PetscObject)viewer)->comm; 543 544 PetscFunctionBegin; 545 MPI_Comm_size(comm,&size); 546 if (size > 1) SETERRQ(PETSC_ERR_ARG_WRONG,0,"view must have one processor"); 547 ierr = ViewerBinaryGetDescriptor(viewer,&fd); CHKERRQ(ierr); 548 ierr = PetscBinaryRead(fd,header,4,PETSC_INT); CHKERRQ(ierr); 549 if (header[0] != MAT_COOKIE) SETERRQ(PETSC_ERR_FILE_UNEXPECTED,0,"Not matrix object"); 550 M = header[1]; N = header[2]; nz = header[3]; 551 552 if (nz == MATRIX_BINARY_FORMAT_DENSE) { /* matrix in file is dense */ 553 ierr = MatCreateSeqDense(comm,M,N,PETSC_NULL,A); CHKERRQ(ierr); 554 B = *A; 555 a = (Mat_SeqDense *) B->data; 556 557 /* read in nonzero values */ 558 ierr = PetscBinaryRead(fd,a->v,M*N,PETSC_SCALAR); CHKERRQ(ierr); 559 560 ierr = MatAssemblyBegin(B,MAT_FINAL_ASSEMBLY); CHKERRQ(ierr); 561 ierr = MatAssemblyEnd(B,MAT_FINAL_ASSEMBLY); CHKERRQ(ierr); 562 /* ierr = MatTranspose(B,PETSC_NULL); CHKERRQ(ierr); */ 563 } else { 564 /* read row lengths */ 565 rowlengths = (int*) PetscMalloc( (M+1)*sizeof(int) ); CHKPTRQ(rowlengths); 566 ierr = PetscBinaryRead(fd,rowlengths,M,PETSC_INT); CHKERRQ(ierr); 567 568 /* create our matrix */ 569 ierr = MatCreateSeqDense(comm,M,N,PETSC_NULL,A); CHKERRQ(ierr); 570 B = *A; 571 a = (Mat_SeqDense *) B->data; 572 v = a->v; 573 574 /* read column indices and nonzeros */ 575 cols = scols = (int *) PetscMalloc( (nz+1)*sizeof(int) ); CHKPTRQ(cols); 576 ierr = PetscBinaryRead(fd,cols,nz,PETSC_INT); CHKERRQ(ierr); 577 vals = svals = (Scalar *) PetscMalloc( (nz+1)*sizeof(Scalar) ); CHKPTRQ(vals); 578 ierr = PetscBinaryRead(fd,vals,nz,PETSC_SCALAR); CHKERRQ(ierr); 579 580 /* insert into matrix */ 581 for ( i=0; i<M; i++ ) { 582 for ( j=0; j<rowlengths[i]; j++ ) v[i+M*scols[j]] = svals[j]; 583 svals += rowlengths[i]; scols += rowlengths[i]; 584 } 585 PetscFree(vals); PetscFree(cols); PetscFree(rowlengths); 586 587 ierr = MatAssemblyBegin(B,MAT_FINAL_ASSEMBLY); CHKERRQ(ierr); 588 ierr = MatAssemblyEnd(B,MAT_FINAL_ASSEMBLY); CHKERRQ(ierr); 589 } 590 PetscFunctionReturn(0); 591 } 592 593 #include "pinclude/pviewer.h" 594 #include "sys.h" 595 596 #undef __FUNC__ 597 #define __FUNC__ "MatView_SeqDense_ASCII" 598 static int MatView_SeqDense_ASCII(Mat A,Viewer viewer) 599 { 600 Mat_SeqDense *a = (Mat_SeqDense *) A->data; 601 int ierr, i, j, format; 602 FILE *fd; 603 char *outputname; 604 Scalar *v; 605 606 PetscFunctionBegin; 607 ierr = ViewerASCIIGetPointer(viewer,&fd); CHKERRQ(ierr); 608 ierr = ViewerFileGetOutputname_Private(viewer,&outputname); CHKERRQ(ierr); 609 ierr = ViewerGetFormat(viewer,&format); 610 if (format == VIEWER_FORMAT_ASCII_INFO || format == VIEWER_FORMAT_ASCII_INFO_LONG) { 611 PetscFunctionReturn(0); /* do nothing for now */ 612 } 613 else if (format == VIEWER_FORMAT_ASCII_COMMON) { 614 for ( i=0; i<a->m; i++ ) { 615 v = a->v + i; 616 fprintf(fd,"row %d:",i); 617 for ( j=0; j<a->n; j++ ) { 618 #if defined(USE_PETSC_COMPLEX) 619 if (real(*v) != 0.0 && imag(*v) != 0.0) fprintf(fd," %d %g + %g i",j,real(*v),imag(*v)); 620 else if (real(*v)) fprintf(fd," %d %g ",j,real(*v)); 621 #else 622 if (*v) fprintf(fd," %d %g ",j,*v); 623 #endif 624 v += a->m; 625 } 626 fprintf(fd,"\n"); 627 } 628 } else { 629 #if defined(USE_PETSC_COMPLEX) 630 int allreal = 1; 631 /* determine if matrix has all real values */ 632 v = a->v; 633 for ( i=0; i<a->m*a->n; i++ ) { 634 if (imag(v[i])) { allreal = 0; break ;} 635 } 636 #endif 637 for ( i=0; i<a->m; i++ ) { 638 v = a->v + i; 639 for ( j=0; j<a->n; j++ ) { 640 #if defined(USE_PETSC_COMPLEX) 641 if (allreal) { 642 fprintf(fd,"%6.4e ",real(*v)); v += a->m; 643 } else { 644 fprintf(fd,"%6.4e + %6.4e i ",real(*v),imag(*v)); v += a->m; 645 } 646 #else 647 fprintf(fd,"%6.4e ",*v); v += a->m; 648 #endif 649 } 650 fprintf(fd,"\n"); 651 } 652 } 653 fflush(fd); 654 PetscFunctionReturn(0); 655 } 656 657 #undef __FUNC__ 658 #define __FUNC__ "MatView_SeqDense_Binary" 659 static int MatView_SeqDense_Binary(Mat A,Viewer viewer) 660 { 661 Mat_SeqDense *a = (Mat_SeqDense *) A->data; 662 int ict, j, n = a->n, m = a->m, i, fd, *col_lens, ierr, nz = m*n; 663 int format; 664 Scalar *v, *anonz,*vals; 665 666 PetscFunctionBegin; 667 ierr = ViewerBinaryGetDescriptor(viewer,&fd); CHKERRQ(ierr); 668 669 ierr = ViewerGetFormat(viewer,&format); CHKERRQ(ierr); 670 if (format == VIEWER_FORMAT_BINARY_NATIVE) { 671 /* store the matrix as a dense matrix */ 672 col_lens = (int *) PetscMalloc( 4*sizeof(int) ); CHKPTRQ(col_lens); 673 col_lens[0] = MAT_COOKIE; 674 col_lens[1] = m; 675 col_lens[2] = n; 676 col_lens[3] = MATRIX_BINARY_FORMAT_DENSE; 677 ierr = PetscBinaryWrite(fd,col_lens,4,PETSC_INT,1); CHKERRQ(ierr); 678 PetscFree(col_lens); 679 680 /* write out matrix, by rows */ 681 vals = (Scalar *) PetscMalloc((m*n+1)*sizeof(Scalar)); CHKPTRQ(vals); 682 v = a->v; 683 for ( i=0; i<m; i++ ) { 684 for ( j=0; j<n; j++ ) { 685 vals[i + j*m] = *v++; 686 } 687 } 688 ierr = PetscBinaryWrite(fd,vals,n*m,PETSC_SCALAR,0); CHKERRQ(ierr); 689 PetscFree(vals); 690 } else { 691 col_lens = (int *) PetscMalloc( (4+nz)*sizeof(int) ); CHKPTRQ(col_lens); 692 col_lens[0] = MAT_COOKIE; 693 col_lens[1] = m; 694 col_lens[2] = n; 695 col_lens[3] = nz; 696 697 /* store lengths of each row and write (including header) to file */ 698 for ( i=0; i<m; i++ ) col_lens[4+i] = n; 699 ierr = PetscBinaryWrite(fd,col_lens,4+m,PETSC_INT,1); CHKERRQ(ierr); 700 701 /* Possibly should write in smaller increments, not whole matrix at once? */ 702 /* store column indices (zero start index) */ 703 ict = 0; 704 for ( i=0; i<m; i++ ) { 705 for ( j=0; j<n; j++ ) col_lens[ict++] = j; 706 } 707 ierr = PetscBinaryWrite(fd,col_lens,nz,PETSC_INT,0); CHKERRQ(ierr); 708 PetscFree(col_lens); 709 710 /* store nonzero values */ 711 anonz = (Scalar *) PetscMalloc((nz+1)*sizeof(Scalar)); CHKPTRQ(anonz); 712 ict = 0; 713 for ( i=0; i<m; i++ ) { 714 v = a->v + i; 715 for ( j=0; j<n; j++ ) { 716 anonz[ict++] = *v; v += a->m; 717 } 718 } 719 ierr = PetscBinaryWrite(fd,anonz,nz,PETSC_SCALAR,0); CHKERRQ(ierr); 720 PetscFree(anonz); 721 } 722 PetscFunctionReturn(0); 723 } 724 725 #undef __FUNC__ 726 #define __FUNC__ "MatView_SeqDense" 727 int MatView_SeqDense(PetscObject obj,Viewer viewer) 728 { 729 Mat A = (Mat) obj; 730 Mat_SeqDense *a = (Mat_SeqDense*) A->data; 731 ViewerType vtype; 732 int ierr; 733 734 PetscFunctionBegin; 735 ierr = ViewerGetType(viewer,&vtype); CHKERRQ(ierr); 736 737 if (vtype == MATLAB_VIEWER) { 738 ierr = ViewerMatlabPutArray_Private(viewer,a->m,a->n,a->v); CHKERRQ(ierr); 739 } else if (vtype == ASCII_FILE_VIEWER || vtype == ASCII_FILES_VIEWER) { 740 ierr = MatView_SeqDense_ASCII(A,viewer);CHKERRQ(ierr); 741 } else if (vtype == BINARY_FILE_VIEWER) { 742 ierr = MatView_SeqDense_Binary(A,viewer);CHKERRQ(ierr); 743 } 744 PetscFunctionReturn(0); 745 } 746 747 #undef __FUNC__ 748 #define __FUNC__ "MatDestroy_SeqDense" 749 int MatDestroy_SeqDense(PetscObject obj) 750 { 751 Mat mat = (Mat) obj; 752 Mat_SeqDense *l = (Mat_SeqDense *) mat->data; 753 int ierr; 754 755 PetscFunctionBegin; 756 #if defined(USE_PETSC_LOG) 757 PLogObjectState(obj,"Rows %d Cols %d",l->m,l->n); 758 #endif 759 if (l->pivots) PetscFree(l->pivots); 760 if (!l->user_alloc) PetscFree(l->v); 761 PetscFree(l); 762 if (mat->mapping) { 763 ierr = ISLocalToGlobalMappingDestroy(mat->mapping); CHKERRQ(ierr); 764 } 765 PLogObjectDestroy(mat); 766 PetscHeaderDestroy(mat); 767 PetscFunctionReturn(0); 768 } 769 770 #undef __FUNC__ 771 #define __FUNC__ "MatTranspose_SeqDense" 772 int MatTranspose_SeqDense(Mat A,Mat *matout) 773 { 774 Mat_SeqDense *mat = (Mat_SeqDense *) A->data; 775 int k, j, m, n; 776 Scalar *v, tmp; 777 778 PetscFunctionBegin; 779 v = mat->v; m = mat->m; n = mat->n; 780 if (matout == PETSC_NULL) { /* in place transpose */ 781 if (m != n) { /* malloc temp to hold transpose */ 782 Scalar *w = (Scalar *) PetscMalloc((m+1)*(n+1)*sizeof(Scalar));CHKPTRQ(w); 783 for ( j=0; j<m; j++ ) { 784 for ( k=0; k<n; k++ ) { 785 w[k + j*n] = v[j + k*m]; 786 } 787 } 788 PetscMemcpy(v,w,m*n*sizeof(Scalar)); 789 PetscFree(w); 790 } else { 791 for ( j=0; j<m; j++ ) { 792 for ( k=0; k<j; k++ ) { 793 tmp = v[j + k*n]; 794 v[j + k*n] = v[k + j*n]; 795 v[k + j*n] = tmp; 796 } 797 } 798 } 799 } else { /* out-of-place transpose */ 800 int ierr; 801 Mat tmat; 802 Mat_SeqDense *tmatd; 803 Scalar *v2; 804 ierr = MatCreateSeqDense(A->comm,mat->n,mat->m,PETSC_NULL,&tmat); CHKERRQ(ierr); 805 tmatd = (Mat_SeqDense *) tmat->data; 806 v = mat->v; v2 = tmatd->v; 807 for ( j=0; j<n; j++ ) { 808 for ( k=0; k<m; k++ ) v2[j + k*n] = v[k + j*m]; 809 } 810 ierr = MatAssemblyBegin(tmat,MAT_FINAL_ASSEMBLY); CHKERRQ(ierr); 811 ierr = MatAssemblyEnd(tmat,MAT_FINAL_ASSEMBLY); CHKERRQ(ierr); 812 *matout = tmat; 813 } 814 PetscFunctionReturn(0); 815 } 816 817 #undef __FUNC__ 818 #define __FUNC__ "MatEqual_SeqDense" 819 int MatEqual_SeqDense(Mat A1,Mat A2, PetscTruth *flg) 820 { 821 Mat_SeqDense *mat1 = (Mat_SeqDense *) A1->data; 822 Mat_SeqDense *mat2 = (Mat_SeqDense *) A2->data; 823 int i; 824 Scalar *v1 = mat1->v, *v2 = mat2->v; 825 826 PetscFunctionBegin; 827 if (A2->type != MATSEQDENSE) SETERRQ(PETSC_ERR_SUP,0,"Matrices should be of type MATSEQDENSE"); 828 if (mat1->m != mat2->m) {*flg = PETSC_FALSE; PetscFunctionReturn(0);} 829 if (mat1->n != mat2->n) {*flg = PETSC_FALSE; PetscFunctionReturn(0);} 830 for ( i=0; i<mat1->m*mat1->n; i++ ) { 831 if (*v1 != *v2) {*flg = PETSC_FALSE; PetscFunctionReturn(0);} 832 v1++; v2++; 833 } 834 *flg = PETSC_TRUE; 835 PetscFunctionReturn(0); 836 } 837 838 #undef __FUNC__ 839 #define __FUNC__ "MatGetDiagonal_SeqDense" 840 int MatGetDiagonal_SeqDense(Mat A,Vec v) 841 { 842 Mat_SeqDense *mat = (Mat_SeqDense *) A->data; 843 int i, n, len; 844 Scalar *x, zero = 0.0; 845 846 PetscFunctionBegin; 847 VecSet(&zero,v); 848 VecGetArray(v,&x); VecGetSize(v,&n); 849 len = PetscMin(mat->m,mat->n); 850 if (n != mat->m) SETERRQ(PETSC_ERR_ARG_SIZ,0,"Nonconforming mat and vec"); 851 for ( i=0; i<len; i++ ) { 852 x[i] = mat->v[i*mat->m + i]; 853 } 854 PetscFunctionReturn(0); 855 } 856 857 #undef __FUNC__ 858 #define __FUNC__ "MatDiagonalScale_SeqDense" 859 int MatDiagonalScale_SeqDense(Mat A,Vec ll,Vec rr) 860 { 861 Mat_SeqDense *mat = (Mat_SeqDense *) A->data; 862 Scalar *l,*r,x,*v; 863 int i,j,m = mat->m, n = mat->n; 864 865 PetscFunctionBegin; 866 if (ll) { 867 VecGetArray(ll,&l); VecGetSize(ll,&m); 868 if (m != mat->m) SETERRQ(PETSC_ERR_ARG_SIZ,0,"Left scaling vec wrong size"); 869 for ( i=0; i<m; i++ ) { 870 x = l[i]; 871 v = mat->v + i; 872 for ( j=0; j<n; j++ ) { (*v) *= x; v+= m;} 873 } 874 PLogFlops(n*m); 875 } 876 if (rr) { 877 VecGetArray(rr,&r); VecGetSize(rr,&n); 878 if (n != mat->n) SETERRQ(PETSC_ERR_ARG_SIZ,0,"Right scaling vec wrong size"); 879 for ( i=0; i<n; i++ ) { 880 x = r[i]; 881 v = mat->v + i*m; 882 for ( j=0; j<m; j++ ) { (*v++) *= x;} 883 } 884 PLogFlops(n*m); 885 } 886 PetscFunctionReturn(0); 887 } 888 889 #undef __FUNC__ 890 #define __FUNC__ "MatNorm_SeqDense" 891 int MatNorm_SeqDense(Mat A,NormType type,double *norm) 892 { 893 Mat_SeqDense *mat = (Mat_SeqDense *) A->data; 894 Scalar *v = mat->v; 895 double sum = 0.0; 896 int i, j; 897 898 PetscFunctionBegin; 899 if (type == NORM_FROBENIUS) { 900 for (i=0; i<mat->n*mat->m; i++ ) { 901 #if defined(USE_PETSC_COMPLEX) 902 sum += real(conj(*v)*(*v)); v++; 903 #else 904 sum += (*v)*(*v); v++; 905 #endif 906 } 907 *norm = sqrt(sum); 908 PLogFlops(2*mat->n*mat->m); 909 } else if (type == NORM_1) { 910 *norm = 0.0; 911 for ( j=0; j<mat->n; j++ ) { 912 sum = 0.0; 913 for ( i=0; i<mat->m; i++ ) { 914 sum += PetscAbsScalar(*v); v++; 915 } 916 if (sum > *norm) *norm = sum; 917 } 918 PLogFlops(mat->n*mat->m); 919 } else if (type == NORM_INFINITY) { 920 *norm = 0.0; 921 for ( j=0; j<mat->m; j++ ) { 922 v = mat->v + j; 923 sum = 0.0; 924 for ( i=0; i<mat->n; i++ ) { 925 sum += PetscAbsScalar(*v); v += mat->m; 926 } 927 if (sum > *norm) *norm = sum; 928 } 929 PLogFlops(mat->n*mat->m); 930 } else { 931 SETERRQ(PETSC_ERR_SUP,0,"No two norm"); 932 } 933 PetscFunctionReturn(0); 934 } 935 936 #undef __FUNC__ 937 #define __FUNC__ "MatSetOption_SeqDense" 938 int MatSetOption_SeqDense(Mat A,MatOption op) 939 { 940 Mat_SeqDense *aij = (Mat_SeqDense *) A->data; 941 942 PetscFunctionBegin; 943 if (op == MAT_ROW_ORIENTED) aij->roworiented = 1; 944 else if (op == MAT_COLUMN_ORIENTED) aij->roworiented = 0; 945 else if (op == MAT_ROWS_SORTED || 946 op == MAT_ROWS_UNSORTED || 947 op == MAT_COLUMNS_SORTED || 948 op == MAT_COLUMNS_UNSORTED || 949 op == MAT_SYMMETRIC || 950 op == MAT_STRUCTURALLY_SYMMETRIC || 951 op == MAT_NO_NEW_NONZERO_LOCATIONS || 952 op == MAT_YES_NEW_NONZERO_LOCATIONS || 953 op == MAT_NEW_NONZERO_LOCATION_ERROR || 954 op == MAT_NO_NEW_DIAGONALS || 955 op == MAT_YES_NEW_DIAGONALS || 956 op == MAT_IGNORE_OFF_PROC_ENTRIES) 957 PLogInfo(A,"MatSetOption_SeqDense:Option ignored\n"); 958 else { 959 SETERRQ(PETSC_ERR_SUP,0,"unknown option"); 960 } 961 PetscFunctionReturn(0); 962 } 963 964 #undef __FUNC__ 965 #define __FUNC__ "MatZeroEntries_SeqDense" 966 int MatZeroEntries_SeqDense(Mat A) 967 { 968 Mat_SeqDense *l = (Mat_SeqDense *) A->data; 969 970 PetscFunctionBegin; 971 PetscMemzero(l->v,l->m*l->n*sizeof(Scalar)); 972 PetscFunctionReturn(0); 973 } 974 975 #undef __FUNC__ 976 #define __FUNC__ "MatGetBlockSize_SeqDense" 977 int MatGetBlockSize_SeqDense(Mat A,int *bs) 978 { 979 PetscFunctionBegin; 980 *bs = 1; 981 PetscFunctionReturn(0); 982 } 983 984 #undef __FUNC__ 985 #define __FUNC__ "MatZeroRows_SeqDense" 986 int MatZeroRows_SeqDense(Mat A,IS is,Scalar *diag) 987 { 988 Mat_SeqDense *l = (Mat_SeqDense *) A->data; 989 int n = l->n, i, j,ierr,N, *rows; 990 Scalar *slot; 991 992 PetscFunctionBegin; 993 ierr = ISGetSize(is,&N); CHKERRQ(ierr); 994 ierr = ISGetIndices(is,&rows); CHKERRQ(ierr); 995 for ( i=0; i<N; i++ ) { 996 slot = l->v + rows[i]; 997 for ( j=0; j<n; j++ ) { *slot = 0.0; slot += n;} 998 } 999 if (diag) { 1000 for ( i=0; i<N; i++ ) { 1001 slot = l->v + (n+1)*rows[i]; 1002 *slot = *diag; 1003 } 1004 } 1005 ISRestoreIndices(is,&rows); 1006 PetscFunctionReturn(0); 1007 } 1008 1009 #undef __FUNC__ 1010 #define __FUNC__ "MatGetSize_SeqDense" 1011 int MatGetSize_SeqDense(Mat A,int *m,int *n) 1012 { 1013 Mat_SeqDense *mat = (Mat_SeqDense *) A->data; 1014 1015 PetscFunctionBegin; 1016 *m = mat->m; *n = mat->n; 1017 PetscFunctionReturn(0); 1018 } 1019 1020 #undef __FUNC__ 1021 #define __FUNC__ "MatGetOwnershipRange_SeqDense" 1022 int MatGetOwnershipRange_SeqDense(Mat A,int *m,int *n) 1023 { 1024 Mat_SeqDense *mat = (Mat_SeqDense *) A->data; 1025 1026 PetscFunctionBegin; 1027 *m = 0; *n = mat->m; 1028 PetscFunctionReturn(0); 1029 } 1030 1031 #undef __FUNC__ 1032 #define __FUNC__ "MatGetArray_SeqDense" 1033 int MatGetArray_SeqDense(Mat A,Scalar **array) 1034 { 1035 Mat_SeqDense *mat = (Mat_SeqDense *) A->data; 1036 1037 PetscFunctionBegin; 1038 *array = mat->v; 1039 PetscFunctionReturn(0); 1040 } 1041 1042 #undef __FUNC__ 1043 #define __FUNC__ "MatRestoreArray_SeqDense" 1044 int MatRestoreArray_SeqDense(Mat A,Scalar **array) 1045 { 1046 PetscFunctionBegin; 1047 PetscFunctionReturn(0); 1048 } 1049 1050 #undef __FUNC__ 1051 #define __FUNC__ "MatGetSubMatrix_SeqDense" 1052 static int MatGetSubMatrix_SeqDense(Mat A,IS isrow,IS iscol,MatGetSubMatrixCall scall, 1053 Mat *submat) 1054 { 1055 Mat_SeqDense *mat = (Mat_SeqDense *) A->data; 1056 int nznew, *smap, i, j, ierr, oldcols = mat->n; 1057 int *irow, *icol, nrows, ncols, *cwork; 1058 Scalar *vwork, *val; 1059 Mat newmat; 1060 1061 PetscFunctionBegin; 1062 ierr = ISGetIndices(isrow,&irow); CHKERRQ(ierr); 1063 ierr = ISGetIndices(iscol,&icol); CHKERRQ(ierr); 1064 ierr = ISGetSize(isrow,&nrows); CHKERRQ(ierr); 1065 ierr = ISGetSize(iscol,&ncols); CHKERRQ(ierr); 1066 1067 smap = (int *) PetscMalloc(oldcols*sizeof(int)); CHKPTRQ(smap); 1068 cwork = (int *) PetscMalloc(ncols*sizeof(int)); CHKPTRQ(cwork); 1069 vwork = (Scalar *) PetscMalloc(ncols*sizeof(Scalar)); CHKPTRQ(vwork); 1070 PetscMemzero((char*)smap,oldcols*sizeof(int)); 1071 for ( i=0; i<ncols; i++ ) smap[icol[i]] = i+1; 1072 1073 /* Create and fill new matrix */ 1074 ierr = MatCreateSeqDense(A->comm,nrows,ncols,PETSC_NULL,&newmat); CHKERRQ(ierr); 1075 for (i=0; i<nrows; i++) { 1076 nznew = 0; 1077 val = mat->v + irow[i]; 1078 for (j=0; j<oldcols; j++) { 1079 if (smap[j]) { 1080 cwork[nznew] = smap[j] - 1; 1081 vwork[nznew++] = val[j * mat->m]; 1082 } 1083 } 1084 ierr = MatSetValues(newmat,1,&i,nznew,cwork,vwork,INSERT_VALUES);CHKERRQ(ierr); 1085 } 1086 ierr = MatAssemblyBegin(newmat,MAT_FINAL_ASSEMBLY); CHKERRQ(ierr); 1087 ierr = MatAssemblyEnd(newmat,MAT_FINAL_ASSEMBLY); CHKERRQ(ierr); 1088 1089 /* Free work space */ 1090 PetscFree(smap); PetscFree(cwork); PetscFree(vwork); 1091 ierr = ISRestoreIndices(isrow,&irow); CHKERRQ(ierr); 1092 ierr = ISRestoreIndices(iscol,&icol); CHKERRQ(ierr); 1093 *submat = newmat; 1094 PetscFunctionReturn(0); 1095 } 1096 1097 #undef __FUNC__ 1098 #define __FUNC__ "MatGetSubMatrices_SeqDense" 1099 int MatGetSubMatrices_SeqDense(Mat A,int n, IS *irow,IS *icol,MatGetSubMatrixCall scall, 1100 Mat **B) 1101 { 1102 int ierr,i; 1103 1104 PetscFunctionBegin; 1105 if (scall == MAT_INITIAL_MATRIX) { 1106 *B = (Mat *) PetscMalloc( (n+1)*sizeof(Mat) ); CHKPTRQ(*B); 1107 } 1108 1109 for ( i=0; i<n; i++ ) { 1110 ierr = MatGetSubMatrix_SeqDense(A,irow[i],icol[i],scall,&(*B)[i]);CHKERRQ(ierr); 1111 } 1112 PetscFunctionReturn(0); 1113 } 1114 1115 #undef __FUNC__ 1116 #define __FUNC__ "MatCopy_SeqDense" 1117 int MatCopy_SeqDense(Mat A, Mat B) 1118 { 1119 Mat_SeqDense *a = (Mat_SeqDense *) A->data, *b = (Mat_SeqDense *)B->data; 1120 int ierr; 1121 1122 PetscFunctionBegin; 1123 if (B->type != MATSEQDENSE) { 1124 ierr = MatCopy_Basic(A,B);CHKERRQ(ierr); 1125 PetscFunctionReturn(0); 1126 } 1127 if (a->m != b->m || a->n != b->n) SETERRQ(PETSC_ERR_ARG_SIZ,0,"size(B) != size(A)"); 1128 PetscMemcpy(b->v,a->v,a->m*a->n*sizeof(Scalar)); 1129 PetscFunctionReturn(0); 1130 } 1131 1132 /* -------------------------------------------------------------------*/ 1133 static struct _MatOps MatOps = {MatSetValues_SeqDense, 1134 MatGetRow_SeqDense, 1135 MatRestoreRow_SeqDense, 1136 MatMult_SeqDense, 1137 MatMultAdd_SeqDense, 1138 MatMultTrans_SeqDense, 1139 MatMultTransAdd_SeqDense, 1140 MatSolve_SeqDense, 1141 MatSolveAdd_SeqDense, 1142 MatSolveTrans_SeqDense, 1143 MatSolveTransAdd_SeqDense, 1144 MatLUFactor_SeqDense, 1145 MatCholeskyFactor_SeqDense, 1146 MatRelax_SeqDense, 1147 MatTranspose_SeqDense, 1148 MatGetInfo_SeqDense, 1149 MatEqual_SeqDense, 1150 MatGetDiagonal_SeqDense, 1151 MatDiagonalScale_SeqDense, 1152 MatNorm_SeqDense, 1153 0, 1154 0, 1155 0, 1156 MatSetOption_SeqDense, 1157 MatZeroEntries_SeqDense, 1158 MatZeroRows_SeqDense, 1159 MatLUFactorSymbolic_SeqDense, 1160 MatLUFactorNumeric_SeqDense, 1161 MatCholeskyFactorSymbolic_SeqDense, 1162 MatCholeskyFactorNumeric_SeqDense, 1163 MatGetSize_SeqDense, 1164 MatGetSize_SeqDense, 1165 MatGetOwnershipRange_SeqDense, 1166 0, 1167 0, 1168 MatGetArray_SeqDense, 1169 MatRestoreArray_SeqDense, 1170 MatConvertSameType_SeqDense,0,0,0,0, 1171 MatAXPY_SeqDense,MatGetSubMatrices_SeqDense,0, 1172 MatGetValues_SeqDense, 1173 MatCopy_SeqDense,0,MatScale_SeqDense, 1174 0,0,0,MatGetBlockSize_SeqDense}; 1175 1176 #undef __FUNC__ 1177 #define __FUNC__ "MatCreateSeqDense" 1178 /*@C 1179 MatCreateSeqDense - Creates a sequential dense matrix that 1180 is stored in column major order (the usual Fortran 77 manner). Many 1181 of the matrix operations use the BLAS and LAPACK routines. 1182 1183 Input Parameters: 1184 . comm - MPI communicator, set to PETSC_COMM_SELF 1185 . m - number of rows 1186 . n - number of columns 1187 . data - optional location of matrix data. Set data=PETSC_NULL for PETSc 1188 to control all matrix memory allocation. 1189 1190 Output Parameter: 1191 . A - the matrix 1192 1193 Notes: 1194 The data input variable is intended primarily for Fortran programmers 1195 who wish to allocate their own matrix memory space. Most users should 1196 set data=PETSC_NULL. 1197 1198 .keywords: dense, matrix, LAPACK, BLAS 1199 1200 .seealso: MatCreate(), MatSetValues() 1201 @*/ 1202 int MatCreateSeqDense(MPI_Comm comm,int m,int n,Scalar *data,Mat *A) 1203 { 1204 Mat B; 1205 Mat_SeqDense *b; 1206 int ierr,flg,size; 1207 1208 PetscFunctionBegin; 1209 MPI_Comm_size(comm,&size); 1210 if (size > 1) SETERRQ(PETSC_ERR_ARG_WRONG,0,"Comm must be of size 1"); 1211 1212 *A = 0; 1213 PetscHeaderCreate(B,_p_Mat,MAT_COOKIE,MATSEQDENSE,comm,MatDestroy,MatView); 1214 PLogObjectCreate(B); 1215 b = (Mat_SeqDense *) PetscMalloc(sizeof(Mat_SeqDense)); CHKPTRQ(b); 1216 PetscMemzero(b,sizeof(Mat_SeqDense)); 1217 PetscMemcpy(&B->ops,&MatOps,sizeof(struct _MatOps)); 1218 B->destroy = MatDestroy_SeqDense; 1219 B->view = MatView_SeqDense; 1220 B->factor = 0; 1221 B->mapping = 0; 1222 PLogObjectMemory(B,sizeof(struct _p_Mat)); 1223 B->data = (void *) b; 1224 1225 b->m = m; B->m = m; B->M = m; 1226 b->n = n; B->n = n; B->N = n; 1227 b->pivots = 0; 1228 b->roworiented = 1; 1229 if (data == PETSC_NULL) { 1230 b->v = (Scalar*) PetscMalloc((m*n+1)*sizeof(Scalar)); CHKPTRQ(b->v); 1231 PetscMemzero(b->v,m*n*sizeof(Scalar)); 1232 b->user_alloc = 0; 1233 PLogObjectMemory(B,n*m*sizeof(Scalar)); 1234 } 1235 else { /* user-allocated storage */ 1236 b->v = data; 1237 b->user_alloc = 1; 1238 } 1239 ierr = OptionsHasName(PETSC_NULL,"-help",&flg); CHKERRQ(ierr); 1240 if (flg) {ierr = MatPrintHelp(B); CHKERRQ(ierr);} 1241 1242 *A = B; 1243 PetscFunctionReturn(0); 1244 } 1245 1246 1247 1248 1249 1250 1251