xref: /petsc/src/mat/impls/elemental/matelem.cxx (revision 55186c17b1fd69a5eddcadb4ca058e4d502a7a85)
1 #include <../src/mat/impls/elemental/matelemimpl.h> /*I "petscmat.h" I*/
2 
3 /*
4     The variable Petsc_Elemental_keyval is used to indicate an MPI attribute that
5   is attached to a communicator, in this case the attribute is a Mat_Elemental_Grid
6 */
7 static PetscMPIInt Petsc_Elemental_keyval = MPI_KEYVAL_INVALID;
8 
9 #undef __FUNCT__
10 #define __FUNCT__ "PetscElementalInitializePackage"
11 /*@C
12    PetscElementalInitializePackage - Initialize Elemental package
13 
14    Logically Collective
15 
16    Input Arguments:
17 .  path - the dynamic library path or PETSC_NULL
18 
19    Level: developer
20 
21 .seealso: MATELEMENTAL, PetscElementalFinalizePackage()
22 @*/
23 PetscErrorCode PetscElementalInitializePackage(const char *path)
24 {
25   PetscErrorCode ierr;
26 
27   PetscFunctionBegin;
28   if (elem::Initialized()) PetscFunctionReturn(0);
29   { /* We have already initialized MPI, so this song and dance is just to pass these variables (which won't be used by Elemental) through the interface that needs references */
30     int zero = 0;
31     char **nothing = 0;
32     elem::Initialize(zero,nothing);
33   }
34   ierr = PetscRegisterFinalize(PetscElementalFinalizePackage);CHKERRQ(ierr);
35   PetscFunctionReturn(0);
36 }
37 
38 #undef __FUNCT__
39 #define __FUNCT__ "PetscElementalFinalizePackage"
40 /*@C
41    PetscElementalFinalizePackage - Finalize Elemental package
42 
43    Logically Collective
44 
45    Level: developer
46 
47 .seealso: MATELEMENTAL, PetscElementalInitializePackage()
48 @*/
49 PetscErrorCode PetscElementalFinalizePackage(void)
50 {
51 
52   PetscFunctionBegin;
53   elem::Finalize();
54   PetscFunctionReturn(0);
55 }
56 
57 #undef __FUNCT__
58 #define __FUNCT__ "MatView_Elemental"
59 static PetscErrorCode MatView_Elemental(Mat A,PetscViewer viewer)
60 {
61   PetscErrorCode ierr;
62   Mat_Elemental  *a = (Mat_Elemental*)A->data;
63   PetscBool      iascii;
64 
65   PetscFunctionBegin;
66   ierr = PetscObjectTypeCompare((PetscObject)viewer,PETSCVIEWERASCII,&iascii);CHKERRQ(ierr);
67   if (iascii) {
68     PetscViewerFormat format;
69     ierr = PetscViewerGetFormat(viewer,&format);CHKERRQ(ierr);
70     if (format == PETSC_VIEWER_ASCII_INFO) {
71       /* call elemental viewing function */
72 
73       if (format == PETSC_VIEWER_ASCII_FACTOR_INFO) {
74         /* call elemental viewing function */
75       }
76 
77     } else if (format == PETSC_VIEWER_DEFAULT) {
78       Mat Aaij;
79       ierr = PetscViewerASCIIUseTabs(viewer,PETSC_FALSE);CHKERRQ(ierr);
80       ierr = PetscObjectPrintClassNamePrefixType((PetscObject)A,viewer,"Matrix Object");CHKERRQ(ierr);
81       a->emat->Print("Elemental matrix (cyclic ordering)");
82       ierr = PetscViewerASCIIUseTabs(viewer,PETSC_TRUE);CHKERRQ(ierr);
83       if (A->factortype == MAT_FACTOR_NONE){
84         ierr = PetscPrintf(((PetscObject)viewer)->comm,"Elemental matrix (explicit ordering)\n");CHKERRQ(ierr);
85         ierr = MatComputeExplicitOperator(A,&Aaij);CHKERRQ(ierr);
86         ierr = MatView(Aaij,PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
87         ierr = MatDestroy(&Aaij);CHKERRQ(ierr);
88       }
89     } else SETERRQ(((PetscObject)viewer)->comm,PETSC_ERR_SUP,"Format");
90   } else SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_SUP,"Viewer type %s not supported by Elemental matrices",((PetscObject)viewer)->type_name);
91   PetscFunctionReturn(0);
92 }
93 
94 #undef __FUNCT__
95 #define __FUNCT__ "MatGetInfo_Elemental"
96 static PetscErrorCode MatGetInfo_Elemental(Mat F,MatInfoType flag,MatInfo *info)
97 {
98   PetscFunctionBegin;
99   /* this routine is called by PCSetUp_LU(). It does nothing yet. */
100   PetscFunctionReturn(0);
101 }
102 
103 #undef __FUNCT__
104 #define __FUNCT__ "MatSetValues_Elemental"
105 static PetscErrorCode MatSetValues_Elemental(Mat A,PetscInt nr,const PetscInt *rows,PetscInt nc,const PetscInt *cols,const PetscScalar *vals,InsertMode imode)
106 {
107   PetscErrorCode ierr;
108   Mat_Elemental  *a = (Mat_Elemental*)A->data;
109   PetscMPIInt    rank;
110   PetscInt       i,j,rrank,ridx,crank,cidx;
111 
112   PetscFunctionBegin;
113   ierr = MPI_Comm_rank(((PetscObject)A)->comm,&rank);CHKERRQ(ierr);
114 
115   const elem::Grid &grid = a->emat->Grid();
116   for (i=0; i<nr; i++) {
117     PetscInt erow,ecol,elrow,elcol;
118     if (rows[i] < 0) continue;
119     P2RO(A,0,rows[i],&rrank,&ridx);
120     RO2E(A,0,rrank,ridx,&erow);
121     if (rrank < 0 || ridx < 0 || erow < 0) SETERRQ(((PetscObject)A)->comm,PETSC_ERR_PLIB,"Incorrect row translation");
122     for (j=0; j<nc; j++) {
123       if (cols[j] < 0) continue;
124       P2RO(A,1,cols[j],&crank,&cidx);
125       RO2E(A,1,crank,cidx,&ecol);
126       if (crank < 0 || cidx < 0 || ecol < 0) SETERRQ(((PetscObject)A)->comm,PETSC_ERR_PLIB,"Incorrect col translation");
127       if (erow % grid.MCSize() != grid.MCRank() || ecol % grid.MRSize() != grid.MRRank()){ /* off-proc entry */
128         if (imode != ADD_VALUES) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Only ADD_VALUES to off-processor entry is supported");
129         /* PetscPrintf(PETSC_COMM_SELF,"[%D] add off-proc entry (%D,%D, %g) (%D %D)\n",rank,rows[i],cols[j],*(vals+i*nc),erow,ecol); */
130         a->esubmat->Set(0,0, vals[i*nc+j]);
131         a->interface->Axpy(1.0,*(a->esubmat),erow,ecol);
132         continue;
133       }
134       elrow = erow / grid.MCSize();
135       elcol = ecol / grid.MRSize();
136       switch (imode) {
137       case INSERT_VALUES: a->emat->SetLocal(elrow,elcol,vals[i*nc+j]); break;
138       case ADD_VALUES: a->emat->UpdateLocal(elrow,elcol,vals[i*nc+j]); break;
139       default: SETERRQ1(((PetscObject)A)->comm,PETSC_ERR_SUP,"No support for InsertMode %d",(int)imode);
140       }
141     }
142   }
143   PetscFunctionReturn(0);
144 }
145 
146 #undef __FUNCT__
147 #define __FUNCT__ "MatMult_Elemental"
148 static PetscErrorCode MatMult_Elemental(Mat A,Vec X,Vec Y)
149 {
150   Mat_Elemental     *a = (Mat_Elemental*)A->data;
151   PetscErrorCode    ierr;
152   const PetscScalar *x;
153   PetscScalar       *y;
154   PetscScalar       one = 1,zero = 0;
155 
156   PetscFunctionBegin;
157   ierr = VecGetArrayRead(X,&x);CHKERRQ(ierr);
158   ierr = VecGetArray(Y,&y);CHKERRQ(ierr);
159   { /* Scoping so that constructor is called before pointer is returned */
160     elem::DistMatrix<PetscScalar,elem::VC,elem::STAR> xe(A->cmap->N,1,0,x,A->cmap->n,*a->grid);
161     elem::DistMatrix<PetscScalar,elem::VC,elem::STAR> ye(A->rmap->N,1,0,y,A->rmap->n,*a->grid);
162     elem::Gemv(elem::NORMAL,one,*a->emat,xe,zero,ye);
163   }
164   ierr = VecRestoreArrayRead(X,&x);CHKERRQ(ierr);
165   ierr = VecRestoreArray(Y,&y);CHKERRQ(ierr);
166   PetscFunctionReturn(0);
167 }
168 
169 #undef __FUNCT__
170 #define __FUNCT__ "MatMultAdd_Elemental"
171 static PetscErrorCode MatMultAdd_Elemental(Mat A,Vec X,Vec Y,Vec Z)
172 {
173   Mat_Elemental     *a = (Mat_Elemental*)A->data;
174   PetscErrorCode    ierr;
175   const PetscScalar *x;
176   PetscScalar       *z;
177   PetscScalar       one = 1.0;
178 
179   PetscFunctionBegin;
180   if (Y != Z) {ierr = VecCopy(Y,Z);CHKERRQ(ierr);}
181   ierr = VecGetArrayRead(X,&x);CHKERRQ(ierr);
182   ierr = VecGetArray(Z,&z);CHKERRQ(ierr);
183   { /* Scoping so that constructor is called before pointer is returned */
184     elem::DistMatrix<PetscScalar,elem::VC,elem::STAR> xe(A->cmap->N,1,0,x,A->cmap->n,*a->grid);
185     elem::DistMatrix<PetscScalar,elem::VC,elem::STAR> ze(A->rmap->N,1,0,z,A->rmap->n,*a->grid);
186     elem::Gemv(elem::NORMAL,one,*a->emat,xe,one,ze);
187   }
188   ierr = VecRestoreArrayRead(X,&x);CHKERRQ(ierr);
189   ierr = VecRestoreArray(Z,&z);CHKERRQ(ierr);
190   PetscFunctionReturn(0);
191 }
192 
193 #undef __FUNCT__
194 #define __FUNCT__ "MatMatMultNumeric_Elemental"
195 static PetscErrorCode MatMatMultNumeric_Elemental(Mat A,Mat B,Mat C)
196 {
197   Mat_Elemental  *a = (Mat_Elemental*)A->data;
198   Mat_Elemental  *b = (Mat_Elemental*)B->data;
199   Mat_Elemental  *c = (Mat_Elemental*)C->data;
200   PetscScalar    one = 1.0,zero = 0.0;
201 
202   PetscFunctionBegin;
203   { /* Scoping so that constructor is called before pointer is returned */
204     elem::Gemm(elem::NORMAL,elem::NORMAL,one,*a->emat,*b->emat,zero,*c->emat);
205   }
206   C->assembled = PETSC_TRUE;
207   PetscFunctionReturn(0);
208 }
209 
210 #undef __FUNCT__
211 #define __FUNCT__ "MatMatMultSymbolic_Elemental"
212 static PetscErrorCode MatMatMultSymbolic_Elemental(Mat A,Mat B,PetscReal fill,Mat *C)
213 {
214   PetscErrorCode ierr;
215   Mat            Ce;
216   MPI_Comm       comm=((PetscObject)A)->comm;
217 
218   PetscFunctionBegin;
219   ierr = MatCreate(comm,&Ce);CHKERRQ(ierr);
220   ierr = MatSetSizes(Ce,A->rmap->n,B->cmap->n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
221   ierr = MatSetType(Ce,MATELEMENTAL);CHKERRQ(ierr);
222   ierr = MatSetUp(Ce);CHKERRQ(ierr);
223   *C = Ce;
224   PetscFunctionReturn(0);
225 }
226 
227 #undef __FUNCT__
228 #define __FUNCT__ "MatMatMult_Elemental"
229 static PetscErrorCode MatMatMult_Elemental(Mat A,Mat B,MatReuse scall,PetscReal fill,Mat *C)
230 {
231   PetscErrorCode ierr;
232 
233   PetscFunctionBegin;
234   if (scall == MAT_INITIAL_MATRIX){
235     ierr = PetscLogEventBegin(MAT_MatMultSymbolic,A,B,0,0);CHKERRQ(ierr);
236     ierr = MatMatMultSymbolic_Elemental(A,B,1.0,C);CHKERRQ(ierr);
237     ierr = PetscLogEventEnd(MAT_MatMultSymbolic,A,B,0,0);CHKERRQ(ierr);
238   }
239   ierr = PetscLogEventBegin(MAT_MatMultNumeric,A,B,0,0);CHKERRQ(ierr);
240   ierr = MatMatMultNumeric_Elemental(A,B,*C);CHKERRQ(ierr);
241   ierr = PetscLogEventEnd(MAT_MatMultNumeric,A,B,0,0);CHKERRQ(ierr);
242   PetscFunctionReturn(0);
243 }
244 
245 #undef __FUNCT__
246 #define __FUNCT__ "MatScale_Elemental"
247 static PetscErrorCode MatScale_Elemental(Mat X,PetscScalar a)
248 {
249   Mat_Elemental  *x = (Mat_Elemental*)X->data;
250 
251   PetscFunctionBegin;
252   elem::Scal(a,*x->emat);
253   PetscFunctionReturn(0);
254 }
255 
256 #undef __FUNCT__
257 #define __FUNCT__ "MatAXPY_Elemental"
258 static PetscErrorCode MatAXPY_Elemental(Mat Y,PetscScalar a,Mat X,MatStructure str)
259 {
260   Mat_Elemental  *x = (Mat_Elemental*)X->data;
261   Mat_Elemental  *y = (Mat_Elemental*)Y->data;
262 
263   PetscFunctionBegin;
264   elem::Axpy(a,*x->emat,*y->emat);
265   PetscFunctionReturn(0);
266 }
267 
268 #undef __FUNCT__
269 #define __FUNCT__ "MatCopy_Elemental"
270 static PetscErrorCode MatCopy_Elemental(Mat A,Mat B,MatStructure str)
271 {
272   Mat_Elemental *a=(Mat_Elemental*)A->data;
273   Mat_Elemental *b=(Mat_Elemental*)B->data;
274 
275   PetscFunctionBegin;
276   elem::Copy(*a->emat,*b->emat);
277   PetscFunctionReturn(0);
278 }
279 
280 #undef __FUNCT__
281 #define __FUNCT__ "MatTranspose_Elemental"
282 static PetscErrorCode MatTranspose_Elemental(Mat A,MatReuse reuse,Mat *B)
283 {
284   /* Only out-of-place supported */
285   Mat            Be;
286   PetscErrorCode ierr;
287   MPI_Comm       comm=((PetscObject)A)->comm;
288   Mat_Elemental  *a = (Mat_Elemental*)A->data, *b;
289 
290   PetscFunctionBegin;
291   if (reuse == MAT_INITIAL_MATRIX){
292     ierr = MatCreate(comm,&Be);CHKERRQ(ierr);
293     ierr = MatSetSizes(Be,A->cmap->n,A->rmap->n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
294     ierr = MatSetType(Be,MATELEMENTAL);CHKERRQ(ierr);
295     ierr = MatSetUp(Be);CHKERRQ(ierr);
296     *B = Be;
297   }
298   b = (Mat_Elemental*)Be->data;
299   elem::Transpose(*a->emat,*b->emat);
300   Be->assembled = PETSC_TRUE;
301   PetscFunctionReturn(0);
302 }
303 
304 #undef __FUNCT__
305 #define __FUNCT__ "MatSolve_Elemental"
306 static PetscErrorCode MatSolve_Elemental(Mat A,Vec B,Vec X)
307 {
308   Mat_Elemental     *a = (Mat_Elemental*)A->data;
309   PetscErrorCode    ierr;
310   PetscScalar       *x;
311 
312   PetscFunctionBegin;
313   ierr = VecCopy(B,X);CHKERRQ(ierr);
314   ierr = VecGetArray(X,&x);CHKERRQ(ierr);
315   elem::DistMatrix<PetscScalar,elem::VC,elem::STAR> xe(A->rmap->N,1,0,x,A->rmap->n,*a->grid);
316   elem::DistMatrix<PetscScalar,elem::MC,elem::MR> xer = xe;
317   switch (A->factortype) {
318   case MAT_FACTOR_LU:
319     if ((*a->pivot).AllocatedMemory()) {
320       elem::SolveAfterLU(elem::NORMAL,*a->emat,*a->pivot,xer);
321       elem::Copy(xer,xe);
322     } else {
323       elem::SolveAfterLU(elem::NORMAL,*a->emat,xer);
324       elem::Copy(xer,xe);
325     }
326     break;
327   case MAT_FACTOR_CHOLESKY:
328     elem::SolveAfterCholesky(elem::UPPER,elem::NORMAL,*a->emat,xer);
329     elem::Copy(xer,xe);
330     break;
331   default:
332     SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Unfactored Matrix or Unsupported MatFactorType");
333     break;
334   }
335   ierr = VecRestoreArray(X,&x);CHKERRQ(ierr);
336   PetscFunctionReturn(0);
337 }
338 
339 #undef __FUNCT__
340 #define __FUNCT__ "MatMatSolve_Elemental"
341 static PetscErrorCode MatMatSolve_Elemental(Mat A,Mat B,Mat X)
342 {
343   Mat_Elemental *a=(Mat_Elemental*)A->data;
344   Mat_Elemental *b=(Mat_Elemental*)B->data;
345   Mat_Elemental *x=(Mat_Elemental*)X->data;
346 
347   PetscFunctionBegin;
348   elem::Copy(*b->emat,*x->emat);
349   switch (A->factortype) {
350   case MAT_FACTOR_LU:
351     if ((*a->pivot).AllocatedMemory()) {
352       elem::SolveAfterLU(elem::NORMAL,*a->emat,*a->pivot,*x->emat);
353     } else {
354       elem::SolveAfterLU(elem::NORMAL,*a->emat,*x->emat);
355     }
356     break;
357   case MAT_FACTOR_CHOLESKY:
358     elem::SolveAfterCholesky(elem::UPPER,elem::NORMAL,*a->emat,*x->emat);
359     break;
360   default:
361     SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Unfactored Matrix or Unsupported MatFactorType");
362     break;
363   }
364   PetscFunctionReturn(0);
365 }
366 
367 #undef __FUNCT__
368 #define __FUNCT__ "MatLUFactor_Elemental"
369 static PetscErrorCode MatLUFactor_Elemental(Mat A,IS row,IS col,const MatFactorInfo *info)
370 {
371   Mat_Elemental  *a = (Mat_Elemental*)A->data;
372 
373   PetscFunctionBegin;
374   if (info->dtcol){
375     elem::LU(*a->emat,*a->pivot);
376   } else {
377     elem::LU(*a->emat);
378   }
379   A->factortype = MAT_FACTOR_LU;
380   A->assembled  = PETSC_TRUE;
381   PetscFunctionReturn(0);
382 }
383 
384 #undef __FUNCT__
385 #define __FUNCT__ "MatLUFactorNumeric_Elemental"
386 static PetscErrorCode  MatLUFactorNumeric_Elemental(Mat F,Mat A,const MatFactorInfo *info)
387 {
388   PetscErrorCode ierr;
389 
390   PetscFunctionBegin;
391   ierr = MatCopy(A,F,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
392   ierr = MatLUFactor_Elemental(F,0,0,info);CHKERRQ(ierr);
393   PetscFunctionReturn(0);
394 }
395 
396 #undef __FUNCT__
397 #define __FUNCT__ "MatLUFactorSymbolic_Elemental"
398 static PetscErrorCode  MatLUFactorSymbolic_Elemental(Mat F,Mat A,IS r,IS c,const MatFactorInfo *info)
399 {
400   PetscFunctionBegin;
401   /* F is create and allocated by MatGetFactor_elemental_petsc(), skip this routine. */
402   PetscFunctionReturn(0);
403 }
404 
405 #undef __FUNCT__
406 #define __FUNCT__ "MatCholeskyFactor_Elemental"
407 static PetscErrorCode MatCholeskyFactor_Elemental(Mat A,IS perm,const MatFactorInfo *info)
408 {
409   Mat_Elemental  *a = (Mat_Elemental*)A->data;
410   elem::DistMatrix<PetscScalar,elem::MC,elem::MR>   atrans;
411   elem::DistMatrix<PetscScalar,elem::MC,elem::STAR> d;
412 
413   PetscFunctionBegin;
414   if (info->dtcol){
415     /* A = U^T * U for SPD Matrix A */
416     printf("Cholesky Factorization for SPD Matrices...\n");
417     elem::Cholesky(elem::UPPER,*a->emat);
418   } else {
419     /* A = U^T * D * U * for Symmetric Matrix A */
420     printf("LDL^T Factorization for Symmetric Matrices\n");
421     PetscInt i,size;
422     elem::LDLT(*a->emat,d);
423     elem::Transpose(*a->emat,atrans);
424     elem::Copy(atrans,*a->emat);
425     size = (*a->emat).Height();
426     for (i=0;i<size;i++) {
427       (*a->emat).Set(i,i,1.0 / (*a->emat).Get(i,i));
428     }
429   }
430   A->factortype = MAT_FACTOR_CHOLESKY;
431   A->assembled  = PETSC_TRUE;
432   PetscFunctionReturn(0);
433 }
434 
435 #undef __FUNCT__
436 #define __FUNCT__ "MatCholeskyFactorNumeric_Elemental"
437 static PetscErrorCode MatCholeskyFactorNumeric_Elemental(Mat F,Mat A,const MatFactorInfo *info)
438 {
439 }
440 #undef __FUNCT__
441 #define __FUNCT__ "MatCholeskyFactorSymbolic_Elemental"
442 static PetscErrorCode MatCholeskyFactorSymbolic_Elemental(Mat F,Mat A,IS perm,const MatFactorInfo *info)
443 {
444   PetscFunctionBegin;
445   /* F is create and allocated by MatGetFactor_elemental_petsc(), skip this routine. */
446   PetscFunctionReturn(0);
447 }
448 
449 EXTERN_C_BEGIN
450 #undef __FUNCT__
451 #define __FUNCT__ "MatGetFactor_elemental_petsc"
452 static PetscErrorCode MatGetFactor_elemental_petsc(Mat A,MatFactorType ftype,Mat *F)
453 {
454   Mat            B;
455   PetscErrorCode ierr;
456 
457   PetscFunctionBegin;
458   /* Create the factorization matrix */
459   ierr = MatCreate(((PetscObject)A)->comm,&B);CHKERRQ(ierr);
460   ierr = MatSetSizes(B,A->rmap->n,A->cmap->n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
461   ierr = MatSetType(B,MATELEMENTAL);CHKERRQ(ierr);
462   ierr = MatSetUp(B);CHKERRQ(ierr);
463   B->factortype = ftype;
464   *F            = B;
465   PetscFunctionReturn(0);
466 }
467 EXTERN_C_END
468 
469 #undef __FUNCT__
470 #define __FUNCT__ "MatNorm_Elemental"
471 static PetscErrorCode MatNorm_Elemental(Mat A,NormType type,PetscReal *nrm)
472 {
473   Mat_Elemental *a=(Mat_Elemental*)A->data;
474 
475   PetscFunctionBegin;
476   switch (type){
477   case NORM_1:
478     *nrm = elem::Norm(*a->emat,elem::ONE_NORM);
479     break;
480   case NORM_FROBENIUS:
481     *nrm = elem::Norm(*a->emat,elem::FROBENIUS_NORM);
482     break;
483   case NORM_INFINITY:
484     *nrm = elem::Norm(*a->emat,elem::INFINITY_NORM);
485     break;
486   default:
487     printf("Error: unsupported norm type!\n");
488   }
489   PetscFunctionReturn(0);
490 }
491 
492 #undef __FUNCT__
493 #define __FUNCT__ "MatZeroEntries_Elemental"
494 static PetscErrorCode MatZeroEntries_Elemental(Mat A)
495 {
496   Mat_Elemental *a=(Mat_Elemental*)A->data;
497 
498   PetscFunctionBegin;
499   elem::Zero(*a->emat);
500   PetscFunctionReturn(0);
501 }
502 
503 EXTERN_C_BEGIN
504 #undef __FUNCT__
505 #define __FUNCT__ "MatGetOwnershipIS_Elemental"
506 static PetscErrorCode MatGetOwnershipIS_Elemental(Mat A,IS *rows,IS *cols)
507 {
508   Mat_Elemental  *a = (Mat_Elemental*)A->data;
509   PetscErrorCode ierr;
510   PetscInt       i,m,shift,stride,*idx;
511 
512   PetscFunctionBegin;
513   if (rows) {
514     m = a->emat->LocalHeight();
515     shift = a->emat->ColShift();
516     stride = a->emat->ColStride();
517     ierr = PetscMalloc(m*sizeof(PetscInt),&idx);CHKERRQ(ierr);
518     for (i=0; i<m; i++) {
519       PetscInt rank,offset;
520       E2RO(A,0,shift+i*stride,&rank,&offset);
521       RO2P(A,0,rank,offset,&idx[i]);
522     }
523     ierr = ISCreateGeneral(PETSC_COMM_SELF,m,idx,PETSC_OWN_POINTER,rows);CHKERRQ(ierr);
524   }
525   if (cols) {
526     m = a->emat->LocalWidth();
527     shift = a->emat->RowShift();
528     stride = a->emat->RowStride();
529     ierr = PetscMalloc(m*sizeof(PetscInt),&idx);CHKERRQ(ierr);
530     for (i=0; i<m; i++) {
531       PetscInt rank,offset;
532       E2RO(A,1,shift+i*stride,&rank,&offset);
533       RO2P(A,1,rank,offset,&idx[i]);
534     }
535     ierr = ISCreateGeneral(PETSC_COMM_SELF,m,idx,PETSC_OWN_POINTER,cols);CHKERRQ(ierr);
536   }
537   PetscFunctionReturn(0);
538 }
539 EXTERN_C_END
540 
541 #undef __FUNCT__
542 #define __FUNCT__ "MatDestroy_Elemental"
543 static PetscErrorCode MatDestroy_Elemental(Mat A)
544 {
545   Mat_Elemental      *a = (Mat_Elemental*)A->data;
546   PetscErrorCode     ierr;
547   Mat_Elemental_Grid *commgrid;
548   PetscBool          flg;
549   MPI_Comm           icomm;
550 
551   PetscFunctionBegin;
552   delete a->interface;
553   delete a->esubmat;
554   delete a->emat;
555 
556   elem::mpi::Comm cxxcomm(((PetscObject)A)->comm);
557   ierr = PetscCommDuplicate(cxxcomm,&icomm,PETSC_NULL);CHKERRQ(ierr);
558   ierr = MPI_Attr_get(icomm,Petsc_Elemental_keyval,(void**)&commgrid,(int*)&flg);CHKERRQ(ierr);
559   if (--commgrid->grid_refct == 0) {
560     delete commgrid->grid;
561     ierr = PetscFree(commgrid);CHKERRQ(ierr);
562   }
563   ierr = PetscCommDestroy(&icomm);CHKERRQ(ierr);
564   ierr = PetscObjectComposeFunctionDynamic((PetscObject)A,"MatGetOwnershipIS_C","",PETSC_NULL);CHKERRQ(ierr);
565   ierr = PetscObjectComposeFunctionDynamic((PetscObject)A,"MatGetFactor_petsc_C","",PETSC_NULL);CHKERRQ(ierr);
566   ierr = PetscFree(A->data);CHKERRQ(ierr);
567   PetscFunctionReturn(0);
568 }
569 
570 #undef __FUNCT__
571 #define __FUNCT__ "MatSetUp_Elemental"
572 PetscErrorCode MatSetUp_Elemental(Mat A)
573 {
574   Mat_Elemental  *a = (Mat_Elemental*)A->data;
575   PetscErrorCode ierr;
576   PetscMPIInt    rsize,csize;
577 
578   PetscFunctionBegin;
579   ierr = PetscLayoutSetUp(A->rmap);CHKERRQ(ierr);
580   ierr = PetscLayoutSetUp(A->cmap);CHKERRQ(ierr);
581 
582   a->emat->ResizeTo(A->rmap->N,A->cmap->N);CHKERRQ(ierr);
583   elem::Zero(*a->emat);
584 
585   ierr = MPI_Comm_size(A->rmap->comm,&rsize);CHKERRQ(ierr);
586   ierr = MPI_Comm_size(A->cmap->comm,&csize);CHKERRQ(ierr);
587   if (csize != rsize) SETERRQ(((PetscObject)A)->comm,PETSC_ERR_ARG_INCOMP,"Cannot use row and column communicators of different sizes");
588   a->commsize = rsize;
589   a->mr[0] = A->rmap->N % rsize; if (!a->mr[0]) a->mr[0] = rsize;
590   a->mr[1] = A->cmap->N % csize; if (!a->mr[1]) a->mr[1] = csize;
591   a->m[0] = A->rmap->N / rsize + (a->mr[0] != rsize);
592   a->m[1] = A->cmap->N / csize + (a->mr[1] != csize);
593   PetscFunctionReturn(0);
594 }
595 
596 #undef __FUNCT__
597 #define __FUNCT__ "MatAssemblyBegin_Elemental"
598 PetscErrorCode MatAssemblyBegin_Elemental(Mat A, MatAssemblyType type)
599 {
600   Mat_Elemental  *a = (Mat_Elemental*)A->data;
601 
602   PetscFunctionBegin;
603   a->interface->Detach();
604   a->interface->Attach(elem::LOCAL_TO_GLOBAL,*(a->emat));
605   PetscFunctionReturn(0);
606 }
607 
608 #undef __FUNCT__
609 #define __FUNCT__ "MatAssemblyEnd_Elemental"
610 PetscErrorCode MatAssemblyEnd_Elemental(Mat A, MatAssemblyType type)
611 {
612   PetscFunctionBegin;
613   /* Currently does nothing */
614   PetscFunctionReturn(0);
615 }
616 
617 /*MC
618    MATELEMENTAL = "elemental" - A matrix type for dense matrices using the Elemental package
619 
620    Options Database Keys:
621 . -mat_type elemental - sets the matrix type to "elemental" during a call to MatSetFromOptions()
622 
623   Level: beginner
624 
625 .seealso: MATDENSE,MatCreateElemental()
626 M*/
627 EXTERN_C_BEGIN
628 #undef __FUNCT__
629 #define __FUNCT__ "MatCreate_Elemental"
630 PETSC_EXTERN_C PetscErrorCode MatCreate_Elemental(Mat A)
631 {
632   Mat_Elemental      *a;
633   PetscErrorCode     ierr;
634   PetscBool          flg;
635   Mat_Elemental_Grid *commgrid;
636   MPI_Comm           icomm;
637 
638   PetscFunctionBegin;
639   ierr = PetscElementalInitializePackage(PETSC_NULL);CHKERRQ(ierr);
640 
641   ierr = PetscNewLog(A,Mat_Elemental,&a);CHKERRQ(ierr);
642   A->data = (void*)a;
643 
644   A->ops->getinfo         = MatGetInfo_Elemental;
645   A->ops->view            = MatView_Elemental;
646   A->ops->destroy         = MatDestroy_Elemental;
647   A->ops->setup           = MatSetUp_Elemental;
648   A->ops->setvalues       = MatSetValues_Elemental;
649   A->ops->mult            = MatMult_Elemental;
650   A->ops->multadd         = MatMultAdd_Elemental;
651   A->ops->matmult         = MatMatMult_Elemental;
652   A->ops->matmultsymbolic = MatMatMultSymbolic_Elemental;
653   A->ops->matmultnumeric  = MatMatMultNumeric_Elemental;
654   A->ops->assemblybegin   = MatAssemblyBegin_Elemental;
655   A->ops->assemblyend     = MatAssemblyEnd_Elemental;
656   A->ops->scale           = MatScale_Elemental;
657   A->ops->axpy            = MatAXPY_Elemental;
658   A->ops->lufactor        = MatLUFactor_Elemental;
659   A->ops->lufactorsymbolic = MatLUFactorSymbolic_Elemental;
660   A->ops->lufactornumeric  = MatLUFactorNumeric_Elemental;
661   A->ops->matsolve        = MatMatSolve_Elemental;
662   A->ops->copy            = MatCopy_Elemental;
663   A->ops->transpose       = MatTranspose_Elemental;
664   A->ops->norm            = MatNorm_Elemental;
665   A->ops->solve           = MatSolve_Elemental;
666   A->ops->zeroentries     = MatZeroEntries_Elemental;
667   A->ops->choleskyfactor  = MatCholeskyFactor_Elemental;
668   A->ops->choleskyfactorsymbolic = MatCholeskyFactorSymbolic_Elemental;
669   A->ops->choleskyfactornumeric  = MatCholeskyFactorNumeric_Elemental;
670 
671   A->insertmode = NOT_SET_VALUES;
672 
673   /* Set up the elemental matrix */
674   elem::mpi::Comm cxxcomm(((PetscObject)A)->comm);
675 
676   /* Grid needs to be shared between multiple Mats on the same communicator, implement by attribute caching on the MPI_Comm */
677   if (Petsc_Elemental_keyval == MPI_KEYVAL_INVALID) {
678     ierr = MPI_Keyval_create(MPI_NULL_COPY_FN,MPI_NULL_DELETE_FN,&Petsc_Elemental_keyval,(void*)0);
679   }
680   ierr = PetscCommDuplicate(cxxcomm,&icomm,PETSC_NULL);CHKERRQ(ierr);
681   ierr = MPI_Attr_get(icomm,Petsc_Elemental_keyval,(void**)&commgrid,(int*)&flg);CHKERRQ(ierr);
682   if (!flg) {
683     ierr = PetscNewLog(A,Mat_Elemental_Grid,&commgrid);CHKERRQ(ierr);
684     commgrid->grid       = new elem::Grid(cxxcomm);
685     commgrid->grid_refct = 1;
686     ierr = MPI_Attr_put(icomm,Petsc_Elemental_keyval,(void*)commgrid);CHKERRQ(ierr);
687   } else {
688     commgrid->grid_refct++;
689   }
690   ierr = PetscCommDestroy(&icomm);CHKERRQ(ierr);
691   a->grid      = commgrid->grid;
692   a->emat      = new elem::DistMatrix<PetscScalar>(*a->grid);
693   a->esubmat   = new elem::Matrix<PetscScalar>(1,1);
694   a->interface = new elem::AxpyInterface<PetscScalar>;
695   a->pivot     = new elem::DistMatrix<PetscInt,elem::VC,elem::STAR>;
696 
697   /* build cache for off array entries formed */
698   a->interface->Attach(elem::LOCAL_TO_GLOBAL,*(a->emat));
699 
700   ierr = PetscObjectComposeFunctionDynamic((PetscObject)A,"MatGetOwnershipIS_C","MatGetOwnershipIS_Elemental",MatGetOwnershipIS_Elemental);CHKERRQ(ierr);
701   ierr = PetscObjectComposeFunctionDynamic((PetscObject)A,"MatGetFactor_petsc_C","MatGetFactor_elemental_petsc",MatGetFactor_elemental_petsc);CHKERRQ(ierr);
702 
703   ierr = PetscObjectChangeTypeName((PetscObject)A,MATELEMENTAL);CHKERRQ(ierr);
704   PetscFunctionReturn(0);
705 }
706 EXTERN_C_END
707