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