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