1 2 /* 3 Defines the basic matrix operations for sequential dense. 4 */ 5 6 #include <../src/mat/impls/dense/seq/dense.h> 7 #include <petscblaslapack.h> 8 9 #include <../src/mat/impls/aij/seq/aij.h> 10 EXTERN_C_BEGIN 11 #undef __FUNCT__ 12 #define __FUNCT__ "MatConvert_SeqDense_SeqAIJ" 13 PetscErrorCode MatConvert_SeqDense_SeqAIJ(Mat A, MatType newtype,MatReuse reuse,Mat *newmat) 14 { 15 Mat B; 16 Mat_SeqDense *a = (Mat_SeqDense*)A->data; 17 PetscErrorCode ierr; 18 PetscInt i; 19 PetscInt *rows; 20 MatScalar *aa = a->v; 21 22 PetscFunctionBegin; 23 ierr = MatCreate(((PetscObject)A)->comm,&B);CHKERRQ(ierr); 24 ierr = MatSetSizes(B,A->rmap->n,A->cmap->n,A->rmap->N,A->cmap->N);CHKERRQ(ierr); 25 ierr = MatSetType(B,MATSEQAIJ);CHKERRQ(ierr); 26 ierr = MatSeqAIJSetPreallocation(B,A->cmap->n,PETSC_NULL);CHKERRQ(ierr); 27 28 ierr = PetscMalloc(A->rmap->n*sizeof(PetscInt),&rows);CHKERRQ(ierr); 29 for (i=0; i<A->rmap->n; i++) rows[i] = i; 30 31 for (i=0; i<A->cmap->n; i++) { 32 ierr = MatSetValues(B,A->rmap->n,rows,1,&i,aa,INSERT_VALUES);CHKERRQ(ierr); 33 aa += a->lda; 34 } 35 ierr = PetscFree(rows);CHKERRQ(ierr); 36 ierr = MatAssemblyBegin(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 37 ierr = MatAssemblyEnd(B,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 38 39 if (reuse == MAT_REUSE_MATRIX) { 40 ierr = MatHeaderReplace(A,B);CHKERRQ(ierr); 41 } else { 42 *newmat = B; 43 } 44 PetscFunctionReturn(0); 45 } 46 EXTERN_C_END 47 48 #undef __FUNCT__ 49 #define __FUNCT__ "MatAXPY_SeqDense" 50 PetscErrorCode MatAXPY_SeqDense(Mat Y,PetscScalar alpha,Mat X,MatStructure str) 51 { 52 Mat_SeqDense *x = (Mat_SeqDense*)X->data,*y = (Mat_SeqDense*)Y->data; 53 PetscScalar oalpha = alpha; 54 PetscInt j; 55 PetscBLASInt N,m,ldax,lday,one = 1; 56 PetscErrorCode ierr; 57 58 PetscFunctionBegin; 59 N = PetscBLASIntCast(X->rmap->n*X->cmap->n); 60 m = PetscBLASIntCast(X->rmap->n); 61 ldax = PetscBLASIntCast(x->lda); 62 lday = PetscBLASIntCast(y->lda); 63 if (ldax>m || lday>m) { 64 for (j=0; j<X->cmap->n; j++) { 65 BLASaxpy_(&m,&oalpha,x->v+j*ldax,&one,y->v+j*lday,&one); 66 } 67 } else { 68 BLASaxpy_(&N,&oalpha,x->v,&one,y->v,&one); 69 } 70 ierr = PetscLogFlops(PetscMax(2*N-1,0));CHKERRQ(ierr); 71 PetscFunctionReturn(0); 72 } 73 74 #undef __FUNCT__ 75 #define __FUNCT__ "MatGetInfo_SeqDense" 76 PetscErrorCode MatGetInfo_SeqDense(Mat A,MatInfoType flag,MatInfo *info) 77 { 78 PetscInt N = A->rmap->n*A->cmap->n; 79 80 PetscFunctionBegin; 81 info->block_size = 1.0; 82 info->nz_allocated = (double)N; 83 info->nz_used = (double)N; 84 info->nz_unneeded = (double)0; 85 info->assemblies = (double)A->num_ass; 86 info->mallocs = 0; 87 info->memory = ((PetscObject)A)->mem; 88 info->fill_ratio_given = 0; 89 info->fill_ratio_needed = 0; 90 info->factor_mallocs = 0; 91 PetscFunctionReturn(0); 92 } 93 94 #undef __FUNCT__ 95 #define __FUNCT__ "MatScale_SeqDense" 96 PetscErrorCode MatScale_SeqDense(Mat A,PetscScalar alpha) 97 { 98 Mat_SeqDense *a = (Mat_SeqDense*)A->data; 99 PetscScalar oalpha = alpha; 100 PetscErrorCode ierr; 101 PetscBLASInt one = 1,j,nz,lda = PetscBLASIntCast(a->lda); 102 103 PetscFunctionBegin; 104 if (lda>A->rmap->n) { 105 nz = PetscBLASIntCast(A->rmap->n); 106 for (j=0; j<A->cmap->n; j++) { 107 BLASscal_(&nz,&oalpha,a->v+j*lda,&one); 108 } 109 } else { 110 nz = PetscBLASIntCast(A->rmap->n*A->cmap->n); 111 BLASscal_(&nz,&oalpha,a->v,&one); 112 } 113 ierr = PetscLogFlops(nz);CHKERRQ(ierr); 114 PetscFunctionReturn(0); 115 } 116 117 #undef __FUNCT__ 118 #define __FUNCT__ "MatIsHermitian_SeqDense" 119 PetscErrorCode MatIsHermitian_SeqDense(Mat A,PetscReal rtol,PetscBool *fl) 120 { 121 Mat_SeqDense *a = (Mat_SeqDense*)A->data; 122 PetscInt i,j,m = A->rmap->n,N; 123 PetscScalar *v = a->v; 124 125 PetscFunctionBegin; 126 *fl = PETSC_FALSE; 127 if (A->rmap->n != A->cmap->n) PetscFunctionReturn(0); 128 N = a->lda; 129 130 for (i=0; i<m; i++) { 131 for (j=i+1; j<m; j++) { 132 if (PetscAbsScalar(v[i+j*N] - PetscConj(v[j+i*N])) > rtol) PetscFunctionReturn(0); 133 } 134 } 135 *fl = PETSC_TRUE; 136 PetscFunctionReturn(0); 137 } 138 139 #undef __FUNCT__ 140 #define __FUNCT__ "MatDuplicateNoCreate_SeqDense" 141 PetscErrorCode MatDuplicateNoCreate_SeqDense(Mat newi,Mat A,MatDuplicateOption cpvalues) 142 { 143 Mat_SeqDense *mat = (Mat_SeqDense*)A->data,*l; 144 PetscErrorCode ierr; 145 PetscInt lda = (PetscInt)mat->lda,j,m; 146 147 PetscFunctionBegin; 148 ierr = PetscLayoutReference(A->rmap,&newi->rmap);CHKERRQ(ierr); 149 ierr = PetscLayoutReference(A->cmap,&newi->cmap);CHKERRQ(ierr); 150 ierr = MatSeqDenseSetPreallocation(newi,PETSC_NULL);CHKERRQ(ierr); 151 if (cpvalues == MAT_COPY_VALUES) { 152 l = (Mat_SeqDense*)newi->data; 153 if (lda>A->rmap->n) { 154 m = A->rmap->n; 155 for (j=0; j<A->cmap->n; j++) { 156 ierr = PetscMemcpy(l->v+j*m,mat->v+j*lda,m*sizeof(PetscScalar));CHKERRQ(ierr); 157 } 158 } else { 159 ierr = PetscMemcpy(l->v,mat->v,A->rmap->n*A->cmap->n*sizeof(PetscScalar));CHKERRQ(ierr); 160 } 161 } 162 newi->assembled = PETSC_TRUE; 163 PetscFunctionReturn(0); 164 } 165 166 #undef __FUNCT__ 167 #define __FUNCT__ "MatDuplicate_SeqDense" 168 PetscErrorCode MatDuplicate_SeqDense(Mat A,MatDuplicateOption cpvalues,Mat *newmat) 169 { 170 PetscErrorCode ierr; 171 172 PetscFunctionBegin; 173 ierr = MatCreate(((PetscObject)A)->comm,newmat);CHKERRQ(ierr); 174 ierr = MatSetSizes(*newmat,A->rmap->n,A->cmap->n,A->rmap->n,A->cmap->n);CHKERRQ(ierr); 175 ierr = MatSetType(*newmat,((PetscObject)A)->type_name);CHKERRQ(ierr); 176 ierr = MatDuplicateNoCreate_SeqDense(*newmat,A,cpvalues);CHKERRQ(ierr); 177 PetscFunctionReturn(0); 178 } 179 180 181 extern PetscErrorCode MatLUFactor_SeqDense(Mat,IS,IS,const MatFactorInfo*); 182 183 #undef __FUNCT__ 184 #define __FUNCT__ "MatLUFactorNumeric_SeqDense" 185 PetscErrorCode MatLUFactorNumeric_SeqDense(Mat fact,Mat A,const MatFactorInfo *info_dummy) 186 { 187 MatFactorInfo info; 188 PetscErrorCode ierr; 189 190 PetscFunctionBegin; 191 ierr = MatDuplicateNoCreate_SeqDense(fact,A,MAT_COPY_VALUES);CHKERRQ(ierr); 192 ierr = MatLUFactor_SeqDense(fact,0,0,&info);CHKERRQ(ierr); 193 PetscFunctionReturn(0); 194 } 195 196 #undef __FUNCT__ 197 #define __FUNCT__ "MatSolve_SeqDense" 198 PetscErrorCode MatSolve_SeqDense(Mat A,Vec xx,Vec yy) 199 { 200 Mat_SeqDense *mat = (Mat_SeqDense*)A->data; 201 PetscErrorCode ierr; 202 PetscScalar *x,*y; 203 PetscBLASInt one = 1,info,m = PetscBLASIntCast(A->rmap->n); 204 205 PetscFunctionBegin; 206 ierr = VecGetArray(xx,&x);CHKERRQ(ierr); 207 ierr = VecGetArray(yy,&y);CHKERRQ(ierr); 208 ierr = PetscMemcpy(y,x,A->rmap->n*sizeof(PetscScalar));CHKERRQ(ierr); 209 if (A->factortype == MAT_FACTOR_LU) { 210 #if defined(PETSC_MISSING_LAPACK_GETRS) 211 SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"GETRS - Lapack routine is unavailable."); 212 #else 213 LAPACKgetrs_("N",&m,&one,mat->v,&mat->lda,mat->pivots,y,&m,&info); 214 if (info) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"GETRS - Bad solve"); 215 #endif 216 } else if (A->factortype == MAT_FACTOR_CHOLESKY){ 217 #if defined(PETSC_MISSING_LAPACK_POTRS) 218 SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"POTRS - Lapack routine is unavailable."); 219 #else 220 LAPACKpotrs_("L",&m,&one,mat->v,&mat->lda,y,&m,&info); 221 if (info) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"POTRS Bad solve"); 222 #endif 223 } 224 else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Matrix must be factored to solve"); 225 ierr = VecRestoreArray(xx,&x);CHKERRQ(ierr); 226 ierr = VecRestoreArray(yy,&y);CHKERRQ(ierr); 227 ierr = PetscLogFlops(2.0*A->cmap->n*A->cmap->n - A->cmap->n);CHKERRQ(ierr); 228 PetscFunctionReturn(0); 229 } 230 231 #undef __FUNCT__ 232 #define __FUNCT__ "MatMatSolve_SeqDense" 233 PetscErrorCode MatMatSolve_SeqDense(Mat A,Mat B,Mat X) 234 { 235 Mat_SeqDense *mat = (Mat_SeqDense*)A->data; 236 PetscErrorCode ierr; 237 PetscScalar *b,*x; 238 PetscInt n; 239 PetscBLASInt nrhs,info,m; 240 PetscBool flg; 241 242 PetscFunctionBegin; 243 m = PetscBLASIntCast(A->rmap->n); 244 ierr = PetscObjectTypeCompareAny((PetscObject)B,&flg,MATSEQDENSE,MATMPIDENSE,PETSC_NULL);CHKERRQ(ierr); 245 if (!flg) SETERRQ(((PetscObject)A)->comm,PETSC_ERR_ARG_WRONG,"Matrix B must be MATDENSE matrix"); 246 ierr = PetscObjectTypeCompareAny((PetscObject)X,&flg,MATSEQDENSE,MATMPIDENSE,PETSC_NULL);CHKERRQ(ierr); 247 if (!flg) SETERRQ(((PetscObject)A)->comm,PETSC_ERR_ARG_WRONG,"Matrix X must be MATDENSE matrix"); 248 249 ierr = MatGetSize(B,PETSC_NULL,&n);CHKERRQ(ierr); 250 nrhs = PetscBLASIntCast(n); 251 ierr = MatGetArray(B,&b);CHKERRQ(ierr); 252 ierr = MatGetArray(X,&x);CHKERRQ(ierr); 253 254 ierr = PetscMemcpy(x,b,m*nrhs*sizeof(PetscScalar));CHKERRQ(ierr); 255 256 if (A->factortype == MAT_FACTOR_LU) { 257 #if defined(PETSC_MISSING_LAPACK_GETRS) 258 SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"GETRS - Lapack routine is unavailable."); 259 #else 260 LAPACKgetrs_("N",&m,&nrhs,mat->v,&mat->lda,mat->pivots,x,&m,&info); 261 if (info) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"GETRS - Bad solve"); 262 #endif 263 } else if (A->factortype == MAT_FACTOR_CHOLESKY){ 264 #if defined(PETSC_MISSING_LAPACK_POTRS) 265 SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"POTRS - Lapack routine is unavailable."); 266 #else 267 LAPACKpotrs_("L",&m,&nrhs,mat->v,&mat->lda,x,&m,&info); 268 if (info) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"POTRS Bad solve"); 269 #endif 270 } 271 else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Matrix must be factored to solve"); 272 273 ierr = MatRestoreArray(B,&b);CHKERRQ(ierr); 274 ierr = MatRestoreArray(X,&x);CHKERRQ(ierr); 275 ierr = PetscLogFlops(nrhs*(2.0*m*m - m));CHKERRQ(ierr); 276 PetscFunctionReturn(0); 277 } 278 279 #undef __FUNCT__ 280 #define __FUNCT__ "MatSolveTranspose_SeqDense" 281 PetscErrorCode MatSolveTranspose_SeqDense(Mat A,Vec xx,Vec yy) 282 { 283 Mat_SeqDense *mat = (Mat_SeqDense*)A->data; 284 PetscErrorCode ierr; 285 PetscScalar *x,*y; 286 PetscBLASInt one = 1,info,m = PetscBLASIntCast(A->rmap->n); 287 288 PetscFunctionBegin; 289 ierr = VecGetArray(xx,&x);CHKERRQ(ierr); 290 ierr = VecGetArray(yy,&y);CHKERRQ(ierr); 291 ierr = PetscMemcpy(y,x,A->rmap->n*sizeof(PetscScalar));CHKERRQ(ierr); 292 /* assume if pivots exist then use LU; else Cholesky */ 293 if (mat->pivots) { 294 #if defined(PETSC_MISSING_LAPACK_GETRS) 295 SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"GETRS - Lapack routine is unavailable."); 296 #else 297 LAPACKgetrs_("T",&m,&one,mat->v,&mat->lda,mat->pivots,y,&m,&info); 298 if (info) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"POTRS - Bad solve"); 299 #endif 300 } else { 301 #if defined(PETSC_MISSING_LAPACK_POTRS) 302 SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"POTRS - Lapack routine is unavailable."); 303 #else 304 LAPACKpotrs_("L",&m,&one,mat->v,&mat->lda,y,&m,&info); 305 if (info) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"POTRS - Bad solve"); 306 #endif 307 } 308 ierr = VecRestoreArray(xx,&x);CHKERRQ(ierr); 309 ierr = VecRestoreArray(yy,&y);CHKERRQ(ierr); 310 ierr = PetscLogFlops(2.0*A->cmap->n*A->cmap->n - A->cmap->n);CHKERRQ(ierr); 311 PetscFunctionReturn(0); 312 } 313 314 #undef __FUNCT__ 315 #define __FUNCT__ "MatSolveAdd_SeqDense" 316 PetscErrorCode MatSolveAdd_SeqDense(Mat A,Vec xx,Vec zz,Vec yy) 317 { 318 Mat_SeqDense *mat = (Mat_SeqDense*)A->data; 319 PetscErrorCode ierr; 320 PetscScalar *x,*y,sone = 1.0; 321 Vec tmp = 0; 322 PetscBLASInt one = 1,info,m = PetscBLASIntCast(A->rmap->n); 323 324 PetscFunctionBegin; 325 ierr = VecGetArray(xx,&x);CHKERRQ(ierr); 326 ierr = VecGetArray(yy,&y);CHKERRQ(ierr); 327 if (!A->rmap->n || !A->cmap->n) PetscFunctionReturn(0); 328 if (yy == zz) { 329 ierr = VecDuplicate(yy,&tmp);CHKERRQ(ierr); 330 ierr = PetscLogObjectParent(A,tmp);CHKERRQ(ierr); 331 ierr = VecCopy(yy,tmp);CHKERRQ(ierr); 332 } 333 ierr = PetscMemcpy(y,x,A->rmap->n*sizeof(PetscScalar));CHKERRQ(ierr); 334 /* assume if pivots exist then use LU; else Cholesky */ 335 if (mat->pivots) { 336 #if defined(PETSC_MISSING_LAPACK_GETRS) 337 SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"GETRS - Lapack routine is unavailable."); 338 #else 339 LAPACKgetrs_("N",&m,&one,mat->v,&mat->lda,mat->pivots,y,&m,&info); 340 if (info) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"Bad solve"); 341 #endif 342 } else { 343 #if defined(PETSC_MISSING_LAPACK_POTRS) 344 SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"POTRS - Lapack routine is unavailable."); 345 #else 346 LAPACKpotrs_("L",&m,&one,mat->v,&mat->lda,y,&m,&info); 347 if (info) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"Bad solve"); 348 #endif 349 } 350 if (tmp) { 351 ierr = VecAXPY(yy,sone,tmp);CHKERRQ(ierr); 352 ierr = VecDestroy(&tmp);CHKERRQ(ierr); 353 } else { 354 ierr = VecAXPY(yy,sone,zz);CHKERRQ(ierr); 355 } 356 ierr = VecRestoreArray(xx,&x);CHKERRQ(ierr); 357 ierr = VecRestoreArray(yy,&y);CHKERRQ(ierr); 358 ierr = PetscLogFlops(2.0*A->cmap->n*A->cmap->n);CHKERRQ(ierr); 359 PetscFunctionReturn(0); 360 } 361 362 #undef __FUNCT__ 363 #define __FUNCT__ "MatSolveTransposeAdd_SeqDense" 364 PetscErrorCode MatSolveTransposeAdd_SeqDense(Mat A,Vec xx,Vec zz,Vec yy) 365 { 366 Mat_SeqDense *mat = (Mat_SeqDense*)A->data; 367 PetscErrorCode ierr; 368 PetscScalar *x,*y,sone = 1.0; 369 Vec tmp; 370 PetscBLASInt one = 1,info,m = PetscBLASIntCast(A->rmap->n); 371 372 PetscFunctionBegin; 373 if (!A->rmap->n || !A->cmap->n) PetscFunctionReturn(0); 374 ierr = VecGetArray(xx,&x);CHKERRQ(ierr); 375 ierr = VecGetArray(yy,&y);CHKERRQ(ierr); 376 if (yy == zz) { 377 ierr = VecDuplicate(yy,&tmp);CHKERRQ(ierr); 378 ierr = PetscLogObjectParent(A,tmp);CHKERRQ(ierr); 379 ierr = VecCopy(yy,tmp);CHKERRQ(ierr); 380 } 381 ierr = PetscMemcpy(y,x,A->rmap->n*sizeof(PetscScalar));CHKERRQ(ierr); 382 /* assume if pivots exist then use LU; else Cholesky */ 383 if (mat->pivots) { 384 #if defined(PETSC_MISSING_LAPACK_GETRS) 385 SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"GETRS - Lapack routine is unavailable."); 386 #else 387 LAPACKgetrs_("T",&m,&one,mat->v,&mat->lda,mat->pivots,y,&m,&info); 388 if (info) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"Bad solve"); 389 #endif 390 } else { 391 #if defined(PETSC_MISSING_LAPACK_POTRS) 392 SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"POTRS - Lapack routine is unavailable."); 393 #else 394 LAPACKpotrs_("L",&m,&one,mat->v,&mat->lda,y,&m,&info); 395 if (info) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"Bad solve"); 396 #endif 397 } 398 if (tmp) { 399 ierr = VecAXPY(yy,sone,tmp);CHKERRQ(ierr); 400 ierr = VecDestroy(&tmp);CHKERRQ(ierr); 401 } else { 402 ierr = VecAXPY(yy,sone,zz);CHKERRQ(ierr); 403 } 404 ierr = VecRestoreArray(xx,&x);CHKERRQ(ierr); 405 ierr = VecRestoreArray(yy,&y);CHKERRQ(ierr); 406 ierr = PetscLogFlops(2.0*A->cmap->n*A->cmap->n);CHKERRQ(ierr); 407 PetscFunctionReturn(0); 408 } 409 410 /* ---------------------------------------------------------------*/ 411 /* COMMENT: I have chosen to hide row permutation in the pivots, 412 rather than put it in the Mat->row slot.*/ 413 #undef __FUNCT__ 414 #define __FUNCT__ "MatLUFactor_SeqDense" 415 PetscErrorCode MatLUFactor_SeqDense(Mat A,IS row,IS col,const MatFactorInfo *minfo) 416 { 417 #if defined(PETSC_MISSING_LAPACK_GETRF) 418 PetscFunctionBegin; 419 SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"GETRF - Lapack routine is unavailable."); 420 #else 421 Mat_SeqDense *mat = (Mat_SeqDense*)A->data; 422 PetscErrorCode ierr; 423 PetscBLASInt n,m,info; 424 425 PetscFunctionBegin; 426 n = PetscBLASIntCast(A->cmap->n); 427 m = PetscBLASIntCast(A->rmap->n); 428 if (!mat->pivots) { 429 ierr = PetscMalloc((A->rmap->n+1)*sizeof(PetscBLASInt),&mat->pivots);CHKERRQ(ierr); 430 ierr = PetscLogObjectMemory(A,A->rmap->n*sizeof(PetscBLASInt));CHKERRQ(ierr); 431 } 432 if (!A->rmap->n || !A->cmap->n) PetscFunctionReturn(0); 433 ierr = PetscFPTrapPush(PETSC_FP_TRAP_OFF);CHKERRQ(ierr); 434 LAPACKgetrf_(&m,&n,mat->v,&mat->lda,mat->pivots,&info); 435 ierr = PetscFPTrapPop();CHKERRQ(ierr); 436 437 if (info<0) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_LIB,"Bad argument to LU factorization"); 438 if (info>0) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MAT_LU_ZRPVT,"Bad LU factorization"); 439 A->ops->solve = MatSolve_SeqDense; 440 A->ops->solvetranspose = MatSolveTranspose_SeqDense; 441 A->ops->solveadd = MatSolveAdd_SeqDense; 442 A->ops->solvetransposeadd = MatSolveTransposeAdd_SeqDense; 443 A->factortype = MAT_FACTOR_LU; 444 445 ierr = PetscLogFlops((2.0*A->cmap->n*A->cmap->n*A->cmap->n)/3);CHKERRQ(ierr); 446 #endif 447 PetscFunctionReturn(0); 448 } 449 450 #undef __FUNCT__ 451 #define __FUNCT__ "MatCholeskyFactor_SeqDense" 452 PetscErrorCode MatCholeskyFactor_SeqDense(Mat A,IS perm,const MatFactorInfo *factinfo) 453 { 454 #if defined(PETSC_MISSING_LAPACK_POTRF) 455 PetscFunctionBegin; 456 SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"POTRF - Lapack routine is unavailable."); 457 #else 458 Mat_SeqDense *mat = (Mat_SeqDense*)A->data; 459 PetscErrorCode ierr; 460 PetscBLASInt info,n = PetscBLASIntCast(A->cmap->n); 461 462 PetscFunctionBegin; 463 ierr = PetscFree(mat->pivots);CHKERRQ(ierr); 464 465 if (!A->rmap->n || !A->cmap->n) PetscFunctionReturn(0); 466 LAPACKpotrf_("L",&n,mat->v,&mat->lda,&info); 467 if (info) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_MAT_CH_ZRPVT,"Bad factorization: zero pivot in row %D",(PetscInt)info-1); 468 A->ops->solve = MatSolve_SeqDense; 469 A->ops->solvetranspose = MatSolveTranspose_SeqDense; 470 A->ops->solveadd = MatSolveAdd_SeqDense; 471 A->ops->solvetransposeadd = MatSolveTransposeAdd_SeqDense; 472 A->factortype = MAT_FACTOR_CHOLESKY; 473 ierr = PetscLogFlops((A->cmap->n*A->cmap->n*A->cmap->n)/3.0);CHKERRQ(ierr); 474 #endif 475 PetscFunctionReturn(0); 476 } 477 478 479 #undef __FUNCT__ 480 #define __FUNCT__ "MatCholeskyFactorNumeric_SeqDense" 481 PetscErrorCode MatCholeskyFactorNumeric_SeqDense(Mat fact,Mat A,const MatFactorInfo *info_dummy) 482 { 483 PetscErrorCode ierr; 484 MatFactorInfo info; 485 486 PetscFunctionBegin; 487 info.fill = 1.0; 488 ierr = MatDuplicateNoCreate_SeqDense(fact,A,MAT_COPY_VALUES);CHKERRQ(ierr); 489 ierr = MatCholeskyFactor_SeqDense(fact,0,&info);CHKERRQ(ierr); 490 PetscFunctionReturn(0); 491 } 492 493 #undef __FUNCT__ 494 #define __FUNCT__ "MatCholeskyFactorSymbolic_SeqDense" 495 PetscErrorCode MatCholeskyFactorSymbolic_SeqDense(Mat fact,Mat A,IS row,const MatFactorInfo *info) 496 { 497 PetscFunctionBegin; 498 fact->assembled = PETSC_TRUE; 499 fact->preallocated = PETSC_TRUE; 500 fact->ops->choleskyfactornumeric = MatCholeskyFactorNumeric_SeqDense; 501 PetscFunctionReturn(0); 502 } 503 504 #undef __FUNCT__ 505 #define __FUNCT__ "MatLUFactorSymbolic_SeqDense" 506 PetscErrorCode MatLUFactorSymbolic_SeqDense(Mat fact,Mat A,IS row,IS col,const MatFactorInfo *info) 507 { 508 PetscFunctionBegin; 509 fact->preallocated = PETSC_TRUE; 510 fact->assembled = PETSC_TRUE; 511 fact->ops->lufactornumeric = MatLUFactorNumeric_SeqDense; 512 PetscFunctionReturn(0); 513 } 514 515 EXTERN_C_BEGIN 516 #undef __FUNCT__ 517 #define __FUNCT__ "MatGetFactor_seqdense_petsc" 518 PetscErrorCode MatGetFactor_seqdense_petsc(Mat A,MatFactorType ftype,Mat *fact) 519 { 520 PetscErrorCode ierr; 521 522 PetscFunctionBegin; 523 ierr = MatCreate(((PetscObject)A)->comm,fact);CHKERRQ(ierr); 524 ierr = MatSetSizes(*fact,A->rmap->n,A->cmap->n,A->rmap->n,A->cmap->n);CHKERRQ(ierr); 525 ierr = MatSetType(*fact,((PetscObject)A)->type_name);CHKERRQ(ierr); 526 if (ftype == MAT_FACTOR_LU){ 527 (*fact)->ops->lufactorsymbolic = MatLUFactorSymbolic_SeqDense; 528 } else { 529 (*fact)->ops->choleskyfactorsymbolic = MatCholeskyFactorSymbolic_SeqDense; 530 } 531 (*fact)->factortype = ftype; 532 PetscFunctionReturn(0); 533 } 534 EXTERN_C_END 535 536 /* ------------------------------------------------------------------*/ 537 #undef __FUNCT__ 538 #define __FUNCT__ "MatSOR_SeqDense" 539 PetscErrorCode MatSOR_SeqDense(Mat A,Vec bb,PetscReal omega,MatSORType flag,PetscReal shift,PetscInt its,PetscInt lits,Vec xx) 540 { 541 Mat_SeqDense *mat = (Mat_SeqDense*)A->data; 542 PetscScalar *x,*b,*v = mat->v,zero = 0.0,xt; 543 PetscErrorCode ierr; 544 PetscInt m = A->rmap->n,i; 545 PetscBLASInt o = 1,bm = PetscBLASIntCast(m); 546 547 PetscFunctionBegin; 548 if (flag & SOR_ZERO_INITIAL_GUESS) { 549 /* this is a hack fix, should have another version without the second BLASdot */ 550 ierr = VecSet(xx,zero);CHKERRQ(ierr); 551 } 552 ierr = VecGetArray(xx,&x);CHKERRQ(ierr); 553 ierr = VecGetArray(bb,&b);CHKERRQ(ierr); 554 its = its*lits; 555 if (its <= 0) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Relaxation requires global its %D and local its %D both positive",its,lits); 556 while (its--) { 557 if (flag & SOR_FORWARD_SWEEP || flag & SOR_LOCAL_FORWARD_SWEEP){ 558 for (i=0; i<m; i++) { 559 xt = b[i] - BLASdot_(&bm,v+i,&bm,x,&o); 560 x[i] = (1. - omega)*x[i] + omega*(xt+v[i + i*m]*x[i])/(v[i + i*m]+shift); 561 } 562 } 563 if (flag & SOR_BACKWARD_SWEEP || flag & SOR_LOCAL_BACKWARD_SWEEP){ 564 for (i=m-1; i>=0; i--) { 565 xt = b[i] - BLASdot_(&bm,v+i,&bm,x,&o); 566 x[i] = (1. - omega)*x[i] + omega*(xt+v[i + i*m]*x[i])/(v[i + i*m]+shift); 567 } 568 } 569 } 570 ierr = VecRestoreArray(bb,&b);CHKERRQ(ierr); 571 ierr = VecRestoreArray(xx,&x);CHKERRQ(ierr); 572 PetscFunctionReturn(0); 573 } 574 575 /* -----------------------------------------------------------------*/ 576 #undef __FUNCT__ 577 #define __FUNCT__ "MatMultTranspose_SeqDense" 578 PetscErrorCode MatMultTranspose_SeqDense(Mat A,Vec xx,Vec yy) 579 { 580 Mat_SeqDense *mat = (Mat_SeqDense*)A->data; 581 PetscScalar *v = mat->v,*x,*y; 582 PetscErrorCode ierr; 583 PetscBLASInt m, n,_One=1; 584 PetscScalar _DOne=1.0,_DZero=0.0; 585 586 PetscFunctionBegin; 587 m = PetscBLASIntCast(A->rmap->n); 588 n = PetscBLASIntCast(A->cmap->n); 589 if (!A->rmap->n || !A->cmap->n) PetscFunctionReturn(0); 590 ierr = VecGetArray(xx,&x);CHKERRQ(ierr); 591 ierr = VecGetArray(yy,&y);CHKERRQ(ierr); 592 BLASgemv_("T",&m,&n,&_DOne,v,&mat->lda,x,&_One,&_DZero,y,&_One); 593 ierr = VecRestoreArray(xx,&x);CHKERRQ(ierr); 594 ierr = VecRestoreArray(yy,&y);CHKERRQ(ierr); 595 ierr = PetscLogFlops(2.0*A->rmap->n*A->cmap->n - A->cmap->n);CHKERRQ(ierr); 596 PetscFunctionReturn(0); 597 } 598 599 #undef __FUNCT__ 600 #define __FUNCT__ "MatMult_SeqDense" 601 PetscErrorCode MatMult_SeqDense(Mat A,Vec xx,Vec yy) 602 { 603 Mat_SeqDense *mat = (Mat_SeqDense*)A->data; 604 PetscScalar *v = mat->v,*x,*y,_DOne=1.0,_DZero=0.0; 605 PetscErrorCode ierr; 606 PetscBLASInt m, n, _One=1; 607 608 PetscFunctionBegin; 609 m = PetscBLASIntCast(A->rmap->n); 610 n = PetscBLASIntCast(A->cmap->n); 611 if (!A->rmap->n || !A->cmap->n) PetscFunctionReturn(0); 612 ierr = VecGetArray(xx,&x);CHKERRQ(ierr); 613 ierr = VecGetArray(yy,&y);CHKERRQ(ierr); 614 BLASgemv_("N",&m,&n,&_DOne,v,&(mat->lda),x,&_One,&_DZero,y,&_One); 615 ierr = VecRestoreArray(xx,&x);CHKERRQ(ierr); 616 ierr = VecRestoreArray(yy,&y);CHKERRQ(ierr); 617 ierr = PetscLogFlops(2.0*A->rmap->n*A->cmap->n - A->rmap->n);CHKERRQ(ierr); 618 PetscFunctionReturn(0); 619 } 620 621 #undef __FUNCT__ 622 #define __FUNCT__ "MatMultAdd_SeqDense" 623 PetscErrorCode MatMultAdd_SeqDense(Mat A,Vec xx,Vec zz,Vec yy) 624 { 625 Mat_SeqDense *mat = (Mat_SeqDense*)A->data; 626 PetscScalar *v = mat->v,*x,*y,_DOne=1.0; 627 PetscErrorCode ierr; 628 PetscBLASInt m, n, _One=1; 629 630 PetscFunctionBegin; 631 m = PetscBLASIntCast(A->rmap->n); 632 n = PetscBLASIntCast(A->cmap->n); 633 if (!A->rmap->n || !A->cmap->n) PetscFunctionReturn(0); 634 if (zz != yy) {ierr = VecCopy(zz,yy);CHKERRQ(ierr);} 635 ierr = VecGetArray(xx,&x);CHKERRQ(ierr); 636 ierr = VecGetArray(yy,&y);CHKERRQ(ierr); 637 BLASgemv_("N",&m,&n,&_DOne,v,&(mat->lda),x,&_One,&_DOne,y,&_One); 638 ierr = VecRestoreArray(xx,&x);CHKERRQ(ierr); 639 ierr = VecRestoreArray(yy,&y);CHKERRQ(ierr); 640 ierr = PetscLogFlops(2.0*A->rmap->n*A->cmap->n);CHKERRQ(ierr); 641 PetscFunctionReturn(0); 642 } 643 644 #undef __FUNCT__ 645 #define __FUNCT__ "MatMultTransposeAdd_SeqDense" 646 PetscErrorCode MatMultTransposeAdd_SeqDense(Mat A,Vec xx,Vec zz,Vec yy) 647 { 648 Mat_SeqDense *mat = (Mat_SeqDense*)A->data; 649 PetscScalar *v = mat->v,*x,*y; 650 PetscErrorCode ierr; 651 PetscBLASInt m, n, _One=1; 652 PetscScalar _DOne=1.0; 653 654 PetscFunctionBegin; 655 m = PetscBLASIntCast(A->rmap->n); 656 n = PetscBLASIntCast(A->cmap->n); 657 if (!A->rmap->n || !A->cmap->n) PetscFunctionReturn(0); 658 if (zz != yy) {ierr = VecCopy(zz,yy);CHKERRQ(ierr);} 659 ierr = VecGetArray(xx,&x);CHKERRQ(ierr); 660 ierr = VecGetArray(yy,&y);CHKERRQ(ierr); 661 BLASgemv_("T",&m,&n,&_DOne,v,&(mat->lda),x,&_One,&_DOne,y,&_One); 662 ierr = VecRestoreArray(xx,&x);CHKERRQ(ierr); 663 ierr = VecRestoreArray(yy,&y);CHKERRQ(ierr); 664 ierr = PetscLogFlops(2.0*A->rmap->n*A->cmap->n);CHKERRQ(ierr); 665 PetscFunctionReturn(0); 666 } 667 668 /* -----------------------------------------------------------------*/ 669 #undef __FUNCT__ 670 #define __FUNCT__ "MatGetRow_SeqDense" 671 PetscErrorCode MatGetRow_SeqDense(Mat A,PetscInt row,PetscInt *ncols,PetscInt **cols,PetscScalar **vals) 672 { 673 Mat_SeqDense *mat = (Mat_SeqDense*)A->data; 674 PetscScalar *v; 675 PetscErrorCode ierr; 676 PetscInt i; 677 678 PetscFunctionBegin; 679 *ncols = A->cmap->n; 680 if (cols) { 681 ierr = PetscMalloc((A->cmap->n+1)*sizeof(PetscInt),cols);CHKERRQ(ierr); 682 for (i=0; i<A->cmap->n; i++) (*cols)[i] = i; 683 } 684 if (vals) { 685 ierr = PetscMalloc((A->cmap->n+1)*sizeof(PetscScalar),vals);CHKERRQ(ierr); 686 v = mat->v + row; 687 for (i=0; i<A->cmap->n; i++) {(*vals)[i] = *v; v += mat->lda;} 688 } 689 PetscFunctionReturn(0); 690 } 691 692 #undef __FUNCT__ 693 #define __FUNCT__ "MatRestoreRow_SeqDense" 694 PetscErrorCode MatRestoreRow_SeqDense(Mat A,PetscInt row,PetscInt *ncols,PetscInt **cols,PetscScalar **vals) 695 { 696 PetscErrorCode ierr; 697 PetscFunctionBegin; 698 if (cols) {ierr = PetscFree(*cols);CHKERRQ(ierr);} 699 if (vals) {ierr = PetscFree(*vals);CHKERRQ(ierr); } 700 PetscFunctionReturn(0); 701 } 702 /* ----------------------------------------------------------------*/ 703 #undef __FUNCT__ 704 #define __FUNCT__ "MatSetValues_SeqDense" 705 PetscErrorCode MatSetValues_SeqDense(Mat A,PetscInt m,const PetscInt indexm[],PetscInt n,const PetscInt indexn[],const PetscScalar v[],InsertMode addv) 706 { 707 Mat_SeqDense *mat = (Mat_SeqDense*)A->data; 708 PetscInt i,j,idx=0; 709 710 PetscFunctionBegin; 711 if (v) PetscValidScalarPointer(v,6); 712 if (!mat->roworiented) { 713 if (addv == INSERT_VALUES) { 714 for (j=0; j<n; j++) { 715 if (indexn[j] < 0) {idx += m; continue;} 716 #if defined(PETSC_USE_DEBUG) 717 if (indexn[j] >= A->cmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Column too large: col %D max %D",indexn[j],A->cmap->n-1); 718 #endif 719 for (i=0; i<m; i++) { 720 if (indexm[i] < 0) {idx++; continue;} 721 #if defined(PETSC_USE_DEBUG) 722 if (indexm[i] >= A->rmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Row too large: row %D max %D",indexm[i],A->rmap->n-1); 723 #endif 724 mat->v[indexn[j]*mat->lda + indexm[i]] = v[idx++]; 725 } 726 } 727 } else { 728 for (j=0; j<n; j++) { 729 if (indexn[j] < 0) {idx += m; continue;} 730 #if defined(PETSC_USE_DEBUG) 731 if (indexn[j] >= A->cmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Column too large: col %D max %D",indexn[j],A->cmap->n-1); 732 #endif 733 for (i=0; i<m; i++) { 734 if (indexm[i] < 0) {idx++; continue;} 735 #if defined(PETSC_USE_DEBUG) 736 if (indexm[i] >= A->rmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Row too large: row %D max %D",indexm[i],A->rmap->n-1); 737 #endif 738 mat->v[indexn[j]*mat->lda + indexm[i]] += v[idx++]; 739 } 740 } 741 } 742 } else { 743 if (addv == INSERT_VALUES) { 744 for (i=0; i<m; i++) { 745 if (indexm[i] < 0) { idx += n; continue;} 746 #if defined(PETSC_USE_DEBUG) 747 if (indexm[i] >= A->rmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Row too large: row %D max %D",indexm[i],A->rmap->n-1); 748 #endif 749 for (j=0; j<n; j++) { 750 if (indexn[j] < 0) { idx++; continue;} 751 #if defined(PETSC_USE_DEBUG) 752 if (indexn[j] >= A->cmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Column too large: col %D max %D",indexn[j],A->cmap->n-1); 753 #endif 754 mat->v[indexn[j]*mat->lda + indexm[i]] = v[idx++]; 755 } 756 } 757 } else { 758 for (i=0; i<m; i++) { 759 if (indexm[i] < 0) { idx += n; continue;} 760 #if defined(PETSC_USE_DEBUG) 761 if (indexm[i] >= A->rmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Row too large: row %D max %D",indexm[i],A->rmap->n-1); 762 #endif 763 for (j=0; j<n; j++) { 764 if (indexn[j] < 0) { idx++; continue;} 765 #if defined(PETSC_USE_DEBUG) 766 if (indexn[j] >= A->cmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Column too large: col %D max %D",indexn[j],A->cmap->n-1); 767 #endif 768 mat->v[indexn[j]*mat->lda + indexm[i]] += v[idx++]; 769 } 770 } 771 } 772 } 773 PetscFunctionReturn(0); 774 } 775 776 #undef __FUNCT__ 777 #define __FUNCT__ "MatGetValues_SeqDense" 778 PetscErrorCode MatGetValues_SeqDense(Mat A,PetscInt m,const PetscInt indexm[],PetscInt n,const PetscInt indexn[],PetscScalar v[]) 779 { 780 Mat_SeqDense *mat = (Mat_SeqDense*)A->data; 781 PetscInt i,j; 782 783 PetscFunctionBegin; 784 /* row-oriented output */ 785 for (i=0; i<m; i++) { 786 if (indexm[i] < 0) {v += n;continue;} 787 if (indexm[i] >= A->rmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Row %D requested larger than number rows %D",indexm[i],A->rmap->n); 788 for (j=0; j<n; j++) { 789 if (indexn[j] < 0) {v++; continue;} 790 if (indexn[j] >= A->cmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Column %D requested larger than number columns %D",indexn[j],A->cmap->n); 791 *v++ = mat->v[indexn[j]*mat->lda + indexm[i]]; 792 } 793 } 794 PetscFunctionReturn(0); 795 } 796 797 /* -----------------------------------------------------------------*/ 798 799 #undef __FUNCT__ 800 #define __FUNCT__ "MatLoad_SeqDense" 801 PetscErrorCode MatLoad_SeqDense(Mat newmat,PetscViewer viewer) 802 { 803 Mat_SeqDense *a; 804 PetscErrorCode ierr; 805 PetscInt *scols,i,j,nz,header[4]; 806 int fd; 807 PetscMPIInt size; 808 PetscInt *rowlengths = 0,M,N,*cols,grows,gcols; 809 PetscScalar *vals,*svals,*v,*w; 810 MPI_Comm comm = ((PetscObject)viewer)->comm; 811 812 PetscFunctionBegin; 813 ierr = MPI_Comm_size(comm,&size);CHKERRQ(ierr); 814 if (size > 1) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"view must have one processor"); 815 ierr = PetscViewerBinaryGetDescriptor(viewer,&fd);CHKERRQ(ierr); 816 ierr = PetscBinaryRead(fd,header,4,PETSC_INT);CHKERRQ(ierr); 817 if (header[0] != MAT_FILE_CLASSID) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_FILE_UNEXPECTED,"Not matrix object"); 818 M = header[1]; N = header[2]; nz = header[3]; 819 820 /* set global size if not set already*/ 821 if (newmat->rmap->n < 0 && newmat->rmap->N < 0 && newmat->cmap->n < 0 && newmat->cmap->N < 0) { 822 ierr = MatSetSizes(newmat,M,N,M,N);CHKERRQ(ierr); 823 } else { 824 /* if sizes and type are already set, check if the vector global sizes are correct */ 825 ierr = MatGetSize(newmat,&grows,&gcols);CHKERRQ(ierr); 826 if (M != grows || N != gcols) SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_FILE_UNEXPECTED, "Matrix in file of different length (%d, %d) than the input matrix (%d, %d)",M,N,grows,gcols); 827 } 828 ierr = MatSeqDenseSetPreallocation(newmat,PETSC_NULL);CHKERRQ(ierr); 829 830 if (nz == MATRIX_BINARY_FORMAT_DENSE) { /* matrix in file is dense */ 831 a = (Mat_SeqDense*)newmat->data; 832 v = a->v; 833 /* Allocate some temp space to read in the values and then flip them 834 from row major to column major */ 835 ierr = PetscMalloc((M*N > 0 ? M*N : 1)*sizeof(PetscScalar),&w);CHKERRQ(ierr); 836 /* read in nonzero values */ 837 ierr = PetscBinaryRead(fd,w,M*N,PETSC_SCALAR);CHKERRQ(ierr); 838 /* now flip the values and store them in the matrix*/ 839 for (j=0; j<N; j++) { 840 for (i=0; i<M; i++) { 841 *v++ =w[i*N+j]; 842 } 843 } 844 ierr = PetscFree(w);CHKERRQ(ierr); 845 } else { 846 /* read row lengths */ 847 ierr = PetscMalloc((M+1)*sizeof(PetscInt),&rowlengths);CHKERRQ(ierr); 848 ierr = PetscBinaryRead(fd,rowlengths,M,PETSC_INT);CHKERRQ(ierr); 849 850 a = (Mat_SeqDense*)newmat->data; 851 v = a->v; 852 853 /* read column indices and nonzeros */ 854 ierr = PetscMalloc((nz+1)*sizeof(PetscInt),&scols);CHKERRQ(ierr); 855 cols = scols; 856 ierr = PetscBinaryRead(fd,cols,nz,PETSC_INT);CHKERRQ(ierr); 857 ierr = PetscMalloc((nz+1)*sizeof(PetscScalar),&svals);CHKERRQ(ierr); 858 vals = svals; 859 ierr = PetscBinaryRead(fd,vals,nz,PETSC_SCALAR);CHKERRQ(ierr); 860 861 /* insert into matrix */ 862 for (i=0; i<M; i++) { 863 for (j=0; j<rowlengths[i]; j++) v[i+M*scols[j]] = svals[j]; 864 svals += rowlengths[i]; scols += rowlengths[i]; 865 } 866 ierr = PetscFree(vals);CHKERRQ(ierr); 867 ierr = PetscFree(cols);CHKERRQ(ierr); 868 ierr = PetscFree(rowlengths);CHKERRQ(ierr); 869 } 870 ierr = MatAssemblyBegin(newmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 871 ierr = MatAssemblyEnd(newmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 872 873 PetscFunctionReturn(0); 874 } 875 876 #undef __FUNCT__ 877 #define __FUNCT__ "MatView_SeqDense_ASCII" 878 static PetscErrorCode MatView_SeqDense_ASCII(Mat A,PetscViewer viewer) 879 { 880 Mat_SeqDense *a = (Mat_SeqDense*)A->data; 881 PetscErrorCode ierr; 882 PetscInt i,j; 883 const char *name; 884 PetscScalar *v; 885 PetscViewerFormat format; 886 #if defined(PETSC_USE_COMPLEX) 887 PetscBool allreal = PETSC_TRUE; 888 #endif 889 890 PetscFunctionBegin; 891 ierr = PetscViewerGetFormat(viewer,&format);CHKERRQ(ierr); 892 if (format == PETSC_VIEWER_ASCII_INFO || format == PETSC_VIEWER_ASCII_INFO_DETAIL) { 893 PetscFunctionReturn(0); /* do nothing for now */ 894 } else if (format == PETSC_VIEWER_ASCII_COMMON) { 895 ierr = PetscViewerASCIIUseTabs(viewer,PETSC_FALSE);CHKERRQ(ierr); 896 ierr = PetscObjectPrintClassNamePrefixType((PetscObject)A,viewer,"Matrix Object");CHKERRQ(ierr); 897 for (i=0; i<A->rmap->n; i++) { 898 v = a->v + i; 899 ierr = PetscViewerASCIIPrintf(viewer,"row %D:",i);CHKERRQ(ierr); 900 for (j=0; j<A->cmap->n; j++) { 901 #if defined(PETSC_USE_COMPLEX) 902 if (PetscRealPart(*v) != 0.0 && PetscImaginaryPart(*v) != 0.0) { 903 ierr = PetscViewerASCIIPrintf(viewer," (%D, %G + %G i) ",j,PetscRealPart(*v),PetscImaginaryPart(*v));CHKERRQ(ierr); 904 } else if (PetscRealPart(*v)) { 905 ierr = PetscViewerASCIIPrintf(viewer," (%D, %G) ",j,PetscRealPart(*v));CHKERRQ(ierr); 906 } 907 #else 908 if (*v) { 909 ierr = PetscViewerASCIIPrintf(viewer," (%D, %G) ",j,*v);CHKERRQ(ierr); 910 } 911 #endif 912 v += a->lda; 913 } 914 ierr = PetscViewerASCIIPrintf(viewer,"\n");CHKERRQ(ierr); 915 } 916 ierr = PetscViewerASCIIUseTabs(viewer,PETSC_TRUE);CHKERRQ(ierr); 917 } else { 918 ierr = PetscViewerASCIIUseTabs(viewer,PETSC_FALSE);CHKERRQ(ierr); 919 #if defined(PETSC_USE_COMPLEX) 920 /* determine if matrix has all real values */ 921 v = a->v; 922 for (i=0; i<A->rmap->n*A->cmap->n; i++) { 923 if (PetscImaginaryPart(v[i])) { allreal = PETSC_FALSE; break ;} 924 } 925 #endif 926 if (format == PETSC_VIEWER_ASCII_MATLAB) { 927 ierr = PetscObjectGetName((PetscObject)A,&name);CHKERRQ(ierr); 928 ierr = PetscViewerASCIIPrintf(viewer,"%% Size = %D %D \n",A->rmap->n,A->cmap->n);CHKERRQ(ierr); 929 ierr = PetscViewerASCIIPrintf(viewer,"%s = zeros(%D,%D);\n",name,A->rmap->n,A->cmap->n);CHKERRQ(ierr); 930 ierr = PetscViewerASCIIPrintf(viewer,"%s = [\n",name);CHKERRQ(ierr); 931 } else { 932 ierr = PetscObjectPrintClassNamePrefixType((PetscObject)A,viewer,"Matrix Object");CHKERRQ(ierr); 933 } 934 935 for (i=0; i<A->rmap->n; i++) { 936 v = a->v + i; 937 for (j=0; j<A->cmap->n; j++) { 938 #if defined(PETSC_USE_COMPLEX) 939 if (allreal) { 940 ierr = PetscViewerASCIIPrintf(viewer,"%18.16e ",(double)PetscRealPart(*v));CHKERRQ(ierr); 941 } else { 942 ierr = PetscViewerASCIIPrintf(viewer,"%18.16e + %18.16ei ",(double)PetscRealPart(*v),(double)PetscImaginaryPart(*v));CHKERRQ(ierr); 943 } 944 #else 945 ierr = PetscViewerASCIIPrintf(viewer,"%18.16e ",(double)*v);CHKERRQ(ierr); 946 #endif 947 v += a->lda; 948 } 949 ierr = PetscViewerASCIIPrintf(viewer,"\n");CHKERRQ(ierr); 950 } 951 if (format == PETSC_VIEWER_ASCII_MATLAB) { 952 ierr = PetscViewerASCIIPrintf(viewer,"];\n");CHKERRQ(ierr); 953 } 954 ierr = PetscViewerASCIIUseTabs(viewer,PETSC_TRUE);CHKERRQ(ierr); 955 } 956 ierr = PetscViewerFlush(viewer);CHKERRQ(ierr); 957 PetscFunctionReturn(0); 958 } 959 960 #undef __FUNCT__ 961 #define __FUNCT__ "MatView_SeqDense_Binary" 962 static PetscErrorCode MatView_SeqDense_Binary(Mat A,PetscViewer viewer) 963 { 964 Mat_SeqDense *a = (Mat_SeqDense*)A->data; 965 PetscErrorCode ierr; 966 int fd; 967 PetscInt ict,j,n = A->cmap->n,m = A->rmap->n,i,*col_lens,nz = m*n; 968 PetscScalar *v,*anonz,*vals; 969 PetscViewerFormat format; 970 971 PetscFunctionBegin; 972 ierr = PetscViewerBinaryGetDescriptor(viewer,&fd);CHKERRQ(ierr); 973 974 ierr = PetscViewerGetFormat(viewer,&format);CHKERRQ(ierr); 975 if (format == PETSC_VIEWER_NATIVE) { 976 /* store the matrix as a dense matrix */ 977 ierr = PetscMalloc(4*sizeof(PetscInt),&col_lens);CHKERRQ(ierr); 978 col_lens[0] = MAT_FILE_CLASSID; 979 col_lens[1] = m; 980 col_lens[2] = n; 981 col_lens[3] = MATRIX_BINARY_FORMAT_DENSE; 982 ierr = PetscBinaryWrite(fd,col_lens,4,PETSC_INT,PETSC_TRUE);CHKERRQ(ierr); 983 ierr = PetscFree(col_lens);CHKERRQ(ierr); 984 985 /* write out matrix, by rows */ 986 ierr = PetscMalloc((m*n+1)*sizeof(PetscScalar),&vals);CHKERRQ(ierr); 987 v = a->v; 988 for (j=0; j<n; j++) { 989 for (i=0; i<m; i++) { 990 vals[j + i*n] = *v++; 991 } 992 } 993 ierr = PetscBinaryWrite(fd,vals,n*m,PETSC_SCALAR,PETSC_FALSE);CHKERRQ(ierr); 994 ierr = PetscFree(vals);CHKERRQ(ierr); 995 } else { 996 ierr = PetscMalloc((4+nz)*sizeof(PetscInt),&col_lens);CHKERRQ(ierr); 997 col_lens[0] = MAT_FILE_CLASSID; 998 col_lens[1] = m; 999 col_lens[2] = n; 1000 col_lens[3] = nz; 1001 1002 /* store lengths of each row and write (including header) to file */ 1003 for (i=0; i<m; i++) col_lens[4+i] = n; 1004 ierr = PetscBinaryWrite(fd,col_lens,4+m,PETSC_INT,PETSC_TRUE);CHKERRQ(ierr); 1005 1006 /* Possibly should write in smaller increments, not whole matrix at once? */ 1007 /* store column indices (zero start index) */ 1008 ict = 0; 1009 for (i=0; i<m; i++) { 1010 for (j=0; j<n; j++) col_lens[ict++] = j; 1011 } 1012 ierr = PetscBinaryWrite(fd,col_lens,nz,PETSC_INT,PETSC_FALSE);CHKERRQ(ierr); 1013 ierr = PetscFree(col_lens);CHKERRQ(ierr); 1014 1015 /* store nonzero values */ 1016 ierr = PetscMalloc((nz+1)*sizeof(PetscScalar),&anonz);CHKERRQ(ierr); 1017 ict = 0; 1018 for (i=0; i<m; i++) { 1019 v = a->v + i; 1020 for (j=0; j<n; j++) { 1021 anonz[ict++] = *v; v += a->lda; 1022 } 1023 } 1024 ierr = PetscBinaryWrite(fd,anonz,nz,PETSC_SCALAR,PETSC_FALSE);CHKERRQ(ierr); 1025 ierr = PetscFree(anonz);CHKERRQ(ierr); 1026 } 1027 PetscFunctionReturn(0); 1028 } 1029 1030 #undef __FUNCT__ 1031 #define __FUNCT__ "MatView_SeqDense_Draw_Zoom" 1032 PetscErrorCode MatView_SeqDense_Draw_Zoom(PetscDraw draw,void *Aa) 1033 { 1034 Mat A = (Mat) Aa; 1035 Mat_SeqDense *a = (Mat_SeqDense*)A->data; 1036 PetscErrorCode ierr; 1037 PetscInt m = A->rmap->n,n = A->cmap->n,color,i,j; 1038 PetscScalar *v = a->v; 1039 PetscViewer viewer; 1040 PetscDraw popup; 1041 PetscReal xl,yl,xr,yr,x_l,x_r,y_l,y_r,scale,maxv = 0.0; 1042 PetscViewerFormat format; 1043 1044 PetscFunctionBegin; 1045 1046 ierr = PetscObjectQuery((PetscObject)A,"Zoomviewer",(PetscObject*)&viewer);CHKERRQ(ierr); 1047 ierr = PetscViewerGetFormat(viewer,&format);CHKERRQ(ierr); 1048 ierr = PetscDrawGetCoordinates(draw,&xl,&yl,&xr,&yr);CHKERRQ(ierr); 1049 1050 /* Loop over matrix elements drawing boxes */ 1051 if (format != PETSC_VIEWER_DRAW_CONTOUR) { 1052 /* Blue for negative and Red for positive */ 1053 color = PETSC_DRAW_BLUE; 1054 for(j = 0; j < n; j++) { 1055 x_l = j; 1056 x_r = x_l + 1.0; 1057 for(i = 0; i < m; i++) { 1058 y_l = m - i - 1.0; 1059 y_r = y_l + 1.0; 1060 #if defined(PETSC_USE_COMPLEX) 1061 if (PetscRealPart(v[j*m+i]) > 0.) { 1062 color = PETSC_DRAW_RED; 1063 } else if (PetscRealPart(v[j*m+i]) < 0.) { 1064 color = PETSC_DRAW_BLUE; 1065 } else { 1066 continue; 1067 } 1068 #else 1069 if (v[j*m+i] > 0.) { 1070 color = PETSC_DRAW_RED; 1071 } else if (v[j*m+i] < 0.) { 1072 color = PETSC_DRAW_BLUE; 1073 } else { 1074 continue; 1075 } 1076 #endif 1077 ierr = PetscDrawRectangle(draw,x_l,y_l,x_r,y_r,color,color,color,color);CHKERRQ(ierr); 1078 } 1079 } 1080 } else { 1081 /* use contour shading to indicate magnitude of values */ 1082 /* first determine max of all nonzero values */ 1083 for(i = 0; i < m*n; i++) { 1084 if (PetscAbsScalar(v[i]) > maxv) maxv = PetscAbsScalar(v[i]); 1085 } 1086 scale = (245.0 - PETSC_DRAW_BASIC_COLORS)/maxv; 1087 ierr = PetscDrawGetPopup(draw,&popup);CHKERRQ(ierr); 1088 if (popup) {ierr = PetscDrawScalePopup(popup,0.0,maxv);CHKERRQ(ierr);} 1089 for(j = 0; j < n; j++) { 1090 x_l = j; 1091 x_r = x_l + 1.0; 1092 for(i = 0; i < m; i++) { 1093 y_l = m - i - 1.0; 1094 y_r = y_l + 1.0; 1095 color = PETSC_DRAW_BASIC_COLORS + (int)(scale*PetscAbsScalar(v[j*m+i])); 1096 ierr = PetscDrawRectangle(draw,x_l,y_l,x_r,y_r,color,color,color,color);CHKERRQ(ierr); 1097 } 1098 } 1099 } 1100 PetscFunctionReturn(0); 1101 } 1102 1103 #undef __FUNCT__ 1104 #define __FUNCT__ "MatView_SeqDense_Draw" 1105 PetscErrorCode MatView_SeqDense_Draw(Mat A,PetscViewer viewer) 1106 { 1107 PetscDraw draw; 1108 PetscBool isnull; 1109 PetscReal xr,yr,xl,yl,h,w; 1110 PetscErrorCode ierr; 1111 1112 PetscFunctionBegin; 1113 ierr = PetscViewerDrawGetDraw(viewer,0,&draw);CHKERRQ(ierr); 1114 ierr = PetscDrawIsNull(draw,&isnull);CHKERRQ(ierr); 1115 if (isnull) PetscFunctionReturn(0); 1116 1117 ierr = PetscObjectCompose((PetscObject)A,"Zoomviewer",(PetscObject)viewer);CHKERRQ(ierr); 1118 xr = A->cmap->n; yr = A->rmap->n; h = yr/10.0; w = xr/10.0; 1119 xr += w; yr += h; xl = -w; yl = -h; 1120 ierr = PetscDrawSetCoordinates(draw,xl,yl,xr,yr);CHKERRQ(ierr); 1121 ierr = PetscDrawZoom(draw,MatView_SeqDense_Draw_Zoom,A);CHKERRQ(ierr); 1122 ierr = PetscObjectCompose((PetscObject)A,"Zoomviewer",PETSC_NULL);CHKERRQ(ierr); 1123 PetscFunctionReturn(0); 1124 } 1125 1126 #undef __FUNCT__ 1127 #define __FUNCT__ "MatView_SeqDense" 1128 PetscErrorCode MatView_SeqDense(Mat A,PetscViewer viewer) 1129 { 1130 PetscErrorCode ierr; 1131 PetscBool iascii,isbinary,isdraw; 1132 1133 PetscFunctionBegin; 1134 ierr = PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);CHKERRQ(ierr); 1135 ierr = PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERBINARY,&isbinary);CHKERRQ(ierr); 1136 ierr = PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERDRAW,&isdraw);CHKERRQ(ierr); 1137 1138 if (iascii) { 1139 ierr = MatView_SeqDense_ASCII(A,viewer);CHKERRQ(ierr); 1140 } else if (isbinary) { 1141 ierr = MatView_SeqDense_Binary(A,viewer);CHKERRQ(ierr); 1142 } else if (isdraw) { 1143 ierr = MatView_SeqDense_Draw(A,viewer);CHKERRQ(ierr); 1144 } else { 1145 SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Viewer type %s not supported by dense matrix",((PetscObject)viewer)->type_name); 1146 } 1147 PetscFunctionReturn(0); 1148 } 1149 1150 #undef __FUNCT__ 1151 #define __FUNCT__ "MatDestroy_SeqDense" 1152 PetscErrorCode MatDestroy_SeqDense(Mat mat) 1153 { 1154 Mat_SeqDense *l = (Mat_SeqDense*)mat->data; 1155 PetscErrorCode ierr; 1156 1157 PetscFunctionBegin; 1158 #if defined(PETSC_USE_LOG) 1159 PetscLogObjectState((PetscObject)mat,"Rows %D Cols %D",mat->rmap->n,mat->cmap->n); 1160 #endif 1161 ierr = PetscFree(l->pivots);CHKERRQ(ierr); 1162 if (!l->user_alloc) {ierr = PetscFree(l->v);CHKERRQ(ierr);} 1163 ierr = PetscFree(mat->data);CHKERRQ(ierr); 1164 1165 ierr = PetscObjectChangeTypeName((PetscObject)mat,0);CHKERRQ(ierr); 1166 ierr = PetscObjectComposeFunctionDynamic((PetscObject)mat,"MatSeqDenseSetPreallocation_C","",PETSC_NULL);CHKERRQ(ierr); 1167 ierr = PetscObjectComposeFunctionDynamic((PetscObject)mat,"MatMatMult_seqaij_seqdense_C","",PETSC_NULL);CHKERRQ(ierr); 1168 ierr = PetscObjectComposeFunctionDynamic((PetscObject)mat,"MatMatMultSymbolic_seqaij_seqdense_C","",PETSC_NULL);CHKERRQ(ierr); 1169 ierr = PetscObjectComposeFunctionDynamic((PetscObject)mat,"MatMatMultNumeric_seqaij_seqdense_C","",PETSC_NULL);CHKERRQ(ierr); 1170 PetscFunctionReturn(0); 1171 } 1172 1173 #undef __FUNCT__ 1174 #define __FUNCT__ "MatTranspose_SeqDense" 1175 PetscErrorCode MatTranspose_SeqDense(Mat A,MatReuse reuse,Mat *matout) 1176 { 1177 Mat_SeqDense *mat = (Mat_SeqDense*)A->data; 1178 PetscErrorCode ierr; 1179 PetscInt k,j,m,n,M; 1180 PetscScalar *v,tmp; 1181 1182 PetscFunctionBegin; 1183 v = mat->v; m = A->rmap->n; M = mat->lda; n = A->cmap->n; 1184 if (reuse == MAT_REUSE_MATRIX && *matout == A) { /* in place transpose */ 1185 if (m != n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Can not transpose non-square matrix in place"); 1186 else { 1187 for (j=0; j<m; j++) { 1188 for (k=0; k<j; k++) { 1189 tmp = v[j + k*M]; 1190 v[j + k*M] = v[k + j*M]; 1191 v[k + j*M] = tmp; 1192 } 1193 } 1194 } 1195 } else { /* out-of-place transpose */ 1196 Mat tmat; 1197 Mat_SeqDense *tmatd; 1198 PetscScalar *v2; 1199 1200 if (reuse == MAT_INITIAL_MATRIX) { 1201 ierr = MatCreate(((PetscObject)A)->comm,&tmat);CHKERRQ(ierr); 1202 ierr = MatSetSizes(tmat,A->cmap->n,A->rmap->n,A->cmap->n,A->rmap->n);CHKERRQ(ierr); 1203 ierr = MatSetType(tmat,((PetscObject)A)->type_name);CHKERRQ(ierr); 1204 ierr = MatSeqDenseSetPreallocation(tmat,PETSC_NULL);CHKERRQ(ierr); 1205 } else { 1206 tmat = *matout; 1207 } 1208 tmatd = (Mat_SeqDense*)tmat->data; 1209 v = mat->v; v2 = tmatd->v; 1210 for (j=0; j<n; j++) { 1211 for (k=0; k<m; k++) v2[j + k*n] = v[k + j*M]; 1212 } 1213 ierr = MatAssemblyBegin(tmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 1214 ierr = MatAssemblyEnd(tmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 1215 *matout = tmat; 1216 } 1217 PetscFunctionReturn(0); 1218 } 1219 1220 #undef __FUNCT__ 1221 #define __FUNCT__ "MatEqual_SeqDense" 1222 PetscErrorCode MatEqual_SeqDense(Mat A1,Mat A2,PetscBool *flg) 1223 { 1224 Mat_SeqDense *mat1 = (Mat_SeqDense*)A1->data; 1225 Mat_SeqDense *mat2 = (Mat_SeqDense*)A2->data; 1226 PetscInt i,j; 1227 PetscScalar *v1 = mat1->v,*v2 = mat2->v; 1228 1229 PetscFunctionBegin; 1230 if (A1->rmap->n != A2->rmap->n) {*flg = PETSC_FALSE; PetscFunctionReturn(0);} 1231 if (A1->cmap->n != A2->cmap->n) {*flg = PETSC_FALSE; PetscFunctionReturn(0);} 1232 for (i=0; i<A1->rmap->n; i++) { 1233 v1 = mat1->v+i; v2 = mat2->v+i; 1234 for (j=0; j<A1->cmap->n; j++) { 1235 if (*v1 != *v2) {*flg = PETSC_FALSE; PetscFunctionReturn(0);} 1236 v1 += mat1->lda; v2 += mat2->lda; 1237 } 1238 } 1239 *flg = PETSC_TRUE; 1240 PetscFunctionReturn(0); 1241 } 1242 1243 #undef __FUNCT__ 1244 #define __FUNCT__ "MatGetDiagonal_SeqDense" 1245 PetscErrorCode MatGetDiagonal_SeqDense(Mat A,Vec v) 1246 { 1247 Mat_SeqDense *mat = (Mat_SeqDense*)A->data; 1248 PetscErrorCode ierr; 1249 PetscInt i,n,len; 1250 PetscScalar *x,zero = 0.0; 1251 1252 PetscFunctionBegin; 1253 ierr = VecSet(v,zero);CHKERRQ(ierr); 1254 ierr = VecGetSize(v,&n);CHKERRQ(ierr); 1255 ierr = VecGetArray(v,&x);CHKERRQ(ierr); 1256 len = PetscMin(A->rmap->n,A->cmap->n); 1257 if (n != A->rmap->n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Nonconforming mat and vec"); 1258 for (i=0; i<len; i++) { 1259 x[i] = mat->v[i*mat->lda + i]; 1260 } 1261 ierr = VecRestoreArray(v,&x);CHKERRQ(ierr); 1262 PetscFunctionReturn(0); 1263 } 1264 1265 #undef __FUNCT__ 1266 #define __FUNCT__ "MatDiagonalScale_SeqDense" 1267 PetscErrorCode MatDiagonalScale_SeqDense(Mat A,Vec ll,Vec rr) 1268 { 1269 Mat_SeqDense *mat = (Mat_SeqDense*)A->data; 1270 PetscScalar *l,*r,x,*v; 1271 PetscErrorCode ierr; 1272 PetscInt i,j,m = A->rmap->n,n = A->cmap->n; 1273 1274 PetscFunctionBegin; 1275 if (ll) { 1276 ierr = VecGetSize(ll,&m);CHKERRQ(ierr); 1277 ierr = VecGetArray(ll,&l);CHKERRQ(ierr); 1278 if (m != A->rmap->n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Left scaling vec wrong size"); 1279 for (i=0; i<m; i++) { 1280 x = l[i]; 1281 v = mat->v + i; 1282 for (j=0; j<n; j++) { (*v) *= x; v+= m;} 1283 } 1284 ierr = VecRestoreArray(ll,&l);CHKERRQ(ierr); 1285 ierr = PetscLogFlops(n*m);CHKERRQ(ierr); 1286 } 1287 if (rr) { 1288 ierr = VecGetSize(rr,&n);CHKERRQ(ierr); 1289 ierr = VecGetArray(rr,&r);CHKERRQ(ierr); 1290 if (n != A->cmap->n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Right scaling vec wrong size"); 1291 for (i=0; i<n; i++) { 1292 x = r[i]; 1293 v = mat->v + i*m; 1294 for (j=0; j<m; j++) { (*v++) *= x;} 1295 } 1296 ierr = VecRestoreArray(rr,&r);CHKERRQ(ierr); 1297 ierr = PetscLogFlops(n*m);CHKERRQ(ierr); 1298 } 1299 PetscFunctionReturn(0); 1300 } 1301 1302 #undef __FUNCT__ 1303 #define __FUNCT__ "MatNorm_SeqDense" 1304 PetscErrorCode MatNorm_SeqDense(Mat A,NormType type,PetscReal *nrm) 1305 { 1306 Mat_SeqDense *mat = (Mat_SeqDense*)A->data; 1307 PetscScalar *v = mat->v; 1308 PetscReal sum = 0.0; 1309 PetscInt lda=mat->lda,m=A->rmap->n,i,j; 1310 PetscErrorCode ierr; 1311 1312 PetscFunctionBegin; 1313 if (type == NORM_FROBENIUS) { 1314 if (lda>m) { 1315 for (j=0; j<A->cmap->n; j++) { 1316 v = mat->v+j*lda; 1317 for (i=0; i<m; i++) { 1318 #if defined(PETSC_USE_COMPLEX) 1319 sum += PetscRealPart(PetscConj(*v)*(*v)); v++; 1320 #else 1321 sum += (*v)*(*v); v++; 1322 #endif 1323 } 1324 } 1325 } else { 1326 for (i=0; i<A->cmap->n*A->rmap->n; i++) { 1327 #if defined(PETSC_USE_COMPLEX) 1328 sum += PetscRealPart(PetscConj(*v)*(*v)); v++; 1329 #else 1330 sum += (*v)*(*v); v++; 1331 #endif 1332 } 1333 } 1334 *nrm = PetscSqrtReal(sum); 1335 ierr = PetscLogFlops(2.0*A->cmap->n*A->rmap->n);CHKERRQ(ierr); 1336 } else if (type == NORM_1) { 1337 *nrm = 0.0; 1338 for (j=0; j<A->cmap->n; j++) { 1339 v = mat->v + j*mat->lda; 1340 sum = 0.0; 1341 for (i=0; i<A->rmap->n; i++) { 1342 sum += PetscAbsScalar(*v); v++; 1343 } 1344 if (sum > *nrm) *nrm = sum; 1345 } 1346 ierr = PetscLogFlops(A->cmap->n*A->rmap->n);CHKERRQ(ierr); 1347 } else if (type == NORM_INFINITY) { 1348 *nrm = 0.0; 1349 for (j=0; j<A->rmap->n; j++) { 1350 v = mat->v + j; 1351 sum = 0.0; 1352 for (i=0; i<A->cmap->n; i++) { 1353 sum += PetscAbsScalar(*v); v += mat->lda; 1354 } 1355 if (sum > *nrm) *nrm = sum; 1356 } 1357 ierr = PetscLogFlops(A->cmap->n*A->rmap->n);CHKERRQ(ierr); 1358 } else SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"No two norm"); 1359 PetscFunctionReturn(0); 1360 } 1361 1362 #undef __FUNCT__ 1363 #define __FUNCT__ "MatSetOption_SeqDense" 1364 PetscErrorCode MatSetOption_SeqDense(Mat A,MatOption op,PetscBool flg) 1365 { 1366 Mat_SeqDense *aij = (Mat_SeqDense*)A->data; 1367 PetscErrorCode ierr; 1368 1369 PetscFunctionBegin; 1370 switch (op) { 1371 case MAT_ROW_ORIENTED: 1372 aij->roworiented = flg; 1373 break; 1374 case MAT_NEW_NONZERO_LOCATIONS: 1375 case MAT_NEW_NONZERO_LOCATION_ERR: 1376 case MAT_NEW_NONZERO_ALLOCATION_ERR: 1377 case MAT_NEW_DIAGONALS: 1378 case MAT_KEEP_NONZERO_PATTERN: 1379 case MAT_IGNORE_OFF_PROC_ENTRIES: 1380 case MAT_USE_HASH_TABLE: 1381 case MAT_SYMMETRIC: 1382 case MAT_STRUCTURALLY_SYMMETRIC: 1383 case MAT_HERMITIAN: 1384 case MAT_SYMMETRY_ETERNAL: 1385 case MAT_IGNORE_LOWER_TRIANGULAR: 1386 ierr = PetscInfo1(A,"Option %s ignored\n",MatOptions[op]);CHKERRQ(ierr); 1387 break; 1388 default: 1389 SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"unknown option %s",MatOptions[op]); 1390 } 1391 PetscFunctionReturn(0); 1392 } 1393 1394 #undef __FUNCT__ 1395 #define __FUNCT__ "MatZeroEntries_SeqDense" 1396 PetscErrorCode MatZeroEntries_SeqDense(Mat A) 1397 { 1398 Mat_SeqDense *l = (Mat_SeqDense*)A->data; 1399 PetscErrorCode ierr; 1400 PetscInt lda=l->lda,m=A->rmap->n,j; 1401 1402 PetscFunctionBegin; 1403 if (lda>m) { 1404 for (j=0; j<A->cmap->n; j++) { 1405 ierr = PetscMemzero(l->v+j*lda,m*sizeof(PetscScalar));CHKERRQ(ierr); 1406 } 1407 } else { 1408 ierr = PetscMemzero(l->v,A->rmap->n*A->cmap->n*sizeof(PetscScalar));CHKERRQ(ierr); 1409 } 1410 PetscFunctionReturn(0); 1411 } 1412 1413 #undef __FUNCT__ 1414 #define __FUNCT__ "MatZeroRows_SeqDense" 1415 PetscErrorCode MatZeroRows_SeqDense(Mat A,PetscInt N,const PetscInt rows[],PetscScalar diag,Vec x,Vec b) 1416 { 1417 PetscErrorCode ierr; 1418 Mat_SeqDense *l = (Mat_SeqDense*)A->data; 1419 PetscInt m = l->lda, n = A->cmap->n, i,j; 1420 PetscScalar *slot,*bb; 1421 const PetscScalar *xx; 1422 1423 PetscFunctionBegin; 1424 #if defined(PETSC_USE_DEBUG) 1425 for (i=0; i<N; i++) { 1426 if (rows[i] < 0) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Negative row requested to be zeroed"); 1427 if (rows[i] >= A->rmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Row %D requested to be zeroed greater than or equal number of rows %D",rows[i],A->rmap->n); 1428 } 1429 #endif 1430 1431 /* fix right hand side if needed */ 1432 if (x && b) { 1433 ierr = VecGetArrayRead(x,&xx);CHKERRQ(ierr); 1434 ierr = VecGetArray(b,&bb);CHKERRQ(ierr); 1435 for (i=0; i<N; i++) { 1436 bb[rows[i]] = diag*xx[rows[i]]; 1437 } 1438 ierr = VecRestoreArrayRead(x,&xx);CHKERRQ(ierr); 1439 ierr = VecRestoreArray(b,&bb);CHKERRQ(ierr); 1440 } 1441 1442 for (i=0; i<N; i++) { 1443 slot = l->v + rows[i]; 1444 for (j=0; j<n; j++) { *slot = 0.0; slot += m;} 1445 } 1446 if (diag != 0.0) { 1447 if (A->rmap->n != A->cmap->n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Only coded for square matrices"); 1448 for (i=0; i<N; i++) { 1449 slot = l->v + (m+1)*rows[i]; 1450 *slot = diag; 1451 } 1452 } 1453 PetscFunctionReturn(0); 1454 } 1455 1456 #undef __FUNCT__ 1457 #define __FUNCT__ "MatGetArray_SeqDense" 1458 PetscErrorCode MatGetArray_SeqDense(Mat A,PetscScalar *array[]) 1459 { 1460 Mat_SeqDense *mat = (Mat_SeqDense*)A->data; 1461 1462 PetscFunctionBegin; 1463 if (mat->lda != A->rmap->n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot get array for Dense matrices with LDA different from number of rows"); 1464 *array = mat->v; 1465 PetscFunctionReturn(0); 1466 } 1467 1468 #undef __FUNCT__ 1469 #define __FUNCT__ "MatRestoreArray_SeqDense" 1470 PetscErrorCode MatRestoreArray_SeqDense(Mat A,PetscScalar *array[]) 1471 { 1472 PetscFunctionBegin; 1473 *array = 0; /* user cannot accidently use the array later */ 1474 PetscFunctionReturn(0); 1475 } 1476 1477 #undef __FUNCT__ 1478 #define __FUNCT__ "MatGetSubMatrix_SeqDense" 1479 static PetscErrorCode MatGetSubMatrix_SeqDense(Mat A,IS isrow,IS iscol,PetscInt cs,MatReuse scall,Mat *B) 1480 { 1481 Mat_SeqDense *mat = (Mat_SeqDense*)A->data; 1482 PetscErrorCode ierr; 1483 PetscInt i,j,nrows,ncols; 1484 const PetscInt *irow,*icol; 1485 PetscScalar *av,*bv,*v = mat->v; 1486 Mat newmat; 1487 1488 PetscFunctionBegin; 1489 ierr = ISGetIndices(isrow,&irow);CHKERRQ(ierr); 1490 ierr = ISGetIndices(iscol,&icol);CHKERRQ(ierr); 1491 ierr = ISGetLocalSize(isrow,&nrows);CHKERRQ(ierr); 1492 ierr = ISGetLocalSize(iscol,&ncols);CHKERRQ(ierr); 1493 1494 /* Check submatrixcall */ 1495 if (scall == MAT_REUSE_MATRIX) { 1496 PetscInt n_cols,n_rows; 1497 ierr = MatGetSize(*B,&n_rows,&n_cols);CHKERRQ(ierr); 1498 if (n_rows != nrows || n_cols != ncols) { 1499 /* resize the result matrix to match number of requested rows/columns */ 1500 ierr = MatSetSizes(*B,nrows,ncols,nrows,ncols);CHKERRQ(ierr); 1501 } 1502 newmat = *B; 1503 } else { 1504 /* Create and fill new matrix */ 1505 ierr = MatCreate(((PetscObject)A)->comm,&newmat);CHKERRQ(ierr); 1506 ierr = MatSetSizes(newmat,nrows,ncols,nrows,ncols);CHKERRQ(ierr); 1507 ierr = MatSetType(newmat,((PetscObject)A)->type_name);CHKERRQ(ierr); 1508 ierr = MatSeqDenseSetPreallocation(newmat,PETSC_NULL);CHKERRQ(ierr); 1509 } 1510 1511 /* Now extract the data pointers and do the copy,column at a time */ 1512 bv = ((Mat_SeqDense*)newmat->data)->v; 1513 1514 for (i=0; i<ncols; i++) { 1515 av = v + mat->lda*icol[i]; 1516 for (j=0; j<nrows; j++) { 1517 *bv++ = av[irow[j]]; 1518 } 1519 } 1520 1521 /* Assemble the matrices so that the correct flags are set */ 1522 ierr = MatAssemblyBegin(newmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 1523 ierr = MatAssemblyEnd(newmat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 1524 1525 /* Free work space */ 1526 ierr = ISRestoreIndices(isrow,&irow);CHKERRQ(ierr); 1527 ierr = ISRestoreIndices(iscol,&icol);CHKERRQ(ierr); 1528 *B = newmat; 1529 PetscFunctionReturn(0); 1530 } 1531 1532 #undef __FUNCT__ 1533 #define __FUNCT__ "MatGetSubMatrices_SeqDense" 1534 PetscErrorCode MatGetSubMatrices_SeqDense(Mat A,PetscInt n,const IS irow[],const IS icol[],MatReuse scall,Mat *B[]) 1535 { 1536 PetscErrorCode ierr; 1537 PetscInt i; 1538 1539 PetscFunctionBegin; 1540 if (scall == MAT_INITIAL_MATRIX) { 1541 ierr = PetscMalloc((n+1)*sizeof(Mat),B);CHKERRQ(ierr); 1542 } 1543 1544 for (i=0; i<n; i++) { 1545 ierr = MatGetSubMatrix_SeqDense(A,irow[i],icol[i],PETSC_DECIDE,scall,&(*B)[i]);CHKERRQ(ierr); 1546 } 1547 PetscFunctionReturn(0); 1548 } 1549 1550 #undef __FUNCT__ 1551 #define __FUNCT__ "MatAssemblyBegin_SeqDense" 1552 PetscErrorCode MatAssemblyBegin_SeqDense(Mat mat,MatAssemblyType mode) 1553 { 1554 PetscFunctionBegin; 1555 PetscFunctionReturn(0); 1556 } 1557 1558 #undef __FUNCT__ 1559 #define __FUNCT__ "MatAssemblyEnd_SeqDense" 1560 PetscErrorCode MatAssemblyEnd_SeqDense(Mat mat,MatAssemblyType mode) 1561 { 1562 PetscFunctionBegin; 1563 PetscFunctionReturn(0); 1564 } 1565 1566 #undef __FUNCT__ 1567 #define __FUNCT__ "MatCopy_SeqDense" 1568 PetscErrorCode MatCopy_SeqDense(Mat A,Mat B,MatStructure str) 1569 { 1570 Mat_SeqDense *a = (Mat_SeqDense*)A->data,*b = (Mat_SeqDense *)B->data; 1571 PetscErrorCode ierr; 1572 PetscInt lda1=a->lda,lda2=b->lda, m=A->rmap->n,n=A->cmap->n, j; 1573 1574 PetscFunctionBegin; 1575 /* If the two matrices don't have the same copy implementation, they aren't compatible for fast copy. */ 1576 if (A->ops->copy != B->ops->copy) { 1577 ierr = MatCopy_Basic(A,B,str);CHKERRQ(ierr); 1578 PetscFunctionReturn(0); 1579 } 1580 if (m != B->rmap->n || n != B->cmap->n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"size(B) != size(A)"); 1581 if (lda1>m || lda2>m) { 1582 for (j=0; j<n; j++) { 1583 ierr = PetscMemcpy(b->v+j*lda2,a->v+j*lda1,m*sizeof(PetscScalar));CHKERRQ(ierr); 1584 } 1585 } else { 1586 ierr = PetscMemcpy(b->v,a->v,A->rmap->n*A->cmap->n*sizeof(PetscScalar));CHKERRQ(ierr); 1587 } 1588 PetscFunctionReturn(0); 1589 } 1590 1591 #undef __FUNCT__ 1592 #define __FUNCT__ "MatSetUp_SeqDense" 1593 PetscErrorCode MatSetUp_SeqDense(Mat A) 1594 { 1595 PetscErrorCode ierr; 1596 1597 PetscFunctionBegin; 1598 ierr = MatSeqDenseSetPreallocation(A,0);CHKERRQ(ierr); 1599 PetscFunctionReturn(0); 1600 } 1601 1602 #undef __FUNCT__ 1603 #define __FUNCT__ "MatConjugate_SeqDense" 1604 static PetscErrorCode MatConjugate_SeqDense(Mat A) 1605 { 1606 Mat_SeqDense *a = (Mat_SeqDense*)A->data; 1607 PetscInt i,nz = A->rmap->n*A->cmap->n; 1608 PetscScalar *aa = a->v; 1609 1610 PetscFunctionBegin; 1611 for (i=0; i<nz; i++) aa[i] = PetscConj(aa[i]); 1612 PetscFunctionReturn(0); 1613 } 1614 1615 #undef __FUNCT__ 1616 #define __FUNCT__ "MatRealPart_SeqDense" 1617 static PetscErrorCode MatRealPart_SeqDense(Mat A) 1618 { 1619 Mat_SeqDense *a = (Mat_SeqDense*)A->data; 1620 PetscInt i,nz = A->rmap->n*A->cmap->n; 1621 PetscScalar *aa = a->v; 1622 1623 PetscFunctionBegin; 1624 for (i=0; i<nz; i++) aa[i] = PetscRealPart(aa[i]); 1625 PetscFunctionReturn(0); 1626 } 1627 1628 #undef __FUNCT__ 1629 #define __FUNCT__ "MatImaginaryPart_SeqDense" 1630 static PetscErrorCode MatImaginaryPart_SeqDense(Mat A) 1631 { 1632 Mat_SeqDense *a = (Mat_SeqDense*)A->data; 1633 PetscInt i,nz = A->rmap->n*A->cmap->n; 1634 PetscScalar *aa = a->v; 1635 1636 PetscFunctionBegin; 1637 for (i=0; i<nz; i++) aa[i] = PetscImaginaryPart(aa[i]); 1638 PetscFunctionReturn(0); 1639 } 1640 1641 /* ----------------------------------------------------------------*/ 1642 #undef __FUNCT__ 1643 #define __FUNCT__ "MatMatMult_SeqDense_SeqDense" 1644 PetscErrorCode MatMatMult_SeqDense_SeqDense(Mat A,Mat B,MatReuse scall,PetscReal fill,Mat *C) 1645 { 1646 PetscErrorCode ierr; 1647 1648 PetscFunctionBegin; 1649 if (scall == MAT_INITIAL_MATRIX){ 1650 ierr = MatMatMultSymbolic_SeqDense_SeqDense(A,B,fill,C);CHKERRQ(ierr); 1651 } 1652 ierr = MatMatMultNumeric_SeqDense_SeqDense(A,B,*C);CHKERRQ(ierr); 1653 PetscFunctionReturn(0); 1654 } 1655 1656 #undef __FUNCT__ 1657 #define __FUNCT__ "MatMatMultSymbolic_SeqDense_SeqDense" 1658 PetscErrorCode MatMatMultSymbolic_SeqDense_SeqDense(Mat A,Mat B,PetscReal fill,Mat *C) 1659 { 1660 PetscErrorCode ierr; 1661 PetscInt m=A->rmap->n,n=B->cmap->n; 1662 Mat Cmat; 1663 1664 PetscFunctionBegin; 1665 if (A->cmap->n != B->rmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"A->cmap->n %d != B->rmap->n %d\n",A->cmap->n,B->rmap->n); 1666 ierr = MatCreate(PETSC_COMM_SELF,&Cmat);CHKERRQ(ierr); 1667 ierr = MatSetSizes(Cmat,m,n,m,n);CHKERRQ(ierr); 1668 ierr = MatSetType(Cmat,MATSEQDENSE);CHKERRQ(ierr); 1669 ierr = MatSeqDenseSetPreallocation(Cmat,PETSC_NULL);CHKERRQ(ierr); 1670 Cmat->assembled = PETSC_TRUE; 1671 Cmat->ops->matmult = MatMatMult_SeqDense_SeqDense; 1672 *C = Cmat; 1673 PetscFunctionReturn(0); 1674 } 1675 1676 #undef __FUNCT__ 1677 #define __FUNCT__ "MatMatMultNumeric_SeqDense_SeqDense" 1678 PetscErrorCode MatMatMultNumeric_SeqDense_SeqDense(Mat A,Mat B,Mat C) 1679 { 1680 Mat_SeqDense *a = (Mat_SeqDense*)A->data; 1681 Mat_SeqDense *b = (Mat_SeqDense*)B->data; 1682 Mat_SeqDense *c = (Mat_SeqDense*)C->data; 1683 PetscBLASInt m,n,k; 1684 PetscScalar _DOne=1.0,_DZero=0.0; 1685 1686 PetscFunctionBegin; 1687 m = PetscBLASIntCast(A->rmap->n); 1688 n = PetscBLASIntCast(B->cmap->n); 1689 k = PetscBLASIntCast(A->cmap->n); 1690 BLASgemm_("N","N",&m,&n,&k,&_DOne,a->v,&a->lda,b->v,&b->lda,&_DZero,c->v,&c->lda); 1691 PetscFunctionReturn(0); 1692 } 1693 1694 #undef __FUNCT__ 1695 #define __FUNCT__ "MatTransposeMatMult_SeqDense_SeqDense" 1696 PetscErrorCode MatTransposeMatMult_SeqDense_SeqDense(Mat A,Mat B,MatReuse scall,PetscReal fill,Mat *C) 1697 { 1698 PetscErrorCode ierr; 1699 1700 PetscFunctionBegin; 1701 if (scall == MAT_INITIAL_MATRIX){ 1702 ierr = MatTransposeMatMultSymbolic_SeqDense_SeqDense(A,B,fill,C);CHKERRQ(ierr); 1703 } 1704 ierr = MatTransposeMatMultNumeric_SeqDense_SeqDense(A,B,*C);CHKERRQ(ierr); 1705 PetscFunctionReturn(0); 1706 } 1707 1708 #undef __FUNCT__ 1709 #define __FUNCT__ "MatTransposeMatMultSymbolic_SeqDense_SeqDense" 1710 PetscErrorCode MatTransposeMatMultSymbolic_SeqDense_SeqDense(Mat A,Mat B,PetscReal fill,Mat *C) 1711 { 1712 PetscErrorCode ierr; 1713 PetscInt m=A->cmap->n,n=B->cmap->n; 1714 Mat Cmat; 1715 1716 PetscFunctionBegin; 1717 if (A->rmap->n != B->rmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"A->rmap->n %d != B->rmap->n %d\n",A->rmap->n,B->rmap->n); 1718 ierr = MatCreate(PETSC_COMM_SELF,&Cmat);CHKERRQ(ierr); 1719 ierr = MatSetSizes(Cmat,m,n,m,n);CHKERRQ(ierr); 1720 ierr = MatSetType(Cmat,MATSEQDENSE);CHKERRQ(ierr); 1721 ierr = MatSeqDenseSetPreallocation(Cmat,PETSC_NULL);CHKERRQ(ierr); 1722 Cmat->assembled = PETSC_TRUE; 1723 *C = Cmat; 1724 PetscFunctionReturn(0); 1725 } 1726 1727 #undef __FUNCT__ 1728 #define __FUNCT__ "MatTransposeMatMultNumeric_SeqDense_SeqDense" 1729 PetscErrorCode MatTransposeMatMultNumeric_SeqDense_SeqDense(Mat A,Mat B,Mat C) 1730 { 1731 Mat_SeqDense *a = (Mat_SeqDense*)A->data; 1732 Mat_SeqDense *b = (Mat_SeqDense*)B->data; 1733 Mat_SeqDense *c = (Mat_SeqDense*)C->data; 1734 PetscBLASInt m,n,k; 1735 PetscScalar _DOne=1.0,_DZero=0.0; 1736 1737 PetscFunctionBegin; 1738 m = PetscBLASIntCast(A->cmap->n); 1739 n = PetscBLASIntCast(B->cmap->n); 1740 k = PetscBLASIntCast(A->rmap->n); 1741 /* 1742 Note the m and n arguments below are the number rows and columns of A', not A! 1743 */ 1744 BLASgemm_("T","N",&m,&n,&k,&_DOne,a->v,&a->lda,b->v,&b->lda,&_DZero,c->v,&c->lda); 1745 PetscFunctionReturn(0); 1746 } 1747 1748 #undef __FUNCT__ 1749 #define __FUNCT__ "MatGetRowMax_SeqDense" 1750 PetscErrorCode MatGetRowMax_SeqDense(Mat A,Vec v,PetscInt idx[]) 1751 { 1752 Mat_SeqDense *a = (Mat_SeqDense*)A->data; 1753 PetscErrorCode ierr; 1754 PetscInt i,j,m = A->rmap->n,n = A->cmap->n,p; 1755 PetscScalar *x; 1756 MatScalar *aa = a->v; 1757 1758 PetscFunctionBegin; 1759 if (A->factortype) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Not for factored matrix"); 1760 1761 ierr = VecSet(v,0.0);CHKERRQ(ierr); 1762 ierr = VecGetArray(v,&x);CHKERRQ(ierr); 1763 ierr = VecGetLocalSize(v,&p);CHKERRQ(ierr); 1764 if (p != A->rmap->n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Nonconforming matrix and vector"); 1765 for (i=0; i<m; i++) { 1766 x[i] = aa[i]; if (idx) idx[i] = 0; 1767 for (j=1; j<n; j++){ 1768 if (PetscRealPart(x[i]) < PetscRealPart(aa[i+m*j])) {x[i] = aa[i + m*j]; if (idx) idx[i] = j;} 1769 } 1770 } 1771 ierr = VecRestoreArray(v,&x);CHKERRQ(ierr); 1772 PetscFunctionReturn(0); 1773 } 1774 1775 #undef __FUNCT__ 1776 #define __FUNCT__ "MatGetRowMaxAbs_SeqDense" 1777 PetscErrorCode MatGetRowMaxAbs_SeqDense(Mat A,Vec v,PetscInt idx[]) 1778 { 1779 Mat_SeqDense *a = (Mat_SeqDense*)A->data; 1780 PetscErrorCode ierr; 1781 PetscInt i,j,m = A->rmap->n,n = A->cmap->n,p; 1782 PetscScalar *x; 1783 PetscReal atmp; 1784 MatScalar *aa = a->v; 1785 1786 PetscFunctionBegin; 1787 if (A->factortype) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Not for factored matrix"); 1788 1789 ierr = VecSet(v,0.0);CHKERRQ(ierr); 1790 ierr = VecGetArray(v,&x);CHKERRQ(ierr); 1791 ierr = VecGetLocalSize(v,&p);CHKERRQ(ierr); 1792 if (p != A->rmap->n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Nonconforming matrix and vector"); 1793 for (i=0; i<m; i++) { 1794 x[i] = PetscAbsScalar(aa[i]); 1795 for (j=1; j<n; j++){ 1796 atmp = PetscAbsScalar(aa[i+m*j]); 1797 if (PetscAbsScalar(x[i]) < atmp) {x[i] = atmp; if (idx) idx[i] = j;} 1798 } 1799 } 1800 ierr = VecRestoreArray(v,&x);CHKERRQ(ierr); 1801 PetscFunctionReturn(0); 1802 } 1803 1804 #undef __FUNCT__ 1805 #define __FUNCT__ "MatGetRowMin_SeqDense" 1806 PetscErrorCode MatGetRowMin_SeqDense(Mat A,Vec v,PetscInt idx[]) 1807 { 1808 Mat_SeqDense *a = (Mat_SeqDense*)A->data; 1809 PetscErrorCode ierr; 1810 PetscInt i,j,m = A->rmap->n,n = A->cmap->n,p; 1811 PetscScalar *x; 1812 MatScalar *aa = a->v; 1813 1814 PetscFunctionBegin; 1815 if (A->factortype) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Not for factored matrix"); 1816 1817 ierr = VecSet(v,0.0);CHKERRQ(ierr); 1818 ierr = VecGetArray(v,&x);CHKERRQ(ierr); 1819 ierr = VecGetLocalSize(v,&p);CHKERRQ(ierr); 1820 if (p != A->rmap->n) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Nonconforming matrix and vector"); 1821 for (i=0; i<m; i++) { 1822 x[i] = aa[i]; if (idx) idx[i] = 0; 1823 for (j=1; j<n; j++){ 1824 if (PetscRealPart(x[i]) > PetscRealPart(aa[i+m*j])) {x[i] = aa[i + m*j]; if (idx) idx[i] = j;} 1825 } 1826 } 1827 ierr = VecRestoreArray(v,&x);CHKERRQ(ierr); 1828 PetscFunctionReturn(0); 1829 } 1830 1831 #undef __FUNCT__ 1832 #define __FUNCT__ "MatGetColumnVector_SeqDense" 1833 PetscErrorCode MatGetColumnVector_SeqDense(Mat A,Vec v,PetscInt col) 1834 { 1835 Mat_SeqDense *a = (Mat_SeqDense*)A->data; 1836 PetscErrorCode ierr; 1837 PetscScalar *x; 1838 1839 PetscFunctionBegin; 1840 if (A->factortype) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Not for factored matrix"); 1841 1842 ierr = VecGetArray(v,&x);CHKERRQ(ierr); 1843 ierr = PetscMemcpy(x,a->v+col*a->lda,A->rmap->n*sizeof(PetscScalar));CHKERRQ(ierr); 1844 ierr = VecRestoreArray(v,&x);CHKERRQ(ierr); 1845 PetscFunctionReturn(0); 1846 } 1847 1848 1849 #undef __FUNCT__ 1850 #define __FUNCT__ "MatGetColumnNorms_SeqDense" 1851 PetscErrorCode MatGetColumnNorms_SeqDense(Mat A,NormType type,PetscReal *norms) 1852 { 1853 PetscErrorCode ierr; 1854 PetscInt i,j,m,n; 1855 PetscScalar *a; 1856 1857 PetscFunctionBegin; 1858 ierr = MatGetSize(A,&m,&n);CHKERRQ(ierr); 1859 ierr = PetscMemzero(norms,n*sizeof(PetscReal));CHKERRQ(ierr); 1860 ierr = MatGetArray(A,&a);CHKERRQ(ierr); 1861 if (type == NORM_2) { 1862 for (i=0; i<n; i++ ){ 1863 for (j=0; j<m; j++) { 1864 norms[i] += PetscAbsScalar(a[j]*a[j]); 1865 } 1866 a += m; 1867 } 1868 } else if (type == NORM_1) { 1869 for (i=0; i<n; i++ ){ 1870 for (j=0; j<m; j++) { 1871 norms[i] += PetscAbsScalar(a[j]); 1872 } 1873 a += m; 1874 } 1875 } else if (type == NORM_INFINITY) { 1876 for (i=0; i<n; i++ ){ 1877 for (j=0; j<m; j++) { 1878 norms[i] = PetscMax(PetscAbsScalar(a[j]),norms[i]); 1879 } 1880 a += m; 1881 } 1882 } else SETERRQ(((PetscObject)A)->comm,PETSC_ERR_ARG_WRONG,"Unknown NormType"); 1883 if (type == NORM_2) { 1884 for (i=0; i<n; i++) norms[i] = PetscSqrtReal(norms[i]); 1885 } 1886 PetscFunctionReturn(0); 1887 } 1888 1889 /* -------------------------------------------------------------------*/ 1890 static struct _MatOps MatOps_Values = {MatSetValues_SeqDense, 1891 MatGetRow_SeqDense, 1892 MatRestoreRow_SeqDense, 1893 MatMult_SeqDense, 1894 /* 4*/ MatMultAdd_SeqDense, 1895 MatMultTranspose_SeqDense, 1896 MatMultTransposeAdd_SeqDense, 1897 0, 1898 0, 1899 0, 1900 /*10*/ 0, 1901 MatLUFactor_SeqDense, 1902 MatCholeskyFactor_SeqDense, 1903 MatSOR_SeqDense, 1904 MatTranspose_SeqDense, 1905 /*15*/ MatGetInfo_SeqDense, 1906 MatEqual_SeqDense, 1907 MatGetDiagonal_SeqDense, 1908 MatDiagonalScale_SeqDense, 1909 MatNorm_SeqDense, 1910 /*20*/ MatAssemblyBegin_SeqDense, 1911 MatAssemblyEnd_SeqDense, 1912 MatSetOption_SeqDense, 1913 MatZeroEntries_SeqDense, 1914 /*24*/ MatZeroRows_SeqDense, 1915 0, 1916 0, 1917 0, 1918 0, 1919 /*29*/ MatSetUp_SeqDense, 1920 0, 1921 0, 1922 MatGetArray_SeqDense, 1923 MatRestoreArray_SeqDense, 1924 /*34*/ MatDuplicate_SeqDense, 1925 0, 1926 0, 1927 0, 1928 0, 1929 /*39*/ MatAXPY_SeqDense, 1930 MatGetSubMatrices_SeqDense, 1931 0, 1932 MatGetValues_SeqDense, 1933 MatCopy_SeqDense, 1934 /*44*/ MatGetRowMax_SeqDense, 1935 MatScale_SeqDense, 1936 0, 1937 0, 1938 0, 1939 /*49*/ 0, 1940 0, 1941 0, 1942 0, 1943 0, 1944 /*54*/ 0, 1945 0, 1946 0, 1947 0, 1948 0, 1949 /*59*/ 0, 1950 MatDestroy_SeqDense, 1951 MatView_SeqDense, 1952 0, 1953 0, 1954 /*64*/ 0, 1955 0, 1956 0, 1957 0, 1958 0, 1959 /*69*/ MatGetRowMaxAbs_SeqDense, 1960 0, 1961 0, 1962 0, 1963 0, 1964 /*74*/ 0, 1965 0, 1966 0, 1967 0, 1968 0, 1969 /*79*/ 0, 1970 0, 1971 0, 1972 0, 1973 /*83*/ MatLoad_SeqDense, 1974 0, 1975 MatIsHermitian_SeqDense, 1976 0, 1977 0, 1978 0, 1979 /*89*/ MatMatMult_SeqDense_SeqDense, 1980 MatMatMultSymbolic_SeqDense_SeqDense, 1981 MatMatMultNumeric_SeqDense_SeqDense, 1982 0, 1983 0, 1984 /*94*/ 0, 1985 0, 1986 0, 1987 0, 1988 0, 1989 /*99*/ 0, 1990 0, 1991 0, 1992 MatConjugate_SeqDense, 1993 0, 1994 /*104*/0, 1995 MatRealPart_SeqDense, 1996 MatImaginaryPart_SeqDense, 1997 0, 1998 0, 1999 /*109*/MatMatSolve_SeqDense, 2000 0, 2001 MatGetRowMin_SeqDense, 2002 MatGetColumnVector_SeqDense, 2003 0, 2004 /*114*/0, 2005 0, 2006 0, 2007 0, 2008 0, 2009 /*119*/0, 2010 0, 2011 0, 2012 0, 2013 0, 2014 /*124*/0, 2015 MatGetColumnNorms_SeqDense, 2016 0, 2017 0, 2018 0, 2019 /*129*/0, 2020 MatTransposeMatMult_SeqDense_SeqDense, 2021 MatTransposeMatMultSymbolic_SeqDense_SeqDense, 2022 MatTransposeMatMultNumeric_SeqDense_SeqDense, 2023 }; 2024 2025 #undef __FUNCT__ 2026 #define __FUNCT__ "MatCreateSeqDense" 2027 /*@C 2028 MatCreateSeqDense - Creates a sequential dense matrix that 2029 is stored in column major order (the usual Fortran 77 manner). Many 2030 of the matrix operations use the BLAS and LAPACK routines. 2031 2032 Collective on MPI_Comm 2033 2034 Input Parameters: 2035 + comm - MPI communicator, set to PETSC_COMM_SELF 2036 . m - number of rows 2037 . n - number of columns 2038 - data - optional location of matrix data in column major order. Set data=PETSC_NULL for PETSc 2039 to control all matrix memory allocation. 2040 2041 Output Parameter: 2042 . A - the matrix 2043 2044 Notes: 2045 The data input variable is intended primarily for Fortran programmers 2046 who wish to allocate their own matrix memory space. Most users should 2047 set data=PETSC_NULL. 2048 2049 Level: intermediate 2050 2051 .keywords: dense, matrix, LAPACK, BLAS 2052 2053 .seealso: MatCreate(), MatCreateDense(), MatSetValues() 2054 @*/ 2055 PetscErrorCode MatCreateSeqDense(MPI_Comm comm,PetscInt m,PetscInt n,PetscScalar *data,Mat *A) 2056 { 2057 PetscErrorCode ierr; 2058 2059 PetscFunctionBegin; 2060 ierr = MatCreate(comm,A);CHKERRQ(ierr); 2061 ierr = MatSetSizes(*A,m,n,m,n);CHKERRQ(ierr); 2062 ierr = MatSetType(*A,MATSEQDENSE);CHKERRQ(ierr); 2063 ierr = MatSeqDenseSetPreallocation(*A,data);CHKERRQ(ierr); 2064 PetscFunctionReturn(0); 2065 } 2066 2067 #undef __FUNCT__ 2068 #define __FUNCT__ "MatSeqDenseSetPreallocation" 2069 /*@C 2070 MatSeqDenseSetPreallocation - Sets the array used for storing the matrix elements 2071 2072 Collective on MPI_Comm 2073 2074 Input Parameters: 2075 + A - the matrix 2076 - data - the array (or PETSC_NULL) 2077 2078 Notes: 2079 The data input variable is intended primarily for Fortran programmers 2080 who wish to allocate their own matrix memory space. Most users should 2081 need not call this routine. 2082 2083 Level: intermediate 2084 2085 .keywords: dense, matrix, LAPACK, BLAS 2086 2087 .seealso: MatCreate(), MatCreateDense(), MatSetValues(), MatSeqDenseSetLDA() 2088 2089 @*/ 2090 PetscErrorCode MatSeqDenseSetPreallocation(Mat B,PetscScalar data[]) 2091 { 2092 PetscErrorCode ierr; 2093 2094 PetscFunctionBegin; 2095 ierr = PetscTryMethod(B,"MatSeqDenseSetPreallocation_C",(Mat,PetscScalar[]),(B,data));CHKERRQ(ierr); 2096 PetscFunctionReturn(0); 2097 } 2098 2099 EXTERN_C_BEGIN 2100 #undef __FUNCT__ 2101 #define __FUNCT__ "MatSeqDenseSetPreallocation_SeqDense" 2102 PetscErrorCode MatSeqDenseSetPreallocation_SeqDense(Mat B,PetscScalar *data) 2103 { 2104 Mat_SeqDense *b; 2105 PetscErrorCode ierr; 2106 2107 PetscFunctionBegin; 2108 B->preallocated = PETSC_TRUE; 2109 2110 ierr = PetscLayoutSetUp(B->rmap);CHKERRQ(ierr); 2111 ierr = PetscLayoutSetUp(B->cmap);CHKERRQ(ierr); 2112 2113 b = (Mat_SeqDense*)B->data; 2114 b->Mmax = B->rmap->n; 2115 b->Nmax = B->cmap->n; 2116 if(b->lda <= 0 || b->changelda) b->lda = B->rmap->n; 2117 2118 if (!data) { /* petsc-allocated storage */ 2119 if (!b->user_alloc) { ierr = PetscFree(b->v);CHKERRQ(ierr); } 2120 ierr = PetscMalloc(b->lda*b->Nmax*sizeof(PetscScalar),&b->v);CHKERRQ(ierr); 2121 ierr = PetscMemzero(b->v,b->lda*b->Nmax*sizeof(PetscScalar));CHKERRQ(ierr); 2122 ierr = PetscLogObjectMemory(B,b->lda*b->Nmax*sizeof(PetscScalar));CHKERRQ(ierr); 2123 b->user_alloc = PETSC_FALSE; 2124 } else { /* user-allocated storage */ 2125 if (!b->user_alloc) { ierr = PetscFree(b->v);CHKERRQ(ierr); } 2126 b->v = data; 2127 b->user_alloc = PETSC_TRUE; 2128 } 2129 B->assembled = PETSC_TRUE; 2130 PetscFunctionReturn(0); 2131 } 2132 EXTERN_C_END 2133 2134 #undef __FUNCT__ 2135 #define __FUNCT__ "MatSeqDenseSetLDA" 2136 /*@C 2137 MatSeqDenseSetLDA - Declare the leading dimension of the user-provided array 2138 2139 Input parameter: 2140 + A - the matrix 2141 - lda - the leading dimension 2142 2143 Notes: 2144 This routine is to be used in conjunction with MatSeqDenseSetPreallocation(); 2145 it asserts that the preallocation has a leading dimension (the LDA parameter 2146 of Blas and Lapack fame) larger than M, the first dimension of the matrix. 2147 2148 Level: intermediate 2149 2150 .keywords: dense, matrix, LAPACK, BLAS 2151 2152 .seealso: MatCreate(), MatCreateSeqDense(), MatSeqDenseSetPreallocation(), MatSetMaximumSize() 2153 2154 @*/ 2155 PetscErrorCode MatSeqDenseSetLDA(Mat B,PetscInt lda) 2156 { 2157 Mat_SeqDense *b = (Mat_SeqDense*)B->data; 2158 2159 PetscFunctionBegin; 2160 if (lda < B->rmap->n) SETERRQ2(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"LDA %D must be at least matrix dimension %D",lda,B->rmap->n); 2161 b->lda = lda; 2162 b->changelda = PETSC_FALSE; 2163 b->Mmax = PetscMax(b->Mmax,lda); 2164 PetscFunctionReturn(0); 2165 } 2166 2167 /*MC 2168 MATSEQDENSE - MATSEQDENSE = "seqdense" - A matrix type to be used for sequential dense matrices. 2169 2170 Options Database Keys: 2171 . -mat_type seqdense - sets the matrix type to "seqdense" during a call to MatSetFromOptions() 2172 2173 Level: beginner 2174 2175 .seealso: MatCreateSeqDense() 2176 2177 M*/ 2178 2179 EXTERN_C_BEGIN 2180 #undef __FUNCT__ 2181 #define __FUNCT__ "MatCreate_SeqDense" 2182 PetscErrorCode MatCreate_SeqDense(Mat B) 2183 { 2184 Mat_SeqDense *b; 2185 PetscErrorCode ierr; 2186 PetscMPIInt size; 2187 2188 PetscFunctionBegin; 2189 ierr = MPI_Comm_size(((PetscObject)B)->comm,&size);CHKERRQ(ierr); 2190 if (size > 1) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Comm must be of size 1"); 2191 2192 ierr = PetscNewLog(B,Mat_SeqDense,&b);CHKERRQ(ierr); 2193 ierr = PetscMemcpy(B->ops,&MatOps_Values,sizeof(struct _MatOps));CHKERRQ(ierr); 2194 B->data = (void*)b; 2195 2196 b->pivots = 0; 2197 b->roworiented = PETSC_TRUE; 2198 b->v = 0; 2199 b->changelda = PETSC_FALSE; 2200 2201 2202 ierr = PetscObjectComposeFunctionDynamic((PetscObject)B,"MatConvert_seqdense_seqaij_C","MatConvert_SeqDense_SeqAIJ",MatConvert_SeqDense_SeqAIJ);CHKERRQ(ierr); 2203 ierr = PetscObjectComposeFunctionDynamic((PetscObject)B,"MatGetFactor_petsc_C", 2204 "MatGetFactor_seqdense_petsc", 2205 MatGetFactor_seqdense_petsc);CHKERRQ(ierr); 2206 ierr = PetscObjectComposeFunctionDynamic((PetscObject)B,"MatSeqDenseSetPreallocation_C", 2207 "MatSeqDenseSetPreallocation_SeqDense", 2208 MatSeqDenseSetPreallocation_SeqDense);CHKERRQ(ierr); 2209 2210 ierr = PetscObjectComposeFunctionDynamic((PetscObject)B,"MatMatMult_seqaij_seqdense_C", 2211 "MatMatMult_SeqAIJ_SeqDense", 2212 MatMatMult_SeqAIJ_SeqDense);CHKERRQ(ierr); 2213 2214 2215 ierr = PetscObjectComposeFunctionDynamic((PetscObject)B,"MatMatMultSymbolic_seqaij_seqdense_C", 2216 "MatMatMultSymbolic_SeqAIJ_SeqDense", 2217 MatMatMultSymbolic_SeqAIJ_SeqDense);CHKERRQ(ierr); 2218 ierr = PetscObjectComposeFunctionDynamic((PetscObject)B,"MatMatMultNumeric_seqaij_seqdense_C", 2219 "MatMatMultNumeric_SeqAIJ_SeqDense", 2220 MatMatMultNumeric_SeqAIJ_SeqDense);CHKERRQ(ierr); 2221 ierr = PetscObjectChangeTypeName((PetscObject)B,MATSEQDENSE);CHKERRQ(ierr); 2222 PetscFunctionReturn(0); 2223 } 2224 EXTERN_C_END 2225