Beispiel #1
0
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);
}
Beispiel #2
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;
}
Beispiel #4
0
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;
	}
}
Beispiel #6
0
/*
   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;
}
Beispiel #7
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);
}
Beispiel #8
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;
}
Beispiel #9
0
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;
}
Beispiel #10
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);
}
Beispiel #12
0
/*@
    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);
}
Beispiel #13
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;
			}
		}
	}
}
Beispiel #15
0
// -------------------------------------------------------------
// 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;
}
Beispiel #16
0
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);
}
Beispiel #17
0
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);
}
Beispiel #18
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);
}
Beispiel #19
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);
}
Beispiel #20
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;
}
Beispiel #21
0
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);
}
Beispiel #22
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);
}
Beispiel #23
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, &GTrans );
#else
        MatTranspose( gradMat, MAT_INITIAL_MATRIX, &GTrans );
#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, &GTrans );
        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, &GTrans ); */
/* 	 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(&GTrans );

#if( PETSC_VERSION_MAJOR <= 2 )
        MatTranspose( gradMat, &GTrans );
#else
        MatTranspose( gradMat, MAT_INITIAL_MATRIX, &GTrans );
#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(&GTrans );
}
Beispiel #25
0
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);
}
Beispiel #26
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();
}
Beispiel #27
0
// 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);
}
Beispiel #28
0
/*
   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);
}
Beispiel #29
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;
}
Beispiel #30
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;
}