xref: /petsc/src/tao/matrix/adamat.c (revision a7e14dcfba0d07adf6226a919460249440ec94c7)
1*a7e14dcfSSatish Balay #include "adamat.h"                /*I  "mat.h"  I*/
2*a7e14dcfSSatish Balay 
3*a7e14dcfSSatish Balay #undef __FUNCT__
4*a7e14dcfSSatish Balay #define __FUNCT__ "MatCreateADA"
5*a7e14dcfSSatish Balay /*@C
6*a7e14dcfSSatish Balay    MatCreateADA - Creates a matrix M=A^T D1 A + D2 where D1, D2 are diagonal
7*a7e14dcfSSatish Balay 
8*a7e14dcfSSatish Balay    Collective on matrix
9*a7e14dcfSSatish Balay 
10*a7e14dcfSSatish Balay    Input Parameters:
11*a7e14dcfSSatish Balay +  mat - matrix of arbitrary type
12*a7e14dcfSSatish Balay .  d1 - A vector with diagonal elements of D1
13*a7e14dcfSSatish Balay -  d2 - A vector
14*a7e14dcfSSatish Balay 
15*a7e14dcfSSatish Balay    Output Parameters:
16*a7e14dcfSSatish Balay .  J - New matrix whose operations are defined in terms of mat, D1, and D2.
17*a7e14dcfSSatish Balay 
18*a7e14dcfSSatish Balay    Notes:
19*a7e14dcfSSatish Balay    The user provides the input data and is responsible for destroying
20*a7e14dcfSSatish Balay    this data after matrix J has been destroyed.
21*a7e14dcfSSatish Balay    The operation MatMult(A,D2,D1) must be well defined.
22*a7e14dcfSSatish Balay    Before calling the operation MatGetDiagonal(), the function
23*a7e14dcfSSatish Balay    MatADAComputeDiagonal() must be called.  The matrices A and D1 must
24*a7e14dcfSSatish Balay    be the same during calls to MatADAComputeDiagonal() and
25*a7e14dcfSSatish Balay    MatGetDiagonal().
26*a7e14dcfSSatish Balay 
27*a7e14dcfSSatish Balay    Level: developer
28*a7e14dcfSSatish Balay 
29*a7e14dcfSSatish Balay .seealso: MatCreate()
30*a7e14dcfSSatish Balay @*/
31*a7e14dcfSSatish Balay PetscErrorCode MatCreateADA(Mat mat,Vec d1, Vec d2, Mat *J)
32*a7e14dcfSSatish Balay {
33*a7e14dcfSSatish Balay   MPI_Comm     comm=((PetscObject)mat)->comm;
34*a7e14dcfSSatish Balay   TaoMatADACtx ctx;
35*a7e14dcfSSatish Balay   PetscErrorCode          ierr;
36*a7e14dcfSSatish Balay   PetscInt nloc,n;
37*a7e14dcfSSatish Balay 
38*a7e14dcfSSatish Balay   PetscFunctionBegin;
39*a7e14dcfSSatish Balay 
40*a7e14dcfSSatish Balay   ierr = PetscNew(_p_TaoMatADACtx,&ctx);CHKERRQ(ierr);
41*a7e14dcfSSatish Balay 
42*a7e14dcfSSatish Balay   ctx->A=mat;
43*a7e14dcfSSatish Balay   ctx->D1=d1;
44*a7e14dcfSSatish Balay   ctx->D2=d2;
45*a7e14dcfSSatish Balay   if (d1){
46*a7e14dcfSSatish Balay     ierr = VecDuplicate(d1,&ctx->W);CHKERRQ(ierr);
47*a7e14dcfSSatish Balay     ierr =  PetscObjectReference((PetscObject)d1);CHKERRQ(ierr);
48*a7e14dcfSSatish Balay   } else {
49*a7e14dcfSSatish Balay     ctx->W=0;
50*a7e14dcfSSatish Balay   }
51*a7e14dcfSSatish Balay   if (d2){
52*a7e14dcfSSatish Balay     ierr = VecDuplicate(d2,&ctx->W2);CHKERRQ(ierr);
53*a7e14dcfSSatish Balay     ierr = VecDuplicate(d2,&ctx->ADADiag);CHKERRQ(ierr);
54*a7e14dcfSSatish Balay     ierr =  PetscObjectReference((PetscObject)d2);CHKERRQ(ierr);
55*a7e14dcfSSatish Balay   } else {
56*a7e14dcfSSatish Balay     ctx->W2=0;
57*a7e14dcfSSatish Balay     ctx->ADADiag=0;
58*a7e14dcfSSatish Balay   }
59*a7e14dcfSSatish Balay 
60*a7e14dcfSSatish Balay   ctx->GotDiag=0;
61*a7e14dcfSSatish Balay   ierr =  PetscObjectReference((PetscObject)mat);CHKERRQ(ierr);
62*a7e14dcfSSatish Balay 
63*a7e14dcfSSatish Balay   ierr=VecGetLocalSize(d2,&nloc);CHKERRQ(ierr);
64*a7e14dcfSSatish Balay   ierr=VecGetSize(d2,&n);CHKERRQ(ierr);
65*a7e14dcfSSatish Balay 
66*a7e14dcfSSatish Balay   ierr = MatCreateShell(comm,nloc,nloc,n,n,ctx,J);CHKERRQ(ierr);
67*a7e14dcfSSatish Balay 
68*a7e14dcfSSatish Balay   ierr = MatShellSetOperation(*J,MATOP_MULT,(void(*)(void))MatMult_ADA);CHKERRQ(ierr);
69*a7e14dcfSSatish Balay   ierr = MatShellSetOperation(*J,MATOP_DESTROY,(void(*)(void))MatDestroy_ADA);CHKERRQ(ierr);
70*a7e14dcfSSatish Balay   ierr = MatShellSetOperation(*J,MATOP_VIEW,(void(*)(void))MatView_ADA);CHKERRQ(ierr);
71*a7e14dcfSSatish Balay   ierr = MatShellSetOperation(*J,MATOP_MULT_TRANSPOSE,(void(*)(void))MatMultTranspose_ADA);CHKERRQ(ierr);
72*a7e14dcfSSatish Balay   ierr = MatShellSetOperation(*J,MATOP_DIAGONAL_SET,(void(*)(void))MatDiagonalSet_ADA);CHKERRQ(ierr);
73*a7e14dcfSSatish Balay   ierr = MatShellSetOperation(*J,MATOP_SHIFT,(void(*)(void))MatShift_ADA);CHKERRQ(ierr);
74*a7e14dcfSSatish Balay   ierr = MatShellSetOperation(*J,MATOP_EQUAL,(void(*)(void))MatEqual_ADA);CHKERRQ(ierr);
75*a7e14dcfSSatish Balay   ierr = MatShellSetOperation(*J,MATOP_SCALE,(void(*)(void))MatScale_ADA);CHKERRQ(ierr);
76*a7e14dcfSSatish Balay   ierr = MatShellSetOperation(*J,MATOP_TRANSPOSE,(void(*)(void))MatTranspose_ADA);CHKERRQ(ierr);
77*a7e14dcfSSatish Balay   ierr = MatShellSetOperation(*J,MATOP_GET_DIAGONAL,(void(*)(void))MatGetDiagonal_ADA);CHKERRQ(ierr);
78*a7e14dcfSSatish Balay   ierr = MatShellSetOperation(*J,MATOP_GET_SUBMATRICES,(void(*)(void))MatGetSubMatrices_ADA);CHKERRQ(ierr);
79*a7e14dcfSSatish Balay   ierr = MatShellSetOperation(*J,MATOP_NORM,(void(*)(void))MatNorm_ADA);CHKERRQ(ierr);
80*a7e14dcfSSatish Balay   ierr = MatShellSetOperation(*J,MATOP_DUPLICATE,(void(*)(void))MatDuplicate_ADA);CHKERRQ(ierr);
81*a7e14dcfSSatish Balay   ierr = MatShellSetOperation(*J,MATOP_GET_SUBMATRIX,(void(*)(void))MatGetSubMatrix_ADA);CHKERRQ(ierr);
82*a7e14dcfSSatish Balay 
83*a7e14dcfSSatish Balay   ierr = PetscLogObjectParent((PetscObject)(*J),(PetscObject)ctx->W); CHKERRQ(ierr);
84*a7e14dcfSSatish Balay   ierr = PetscLogObjectParent((PetscObject)mat,(PetscObject)(*J)); CHKERRQ(ierr);
85*a7e14dcfSSatish Balay 
86*a7e14dcfSSatish Balay   ierr = MatSetOption(*J,MAT_SYMMETRIC,PETSC_TRUE);CHKERRQ(ierr);
87*a7e14dcfSSatish Balay   PetscFunctionReturn(0);
88*a7e14dcfSSatish Balay }
89*a7e14dcfSSatish Balay 
90*a7e14dcfSSatish Balay #undef __FUNCT__
91*a7e14dcfSSatish Balay #define __FUNCT__ "MatMult_ADA"
92*a7e14dcfSSatish Balay PetscErrorCode MatMult_ADA(Mat mat,Vec a,Vec y)
93*a7e14dcfSSatish Balay {
94*a7e14dcfSSatish Balay   TaoMatADACtx ctx;
95*a7e14dcfSSatish Balay   PetscReal        one = 1.0;
96*a7e14dcfSSatish Balay   PetscErrorCode           ierr;
97*a7e14dcfSSatish Balay 
98*a7e14dcfSSatish Balay   PetscFunctionBegin;
99*a7e14dcfSSatish Balay   ierr = MatShellGetContext(mat,(void **)&ctx);CHKERRQ(ierr);
100*a7e14dcfSSatish Balay 
101*a7e14dcfSSatish Balay   ierr = MatMult(ctx->A,a,ctx->W);CHKERRQ(ierr);
102*a7e14dcfSSatish Balay   if (ctx->D1){
103*a7e14dcfSSatish Balay     ierr = VecPointwiseMult(ctx->W,ctx->D1,ctx->W);CHKERRQ(ierr);
104*a7e14dcfSSatish Balay   }
105*a7e14dcfSSatish Balay   ierr = MatMultTranspose(ctx->A,ctx->W,y);CHKERRQ(ierr);
106*a7e14dcfSSatish Balay   if (ctx->D2){
107*a7e14dcfSSatish Balay     ierr = VecPointwiseMult(ctx->W2, ctx->D2, a);CHKERRQ(ierr);
108*a7e14dcfSSatish Balay     ierr = VecAXPY(y, one, ctx->W2);CHKERRQ(ierr);
109*a7e14dcfSSatish Balay   }
110*a7e14dcfSSatish Balay   PetscFunctionReturn(0);
111*a7e14dcfSSatish Balay }
112*a7e14dcfSSatish Balay 
113*a7e14dcfSSatish Balay #undef __FUNCT__
114*a7e14dcfSSatish Balay #define __FUNCT__ "MatMultTranspose_ADA"
115*a7e14dcfSSatish Balay PetscErrorCode MatMultTranspose_ADA(Mat mat,Vec a,Vec y)
116*a7e14dcfSSatish Balay {
117*a7e14dcfSSatish Balay   PetscErrorCode ierr;
118*a7e14dcfSSatish Balay 
119*a7e14dcfSSatish Balay   PetscFunctionBegin;
120*a7e14dcfSSatish Balay   ierr = MatMult_ADA(mat,a,y);CHKERRQ(ierr);
121*a7e14dcfSSatish Balay   PetscFunctionReturn(0);
122*a7e14dcfSSatish Balay }
123*a7e14dcfSSatish Balay 
124*a7e14dcfSSatish Balay #undef __FUNCT__
125*a7e14dcfSSatish Balay #define __FUNCT__ "MatDiagonalSet_ADA"
126*a7e14dcfSSatish Balay PetscErrorCode MatDiagonalSet_ADA(Vec D, Mat M)
127*a7e14dcfSSatish Balay {
128*a7e14dcfSSatish Balay   TaoMatADACtx ctx;
129*a7e14dcfSSatish Balay   PetscReal        zero=0.0,one = 1.0;
130*a7e14dcfSSatish Balay   PetscErrorCode   ierr;
131*a7e14dcfSSatish Balay 
132*a7e14dcfSSatish Balay   PetscFunctionBegin;
133*a7e14dcfSSatish Balay   ierr = MatShellGetContext(M,(void **)&ctx);CHKERRQ(ierr);
134*a7e14dcfSSatish Balay 
135*a7e14dcfSSatish Balay   if (ctx->D2==PETSC_NULL){
136*a7e14dcfSSatish Balay     ierr = VecDuplicate(D,&ctx->D2);CHKERRQ(ierr);
137*a7e14dcfSSatish Balay     ierr = VecSet(ctx->D2, zero);CHKERRQ(ierr);
138*a7e14dcfSSatish Balay   }
139*a7e14dcfSSatish Balay   ierr = VecAXPY(ctx->D2, one, D);CHKERRQ(ierr);
140*a7e14dcfSSatish Balay 
141*a7e14dcfSSatish Balay   PetscFunctionReturn(0);
142*a7e14dcfSSatish Balay }
143*a7e14dcfSSatish Balay 
144*a7e14dcfSSatish Balay #undef __FUNCT__
145*a7e14dcfSSatish Balay #define __FUNCT__ "MatDestroy_ADA"
146*a7e14dcfSSatish Balay PetscErrorCode MatDestroy_ADA(Mat mat)
147*a7e14dcfSSatish Balay {
148*a7e14dcfSSatish Balay   PetscErrorCode          ierr;
149*a7e14dcfSSatish Balay   TaoMatADACtx ctx;
150*a7e14dcfSSatish Balay 
151*a7e14dcfSSatish Balay   PetscFunctionBegin;
152*a7e14dcfSSatish Balay   ierr=MatShellGetContext(mat,(void **)&ctx);CHKERRQ(ierr);
153*a7e14dcfSSatish Balay   if (ctx->W) {
154*a7e14dcfSSatish Balay     ierr=VecDestroy(&ctx->W);CHKERRQ(ierr);
155*a7e14dcfSSatish Balay   }
156*a7e14dcfSSatish Balay   if (ctx->W2) {
157*a7e14dcfSSatish Balay     ierr=VecDestroy(&ctx->W2);CHKERRQ(ierr);
158*a7e14dcfSSatish Balay   }
159*a7e14dcfSSatish Balay   if (ctx->ADADiag) {
160*a7e14dcfSSatish Balay     ierr=VecDestroy(&ctx->ADADiag);CHKERRQ(ierr);
161*a7e14dcfSSatish Balay   }
162*a7e14dcfSSatish Balay   if (ctx->A) {
163*a7e14dcfSSatish Balay     ierr=MatDestroy(&ctx->A);CHKERRQ(ierr);
164*a7e14dcfSSatish Balay   }
165*a7e14dcfSSatish Balay   if (ctx->D1) {
166*a7e14dcfSSatish Balay     ierr=VecDestroy(&ctx->D1);CHKERRQ(ierr);
167*a7e14dcfSSatish Balay   }
168*a7e14dcfSSatish Balay   if (ctx->D2) {
169*a7e14dcfSSatish Balay     ierr=VecDestroy(&ctx->D2);CHKERRQ(ierr);
170*a7e14dcfSSatish Balay   }
171*a7e14dcfSSatish Balay   ierr = PetscFree(ctx); CHKERRQ(ierr);
172*a7e14dcfSSatish Balay   PetscFunctionReturn(0);
173*a7e14dcfSSatish Balay }
174*a7e14dcfSSatish Balay 
175*a7e14dcfSSatish Balay #undef __FUNCT__
176*a7e14dcfSSatish Balay #define __FUNCT__ "MatView_ADA"
177*a7e14dcfSSatish Balay PetscErrorCode MatView_ADA(Mat mat,PetscViewer viewer)
178*a7e14dcfSSatish Balay {
179*a7e14dcfSSatish Balay 
180*a7e14dcfSSatish Balay   PetscFunctionBegin;
181*a7e14dcfSSatish Balay   PetscFunctionReturn(0);
182*a7e14dcfSSatish Balay }
183*a7e14dcfSSatish Balay 
184*a7e14dcfSSatish Balay #undef __FUNCT__
185*a7e14dcfSSatish Balay #define __FUNCT__ "MatShift_ADA"
186*a7e14dcfSSatish Balay PetscErrorCode MatShift_ADA(Mat Y, PetscReal a)
187*a7e14dcfSSatish Balay {
188*a7e14dcfSSatish Balay   PetscErrorCode ierr;
189*a7e14dcfSSatish Balay   TaoMatADACtx   ctx;
190*a7e14dcfSSatish Balay 
191*a7e14dcfSSatish Balay   PetscFunctionBegin;
192*a7e14dcfSSatish Balay   ierr = MatShellGetContext(Y,(void **)&ctx);CHKERRQ(ierr);
193*a7e14dcfSSatish Balay   ierr = VecShift(ctx->D2,a);CHKERRQ(ierr);
194*a7e14dcfSSatish Balay   PetscFunctionReturn(0);
195*a7e14dcfSSatish Balay }
196*a7e14dcfSSatish Balay 
197*a7e14dcfSSatish Balay #undef __FUNCT__
198*a7e14dcfSSatish Balay #define __FUNCT__ "MatDuplicate_ADA"
199*a7e14dcfSSatish Balay PetscErrorCode MatDuplicate_ADA(Mat mat,MatDuplicateOption op,Mat *M)
200*a7e14dcfSSatish Balay {
201*a7e14dcfSSatish Balay   PetscErrorCode    ierr;
202*a7e14dcfSSatish Balay   TaoMatADACtx      ctx;
203*a7e14dcfSSatish Balay   Mat               A2;
204*a7e14dcfSSatish Balay   Vec               D1b=NULL,D2b;
205*a7e14dcfSSatish Balay 
206*a7e14dcfSSatish Balay   PetscFunctionBegin;
207*a7e14dcfSSatish Balay   ierr = MatShellGetContext(mat,(void **)&ctx);CHKERRQ(ierr);
208*a7e14dcfSSatish Balay   ierr = MatDuplicate(ctx->A,op,&A2);CHKERRQ(ierr);
209*a7e14dcfSSatish Balay   if (ctx->D1){
210*a7e14dcfSSatish Balay     ierr = VecDuplicate(ctx->D1,&D1b);CHKERRQ(ierr);
211*a7e14dcfSSatish Balay     ierr = VecCopy(ctx->D1,D1b);CHKERRQ(ierr);
212*a7e14dcfSSatish Balay   }
213*a7e14dcfSSatish Balay   ierr = VecDuplicate(ctx->D2,&D2b);CHKERRQ(ierr);
214*a7e14dcfSSatish Balay   ierr = VecCopy(ctx->D2,D2b);CHKERRQ(ierr);
215*a7e14dcfSSatish Balay   ierr = MatCreateADA(A2,D1b,D2b,M);CHKERRQ(ierr);
216*a7e14dcfSSatish Balay   if (ctx->D1){
217*a7e14dcfSSatish Balay     ierr = PetscObjectDereference((PetscObject)D1b);CHKERRQ(ierr);
218*a7e14dcfSSatish Balay   }
219*a7e14dcfSSatish Balay   ierr = PetscObjectDereference((PetscObject)D2b);CHKERRQ(ierr);
220*a7e14dcfSSatish Balay   ierr = PetscObjectDereference((PetscObject)A2);CHKERRQ(ierr);
221*a7e14dcfSSatish Balay 
222*a7e14dcfSSatish Balay   PetscFunctionReturn(0);
223*a7e14dcfSSatish Balay }
224*a7e14dcfSSatish Balay 
225*a7e14dcfSSatish Balay #undef __FUNCT__
226*a7e14dcfSSatish Balay #define __FUNCT__ "MatEqual_ADA"
227*a7e14dcfSSatish Balay PetscErrorCode MatEqual_ADA(Mat A,Mat B,PetscBool *flg)
228*a7e14dcfSSatish Balay {
229*a7e14dcfSSatish Balay   PetscErrorCode    ierr;
230*a7e14dcfSSatish Balay   TaoMatADACtx  ctx1,ctx2;
231*a7e14dcfSSatish Balay 
232*a7e14dcfSSatish Balay   PetscFunctionBegin;
233*a7e14dcfSSatish Balay   ierr = MatShellGetContext(A,(void **)&ctx1);CHKERRQ(ierr);
234*a7e14dcfSSatish Balay   ierr = MatShellGetContext(B,(void **)&ctx2);CHKERRQ(ierr);
235*a7e14dcfSSatish Balay   ierr = VecEqual(ctx1->D2,ctx2->D2,flg);CHKERRQ(ierr);
236*a7e14dcfSSatish Balay   if (*flg==PETSC_TRUE){
237*a7e14dcfSSatish Balay     ierr = VecEqual(ctx1->D1,ctx2->D1,flg);CHKERRQ(ierr);
238*a7e14dcfSSatish Balay   }
239*a7e14dcfSSatish Balay   if (*flg==PETSC_TRUE){
240*a7e14dcfSSatish Balay     ierr = MatEqual(ctx1->A,ctx2->A,flg);CHKERRQ(ierr);
241*a7e14dcfSSatish Balay   }
242*a7e14dcfSSatish Balay   PetscFunctionReturn(0);
243*a7e14dcfSSatish Balay }
244*a7e14dcfSSatish Balay 
245*a7e14dcfSSatish Balay #undef __FUNCT__
246*a7e14dcfSSatish Balay #define __FUNCT__ "MatScale_ADA"
247*a7e14dcfSSatish Balay PetscErrorCode MatScale_ADA(Mat mat, PetscReal a)
248*a7e14dcfSSatish Balay {
249*a7e14dcfSSatish Balay   PetscErrorCode   ierr;
250*a7e14dcfSSatish Balay   TaoMatADACtx ctx;
251*a7e14dcfSSatish Balay 
252*a7e14dcfSSatish Balay   PetscFunctionBegin;
253*a7e14dcfSSatish Balay   ierr = MatShellGetContext(mat,(void **)&ctx);CHKERRQ(ierr);
254*a7e14dcfSSatish Balay   ierr = VecScale(ctx->D1,a);CHKERRQ(ierr);
255*a7e14dcfSSatish Balay   if (ctx->D2){
256*a7e14dcfSSatish Balay     ierr = VecScale(ctx->D2,a);CHKERRQ(ierr);
257*a7e14dcfSSatish Balay   }
258*a7e14dcfSSatish Balay   PetscFunctionReturn(0);
259*a7e14dcfSSatish Balay }
260*a7e14dcfSSatish Balay 
261*a7e14dcfSSatish Balay #undef __FUNCT__
262*a7e14dcfSSatish Balay #define __FUNCT__ "MatTranspose_ADA"
263*a7e14dcfSSatish Balay PetscErrorCode MatTranspose_ADA(Mat mat,Mat *B)
264*a7e14dcfSSatish Balay {
265*a7e14dcfSSatish Balay   PetscErrorCode ierr;
266*a7e14dcfSSatish Balay   TaoMatADACtx ctx;
267*a7e14dcfSSatish Balay 
268*a7e14dcfSSatish Balay   PetscFunctionBegin;
269*a7e14dcfSSatish Balay   if (*B){
270*a7e14dcfSSatish Balay     ierr = MatShellGetContext(mat,(void **)&ctx);CHKERRQ(ierr);
271*a7e14dcfSSatish Balay     ierr = MatDuplicate(mat,MAT_COPY_VALUES,B);CHKERRQ(ierr);
272*a7e14dcfSSatish Balay   }
273*a7e14dcfSSatish Balay   PetscFunctionReturn(0);
274*a7e14dcfSSatish Balay }
275*a7e14dcfSSatish Balay 
276*a7e14dcfSSatish Balay #undef __FUNCT__
277*a7e14dcfSSatish Balay #define __FUNCT__ "MatADAComputeDiagonal"
278*a7e14dcfSSatish Balay PetscErrorCode MatADAComputeDiagonal(Mat mat)
279*a7e14dcfSSatish Balay {
280*a7e14dcfSSatish Balay   PetscErrorCode ierr;
281*a7e14dcfSSatish Balay   PetscInt          i,m,n,low,high;
282*a7e14dcfSSatish Balay   PetscReal       *dtemp,*dptr;
283*a7e14dcfSSatish Balay   TaoMatADACtx ctx;
284*a7e14dcfSSatish Balay 
285*a7e14dcfSSatish Balay   PetscFunctionBegin;
286*a7e14dcfSSatish Balay   ierr = MatShellGetContext(mat,(void **)&ctx);CHKERRQ(ierr);
287*a7e14dcfSSatish Balay 
288*a7e14dcfSSatish Balay   ierr = MatGetOwnershipRange(mat, &low, &high);CHKERRQ(ierr);
289*a7e14dcfSSatish Balay   ierr = MatGetSize(mat,&m,&n);CHKERRQ(ierr);
290*a7e14dcfSSatish Balay 
291*a7e14dcfSSatish Balay   ierr = PetscMalloc( n*sizeof(PetscReal),&dtemp ); CHKERRQ(ierr);
292*a7e14dcfSSatish Balay 
293*a7e14dcfSSatish Balay   for (i=0; i<n; i++){
294*a7e14dcfSSatish Balay     ierr = MatGetColumnVector(ctx->A, ctx->W, i);CHKERRQ(ierr);
295*a7e14dcfSSatish Balay     ierr = VecPointwiseMult(ctx->W,ctx->W,ctx->W);CHKERRQ(ierr);
296*a7e14dcfSSatish Balay     ierr = VecDotBegin(ctx->D1, ctx->W,dtemp+i);CHKERRQ(ierr);
297*a7e14dcfSSatish Balay   }
298*a7e14dcfSSatish Balay   for (i=0; i<n; i++){
299*a7e14dcfSSatish Balay     ierr = VecDotEnd(ctx->D1, ctx->W,dtemp+i);CHKERRQ(ierr);
300*a7e14dcfSSatish Balay   }
301*a7e14dcfSSatish Balay 
302*a7e14dcfSSatish Balay   ierr = VecGetArray(ctx->ADADiag,&dptr);CHKERRQ(ierr);
303*a7e14dcfSSatish Balay   for (i=low; i<high; i++){
304*a7e14dcfSSatish Balay     dptr[i-low]= dtemp[i];
305*a7e14dcfSSatish Balay   }
306*a7e14dcfSSatish Balay   ierr = VecRestoreArray(ctx->ADADiag,&dptr);CHKERRQ(ierr);
307*a7e14dcfSSatish Balay   if (dtemp) {
308*a7e14dcfSSatish Balay     ierr = PetscFree(dtemp); CHKERRQ(ierr);
309*a7e14dcfSSatish Balay   }
310*a7e14dcfSSatish Balay   PetscFunctionReturn(0);
311*a7e14dcfSSatish Balay }
312*a7e14dcfSSatish Balay 
313*a7e14dcfSSatish Balay #undef __FUNCT__
314*a7e14dcfSSatish Balay #define __FUNCT__ "MatGetDiagonal_ADA"
315*a7e14dcfSSatish Balay PetscErrorCode MatGetDiagonal_ADA(Mat mat,Vec v)
316*a7e14dcfSSatish Balay {
317*a7e14dcfSSatish Balay   PetscErrorCode      ierr;
318*a7e14dcfSSatish Balay   PetscReal       one=1.0;
319*a7e14dcfSSatish Balay   TaoMatADACtx ctx;
320*a7e14dcfSSatish Balay 
321*a7e14dcfSSatish Balay   PetscFunctionBegin;
322*a7e14dcfSSatish Balay   ierr = MatShellGetContext(mat,(void **)&ctx);CHKERRQ(ierr);
323*a7e14dcfSSatish Balay   ierr = MatADAComputeDiagonal(mat); CHKERRQ(ierr);
324*a7e14dcfSSatish Balay   ierr=VecCopy(ctx->ADADiag,v);CHKERRQ(ierr);
325*a7e14dcfSSatish Balay   if (ctx->D2){
326*a7e14dcfSSatish Balay     ierr=VecAXPY(v, one, ctx->D2);CHKERRQ(ierr);
327*a7e14dcfSSatish Balay   }
328*a7e14dcfSSatish Balay 
329*a7e14dcfSSatish Balay   PetscFunctionReturn(0);
330*a7e14dcfSSatish Balay }
331*a7e14dcfSSatish Balay 
332*a7e14dcfSSatish Balay #undef __FUNCT__
333*a7e14dcfSSatish Balay #define __FUNCT__ "MatGetSubMatrices_ADA"
334*a7e14dcfSSatish Balay PetscErrorCode MatGetSubMatrices_ADA(Mat A,PetscInt n, IS *irow,IS *icol,MatReuse scall,Mat **B)
335*a7e14dcfSSatish Balay {
336*a7e14dcfSSatish Balay   PetscErrorCode ierr;
337*a7e14dcfSSatish Balay   PetscInt i;
338*a7e14dcfSSatish Balay 
339*a7e14dcfSSatish Balay   PetscFunctionBegin;
340*a7e14dcfSSatish Balay   if (scall == MAT_INITIAL_MATRIX) {
341*a7e14dcfSSatish Balay     ierr = PetscMalloc( (n+1)*sizeof(Mat),B );CHKERRQ(ierr);
342*a7e14dcfSSatish Balay   }
343*a7e14dcfSSatish Balay 
344*a7e14dcfSSatish Balay   for ( i=0; i<n; i++ ) {
345*a7e14dcfSSatish Balay     ierr = MatGetSubMatrix_ADA(A,irow[i],icol[i],scall,&(*B)[i]);CHKERRQ(ierr);
346*a7e14dcfSSatish Balay   }
347*a7e14dcfSSatish Balay   PetscFunctionReturn(0);
348*a7e14dcfSSatish Balay }
349*a7e14dcfSSatish Balay 
350*a7e14dcfSSatish Balay #undef __FUNCT__
351*a7e14dcfSSatish Balay #define __FUNCT__ "MatGetSubMatrix_ADA"
352*a7e14dcfSSatish Balay PetscErrorCode MatGetSubMatrix_ADA(Mat mat,IS isrow,IS iscol,MatReuse cll,
353*a7e14dcfSSatish Balay 			Mat *newmat)
354*a7e14dcfSSatish Balay {
355*a7e14dcfSSatish Balay   PetscErrorCode          ierr;
356*a7e14dcfSSatish Balay   PetscInt low,high;
357*a7e14dcfSSatish Balay   PetscInt          n,nlocal,i;
358*a7e14dcfSSatish Balay   const PetscInt          *iptr;
359*a7e14dcfSSatish Balay   PetscReal       *dptr,*ddptr,zero=0.0;
360*a7e14dcfSSatish Balay   VecType      type_name;
361*a7e14dcfSSatish Balay   IS           ISrow;
362*a7e14dcfSSatish Balay   Vec          D1,D2;
363*a7e14dcfSSatish Balay   Mat          Atemp;
364*a7e14dcfSSatish Balay   TaoMatADACtx ctx;
365*a7e14dcfSSatish Balay 
366*a7e14dcfSSatish Balay   PetscFunctionBegin;
367*a7e14dcfSSatish Balay 
368*a7e14dcfSSatish Balay   ierr = MatShellGetContext(mat,(void **)&ctx);CHKERRQ(ierr);
369*a7e14dcfSSatish Balay 
370*a7e14dcfSSatish Balay   ierr = MatGetOwnershipRange(ctx->A,&low,&high);CHKERRQ(ierr);
371*a7e14dcfSSatish Balay   ierr = ISCreateStride(((PetscObject)mat)->comm,high-low,low,1,&ISrow);CHKERRQ(ierr);
372*a7e14dcfSSatish Balay   ierr = MatGetSubMatrix(ctx->A,ISrow,iscol,cll,&Atemp);CHKERRQ(ierr);
373*a7e14dcfSSatish Balay   ierr = ISDestroy(&ISrow);CHKERRQ(ierr);
374*a7e14dcfSSatish Balay 
375*a7e14dcfSSatish Balay   if (ctx->D1){
376*a7e14dcfSSatish Balay     ierr=VecDuplicate(ctx->D1,&D1);CHKERRQ(ierr);
377*a7e14dcfSSatish Balay     ierr=VecCopy(ctx->D1,D1);CHKERRQ(ierr);
378*a7e14dcfSSatish Balay   } else {
379*a7e14dcfSSatish Balay     D1=PETSC_NULL;
380*a7e14dcfSSatish Balay   }
381*a7e14dcfSSatish Balay 
382*a7e14dcfSSatish Balay   if (ctx->D2){
383*a7e14dcfSSatish Balay     ierr=ISGetSize(isrow,&n);CHKERRQ(ierr);
384*a7e14dcfSSatish Balay     ierr=ISGetLocalSize(isrow,&nlocal);CHKERRQ(ierr);
385*a7e14dcfSSatish Balay     ierr=VecCreate(((PetscObject)(ctx->D2))->comm,&D2);CHKERRQ(ierr);
386*a7e14dcfSSatish Balay     ierr=VecGetType(ctx->D2,&type_name);CHKERRQ(ierr);
387*a7e14dcfSSatish Balay     ierr=VecSetSizes(D2,nlocal,n);CHKERRQ(ierr);
388*a7e14dcfSSatish Balay     ierr=VecSetType(D2,type_name);CHKERRQ(ierr);
389*a7e14dcfSSatish Balay     ierr=VecSet(D2, zero);CHKERRQ(ierr);
390*a7e14dcfSSatish Balay     ierr=VecGetArray(ctx->D2, &dptr); CHKERRQ(ierr);
391*a7e14dcfSSatish Balay     ierr=VecGetArray(D2, &ddptr); CHKERRQ(ierr);
392*a7e14dcfSSatish Balay     ierr=ISGetIndices(isrow,&iptr); CHKERRQ(ierr);
393*a7e14dcfSSatish Balay     for (i=0;i<nlocal;i++){
394*a7e14dcfSSatish Balay       ddptr[i] = dptr[iptr[i]-low];
395*a7e14dcfSSatish Balay     }
396*a7e14dcfSSatish Balay     ierr=ISRestoreIndices(isrow,&iptr); CHKERRQ(ierr);
397*a7e14dcfSSatish Balay     ierr=VecRestoreArray(D2, &ddptr); CHKERRQ(ierr);
398*a7e14dcfSSatish Balay     ierr=VecRestoreArray(ctx->D2, &dptr); CHKERRQ(ierr);
399*a7e14dcfSSatish Balay 
400*a7e14dcfSSatish Balay   } else {
401*a7e14dcfSSatish Balay     D2=PETSC_NULL;
402*a7e14dcfSSatish Balay   }
403*a7e14dcfSSatish Balay 
404*a7e14dcfSSatish Balay   ierr = MatCreateADA(Atemp,D1,D2,newmat);CHKERRQ(ierr);
405*a7e14dcfSSatish Balay   ierr = MatShellGetContext(*newmat,(void **)&ctx);CHKERRQ(ierr);
406*a7e14dcfSSatish Balay   ierr = PetscObjectDereference((PetscObject)Atemp);CHKERRQ(ierr);
407*a7e14dcfSSatish Balay   if (ctx->D1){
408*a7e14dcfSSatish Balay     ierr = PetscObjectDereference((PetscObject)D1);CHKERRQ(ierr);
409*a7e14dcfSSatish Balay   }
410*a7e14dcfSSatish Balay   if (ctx->D2){
411*a7e14dcfSSatish Balay     ierr = PetscObjectDereference((PetscObject)D2);CHKERRQ(ierr);
412*a7e14dcfSSatish Balay   }
413*a7e14dcfSSatish Balay   PetscFunctionReturn(0);
414*a7e14dcfSSatish Balay }
415*a7e14dcfSSatish Balay 
416*a7e14dcfSSatish Balay #undef __FUNCT__
417*a7e14dcfSSatish Balay #define __FUNCT__ "MatGetRowADA"
418*a7e14dcfSSatish Balay PetscErrorCode MatGetRowADA(Mat mat,PetscInt row,PetscInt *ncols,PetscInt **cols,PetscReal **vals)
419*a7e14dcfSSatish Balay {
420*a7e14dcfSSatish Balay   PetscErrorCode ierr;
421*a7e14dcfSSatish Balay   PetscInt m,n;
422*a7e14dcfSSatish Balay 
423*a7e14dcfSSatish Balay   PetscFunctionBegin;
424*a7e14dcfSSatish Balay   ierr = MatGetSize(mat,&m,&n);CHKERRQ(ierr);
425*a7e14dcfSSatish Balay 
426*a7e14dcfSSatish Balay   if (*ncols>0){
427*a7e14dcfSSatish Balay     ierr = PetscMalloc( (*ncols)*sizeof(PetscInt),cols );CHKERRQ(ierr);
428*a7e14dcfSSatish Balay     ierr = PetscMalloc( (*ncols)*sizeof(PetscReal),vals );CHKERRQ(ierr);
429*a7e14dcfSSatish Balay   } else {
430*a7e14dcfSSatish Balay     *cols=PETSC_NULL;
431*a7e14dcfSSatish Balay     *vals=PETSC_NULL;
432*a7e14dcfSSatish Balay   }
433*a7e14dcfSSatish Balay 
434*a7e14dcfSSatish Balay   PetscFunctionReturn(0);
435*a7e14dcfSSatish Balay }
436*a7e14dcfSSatish Balay 
437*a7e14dcfSSatish Balay #undef __FUNCT__
438*a7e14dcfSSatish Balay #define __FUNCT__ "MatRestoreRowADA"
439*a7e14dcfSSatish Balay PetscErrorCode MatRestoreRowADA(Mat mat,PetscInt row,PetscInt *ncols,PetscInt **cols,PetscReal **vals)
440*a7e14dcfSSatish Balay {
441*a7e14dcfSSatish Balay   PetscErrorCode ierr;
442*a7e14dcfSSatish Balay   PetscFunctionBegin;
443*a7e14dcfSSatish Balay   if (*ncols>0){
444*a7e14dcfSSatish Balay     ierr = PetscFree(*cols);  CHKERRQ(ierr);
445*a7e14dcfSSatish Balay     ierr = PetscFree(*vals);  CHKERRQ(ierr);
446*a7e14dcfSSatish Balay   }
447*a7e14dcfSSatish Balay   *cols=PETSC_NULL;
448*a7e14dcfSSatish Balay   *vals=PETSC_NULL;
449*a7e14dcfSSatish Balay   PetscFunctionReturn(0);
450*a7e14dcfSSatish Balay }
451*a7e14dcfSSatish Balay 
452*a7e14dcfSSatish Balay #undef __FUNCT__
453*a7e14dcfSSatish Balay #define __FUNCT__ "MatGetColumnVectorADA"
454*a7e14dcfSSatish Balay PetscErrorCode MatGetColumnVector_ADA(Mat mat,Vec Y, PetscInt col)
455*a7e14dcfSSatish Balay {
456*a7e14dcfSSatish Balay   PetscErrorCode    ierr;
457*a7e14dcfSSatish Balay   PetscInt low,high;
458*a7e14dcfSSatish Balay   PetscReal zero=0.0,one=1.0;
459*a7e14dcfSSatish Balay 
460*a7e14dcfSSatish Balay   PetscFunctionBegin;
461*a7e14dcfSSatish Balay   ierr=VecSet(Y, zero);CHKERRQ(ierr);
462*a7e14dcfSSatish Balay   ierr=VecGetOwnershipRange(Y,&low,&high);CHKERRQ(ierr);
463*a7e14dcfSSatish Balay   if (col>=low && col<high){
464*a7e14dcfSSatish Balay     ierr=VecSetValue(Y,col,one,INSERT_VALUES);CHKERRQ(ierr);
465*a7e14dcfSSatish Balay   }
466*a7e14dcfSSatish Balay   ierr=VecAssemblyBegin(Y);CHKERRQ(ierr);
467*a7e14dcfSSatish Balay   ierr=VecAssemblyEnd(Y);CHKERRQ(ierr);
468*a7e14dcfSSatish Balay   ierr=MatMult_ADA(mat,Y,Y);CHKERRQ(ierr);
469*a7e14dcfSSatish Balay 
470*a7e14dcfSSatish Balay   PetscFunctionReturn(0);
471*a7e14dcfSSatish Balay }
472*a7e14dcfSSatish Balay 
473*a7e14dcfSSatish Balay PetscErrorCode MatConvert_ADA(Mat mat,MatType newtype,Mat *NewMat)
474*a7e14dcfSSatish Balay {
475*a7e14dcfSSatish Balay   PetscErrorCode ierr;
476*a7e14dcfSSatish Balay   PetscMPIInt size;
477*a7e14dcfSSatish Balay   PetscBool sametype, issame, isdense, isseqdense;
478*a7e14dcfSSatish Balay   TaoMatADACtx  ctx;
479*a7e14dcfSSatish Balay 
480*a7e14dcfSSatish Balay   PetscFunctionBegin;
481*a7e14dcfSSatish Balay   ierr = MatShellGetContext(mat,(void **)&ctx);CHKERRQ(ierr);
482*a7e14dcfSSatish Balay   MPI_Comm_size(((PetscObject)mat)->comm,&size);
483*a7e14dcfSSatish Balay 
484*a7e14dcfSSatish Balay 
485*a7e14dcfSSatish Balay   ierr = PetscObjectTypeCompare((PetscObject)mat,newtype,&sametype);CHKERRQ(ierr);
486*a7e14dcfSSatish Balay   ierr = PetscObjectTypeCompare((PetscObject)mat,MATSAME,&issame); CHKERRQ(ierr);
487*a7e14dcfSSatish Balay   ierr = PetscObjectTypeCompare((PetscObject)mat,MATMPIDENSE,&isdense); CHKERRQ(ierr);
488*a7e14dcfSSatish Balay   ierr = PetscObjectTypeCompare((PetscObject)mat,MATSEQDENSE,&isseqdense); CHKERRQ(ierr);
489*a7e14dcfSSatish Balay 
490*a7e14dcfSSatish Balay   if (sametype || issame) {
491*a7e14dcfSSatish Balay 
492*a7e14dcfSSatish Balay     ierr=MatDuplicate(mat,MAT_COPY_VALUES,NewMat);CHKERRQ(ierr);
493*a7e14dcfSSatish Balay 
494*a7e14dcfSSatish Balay   } else if (isdense) {
495*a7e14dcfSSatish Balay 
496*a7e14dcfSSatish Balay     PetscInt i,j,low,high,m,n,M,N;
497*a7e14dcfSSatish Balay     PetscReal *dptr;
498*a7e14dcfSSatish Balay     Vec X;
499*a7e14dcfSSatish Balay 
500*a7e14dcfSSatish Balay     ierr = VecDuplicate(ctx->D2,&X);CHKERRQ(ierr);
501*a7e14dcfSSatish Balay     ierr=MatGetSize(mat,&M,&N);CHKERRQ(ierr);
502*a7e14dcfSSatish Balay     ierr=MatGetLocalSize(mat,&m,&n);CHKERRQ(ierr);
503*a7e14dcfSSatish Balay     ierr = MatCreateDense(((PetscObject)mat)->comm,m,m,N,N,PETSC_NULL,NewMat);
504*a7e14dcfSSatish Balay     CHKERRQ(ierr);
505*a7e14dcfSSatish Balay     ierr = MatGetOwnershipRange(*NewMat,&low,&high);CHKERRQ(ierr);
506*a7e14dcfSSatish Balay     for (i=0;i<M;i++){
507*a7e14dcfSSatish Balay       ierr = MatGetColumnVector_ADA(mat,X,i);CHKERRQ(ierr);
508*a7e14dcfSSatish Balay       ierr = VecGetArray(X,&dptr);CHKERRQ(ierr);
509*a7e14dcfSSatish Balay       for (j=0; j<high-low; j++){
510*a7e14dcfSSatish Balay 	      ierr = MatSetValue(*NewMat,low+j,i,dptr[j],INSERT_VALUES);CHKERRQ(ierr);
511*a7e14dcfSSatish Balay       }
512*a7e14dcfSSatish Balay       ierr=VecRestoreArray(X,&dptr);CHKERRQ(ierr);
513*a7e14dcfSSatish Balay     }
514*a7e14dcfSSatish Balay     ierr=MatAssemblyBegin(*NewMat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
515*a7e14dcfSSatish Balay     ierr=MatAssemblyEnd(*NewMat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
516*a7e14dcfSSatish Balay     ierr = VecDestroy(&X);CHKERRQ(ierr);
517*a7e14dcfSSatish Balay 
518*a7e14dcfSSatish Balay   } else if (isseqdense && size==1){
519*a7e14dcfSSatish Balay 
520*a7e14dcfSSatish Balay     PetscInt i,j,low,high,m,n,M,N;
521*a7e14dcfSSatish Balay     PetscReal *dptr;
522*a7e14dcfSSatish Balay     Vec X;
523*a7e14dcfSSatish Balay 
524*a7e14dcfSSatish Balay     ierr = VecDuplicate(ctx->D2,&X);CHKERRQ(ierr);
525*a7e14dcfSSatish Balay     ierr = MatGetSize(mat,&M,&N);CHKERRQ(ierr);
526*a7e14dcfSSatish Balay     ierr = MatGetLocalSize(mat,&m,&n);CHKERRQ(ierr);
527*a7e14dcfSSatish Balay     ierr = MatCreateSeqDense(((PetscObject)mat)->comm,N,N,PETSC_NULL,NewMat);
528*a7e14dcfSSatish Balay     CHKERRQ(ierr);
529*a7e14dcfSSatish Balay     ierr = MatGetOwnershipRange(*NewMat,&low,&high);CHKERRQ(ierr);
530*a7e14dcfSSatish Balay     for (i=0;i<M;i++){
531*a7e14dcfSSatish Balay       ierr = MatGetColumnVector_ADA(mat,X,i);CHKERRQ(ierr);
532*a7e14dcfSSatish Balay       ierr = VecGetArray(X,&dptr);CHKERRQ(ierr);
533*a7e14dcfSSatish Balay       for (j=0; j<high-low; j++){
534*a7e14dcfSSatish Balay 	      ierr = MatSetValue(*NewMat,low+j,i,dptr[j],INSERT_VALUES);CHKERRQ(ierr);
535*a7e14dcfSSatish Balay       }
536*a7e14dcfSSatish Balay       ierr=VecRestoreArray(X,&dptr);CHKERRQ(ierr);
537*a7e14dcfSSatish Balay     }
538*a7e14dcfSSatish Balay     ierr=MatAssemblyBegin(*NewMat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
539*a7e14dcfSSatish Balay     ierr=MatAssemblyEnd(*NewMat,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
540*a7e14dcfSSatish Balay     ierr=VecDestroy(&X);CHKERRQ(ierr);
541*a7e14dcfSSatish Balay 
542*a7e14dcfSSatish Balay   } else {
543*a7e14dcfSSatish Balay     SETERRQ(PETSC_COMM_SELF,1,"No support to convert objects to that type");
544*a7e14dcfSSatish Balay   }
545*a7e14dcfSSatish Balay   PetscFunctionReturn(0);
546*a7e14dcfSSatish Balay }
547*a7e14dcfSSatish Balay 
548*a7e14dcfSSatish Balay #undef __FUNCT__
549*a7e14dcfSSatish Balay #define __FUNCT__ "MatNorm_ADA"
550*a7e14dcfSSatish Balay PetscErrorCode MatNorm_ADA(Mat mat,NormType type,PetscReal *norm)
551*a7e14dcfSSatish Balay {
552*a7e14dcfSSatish Balay   PetscErrorCode ierr;
553*a7e14dcfSSatish Balay   TaoMatADACtx  ctx;
554*a7e14dcfSSatish Balay 
555*a7e14dcfSSatish Balay   PetscFunctionBegin;
556*a7e14dcfSSatish Balay   ierr = MatShellGetContext(mat,(void **)&ctx);CHKERRQ(ierr);
557*a7e14dcfSSatish Balay 
558*a7e14dcfSSatish Balay   if (type == NORM_FROBENIUS) {
559*a7e14dcfSSatish Balay     *norm = 1.0;
560*a7e14dcfSSatish Balay   } else if (type == NORM_1 || type == NORM_INFINITY) {
561*a7e14dcfSSatish Balay     *norm = 1.0;
562*a7e14dcfSSatish Balay   } else {
563*a7e14dcfSSatish Balay     SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"No two norm");
564*a7e14dcfSSatish Balay   }
565*a7e14dcfSSatish Balay   PetscFunctionReturn(0);
566*a7e14dcfSSatish Balay }
567