PetscErrorCode TSPrecond_Sundials(realtype tn,N_Vector y,N_Vector fy,
booleantype jok,booleantype *jcurPtr,
realtype _gamma,void *P_data,
N_Vector vtemp1,N_Vector vtemp2,N_Vector vtemp3)
{
TS ts = (TS) P_data;
TS_Sundials *cvode = (TS_Sundials*)ts->data;
PC pc = cvode->pc;
PetscErrorCode ierr;
Mat Jac = ts->B;
Vec yy = cvode->w1;
PetscScalar one = 1.0,gm;
MatStructure str = DIFFERENT_NONZERO_PATTERN;
PetscScalar *y_data;
PetscFunctionBegin;
/* This allows us to construct preconditioners in-place if we like */
ierr = MatSetUnfactored(Jac);CHKERRQ(ierr);
/* jok - TRUE means reuse current Jacobian else recompute Jacobian */
if (jok) {
ierr = MatCopy(cvode->pmat,Jac,str);CHKERRQ(ierr);
*jcurPtr = FALSE;
} else {
/* make PETSc vector yy point to SUNDIALS vector y */
y_data = (PetscScalar *) N_VGetArrayPointer(y);
ierr = VecPlaceArray(yy,y_data); CHKERRQ(ierr);
/* compute the Jacobian */
ierr = TSComputeRHSJacobian(ts,ts->ptime,yy,&Jac,&Jac,&str);CHKERRQ(ierr);
ierr = VecResetArray(yy); CHKERRQ(ierr);
/* copy the Jacobian matrix */
if (!cvode->pmat) {
ierr = MatDuplicate(Jac,MAT_COPY_VALUES,&cvode->pmat);CHKERRQ(ierr);
ierr = PetscLogObjectParent(ts,cvode->pmat);CHKERRQ(ierr);
} else {
ierr = MatCopy(Jac,cvode->pmat,str);CHKERRQ(ierr);
}
*jcurPtr = TRUE;
}
/* construct I-gamma*Jac */
gm = -_gamma;
ierr = MatScale(Jac,gm);CHKERRQ(ierr);
ierr = MatShift(Jac,one);CHKERRQ(ierr);
ierr = PCSetOperators(pc,Jac,Jac,str);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
static PetscErrorCode MatDuplicate_LMVM(Mat B, MatDuplicateOption op, Mat *mat)
{
Mat_LMVM *bctx = (Mat_LMVM*)B->data;
Mat_LMVM *mctx;
PetscErrorCode ierr;
MatType lmvmType;
Mat A;
PetscFunctionBegin;
ierr = MatGetType(B, &lmvmType);CHKERRQ(ierr);
ierr = MatCreate(PetscObjectComm((PetscObject)B), mat);CHKERRQ(ierr);
ierr = MatSetType(*mat, lmvmType);CHKERRQ(ierr);
A = *mat;
mctx = (Mat_LMVM*)A->data;
mctx->m = bctx->m;
mctx->ksp_max_it = bctx->ksp_max_it;
mctx->ksp_rtol = bctx->ksp_rtol;
mctx->ksp_atol = bctx->ksp_atol;
mctx->shift = bctx->shift;
ierr = KSPSetTolerances(mctx->J0ksp, mctx->ksp_rtol, mctx->ksp_atol, PETSC_DEFAULT, mctx->ksp_max_it);CHKERRQ(ierr);
ierr = MatLMVMAllocate(*mat, bctx->Xprev, bctx->Fprev);CHKERRQ(ierr);
if (op == MAT_COPY_VALUES) {
ierr = MatCopy(B, *mat, SAME_NONZERO_PATTERN);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
// Compute the minimum-norm solution to a real linear least squares problem
// minimize 2-norm (|b-A*x|)
void MatB_Ax( Mat &A, Mat &B, Mat &X)
{
integer m = A.row;
integer n = A.col;
integer nrhs = B.col;
integer lda = A.row;
integer ldb = B.row;
doublereal rcond = 1e-5;
doublereal wkopt;
doublereal *work;
integer *iwork = new integer[3*m*0+11*m];
integer info, rank;
doublereal S[3];
MatCopy( B, X);
integer lwork = -1;
dgelsd_( &m, &n, &nrhs, A.data, &lda, X.data, &ldb, S, &rcond, &rank, &wkopt, &lwork, iwork, &info);
lwork = (integer)wkopt;
work = new doublereal[lwork];
dgelsd_( &m, &n, &nrhs, A.data, &lda, X.data, &ldb, S, &rcond, &rank, work, &lwork, iwork, &info);
/* Check for convergence */
if( info != 0 ) {
printf( "The algorithm computing SVD failed to converge;\n" );
printf( "the least squares solution could not be computed.\n" );
system("pause");
}
delete [] work;
delete [] iwork;
}
PetscErrorCode _RHS_time_dep_ham_p(TS ts,PetscReal t,Vec X,Mat AA,Mat BB,void *ctx){
double time_dep_val;
PetscScalar time_dep_scalar;
int i,j;
operator op;
MatZeroEntries(AA);
MatCopy(full_A,AA,SAME_NONZERO_PATTERN);
for (i=0;i<_num_time_dep;i++){
time_dep_val = _time_dep_list[i].time_dep_func(t);
_add_ops_to_mat_ham(time_dep_val,AA,_time_dep_list[i].num_ops,_time_dep_list[i].ops);
}
for (i=0;i<_num_time_dep_lin;i++){
time_dep_val = _time_dep_list_lin[i].time_dep_func(t);
_add_ops_to_mat_lin(time_dep_val,AA,_time_dep_list_lin[i].num_ops,_time_dep_list_lin[i].ops);
}
MatAssemblyBegin(AA,MAT_FINAL_ASSEMBLY);
MatAssemblyEnd(AA,MAT_FINAL_ASSEMBLY);
if(AA!=BB) {
MatAssemblyBegin(AA,MAT_FINAL_ASSEMBLY);
MatAssemblyEnd(AA,MAT_FINAL_ASSEMBLY);
}
PetscFunctionReturn(0);
}
// C = A*scalar
void MatAs( Mat &A, double B, Mat &C)
{
MatCopy( A, C);
for ( int k = 0 ; k < A.len ; k++)
{
C.data[k] = A.data[k] * B;
}
}
/*
FormJacobian1 - Evaluates Jacobian matrix.
Input Parameters:
. snes - the SNES context
. x - input vector
. ctx - optional user-defined context
Output Parameters:
. jac - Jacobian matrix
. B - optionally different preconditioning matrix
. flag - flag indicating matrix structure
*/
PetscErrorCode FormJacobian1(SNES snes,Vec x,Mat *jac,Mat *B,MatStructure *flag,void *ctx)
{
PetscErrorCode ierr;
AppCtx *user = (AppCtx*)ctx;
ierr = MatCopy(user->M,*jac,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
ierr = MatAssemblyBegin(*jac,MAT_FINAL_ASSEMBLY);
ierr = MatAssemblyEnd(*jac,MAT_FINAL_ASSEMBLY);
return 0;
}
PetscErrorCode FormJacobian(SNES snes,Vec X,Mat J,Mat B,void *ctx)
{
PetscErrorCode ierr;
AppCtx *user=(AppCtx*)ctx;
PetscFunctionBeginUser;
ierr = MatCopy(user->M,J,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
ierr = MatAssemblyBegin(J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
int main(int argc,char **args)
{
const PetscScalar xvals[] = {11,13},yvals[] = {17,19};
const PetscInt inds[] = {0,1};
PetscScalar avals[] = {2,3,5,7};
Mat S1,S2;
Vec X,Y;
User user;
PetscErrorCode ierr;
ierr = PetscInitialize(&argc,&args,(char*)0,help);if (ierr) return ierr;
ierr = PetscNew(&user);CHKERRQ(ierr);
ierr = MatCreateSeqAIJ(PETSC_COMM_WORLD,2,2,2,NULL,&user->A);CHKERRQ(ierr);
ierr = MatSetUp(user->A);CHKERRQ(ierr);
ierr = MatSetValues(user->A,2,inds,2,inds,avals,INSERT_VALUES);CHKERRQ(ierr);
ierr = MatAssemblyBegin(user->A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(user->A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = VecCreateSeq(PETSC_COMM_WORLD,2,&X);CHKERRQ(ierr);
ierr = VecSetValues(X,2,inds,xvals,INSERT_VALUES);CHKERRQ(ierr);
ierr = VecAssemblyBegin(X);CHKERRQ(ierr);
ierr = VecAssemblyEnd(X);CHKERRQ(ierr);
ierr = VecDuplicate(X,&Y);CHKERRQ(ierr);
ierr = VecSetValues(Y,2,inds,yvals,INSERT_VALUES);CHKERRQ(ierr);
ierr = VecAssemblyBegin(Y);CHKERRQ(ierr);
ierr = VecAssemblyEnd(Y);CHKERRQ(ierr);
ierr = MatCreateShell(PETSC_COMM_WORLD,2,2,2,2,user,&S1);CHKERRQ(ierr);
ierr = MatSetUp(S1);CHKERRQ(ierr);
ierr = MatShellSetOperation(S1,MATOP_MULT,(void (*)(void))MatMult_User);CHKERRQ(ierr);
ierr = MatShellSetOperation(S1,MATOP_COPY,(void (*)(void))MatCopy_User);CHKERRQ(ierr);
ierr = MatShellSetOperation(S1,MATOP_DESTROY,(void (*)(void))MatDestroy_User);CHKERRQ(ierr);
ierr = MatCreateShell(PETSC_COMM_WORLD,2,2,2,2,NULL,&S2);CHKERRQ(ierr);
ierr = MatSetUp(S2);CHKERRQ(ierr);
ierr = MatShellSetOperation(S2,MATOP_MULT,(void (*)(void))MatMult_User);CHKERRQ(ierr);
ierr = MatShellSetOperation(S2,MATOP_COPY,(void (*)(void))MatCopy_User);CHKERRQ(ierr);
ierr = MatShellSetOperation(S2,MATOP_DESTROY,(void (*)(void))MatDestroy_User);CHKERRQ(ierr);
ierr = MatScale(S1,31);CHKERRQ(ierr);
ierr = MatShift(S1,37);CHKERRQ(ierr);
ierr = MatDiagonalScale(S1,X,Y);CHKERRQ(ierr);
ierr = MatCopy(S1,S2,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
ierr = MatMult(S1,X,Y);CHKERRQ(ierr);
ierr = VecView(Y,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
ierr = MatMult(S2,X,Y);CHKERRQ(ierr);
ierr = VecView(Y,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
ierr = MatDestroy(&S1);CHKERRQ(ierr);
ierr = MatDestroy(&S2);CHKERRQ(ierr);
ierr = VecDestroy(&X);CHKERRQ(ierr);
ierr = VecDestroy(&Y);CHKERRQ(ierr);
ierr = PetscFinalize();
return ierr;
}
PetscErrorCode H2SetH(H2 h2) {
PetscErrorCode ierr;
PetscReal a = h2->bondlength/2.0;
if(h2->H == NULL) {
ierr = MatConvert(h2->H0, MATSAME, MAT_INITIAL_MATRIX, &h2->H); CHKERRQ(ierr);
} else {
ierr = MatCopy(h2->H0, h2->H, DIFFERENT_NONZERO_PATTERN); CHKERRQ(ierr);
}
ierr = OCE2PlusVneMat(h2->oce, a, 1.0, h2->H); CHKERRQ(ierr);
return 0;
}
PetscErrorCode FormJacobian(SNES snes,Vec X,Mat *J,Mat *B,MatStructure *flg,void *ctx)
{
PetscErrorCode ierr;
AppCtx *user=(AppCtx*)ctx;
PetscFunctionBeginUser;
*flg = SAME_NONZERO_PATTERN;
ierr = MatCopy(user->M,*J,*flg);CHKERRQ(ierr);
ierr = MatAssemblyBegin(*J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(*J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
// C = A+B
void MatAdd( Mat &A, Mat &B, Mat &C)
{
if ( B.row != A.row || B.col != A.col)
{
cerr<<"[Error:CMatrix+] Matrix dimensions must agree."<<endl;
system("pause");
exit(0);
}
MatCopy( A, C);
Add_AB( A.data, B.data, C.data, C.len);
}
/*@
MatCreateSchurComplementPmat - create a preconditioning matrix for the Schur complement by assembling Sp = A11 - A10 inv(diag(A00)) A01
Collective on Mat
Input Parameters:
+ A00,A01,A10,A11 - the four parts of the original matrix A = [A00 A01; A10 A11] (A01,A10, and A11 are optional, implying zero matrices)
. ainvtype - type of approximation for inv(A00) used when forming Sp = A11 - A10 inv(A00) A01
- preuse - MAT_INITIAL_MATRIX for a new Sp, or MAT_REUSE_MATRIX to reuse an existing Sp, or MAT_IGNORE_MATRIX to put nothing in Sp
Output Parameter:
- Spmat - approximate Schur complement suitable for preconditioning S = A11 - A10 inv(diag(A00)) A01
Note:
Since the real Schur complement is usually dense, providing a good approximation to newpmat usually requires
application-specific information. The default for assembled matrices is to use the inverse of the diagonal of
the (0,0) block A00 in place of A00^{-1}. This rarely produce a scalable algorithm. Optionally, A00 can be lumped
before forming inv(diag(A00)).
Level: advanced
Concepts: matrices^submatrices
.seealso: MatCreateSchurComplement(), MatGetSchurComplement(), MatSchurComplementGetPmat(), MatSchurComplementAinvType
@*/
PetscErrorCode MatCreateSchurComplementPmat(Mat A00,Mat A01,Mat A10,Mat A11,MatSchurComplementAinvType ainvtype,MatReuse preuse,Mat *Spmat)
{
PetscErrorCode ierr;
PetscInt N00;
PetscFunctionBegin;
/* Use an appropriate approximate inverse of A00 to form A11 - A10 inv(diag(A00)) A01; a NULL A01, A10 or A11 indicates a zero matrix. */
/* TODO: Perhaps should create an appropriately-sized zero matrix of the same type as A00? */
if ((!A01 || !A10) & !A11) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONGSTATE,"Cannot assemble Spmat: A01, A10 and A11 are all NULL.");
if (preuse == MAT_IGNORE_MATRIX) PetscFunctionReturn(0);
/* A zero size A00 or empty A01 or A10 imply S = A11. */
ierr = MatGetSize(A00,&N00,NULL);CHKERRQ(ierr);
if (!A01 || !A10 || !N00) {
if (preuse == MAT_INITIAL_MATRIX) {
ierr = MatDuplicate(A11,MAT_COPY_VALUES,Spmat);CHKERRQ(ierr);
} else { /* MAT_REUSE_MATRIX */
/* TODO: when can we pass SAME_NONZERO_PATTERN? */
ierr = MatCopy(A11,*Spmat,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
}
} else {
Mat AdB;
Vec diag;
ierr = MatCreateVecs(A00,&diag,NULL);CHKERRQ(ierr);
if (ainvtype == MAT_SCHUR_COMPLEMENT_AINV_LUMP) {
ierr = MatGetRowSum(A00,diag);CHKERRQ(ierr);
} else if (ainvtype == MAT_SCHUR_COMPLEMENT_AINV_DIAG) {
ierr = MatGetDiagonal(A00,diag);CHKERRQ(ierr);
} else SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Unknown MatSchurComplementAinvType: %D", ainvtype);
ierr = VecReciprocal(diag);CHKERRQ(ierr);
ierr = MatDuplicate(A01,MAT_COPY_VALUES,&AdB);CHKERRQ(ierr);
ierr = MatDiagonalScale(AdB,diag,NULL);CHKERRQ(ierr);
ierr = VecDestroy(&diag);CHKERRQ(ierr);
/* Cannot really reuse Spmat in MatMatMult() because of MatAYPX() -->
MatAXPY() --> MatHeaderReplace() --> MatDestroy_XXX_MatMatMult() */
ierr = MatDestroy(Spmat);CHKERRQ(ierr);
ierr = MatMatMult(A10,AdB,MAT_INITIAL_MATRIX,PETSC_DEFAULT,Spmat);CHKERRQ(ierr);
if (!A11) {
ierr = MatScale(*Spmat,-1.0);CHKERRQ(ierr);
} else {
/* TODO: when can we pass SAME_NONZERO_PATTERN? */
ierr = MatAYPX(*Spmat,-1,A11,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
}
ierr = MatDestroy(&AdB);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
PetscErrorCode FormJacobian(SNES snes,Vec X,Mat J,Mat B,void *ctx)
{
PetscErrorCode ierr;
AppCtx *user =(AppCtx*)ctx;
static PetscBool copied = PETSC_FALSE;
PetscFunctionBeginUser;
/* for active set method the matrix does not get changed, so do not need to copy each time,
if the active set remains the same for several solves the preconditioner does not need to be rebuilt*/
if (!copied) {
ierr = MatCopy(user->M,J,*flg);CHKERRQ(ierr);
copied = PETSC_TRUE;
}
ierr = MatAssemblyBegin(J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
// C = A*B
void MatAB( Mat &A, Mat &B, Mat &C, int dot)
{
if (dot)
{
if ( B.row != A.row || B.col != A.col)
{
cerr<<"[Error:CMatrix*] Matrix dimensions must agree."<<endl;
system("pause");
exit(0);
}
MatCopy( A, C);
for ( int y = 0 ; y < C.row ; y++)
{
for ( int x = 0 ; x < C.col ; x++)
{
C.data[y*C.col+x] = A.data[y*C.col+x]*B.data[y*C.col+x];
}
}
}
else
{
if ( B.row != A.col)
{
cerr<<"[Error:CMatrix*] Matrix dimensions must agree."<<endl;
system("pause");
exit(0);
}
MatInitialize( A.row, B.col, C);
for ( int y = 0 ; y < C.row ; y++)
{
for ( int x = 0 ; x < C.col ; x++)
{
double tmp = 0.;
for ( int k = 0 ; k < A.col ; k++)
{
tmp += A.data[y*A.col+k] * B.data[k*B.col+x];
}
C.data[y*C.col+x] = tmp;
}
}
}
}
// -------------------------------------------------------------
// MatConvertToDenseGA
// -------------------------------------------------------------
PetscErrorCode
MatConvertToDenseGA(Mat A, Mat *B)
{
PetscErrorCode ierr = 0;
MPI_Comm comm;
int lrows, grows, lcols, gcols;
ierr = PetscObjectGetComm((PetscObject)A, &comm); CHKERRQ(ierr);
ierr = MatGetSize(A, &grows, &gcols); CHKERRQ(ierr);
ierr = MatGetLocalSize(A, &lrows, &lcols); CHKERRQ(ierr);
ierr = MatCreateDenseGA(comm, lrows, lcols, grows, gcols, B); CHKERRXX(ierr);
ierr = MatCopy(A, *B, SAME_NONZERO_PATTERN); CHKERRXX(ierr);
return ierr;
}
void PrepareInvMatrix(float Tx, float Ty, float Tz,
float Sx, float Sy, float Sz,
float Rx, float Ry, float Rz,
Matx4x4 XForm)
{
Matx4x4 M1, M2, M3, M4, M5, M6, M7, M8, M9;
Scale3D(Sx, Sy, Sz, M1);
Rotate3D(1, Rx, M2);
Rotate3D(2, Ry, M3);
Rotate3D(3, Rz, M4);
Translate3D(Tx, Ty, Tz, M5);
Multiply3DMatricies(M4, M5, M6);
Multiply3DMatricies(M3, M6, M7);
Multiply3DMatricies(M2, M7, M8);
Multiply3DMatricies(M1, M8, M9);
MatCopy(M9, XForm);
}
PetscErrorCode _RHS_time_dep_ham(TS ts,PetscReal t,Vec X,Mat AA,Mat BB,void *ctx){
double time_dep_val;
PetscScalar time_dep_scalar;
int i,j;
operator op;
MatZeroEntries(AA);
MatCopy(full_A,AA,SAME_NONZERO_PATTERN);
for (i=0;i<_num_time_dep;i++){
time_dep_val = _time_dep_list[i].time_dep_func(t);
for(j=0;j<_time_dep_list[i].num_ops;j++){
op = _time_dep_list[i].ops[j];
/* Add -i *(I cross H(t)) */
time_dep_scalar = 0 - time_dep_val*PETSC_i;
_add_to_PETSc_kron(AA,time_dep_scalar,op->n_before,op->my_levels,
op->my_op_type,op->position,total_levels,1,0);
/* Add i *(H(t)^T cross I) */
time_dep_scalar = 0 + time_dep_val*PETSC_i;
_add_to_PETSc_kron(AA,time_dep_scalar,op->n_before,op->my_levels,
op->my_op_type,op->position,1,total_levels,1);
}
/* Consider putting _time_dep_func and _time_dep_mats in *ctx? */
}
MatAssemblyBegin(AA,MAT_FINAL_ASSEMBLY);
MatAssemblyEnd(AA,MAT_FINAL_ASSEMBLY);
if(AA!=BB) {
MatAssemblyBegin(AA,MAT_FINAL_ASSEMBLY);
MatAssemblyEnd(AA,MAT_FINAL_ASSEMBLY);
}
PetscFunctionReturn(0);
}
/*
K is the discretiziation of the Laplacian
G is the discretization of the gradient
Computes Jacobian of K u + diag(u) G u which is given by
K + diag(u)G + diag(Gu)
*/
PetscErrorCode RHSJacobian(TS ts,PetscReal t,Vec globalin,Mat A, Mat B,void *ctx)
{
PetscErrorCode ierr;
AppCtx *appctx = (AppCtx*)ctx;
Vec Gglobalin;
PetscFunctionBegin;
/* A = diag(u) G */
ierr = MatCopy(appctx->SEMop.grad,A,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
ierr = MatDiagonalScale(A,globalin,NULL);CHKERRQ(ierr);
/* A = A + diag(Gu) */
ierr = VecDuplicate(globalin,&Gglobalin);CHKERRQ(ierr);
ierr = MatMult(appctx->SEMop.grad,globalin,Gglobalin);CHKERRQ(ierr);
ierr = MatDiagonalSet(A,Gglobalin,ADD_VALUES);CHKERRQ(ierr);
ierr = VecDestroy(&Gglobalin);CHKERRQ(ierr);
/* A = K - A */
ierr = MatScale(A,-1.0);CHKERRQ(ierr);
ierr = MatAXPY(A,0.0,appctx->SEMop.keptstiff,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode TaoPounders_solvequadratic(Tao tao,PetscReal *gnorm, PetscReal *qmin)
{
PetscErrorCode ierr;
#if defined(PETSC_USE_REAL_SINGLE)
PetscReal atol=1.0e-5;
#else
PetscReal atol=1.0e-10;
#endif
PetscInt info,its;
TAO_POUNDERS *mfqP = (TAO_POUNDERS*)tao->data;
PetscReal maxval;
PetscInt i,j;
PetscFunctionBegin;
ierr = VecCopy(mfqP->Gres, mfqP->subb);CHKERRQ(ierr);
ierr = VecSet(mfqP->subx,0.0);CHKERRQ(ierr);
ierr = VecSet(mfqP->subndel,-mfqP->delta);CHKERRQ(ierr);
ierr = VecSet(mfqP->subpdel,mfqP->delta);CHKERRQ(ierr);
ierr = MatCopy(mfqP->Hres,mfqP->subH,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
ierr = TaoResetStatistics(mfqP->subtao);CHKERRQ(ierr);
ierr = TaoSetTolerances(mfqP->subtao,NULL,NULL,*gnorm,*gnorm,NULL);CHKERRQ(ierr);
/* enforce bound constraints -- experimental */
if (tao->XU && tao->XL) {
ierr = VecCopy(tao->XU,mfqP->subxu);CHKERRQ(ierr);
ierr = VecAXPY(mfqP->subxu,-1.0,tao->solution);CHKERRQ(ierr);
ierr = VecScale(mfqP->subxu,1.0/mfqP->delta);CHKERRQ(ierr);
ierr = VecCopy(tao->XL,mfqP->subxl);CHKERRQ(ierr);
ierr = VecAXPY(mfqP->subxl,-1.0,tao->solution);CHKERRQ(ierr);
ierr = VecScale(mfqP->subxl,1.0/mfqP->delta);CHKERRQ(ierr);
ierr = VecPointwiseMin(mfqP->subxu,mfqP->subxu,mfqP->subpdel);CHKERRQ(ierr);
ierr = VecPointwiseMax(mfqP->subxl,mfqP->subxl,mfqP->subndel);CHKERRQ(ierr);
} else {
ierr = VecCopy(mfqP->subpdel,mfqP->subxu);CHKERRQ(ierr);
ierr = VecCopy(mfqP->subndel,mfqP->subxl);CHKERRQ(ierr);
}
/* Make sure xu > xl */
ierr = VecCopy(mfqP->subxl,mfqP->subpdel);CHKERRQ(ierr);
ierr = VecAXPY(mfqP->subpdel,-1.0,mfqP->subxu); CHKERRQ(ierr);
ierr = VecMax(mfqP->subpdel,NULL,&maxval);CHKERRQ(ierr);
if (maxval > 1e-10) {
SETERRQ(PETSC_COMM_WORLD,1,"upper bound < lower bound in subproblem");
}
/* Make sure xu > tao->solution > xl */
ierr = VecCopy(mfqP->subxl,mfqP->subpdel);CHKERRQ(ierr);
ierr = VecAXPY(mfqP->subpdel,-1.0,mfqP->subx); CHKERRQ(ierr);
ierr = VecMax(mfqP->subpdel,NULL,&maxval);CHKERRQ(ierr);
if (maxval > 1e-10) {
SETERRQ(PETSC_COMM_WORLD,1,"initial guess < lower bound in subproblem");
}
ierr = VecCopy(mfqP->subx,mfqP->subpdel);CHKERRQ(ierr);
ierr = VecAXPY(mfqP->subpdel,-1.0,mfqP->subxu); CHKERRQ(ierr);
ierr = VecMax(mfqP->subpdel,NULL,&maxval);CHKERRQ(ierr);
if (maxval > 1e-10) {
SETERRQ(PETSC_COMM_WORLD,1,"initial guess > upper bound in subproblem");
}
ierr = TaoSolve(mfqP->subtao);CHKERRQ(ierr);
ierr = TaoGetSolutionStatus(mfqP->subtao,NULL,qmin,NULL,NULL,NULL,NULL);CHKERRQ(ierr);
/* test bounds post-solution*/
ierr = VecCopy(mfqP->subxl,mfqP->subpdel);CHKERRQ(ierr);
ierr = VecAXPY(mfqP->subpdel,-1.0,mfqP->subx); CHKERRQ(ierr);
ierr = VecMax(mfqP->subpdel,NULL,&maxval);CHKERRQ(ierr);
if (maxval > 1e-5) {
ierr = PetscInfo(tao,"subproblem solution < lower bound");CHKERRQ(ierr);
tao->reason = TAO_DIVERGED_TR_REDUCTION;
}
ierr = VecCopy(mfqP->subx,mfqP->subpdel);CHKERRQ(ierr);
ierr = VecAXPY(mfqP->subpdel,-1.0,mfqP->subxu); CHKERRQ(ierr);
ierr = VecMax(mfqP->subpdel,NULL,&maxval);CHKERRQ(ierr);
if (maxval > 1e-5) {
ierr = PetscInfo(tao,"subproblem solution > upper bound");
tao->reason = TAO_DIVERGED_TR_REDUCTION;
}
*qmin *= -1;
PetscFunctionReturn(0);
}
/*******************************+++*******************************/
int CalcCV(KrigingModel *KrigMod, real *YHatCV, real *SE)
/*****************************************************************/
/* Purpose: Compute kriging cross-validation predictions and, */
/* optionally, their standard errors. */
/* */
/* Args: KrigMod Input: Kriging model without */
/* decompositions. */
/* Output: Decompositions are garbage. */
/* YHatCV Output: Cross-validation predictions. */
/* SE Output: Standard errors (computed only */
/* if SE != NULL). */
/* */
/* Returns: OK or an error number. */
/* */
/* Comment: Calling routine must allocate space for YHatCV */
/* and SE. */
/* Better matrix updating for doing this? */
/* KrigMod decompositions are changed. */
/* Standard errors include contribution from epsilon */
/* in predicted observation. */
/* 1995.02.21: SigmaSq not recomputed. */
/* 1996.04.12: Temporary output showing progress. */
/* */
/* Version: 1996.04.12 */
/*****************************************************************/
{
int ErrNum;
Matrix C, FTilde;
Matrix *Chol, *F, *Q, *R;
real c, s, t;
real *Col, *Beta, *f, *r, *RBeta, *ResTilde, *Y, *YTilde;
size_t i, ii, j, k, m, n;
Y = KrigY(KrigMod);
F = KrigF(KrigMod);
Chol = KrigChol(KrigMod);
Q = KrigQ(KrigMod);
R = KrigR(KrigMod);
/* Use workspace in KrigMod. */
f = KrigMod->fRow;
r = KrigMod->r;
RBeta = KrigMod->RBeta;
Beta = KrigMod->Beta;
ResTilde = KrigMod->ResTilde;
n = MatNumRows(F);
k = MatNumCols(F);
if (n == 0)
return OK;
else if (n == 1)
{
YHatCV[0] = NA_REAL;
if (SE != NULL)
SE[0] = NA_REAL;
return OK;
}
MatAlloc(n, n, UP_TRIANG, &C);
MatAlloc(n, k, RECT, &FTilde);
YTilde = AllocReal(n, NULL);
MatPutNumRows(Q, n - 1);
/* Put correlation matrix in C. */
KrigCorMat(0, NULL, KrigMod);
MatCopy(Chol, &C);
/* Overwrite correlation matrix with Cholesky decomposition. */
if (TriCholesky(Chol, 0, Chol) != OK)
{
Error("Ill-conditioned Cholesky factor.\n");
ErrNum = NUMERIC_ERR;
}
else
ErrNum = OK;
/* Compute FTilde and YTilde for all n rows. */
if (ErrNum == OK)
ErrNum = KrigSolve(Chol, F, Y, &FTilde, YTilde);
/* Delete case i and predict Y[i]. */
for (i = n - 1, ii = 0; ii < n && ErrNum == OK; ii++, i--)
{
OutputTemp("Cross validating variable: %s Run: %d",
yName, i + 1);
/* Permute adjacent columns of Chol until */
/* column i is moved to the last column. */
for (j = i; j < n - 1; j++)
{
TriPerm(j, j + 1, Chol, &c, &s);
/* Apply the same rotation to YTilde and FTilde. */
t = c * YTilde[j] + s * YTilde[j+1];
YTilde[j+1] = -s * YTilde[j] + c * YTilde[j+1];
YTilde[j] = t;
for (m = 0; m < k; m++)
{
Col = MatCol(&FTilde, m);
t = c * Col[j] + s * Col[j+1];
Col[j+1] = -s * Col[j] + c * Col[j+1];
Col[j] = t;
}
}
/* Correlations between case i and the other cases. */
/* Note that cases after i are now in reverse order. */
for (j = 0; j < i; j++)
r[j] = MatElem(&C, j, i);
for (j = 0; j < n - 1 - i; j++)
r[i+j] = MatElem(&C, i, n - 1 - j);
/* Linear model terms for case i. */
MatRow(F, i, f);
/* Pretend we have only n - 1 cases. */
MatPutNumRows(Chol, n - 1);
MatPutNumCols(Chol, n - 1);
MatPutNumRows(&FTilde, n - 1);
/* Gram-Schmidt QR orthogonalization of FTilde. */
if (QRLS(&FTilde, YTilde, Q, R, RBeta, ResTilde) != OK)
{
Error("Cannot perform QR decomposition.\n");
ErrNum = NUMERIC_ERR;
}
else
{
/* Leave-one-out beta's can be obtained as follows. */
/*
if (TriBackSolve(R, RBeta, Beta) != OK)
Error("Cannot compute regression beta's.\n");
else
{
for (j = 0; j < k; j++)
Output(" %e", Beta[j]);
Output("\n");
}
*/
if (SE != NULL)
{
/* Standard error required. */
/* KrigMod->SigmaSq is not updated. */
/* RAve = 1.0 for epsilon contribution. */
ErrNum = KrigYHatSE(KrigMod, 1.0, f, r,
&YHatCV[i], &SE[i]);
}
else
/* No standard error. */
ErrNum = KrigYHatSE(KrigMod, 1.0, f, r,
&YHatCV[i], NULL);
}
/* Restore sizes of Chol and FTilde. */
MatPutNumRows(Chol, n);
MatPutNumCols(Chol, n);
MatPutNumRows(&FTilde, n);
}
OutputTemp("");
if (ErrNum != OK)
for (i = 0; i < n; i++)
YHatCV[i] = SE[i] = NA_REAL;
MatPutNumRows(Q, n);
MatFree(&C);
MatFree(&FTilde);
AllocFree(YTilde);
return ErrNum;
}
PetscErrorCode TestMatZeroRows(Mat A, Mat Afull, PetscBool squaretest, IS is, PetscScalar diag)
{
Mat B,Bcheck,B2 = NULL,lB;
Vec x = NULL, b = NULL, b2 = NULL;
ISLocalToGlobalMapping l2gr,l2gc;
PetscReal error;
char diagstr[16];
const PetscInt *idxs;
PetscInt rst,ren,i,n,N,d;
PetscMPIInt rank;
PetscBool miss,haszerorows;
PetscErrorCode ierr;
PetscFunctionBeginUser;
if (diag == 0.) {
ierr = PetscStrcpy(diagstr,"zero");CHKERRQ(ierr);
} else {
ierr = PetscStrcpy(diagstr,"nonzero");CHKERRQ(ierr);
}
ierr = ISView(is,NULL);CHKERRQ(ierr);
ierr = MatGetLocalToGlobalMapping(A,&l2gr,&l2gc);CHKERRQ(ierr);
/* tests MatDuplicate and MatCopy */
if (diag == 0.) {
ierr = MatDuplicate(A,MAT_COPY_VALUES,&B);CHKERRQ(ierr);
} else {
ierr = MatDuplicate(A,MAT_DO_NOT_COPY_VALUES,&B);CHKERRQ(ierr);
ierr = MatCopy(A,B,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
}
ierr = MatISGetLocalMat(B,&lB);CHKERRQ(ierr);
ierr = MatHasOperation(lB,MATOP_ZERO_ROWS,&haszerorows);CHKERRQ(ierr);
if (squaretest && haszerorows) {
ierr = MatCreateVecs(B,&x,&b);CHKERRQ(ierr);
ierr = MatDuplicate(B,MAT_COPY_VALUES,&B2);CHKERRQ(ierr);
ierr = VecSetLocalToGlobalMapping(b,l2gr);CHKERRQ(ierr);
ierr = VecSetLocalToGlobalMapping(x,l2gc);CHKERRQ(ierr);
ierr = VecSetRandom(x,NULL);CHKERRQ(ierr);
ierr = VecSetRandom(b,NULL);CHKERRQ(ierr);
/* mimic b[is] = x[is] */
ierr = VecDuplicate(b,&b2);CHKERRQ(ierr);
ierr = VecSetLocalToGlobalMapping(b2,l2gr);CHKERRQ(ierr);
ierr = VecCopy(b,b2);CHKERRQ(ierr);
ierr = ISGetLocalSize(is,&n);CHKERRQ(ierr);
ierr = ISGetIndices(is,&idxs);CHKERRQ(ierr);
ierr = VecGetSize(x,&N);CHKERRQ(ierr);
for (i=0;i<n;i++) {
if (0 <= idxs[i] && idxs[i] < N) {
ierr = VecSetValue(b2,idxs[i],diag,INSERT_VALUES);CHKERRQ(ierr);
ierr = VecSetValue(x,idxs[i],1.,INSERT_VALUES);CHKERRQ(ierr);
}
}
ierr = VecAssemblyBegin(b2);CHKERRQ(ierr);
ierr = VecAssemblyEnd(b2);CHKERRQ(ierr);
ierr = VecAssemblyBegin(x);CHKERRQ(ierr);
ierr = VecAssemblyEnd(x);CHKERRQ(ierr);
ierr = ISRestoreIndices(is,&idxs);CHKERRQ(ierr);
/* test ZeroRows on MATIS */
ierr = PetscPrintf(PETSC_COMM_WORLD,"Test MatZeroRows (diag %s)\n",diagstr);CHKERRQ(ierr);
ierr = MatZeroRowsIS(B,is,diag,x,b);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"Test MatZeroRowsColumns (diag %s)\n",diagstr);CHKERRQ(ierr);
ierr = MatZeroRowsColumnsIS(B2,is,diag,NULL,NULL);CHKERRQ(ierr);
} else if (haszerorows) {
/* test ZeroRows on MATIS */
ierr = PetscPrintf(PETSC_COMM_WORLD,"Test MatZeroRows (diag %s)\n",diagstr);CHKERRQ(ierr);
ierr = MatZeroRowsIS(B,is,diag,NULL,NULL);CHKERRQ(ierr);
b = b2 = x = NULL;
} else {
ierr = PetscPrintf(PETSC_COMM_WORLD,"Skipping MatZeroRows (diag %s)\n",diagstr);CHKERRQ(ierr);
b = b2 = x = NULL;
}
if (squaretest && haszerorows) {
ierr = VecAXPY(b2,-1.,b);CHKERRQ(ierr);
ierr = VecNorm(b2,NORM_INFINITY,&error);CHKERRQ(ierr);
if (error > PETSC_SQRT_MACHINE_EPSILON) SETERRQ2(PETSC_COMM_WORLD,PETSC_ERR_PLIB,"ERROR IN ZEROROWS ON B %g (diag %s)",error,diagstr);
}
/* test MatMissingDiagonal */
ierr = PetscPrintf(PETSC_COMM_WORLD,"Test MatMissingDiagonal\n");CHKERRQ(ierr);
ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr);
ierr = MatMissingDiagonal(B,&miss,&d);CHKERRQ(ierr);
ierr = MatGetOwnershipRange(B,&rst,&ren);CHKERRQ(ierr);
ierr = PetscViewerASCIIPushSynchronized(PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
ierr = PetscViewerASCIISynchronizedPrintf(PETSC_VIEWER_STDOUT_WORLD, "[%d] [%D,%D) Missing %d, row %D (diag %s)\n",rank,rst,ren,(int)miss,d,diagstr);CHKERRQ(ierr);
ierr = PetscViewerFlush(PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
ierr = PetscViewerASCIIPopSynchronized(PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
ierr = VecDestroy(&x);CHKERRQ(ierr);
ierr = VecDestroy(&b);CHKERRQ(ierr);
ierr = VecDestroy(&b2);CHKERRQ(ierr);
/* check the result of ZeroRows with that from MPIAIJ routines
assuming that MatConvert_IS_XAIJ and MatZeroRows_MPIAIJ work fine */
if (haszerorows) {
ierr = MatDuplicate(Afull,MAT_COPY_VALUES,&Bcheck);CHKERRQ(ierr);
ierr = MatSetOption(Bcheck,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
ierr = MatZeroRowsIS(Bcheck,is,diag,NULL,NULL);CHKERRQ(ierr);
ierr = CheckMat(B,Bcheck,PETSC_FALSE,"Zerorows");CHKERRQ(ierr);
ierr = MatDestroy(&Bcheck);CHKERRQ(ierr);
}
ierr = MatDestroy(&B);CHKERRQ(ierr);
if (B2) { /* test MatZeroRowsColumns */
ierr = MatDuplicate(Afull,MAT_COPY_VALUES,&B);CHKERRQ(ierr);
ierr = MatSetOption(B,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE);CHKERRQ(ierr);
ierr = MatZeroRowsColumnsIS(B,is,diag,NULL,NULL);CHKERRQ(ierr);
ierr = CheckMat(B2,B,PETSC_FALSE,"MatZeroRowsColumns");CHKERRQ(ierr);
ierr = MatDestroy(&B);CHKERRQ(ierr);
ierr = MatDestroy(&B2);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
/*
PEPBuildDiagonalScaling - compute two diagonal matrices to be applied for balancing
in polynomial eigenproblems.
*/
PetscErrorCode PEPBuildDiagonalScaling(PEP pep)
{
PetscErrorCode ierr;
PetscInt it,i,j,k,nmat,nr,e,nz,lst,lend,nc=0,*cols,emax,emin,emaxl,eminl;
const PetscInt *cidx,*ridx;
Mat M,*T,A;
PetscMPIInt n;
PetscBool cont=PETSC_TRUE,flg=PETSC_FALSE;
PetscScalar *array,*Dr,*Dl,t;
PetscReal l2,d,*rsum,*aux,*csum,w=1.0;
MatStructure str;
MatInfo info;
PetscFunctionBegin;
l2 = 2*PetscLogReal(2.0);
nmat = pep->nmat;
ierr = PetscMPIIntCast(pep->n,&n);
ierr = STGetMatStructure(pep->st,&str);CHKERRQ(ierr);
ierr = PetscMalloc1(nmat,&T);CHKERRQ(ierr);
for (k=0;k<nmat;k++) {
ierr = STGetTOperators(pep->st,k,&T[k]);CHKERRQ(ierr);
}
/* Form local auxiliar matrix M */
ierr = PetscObjectTypeCompareAny((PetscObject)T[0],&cont,MATMPIAIJ,MATSEQAIJ);CHKERRQ(ierr);
if (!cont) SETERRQ(PetscObjectComm((PetscObject)T[0]),PETSC_ERR_SUP,"Only for MPIAIJ or SEQAIJ matrix types");
ierr = PetscObjectTypeCompare((PetscObject)T[0],MATMPIAIJ,&cont);CHKERRQ(ierr);
if (cont) {
ierr = MatMPIAIJGetLocalMat(T[0],MAT_INITIAL_MATRIX,&M);CHKERRQ(ierr);
flg = PETSC_TRUE;
} else {
ierr = MatDuplicate(T[0],MAT_COPY_VALUES,&M);CHKERRQ(ierr);
}
ierr = MatGetInfo(M,MAT_LOCAL,&info);CHKERRQ(ierr);
nz = info.nz_used;
ierr = MatSeqAIJGetArray(M,&array);CHKERRQ(ierr);
for (i=0;i<nz;i++) {
t = PetscAbsScalar(array[i]);
array[i] = t*t;
}
ierr = MatSeqAIJRestoreArray(M,&array);CHKERRQ(ierr);
for (k=1;k<nmat;k++) {
if (flg) {
ierr = MatMPIAIJGetLocalMat(T[k],MAT_INITIAL_MATRIX,&A);CHKERRQ(ierr);
} else {
if (str==SAME_NONZERO_PATTERN) {
ierr = MatCopy(T[k],A,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
} else {
ierr = MatDuplicate(T[k],MAT_COPY_VALUES,&A);CHKERRQ(ierr);
}
}
ierr = MatGetInfo(A,MAT_LOCAL,&info);CHKERRQ(ierr);
nz = info.nz_used;
ierr = MatSeqAIJGetArray(A,&array);CHKERRQ(ierr);
for (i=0;i<nz;i++) {
t = PetscAbsScalar(array[i]);
array[i] = t*t;
}
ierr = MatSeqAIJRestoreArray(A,&array);CHKERRQ(ierr);
w *= pep->slambda*pep->slambda*pep->sfactor;
ierr = MatAXPY(M,w,A,str);CHKERRQ(ierr);
if (flg || str!=SAME_NONZERO_PATTERN || k==nmat-2) {
ierr = MatDestroy(&A);CHKERRQ(ierr);
}
}
ierr = MatGetRowIJ(M,0,PETSC_FALSE,PETSC_FALSE,&nr,&ridx,&cidx,&cont);CHKERRQ(ierr);
if (!cont) SETERRQ(PetscObjectComm((PetscObject)T[0]), PETSC_ERR_SUP,"It is not possible to compute scaling diagonals for these PEP matrices");
ierr = MatGetInfo(M,MAT_LOCAL,&info);CHKERRQ(ierr);
nz = info.nz_used;
ierr = VecGetOwnershipRange(pep->Dl,&lst,&lend);CHKERRQ(ierr);
ierr = PetscMalloc4(nr,&rsum,pep->n,&csum,pep->n,&aux,PetscMin(pep->n-lend+lst,nz),&cols);CHKERRQ(ierr);
ierr = VecSet(pep->Dr,1.0);CHKERRQ(ierr);
ierr = VecSet(pep->Dl,1.0);CHKERRQ(ierr);
ierr = VecGetArray(pep->Dl,&Dl);CHKERRQ(ierr);
ierr = VecGetArray(pep->Dr,&Dr);CHKERRQ(ierr);
ierr = MatSeqAIJGetArray(M,&array);CHKERRQ(ierr);
ierr = PetscMemzero(aux,pep->n*sizeof(PetscReal));CHKERRQ(ierr);
for (j=0;j<nz;j++) {
/* Search non-zero columns outsize lst-lend */
if (aux[cidx[j]]==0 && (cidx[j]<lst || lend<=cidx[j])) cols[nc++] = cidx[j];
/* Local column sums */
aux[cidx[j]] += PetscAbsScalar(array[j]);
}
for (it=0;it<pep->sits && cont;it++) {
emaxl = 0; eminl = 0;
/* Column sum */
if (it>0) { /* it=0 has been already done*/
ierr = MatSeqAIJGetArray(M,&array);CHKERRQ(ierr);
ierr = PetscMemzero(aux,pep->n*sizeof(PetscReal));CHKERRQ(ierr);
for (j=0;j<nz;j++) aux[cidx[j]] += PetscAbsScalar(array[j]);
ierr = MatSeqAIJRestoreArray(M,&array);CHKERRQ(ierr);
}
ierr = MPI_Allreduce(aux,csum,n,MPIU_REAL,MPIU_SUM,PetscObjectComm((PetscObject)pep->Dr));
/* Update Dr */
for (j=lst;j<lend;j++) {
d = PetscLogReal(csum[j])/l2;
e = -(PetscInt)((d < 0)?(d-0.5):(d+0.5));
d = PetscPowReal(2.0,e);
Dr[j-lst] *= d;
aux[j] = d*d;
emaxl = PetscMax(emaxl,e);
eminl = PetscMin(eminl,e);
}
for (j=0;j<nc;j++) {
d = PetscLogReal(csum[cols[j]])/l2;
e = -(PetscInt)((d < 0)?(d-0.5):(d+0.5));
d = PetscPowReal(2.0,e);
aux[cols[j]] = d*d;
emaxl = PetscMax(emaxl,e);
eminl = PetscMin(eminl,e);
}
/* Scale M */
ierr = MatSeqAIJGetArray(M,&array);CHKERRQ(ierr);
for (j=0;j<nz;j++) {
array[j] *= aux[cidx[j]];
}
ierr = MatSeqAIJRestoreArray(M,&array);CHKERRQ(ierr);
/* Row sum */
ierr = PetscMemzero(rsum,nr*sizeof(PetscReal));CHKERRQ(ierr);
ierr = MatSeqAIJGetArray(M,&array);CHKERRQ(ierr);
for (i=0;i<nr;i++) {
for (j=ridx[i];j<ridx[i+1];j++) rsum[i] += PetscAbsScalar(array[j]);
/* Update Dl */
d = PetscLogReal(rsum[i])/l2;
e = -(PetscInt)((d < 0)?(d-0.5):(d+0.5));
d = PetscPowReal(2.0,e);
Dl[i] *= d;
/* Scale M */
for (j=ridx[i];j<ridx[i+1];j++) array[j] *= d*d;
emaxl = PetscMax(emaxl,e);
eminl = PetscMin(eminl,e);
}
ierr = MatSeqAIJRestoreArray(M,&array);CHKERRQ(ierr);
/* Compute global max and min */
ierr = MPI_Allreduce(&emaxl,&emax,1,MPIU_INT,MPIU_MAX,PetscObjectComm((PetscObject)pep->Dl));
ierr = MPI_Allreduce(&eminl,&emin,1,MPIU_INT,MPIU_MIN,PetscObjectComm((PetscObject)pep->Dl));
if (emax<=emin+2) cont = PETSC_FALSE;
}
ierr = VecRestoreArray(pep->Dr,&Dr);CHKERRQ(ierr);
ierr = VecRestoreArray(pep->Dl,&Dl);CHKERRQ(ierr);
/* Free memory*/
ierr = MatDestroy(&M);CHKERRQ(ierr);
ierr = PetscFree4(rsum,csum,aux,cols);CHKERRQ(ierr);
ierr = PetscFree(T);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
PetscErrorCode MatISGetMPIXAIJ_IS(Mat mat, MatReuse reuse, Mat *M)
{
Mat_IS *matis = (Mat_IS*)(mat->data);
Mat local_mat;
/* info on mat */
PetscInt bs,rows,cols,lrows,lcols;
PetscInt local_rows,local_cols;
PetscBool isdense,issbaij,isseqaij;
PetscMPIInt nsubdomains;
/* values insertion */
PetscScalar *array;
/* work */
PetscErrorCode ierr;
PetscFunctionBegin;
/* get info from mat */
ierr = MPI_Comm_size(PetscObjectComm((PetscObject)mat),&nsubdomains);CHKERRQ(ierr);
if (nsubdomains == 1) {
if (reuse == MAT_INITIAL_MATRIX) {
ierr = MatDuplicate(matis->A,MAT_COPY_VALUES,&(*M));CHKERRQ(ierr);
} else {
ierr = MatCopy(matis->A,*M,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
ierr = MatGetSize(mat,&rows,&cols);CHKERRQ(ierr);
ierr = MatGetBlockSize(mat,&bs);CHKERRQ(ierr);
ierr = MatGetLocalSize(mat,&lrows,&lcols);CHKERRQ(ierr);
ierr = MatGetSize(matis->A,&local_rows,&local_cols);CHKERRQ(ierr);
ierr = PetscObjectTypeCompare((PetscObject)matis->A,MATSEQDENSE,&isdense);CHKERRQ(ierr);
ierr = PetscObjectTypeCompare((PetscObject)matis->A,MATSEQAIJ,&isseqaij);CHKERRQ(ierr);
ierr = PetscObjectTypeCompare((PetscObject)matis->A,MATSEQSBAIJ,&issbaij);CHKERRQ(ierr);
if (reuse == MAT_INITIAL_MATRIX) {
MatType new_mat_type;
PetscBool issbaij_red;
/* determining new matrix type */
ierr = MPIU_Allreduce(&issbaij,&issbaij_red,1,MPIU_BOOL,MPI_LAND,PetscObjectComm((PetscObject)mat));CHKERRQ(ierr);
if (issbaij_red) {
new_mat_type = MATSBAIJ;
} else {
if (bs>1) {
new_mat_type = MATBAIJ;
} else {
new_mat_type = MATAIJ;
}
}
ierr = MatCreate(PetscObjectComm((PetscObject)mat),M);CHKERRQ(ierr);
ierr = MatSetSizes(*M,lrows,lcols,rows,cols);CHKERRQ(ierr);
ierr = MatSetBlockSize(*M,bs);CHKERRQ(ierr);
ierr = MatSetType(*M,new_mat_type);CHKERRQ(ierr);
ierr = MatISSetMPIXAIJPreallocation_Private(mat,*M,PETSC_FALSE);CHKERRQ(ierr);
} else {
PetscInt mbs,mrows,mcols,mlrows,mlcols;
/* some checks */
ierr = MatGetBlockSize(*M,&mbs);CHKERRQ(ierr);
ierr = MatGetSize(*M,&mrows,&mcols);CHKERRQ(ierr);
ierr = MatGetLocalSize(*M,&mlrows,&mlcols);CHKERRQ(ierr);
if (mrows != rows) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix. Wrong number of rows (%d != %d)",rows,mrows);
if (mcols != cols) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix. Wrong number of cols (%d != %d)",cols,mcols);
if (mlrows != lrows) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix. Wrong number of local rows (%d != %d)",lrows,mlrows);
if (mlcols != lcols) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix. Wrong number of local cols (%d != %d)",lcols,mlcols);
if (mbs != bs) SETERRQ2(PetscObjectComm((PetscObject)mat),PETSC_ERR_SUP,"Cannot reuse matrix. Wrong block size (%d != %d)",bs,mbs);
ierr = MatZeroEntries(*M);CHKERRQ(ierr);
}
if (issbaij) {
ierr = MatConvert(matis->A,MATSEQBAIJ,MAT_INITIAL_MATRIX,&local_mat);CHKERRQ(ierr);
} else {
ierr = PetscObjectReference((PetscObject)matis->A);CHKERRQ(ierr);
local_mat = matis->A;
}
/* Set values */
ierr = MatSetLocalToGlobalMapping(*M,mat->rmap->mapping,mat->cmap->mapping);CHKERRQ(ierr);
if (isdense) { /* special case for dense local matrices */
PetscInt i,*dummy_rows,*dummy_cols;
if (local_rows != local_cols) {
ierr = PetscMalloc2(local_rows,&dummy_rows,local_cols,&dummy_cols);CHKERRQ(ierr);
for (i=0;i<local_rows;i++) dummy_rows[i] = i;
for (i=0;i<local_cols;i++) dummy_cols[i] = i;
} else {
ierr = PetscMalloc1(local_rows,&dummy_rows);CHKERRQ(ierr);
for (i=0;i<local_rows;i++) dummy_rows[i] = i;
dummy_cols = dummy_rows;
}
ierr = MatSetOption(*M,MAT_ROW_ORIENTED,PETSC_FALSE);CHKERRQ(ierr);
ierr = MatDenseGetArray(local_mat,&array);CHKERRQ(ierr);
ierr = MatSetValuesLocal(*M,local_rows,dummy_rows,local_cols,dummy_cols,array,ADD_VALUES);CHKERRQ(ierr);
ierr = MatDenseRestoreArray(local_mat,&array);CHKERRQ(ierr);
if (dummy_rows != dummy_cols) {
ierr = PetscFree2(dummy_rows,dummy_cols);CHKERRQ(ierr);
} else {
ierr = PetscFree(dummy_rows);CHKERRQ(ierr);
}
} else if (isseqaij) {
PetscInt i,nvtxs,*xadj,*adjncy;
PetscBool done;
ierr = MatGetRowIJ(local_mat,0,PETSC_FALSE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&done);CHKERRQ(ierr);
if (!done) SETERRQ1(PetscObjectComm((PetscObject)local_mat),PETSC_ERR_PLIB,"Error in MatRestoreRowIJ called in %s\n",__FUNCT__);
ierr = MatSeqAIJGetArray(local_mat,&array);CHKERRQ(ierr);
for (i=0;i<nvtxs;i++) {
ierr = MatSetValuesLocal(*M,1,&i,xadj[i+1]-xadj[i],adjncy+xadj[i],array+xadj[i],ADD_VALUES);CHKERRQ(ierr);
}
ierr = MatRestoreRowIJ(local_mat,0,PETSC_FALSE,PETSC_FALSE,&nvtxs,(const PetscInt**)&xadj,(const PetscInt**)&adjncy,&done);CHKERRQ(ierr);
if (!done) SETERRQ1(PetscObjectComm((PetscObject)local_mat),PETSC_ERR_PLIB,"Error in MatRestoreRowIJ called in %s\n",__FUNCT__);
ierr = MatSeqAIJRestoreArray(local_mat,&array);CHKERRQ(ierr);
} else { /* very basic values insertion for all other matrix types */
PetscInt i;
for (i=0;i<local_rows;i++) {
PetscInt j;
const PetscInt *local_indices_cols;
ierr = MatGetRow(local_mat,i,&j,&local_indices_cols,(const PetscScalar**)&array);CHKERRQ(ierr);
ierr = MatSetValuesLocal(*M,1,&i,j,local_indices_cols,array,ADD_VALUES);CHKERRQ(ierr);
ierr = MatRestoreRow(local_mat,i,&j,&local_indices_cols,(const PetscScalar**)&array);CHKERRQ(ierr);
}
}
ierr = MatAssemblyBegin(*M,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatDestroy(&local_mat);CHKERRQ(ierr);
ierr = MatAssemblyEnd(*M,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
if (isdense) {
ierr = MatSetOption(*M,MAT_ROW_ORIENTED,PETSC_TRUE);CHKERRQ(ierr);
}
PetscFunctionReturn(0);
}
void _Stokes_SLE_PenaltySolver_Solve( void* solver,void* stokesSLE ) {
Stokes_SLE_PenaltySolver* self = (Stokes_SLE_PenaltySolver*)solver;
Stokes_SLE* sle = (Stokes_SLE*)stokesSLE;
/* Create shortcuts to stuff needed on sle */
Mat kMatrix = sle->kStiffMat->matrix;
Mat gradMat = sle->gStiffMat->matrix;
Mat divMat = NULL;
Mat C_Mat = sle->cStiffMat->matrix;
Vec uVec = sle->uSolnVec->vector;
Vec pVec = sle->pSolnVec->vector;
Vec fVec = sle->fForceVec->vector;
Vec hVec = sle->hForceVec->vector;
Vec hTempVec;
Vec fTempVec;
Vec penalty;
Mat GTrans, kHat;
KSP ksp_v;
double negOne=-1.0;
double one=1.0;
Mat C_InvMat;
Vec diagC;
PC pc;
int rank;
MPI_Comm_rank( MPI_COMM_WORLD, &rank );
Journal_DPrintf( self->debug, "In %s():\n", __func__ );
VecDuplicate( hVec, &hTempVec );
VecDuplicate( fVec, &fTempVec );
VecDuplicate( pVec, &diagC );
if( sle->dStiffMat == NULL ) {
Journal_DPrintf( self->debug, "Div matrix == NULL : Problem is assumed to be symmetric. ie Div = GTrans \n");
#if( PETSC_VERSION_MAJOR <= 2 )
MatTranspose( gradMat, >rans );
#else
MatTranspose( gradMat, MAT_INITIAL_MATRIX, >rans );
#endif
divMat = GTrans;
}
else {
MatType type;
PetscInt size[2];
MatGetType( sle->dStiffMat->matrix, &type );
MatGetLocalSize( sle->dStiffMat->matrix, size + 0, size + 1 );
/* make a copy we can play with */
MatCreate( sle->comm, >rans );
MatSetSizes( GTrans, size[0], size[1], PETSC_DECIDE, PETSC_DECIDE );
MatSetType( GTrans, type );
#if (((PETSC_VERSION_MAJOR==3) && (PETSC_VERSION_MINOR>=3)) || (PETSC_VERSION_MAJOR>3) )
MatSetUp(GTrans);
#endif
MatCopy( sle->dStiffMat->matrix, GTrans, DIFFERENT_NONZERO_PATTERN );
divMat = GTrans;
}
Stokes_SLE_PenaltySolver_MakePenalty( self, sle, &penalty );
/* Create CInv */
MatGetDiagonal( C_Mat, diagC );
VecReciprocal( diagC );
VecPointwiseMult( diagC, penalty, diagC );
{ /* Print the maximum and minimum penalties in my system. */
PetscInt idx;
PetscReal min, max;
VecMin( diagC, &idx, &min );
VecMax( diagC, &idx, &max );
if( rank == 0 ) {
printf( "PENALTY RANGE:\n" );
printf( " MIN: %e\n", min );
printf( " MAX: %e\n", max );
}
}
MatDiagonalSet( C_Mat, diagC, INSERT_VALUES );
C_InvMat = C_Mat; /* Use pointer CInv since C has been inverted */
/* Build RHS : rhs = f - GCInv h */
MatMult( C_InvMat, hVec, hTempVec ); /* hTempVec = C_InvMat * hVec */
VecScale( hTempVec, -1.0 );
MatMult( gradMat, hTempVec, fTempVec );
#if 0
VecPointwiseMult( fTempVec, penalty, fTempVec );
{ /* Print the maximum and minimum penalties in my system. */
PetscInt idx;
PetscReal min, max;
VecMin( fTempVec, &idx, &min );
VecMax( fTempVec, &idx, &max );
printf( "PENALTY RANGE:\n" );
printf( " MIN: %e\n", min );
printf( " MAX: %e\n", max );
}
#endif
VecAXPY( fTempVec, 1.0, fVec );
/*MatMultAdd( gradMat, hTempVec, fVec, fTempVec );*/
/* Build G CInv GTrans */
/* MatTranspose( gradMat, >rans ); */
/* since CInv is diagonal we can just scale mat entries by the diag vector */
MatDiagonalScale( divMat, diagC, PETSC_NULL ); /* Div = CInve Div */
MatMatMult( gradMat, divMat, MAT_INITIAL_MATRIX, PETSC_DEFAULT, &kHat );
/*MatDiagonalScale( kHat, penalty, PETSC_NULL );*/
MatScale( kHat, -1.0 );
MatAXPY( kMatrix, 1.0, kHat, SAME_NONZERO_PATTERN );
/* Setup solver context and make sure that it uses a direct solver */
KSPCreate( sle->comm, &ksp_v );
Stg_KSPSetOperators( ksp_v, kMatrix, kMatrix, DIFFERENT_NONZERO_PATTERN );
KSPSetType( ksp_v, KSPPREONLY );
KSPGetPC( ksp_v, &pc );
PCSetType( pc, PCLU );
KSPSetFromOptions( ksp_v );
KSPSolve( ksp_v, fTempVec, uVec );
/* Recover p */
if( sle->dStiffMat == NULL ) {
/* since Div was modified when C is diagonal, re build the transpose */
if( GTrans != PETSC_NULL )
Stg_MatDestroy(>rans );
#if( PETSC_VERSION_MAJOR <= 2 )
MatTranspose( gradMat, >rans );
#else
MatTranspose( gradMat, MAT_INITIAL_MATRIX, >rans );
#endif
divMat = GTrans;
}
else {
/* never modified Div_null so set divMat to point back to it */
divMat = sle->dStiffMat->matrix;
}
MatMult( divMat, uVec, hTempVec ); /* hTemp = Div v */
VecAYPX( hTempVec, negOne, hVec ); /* hTemp = H - hTemp : hTemp = H - Div v */
MatMult( C_InvMat, hTempVec, pVec ); /* p = CInv hTemp : p = CInv ( H - Div v ) */
Stg_MatDestroy(&kHat );
if( fTempVec != PETSC_NULL ) Stg_VecDestroy(&fTempVec );
if( hTempVec != PETSC_NULL ) Stg_VecDestroy(&hTempVec );
if( diagC != PETSC_NULL ) Stg_VecDestroy(&diagC );
if( ksp_v != PETSC_NULL ) Stg_KSPDestroy(&ksp_v );
if( GTrans != PETSC_NULL ) Stg_MatDestroy(>rans );
}
PetscErrorCode MatMatSolve_SuperLU_DIST(Mat A,Mat B_mpi,Mat X)
{
Mat_SuperLU_DIST *lu = (Mat_SuperLU_DIST*)A->spptr;
PetscErrorCode ierr;
PetscMPIInt size;
PetscInt M=A->rmap->N,m=A->rmap->n,nrhs;
SuperLUStat_t stat;
double berr[1];
PetscScalar *bptr;
int info; /* SuperLU_Dist info code is ALWAYS an int, even with long long indices */
PetscBool flg;
PetscFunctionBegin;
if (lu->options.Fact != FACTORED) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"SuperLU_DIST options.Fact mush equal FACTORED");
ierr = PetscObjectTypeCompareAny((PetscObject)B_mpi,&flg,MATSEQDENSE,MATMPIDENSE,NULL);CHKERRQ(ierr);
if (!flg) SETERRQ(PetscObjectComm((PetscObject)A),PETSC_ERR_ARG_WRONG,"Matrix B must be MATDENSE matrix");
ierr = PetscObjectTypeCompareAny((PetscObject)X,&flg,MATSEQDENSE,MATMPIDENSE,NULL);CHKERRQ(ierr);
if (!flg) SETERRQ(PetscObjectComm((PetscObject)A),PETSC_ERR_ARG_WRONG,"Matrix X must be MATDENSE matrix");
ierr = MPI_Comm_size(PetscObjectComm((PetscObject)A),&size);CHKERRQ(ierr);
if (size > 1 && lu->MatInputMode == GLOBAL) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"MatInputMode=GLOBAL for nproc %d>1 is not supported",size);
/* size==1 or distributed mat input */
if (lu->options.SolveInitialized && !lu->matmatsolve_iscalled) {
/* communication pattern of SOLVEstruct is unlikely created for matmatsolve,
thus destroy it and create a new SOLVEstruct.
Otherwise it may result in memory corruption or incorrect solution
See src/mat/examples/tests/ex125.c */
#if defined(PETSC_USE_COMPLEX)
PetscStackCall("SuperLU_DIST:zSolveFinalize",zSolveFinalize(&lu->options, &lu->SOLVEstruct));
#else
PetscStackCall("SuperLU_DIST:dSolveFinalize",dSolveFinalize(&lu->options, &lu->SOLVEstruct));
#endif
lu->options.SolveInitialized = NO;
}
ierr = MatCopy(B_mpi,X,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
ierr = MatGetSize(B_mpi,NULL,&nrhs);CHKERRQ(ierr);
PetscStackCall("SuperLU_DIST:PStatInit",PStatInit(&stat)); /* Initialize the statistics variables. */
ierr = MatDenseGetArray(X,&bptr);CHKERRQ(ierr);
if (lu->MatInputMode == GLOBAL) { /* size == 1 */
#if defined(PETSC_USE_COMPLEX)
PetscStackCall("SuperLU_DIST:pzgssvx_ABglobal",pzgssvx_ABglobal(&lu->options, &lu->A_sup, &lu->ScalePermstruct,(doublecomplex*)bptr, M, nrhs,&lu->grid, &lu->LUstruct, berr, &stat, &info));
#else
PetscStackCall("SuperLU_DIST:pdgssvx_ABglobal",pdgssvx_ABglobal(&lu->options, &lu->A_sup, &lu->ScalePermstruct,bptr, M, nrhs, &lu->grid, &lu->LUstruct, berr, &stat, &info));
#endif
} else { /* distributed mat input */
#if defined(PETSC_USE_COMPLEX)
PetscStackCall("SuperLU_DIST:pzgssvx",pzgssvx(&lu->options,&lu->A_sup,&lu->ScalePermstruct,(doublecomplex*)bptr,m,nrhs,&lu->grid, &lu->LUstruct,&lu->SOLVEstruct,berr,&stat,&info));
#else
PetscStackCall("SuperLU_DIST:pdgssvx",pdgssvx(&lu->options,&lu->A_sup,&lu->ScalePermstruct,bptr,m,nrhs,&lu->grid,&lu->LUstruct,&lu->SOLVEstruct,berr,&stat,&info));
#endif
}
if (info) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_LIB,"pdgssvx fails, info: %d\n",info);
ierr = MatDenseRestoreArray(X,&bptr);CHKERRQ(ierr);
if (lu->options.PrintStat) PStatPrint(&lu->options, &stat, &lu->grid); /* Print the statistics. */
PetscStackCall("SuperLU_DIST:PStatFree",PStatFree(&stat));
lu->matsolve_iscalled = PETSC_FALSE;
lu->matmatsolve_iscalled = PETSC_TRUE;
PetscFunctionReturn(0);
}
void OGL_ModelData::Load()
{
// Already loaded?
if (ModelPresent()) {
return;
}
// Load the model
Model.Clear();
if (ModelFile == FileSpecifier()) {
return;
}
if (!ModelFile.Exists()) {
return;
}
bool Success = false;
char *Type = &ModelType[0];
if (StringsEqual(Type,"wave",4)) {
// Alias|Wavefront
Success = LoadModel_Wavefront(ModelFile, Model);
}
else if (StringsEqual(Type,"3ds",3)) {
// 3D Studio Max
Success = LoadModel_Studio(ModelFile, Model);
}
else if (StringsEqual(Type,"dim3",4)) {
// Brian Barnes's "Dim3" model format (first pass: model geometry)
Success = LoadModel_Dim3(ModelFile, Model, LoadModelDim3_First);
// Second and third passes: frames and sequences
try
{
if (ModelFile1 == FileSpecifier()) {
throw 0;
}
if (!ModelFile1.Exists()) {
throw 0;
}
if (!LoadModel_Dim3(ModelFile1, Model, LoadModelDim3_Rest)) {
throw 0;
}
}
catch(...)
{}
//
try
{
if (ModelFile2 == FileSpecifier()) {
throw 0;
}
if (!ModelFile2.Exists()) {
throw 0;
}
if (!LoadModel_Dim3(ModelFile2, Model, LoadModelDim3_Rest)) {
throw 0;
}
}
catch(...)
{}
}
#if HAVE_QUESA
else if (StringsEqual(Type,
"qd3d") ||
StringsEqual(Type,"3dmf") || StringsEqual(Type,"quesa")) {
// QuickDraw 3D / Quesa
Success = LoadModel_QD3D(ModelFile, Model);
}
#endif
if (!Success) {
Model.Clear();
return;
}
// Calculate transformation matrix
GLfloat Angle, Cosine, Sine;
GLfloat RotMatrix[3][3], NewRotMatrix[3][3], IndivRotMatrix[3][3];
MatIdentity(RotMatrix);
MatIdentity(IndivRotMatrix);
Angle = (float)Degree2Radian*XRot;
Cosine = (float)cos(Angle);
Sine = (float)sin(Angle);
IndivRotMatrix[1][1] = Cosine;
IndivRotMatrix[1][2] = -Sine;
IndivRotMatrix[2][1] = Sine;
IndivRotMatrix[2][2] = Cosine;
MatMult(IndivRotMatrix,RotMatrix,NewRotMatrix);
MatCopy(NewRotMatrix,RotMatrix);
MatIdentity(IndivRotMatrix);
Angle = (float)Degree2Radian*YRot;
Cosine = (float)cos(Angle);
Sine = (float)sin(Angle);
IndivRotMatrix[2][2] = Cosine;
IndivRotMatrix[2][0] = -Sine;
IndivRotMatrix[0][2] = Sine;
IndivRotMatrix[0][0] = Cosine;
MatMult(IndivRotMatrix,RotMatrix,NewRotMatrix);
MatCopy(NewRotMatrix,RotMatrix);
MatIdentity(IndivRotMatrix);
Angle = (float)Degree2Radian*ZRot;
Cosine = (float)cos(Angle);
Sine = (float)sin(Angle);
IndivRotMatrix[0][0] = Cosine;
IndivRotMatrix[0][1] = -Sine;
IndivRotMatrix[1][0] = Sine;
IndivRotMatrix[1][1] = Cosine;
MatMult(IndivRotMatrix,RotMatrix,NewRotMatrix);
MatCopy(NewRotMatrix,RotMatrix);
MatScalMult(NewRotMatrix,Scale); // For the position vertices
if (Scale < 0) {
MatScalMult(RotMatrix,-1); // For the normals
}
// Is model animated or static?
// Test by trying to find neutral positions (useful for working with the normals later on)
if (Model.FindPositions_Neutral(false)) {
// Copy over the vector and normal transformation matrices:
for (int k=0; k<3; k++)
for (int l=0; l<3; l++)
{
Model.TransformPos.M[k][l] = NewRotMatrix[k][l];
Model.TransformNorm.M[k][l] = RotMatrix[k][l];
}
Model.TransformPos.M[0][3] = XShift;
Model.TransformPos.M[1][3] = YShift;
Model.TransformPos.M[2][3] = ZShift;
// Find the transformed bounding box:
bool RestOfCorners = false;
GLfloat NewBoundingBox[2][3];
// The indices i1, i2, and i3 are for selecting which of the box's two principal corners
// to get coordinates from
for (int i1=0; i1<2; i1++)
{
GLfloat X = Model.BoundingBox[i1][0];
for (int i2=0; i2<2; i2++)
{
GLfloat Y = Model.BoundingBox[i2][0];
for (int i3=0; i3<2; i3++)
{
GLfloat Z = Model.BoundingBox[i3][0];
GLfloat Corner[3];
for (int ic=0; ic<3; ic++)
{
GLfloat *Row = Model.TransformPos.M[ic];
Corner[ic] = Row[0]*X + Row[1]*Y + Row[2]*Z + Row[3];
}
if (RestOfCorners) {
// Find minimum and maximum for each coordinate
for (int ic=0; ic<3; ic++)
{
NewBoundingBox[0][ic] = min(NewBoundingBox[0][ic],Corner[ic]);
NewBoundingBox[1][ic] = max(NewBoundingBox[1][ic],Corner[ic]);
}
}
else
{
// Simply copy it in:
for (int ic=0; ic<3; ic++)
NewBoundingBox[0][ic] = NewBoundingBox[1][ic] = Corner[ic];
RestOfCorners = true;
}
}
}
}
for (int ic=0; ic<2; ic++)
objlist_copy(Model.BoundingBox[ic],NewBoundingBox[ic],3);
}
else
{
// Static model
size_t NumVerts = Model.Positions.size()/3;
for (size_t k=0; k<NumVerts; k++)
{
GLfloat *Pos = Model.PosBase() + 3*k;
GLfloat NewPos[3];
MatVecMult(NewRotMatrix,Pos,NewPos); // Has the scaling
Pos[0] = NewPos[0] + XShift;
Pos[1] = NewPos[1] + YShift;
Pos[2] = NewPos[2] + ZShift;
}
size_t NumNorms = Model.Normals.size()/3;
for (size_t k=0; k<NumNorms; k++)
{
GLfloat *Norms = Model.NormBase() + 3*k;
GLfloat NewNorms[3];
MatVecMult(RotMatrix,Norms,NewNorms); // Not scaled
objlist_copy(Norms,NewNorms,3);
}
// So as to be consistent with the new points
Model.FindBoundingBox();
}
Model.AdjustNormals(NormalType,NormalSplit);
Model.CalculateTangents();
// Don't forget the skins
OGL_SkinManager::Load();
}
// Sets the arg to that matrix
static void MatIdentity(GLfloat Mat[3][3])
{
const GLfloat IMat[3][3] = {{1,0,0},{0,1,0},{0,0,1}};
MatCopy(IMat,Mat);
}
/*
Computes coefficients for the transformed polynomial,
and stores the result in argument S.
alpha - value of the parameter of the transformed polynomial
beta - value of the previous shift (only used in inplace mode)
k - number of A matrices involved in the computation
coeffs - coefficients of the expansion
initial - true if this is the first time (only relevant for shell mode)
*/
PetscErrorCode STMatMAXPY_Private(ST st,PetscScalar alpha,PetscScalar beta,PetscInt k,PetscScalar *coeffs,PetscBool initial,Mat *S)
{
PetscErrorCode ierr;
PetscInt *matIdx=NULL,nmat,i,ini=-1;
PetscScalar t=1.0,ta,gamma;
PetscBool nz=PETSC_FALSE;
PetscFunctionBegin;
nmat = st->nmat-k;
switch (st->shift_matrix) {
case ST_MATMODE_INPLACE:
if (st->nmat>2) SETERRQ(PetscObjectComm((PetscObject)st),PETSC_ERR_SUP,"ST_MATMODE_INPLACE not supported for polynomial eigenproblems");
if (initial) {
ierr = PetscObjectReference((PetscObject)st->A[0]);CHKERRQ(ierr);
*S = st->A[0];
gamma = alpha;
} else gamma = alpha-beta;
if (gamma != 0.0) {
if (st->nmat>1) {
ierr = MatAXPY(*S,gamma,st->A[1],st->str);CHKERRQ(ierr);
} else {
ierr = MatShift(*S,gamma);CHKERRQ(ierr);
}
}
break;
case ST_MATMODE_SHELL:
if (initial) {
if (st->nmat>2) {
ierr = PetscMalloc(nmat*sizeof(PetscInt),&matIdx);CHKERRQ(ierr);
for (i=0;i<nmat;i++) matIdx[i] = k+i;
}
ierr = STMatShellCreate(st,alpha,nmat,matIdx,coeffs,S);CHKERRQ(ierr);
ierr = PetscLogObjectParent((PetscObject)st,(PetscObject)*S);CHKERRQ(ierr);
if (st->nmat>2) { ierr = PetscFree(matIdx);CHKERRQ(ierr); }
} else {
ierr = STMatShellShift(*S,alpha);CHKERRQ(ierr);
}
break;
case ST_MATMODE_COPY:
if (coeffs) {
for (i=0;i<nmat && ini==-1;i++) {
if (coeffs[i]!=0.0) ini = i;
else t *= alpha;
}
if (coeffs[ini] != 1.0) nz = PETSC_TRUE;
for (i=ini+1;i<nmat&&!nz;i++) if (coeffs[i]!=0.0) nz = PETSC_TRUE;
} else { nz = PETSC_TRUE; ini = 0; }
if ((alpha == 0.0 || !nz) && t==1.0) {
ierr = MatDestroy(S);CHKERRQ(ierr);
ierr = PetscObjectReference((PetscObject)st->A[k+ini]);CHKERRQ(ierr);
*S = st->A[k+ini];
} else {
if (*S && *S!=st->A[k+ini]) {
ierr = MatCopy(st->A[k+ini],*S,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
} else {
ierr = MatDestroy(S);CHKERRQ(ierr);
ierr = MatDuplicate(st->A[k+ini],MAT_COPY_VALUES,S);CHKERRQ(ierr);
ierr = PetscLogObjectParent((PetscObject)st,(PetscObject)*S);CHKERRQ(ierr);
}
if (coeffs && coeffs[ini]!=1.0) {
ierr = MatScale(*S,coeffs[ini]);CHKERRQ(ierr);
}
for (i=ini+k+1;i<PetscMax(2,st->nmat);i++) {
t *= alpha;
ta = t;
if (coeffs) ta *= coeffs[i-k];
if (ta!=0.0) {
if (st->nmat>1) {
ierr = MatAXPY(*S,ta,st->A[i],st->str);CHKERRQ(ierr);
} else {
ierr = MatShift(*S,ta);CHKERRQ(ierr);
}
}
}
}
}
ierr = STMatSetHermitian(st,*S);CHKERRQ(ierr);
PetscFunctionReturn(0);
}
int main(int argc,char **args)
{
Mat C,A;
PetscInt i, n = 10,midx[3],bs=1;
PetscErrorCode ierr;
PetscScalar v[3];
PetscBool flg,isAIJ;
MatType type;
PetscMPIInt size;
PetscInitialize(&argc,&args,(char *)0,help);
ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(PETSC_NULL,"-n",&n,PETSC_NULL);CHKERRQ(ierr);
ierr = PetscOptionsGetInt(PETSC_NULL,"-mat_block_size",&bs,PETSC_NULL);CHKERRQ(ierr);
ierr = MatCreate(PETSC_COMM_WORLD,&C);CHKERRQ(ierr);
ierr = MatSetSizes(C,PETSC_DECIDE,PETSC_DECIDE,n,n);CHKERRQ(ierr);
ierr = MatSetType(C,MATAIJ);CHKERRQ(ierr);
ierr = MatSetFromOptions(C);CHKERRQ(ierr);
ierr = MatGetType(C,&type);CHKERRQ(ierr);
if (size == 1){
ierr = PetscObjectTypeCompare((PetscObject)C,MATSEQAIJ,&isAIJ);CHKERRQ(ierr);
} else {
ierr = PetscObjectTypeCompare((PetscObject)C,MATMPIAIJ,&isAIJ);CHKERRQ(ierr);
}
ierr = MatSeqAIJSetPreallocation(C,3,PETSC_NULL);
ierr = MatMPIAIJSetPreallocation(C,3,PETSC_NULL,3,PETSC_NULL);CHKERRQ(ierr);
ierr = MatSeqBAIJSetPreallocation(C,bs,3,PETSC_NULL);
ierr = MatMPIBAIJSetPreallocation(C,bs,3,PETSC_NULL,3,PETSC_NULL);CHKERRQ(ierr);
v[0] = -1.; v[1] = 2.; v[2] = -1.;
for (i=1; i<n-1; i++){
midx[2] = i-1; midx[1] = i; midx[0] = i+1;
ierr = MatSetValues(C,1,&i,3,midx,v,INSERT_VALUES);CHKERRQ(ierr);
}
i = 0; midx[0] = 0; midx[1] = 1;
v[0] = 2.0; v[1] = -1.;
ierr = MatSetValues(C,1,&i,2,midx,v,INSERT_VALUES);CHKERRQ(ierr);
i = n-1; midx[0] = n-2; midx[1] = n-1;
v[0] = -1.0; v[1] = 2.;
ierr = MatSetValues(C,1,&i,2,midx,v,INSERT_VALUES);CHKERRQ(ierr);
ierr = MatAssemblyBegin(C,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(C,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatCreate(PETSC_COMM_WORLD,&A);CHKERRQ(ierr);
ierr = MatSetSizes(A,PETSC_DECIDE,PETSC_DECIDE,n,n);CHKERRQ(ierr);
ierr = MatSetFromOptions(A);CHKERRQ(ierr);
ierr = MatSetUp(A);CHKERRQ(ierr);
ierr = MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
ierr = MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
/* test matrices with different nonzero patterns - Note: A is created with different nonzero pattern of C! */
ierr = MatCopy(C,A,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
ierr = MatEqual(A,C,&flg);CHKERRQ(ierr);
if (!flg) SETERRQ(PETSC_COMM_SELF,1,"MatCopy(C,A,DIFFERENT_NONZERO_PATTERN): Matrices are NOT equal");
ierr = PetscViewerSetFormat(PETSC_VIEWER_STDOUT_WORLD,PETSC_VIEWER_ASCII_INFO);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"A is obtained with MatCopy(,,DIFFERENT_NONZERO_PATTERN):\n");CHKERRQ(ierr);
ierr = MatView(A,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
ierr = MatDestroy(&A);CHKERRQ(ierr);
/* test matrices with same nonzero pattern */
ierr = MatDuplicate(C,MAT_DO_NOT_COPY_VALUES,&A);CHKERRQ(ierr);
ierr = MatCopy(C,A,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
ierr = MatEqual(A,C,&flg);CHKERRQ(ierr);
if (!flg) SETERRQ(PETSC_COMM_SELF,1,"MatCopy(C,A,SAME_NONZERO_PATTERN): Matrices are NOT equal");
ierr = PetscViewerSetFormat(PETSC_VIEWER_STDOUT_WORLD,PETSC_VIEWER_ASCII_INFO);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"\nA is obtained with MatCopy(,,SAME_NONZERO_PATTERN):\n");CHKERRQ(ierr);
ierr = MatView(A,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
ierr = PetscViewerSetFormat(PETSC_VIEWER_STDOUT_WORLD,PETSC_VIEWER_ASCII_COMMON);CHKERRQ(ierr);
ierr = PetscPrintf(PETSC_COMM_WORLD,"A:\n");CHKERRQ(ierr);
ierr = MatView(A,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
/* test MatStore/RetrieveValues() */
if (isAIJ){
ierr = MatSetOption(A,MAT_NEW_NONZERO_LOCATIONS,PETSC_FALSE);CHKERRQ(ierr);
ierr = MatStoreValues(A);CHKERRQ(ierr);
ierr = MatZeroEntries(A);CHKERRQ(ierr);
ierr = MatRetrieveValues(A);CHKERRQ(ierr);
}
ierr = MatDestroy(&C);CHKERRQ(ierr);
ierr = MatDestroy(&A);CHKERRQ(ierr);
ierr = PetscFinalize();
return 0;
}
// -------------------------------------------------------------
// MatMatMult_DenseGA
// -------------------------------------------------------------
static
PetscErrorCode
MatMatMult_DenseGA(Mat A, Mat B, MatReuse scall, PetscReal fill, Mat *C)
{
// matrix sizes appear to be checked before here, so we won't do it again
PetscErrorCode ierr = 0;
MPI_Comm comm;
ierr = PetscObjectGetComm((PetscObject)A, &comm); CHKERRQ(ierr);
MatType atype, btype;
ierr = MatGetType(A, &atype);
ierr = MatGetType(B, &btype);
PetscBool issame;
PetscStrcmp(atype, btype, &issame);
Mat Bga, Cga;
struct MatGACtx *Actx, *Bctx, *Cctx;
ierr = MatShellGetContext(A, &Actx); CHKERRQ(ierr);
if (issame) {
Bga = B;
} else {
ierr = MatConvertToDenseGA(B, &Bga); CHKERRQ(ierr);
}
ierr = MatShellGetContext(Bga, &Bctx); CHKERRQ(ierr);
PetscInt lrows, lcols, grows, gcols, junk;
ierr = MatGetSize(A, &grows, &junk); CHKERRQ(ierr);
ierr = MatGetSize(B, &junk, &gcols); CHKERRQ(ierr);
ierr = MatGetLocalSize(A, &lrows, &junk); CHKERRQ(ierr);
ierr = MatGetLocalSize(B, &junk, &lcols); CHKERRQ(ierr);
ierr = MatCreateDenseGA(comm, lrows, lcols, grows, gcols, &Cga); CHKERRQ(ierr);
ierr = MatShellGetContext(Cga, &Cctx); CHKERRQ(ierr);
PetscScalarGA alpha(one), beta(zero);
int ndim, itype, lo[2] = {0,0}, ahi[2], bhi[2], chi[2];
NGA_Inquire(Actx->ga, &itype, &ndim, ahi);
ahi[0] -= 1; ahi[1] -= 1;
NGA_Inquire(Bctx->ga, &itype, &ndim, bhi);
bhi[0] -= 1; bhi[1] -= 1;
NGA_Inquire(Cctx->ga, &itype, &ndim, chi);
chi[0] -= 1; chi[1] -= 1;
// GA_Print(Actx->ga);
// GA_Print(Bctx->ga);
NGA_Matmul_patch('N', 'N', &alpha, &beta,
Actx->ga, lo, ahi,
Bctx->ga, lo, bhi,
Cctx->ga, lo, chi);
// GA_Print(Cctx->ga);
switch (scall) {
case MAT_REUSE_MATRIX:
ierr = MatCopy(Cga, *C, SAME_NONZERO_PATTERN); CHKERRQ(ierr);
case MAT_INITIAL_MATRIX:
default:
ierr = MatDuplicate(Cga, MAT_COPY_VALUES, C); CHKERRQ(ierr);
break;
}
if (!issame) ierr = MatDestroy(&Bga); CHKERRQ(ierr);
ierr = MatDestroy(&Cga); CHKERRQ(ierr);
return ierr;
}