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