xref: /petsc/src/mat/impls/elemental/matelem.cxx (revision 45cf121f96de81a3df3e219b4b036629cd06311f)
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     /*ierr = PetscLogEventBegin(MAT_MatMultSymbolic,A,B,0,0);CHKERRQ(ierr);
281     ierr = MatMatMultSymbolic_Elemental(A,B,1.0,C);CHKERRQ(ierr);
282     ierr = PetscLogEventEnd(MAT_MatMultSymbolic,A,B,0,0);CHKERRQ(ierr);   */
283   }
284   Mat_Elemental     *a = (Mat_Elemental*)A->data;
285   Mat_Elemental     *b = (Mat_Elemental*)Be->data;
286   elem::Transpose(*a->emat,*b->emat);
287   Be->assembled = PETSC_TRUE;
288 
289 
290   /*ierr = PetscLogEventBegin(MAT_MatMultNumeric,A,B,0,0);CHKERRQ(ierr);
291   ierr = MatMatMultNumeric_Elemental(A,B,*C);CHKERRQ(ierr);
292   ierr = PetscLogEventEnd(MAT_MatMultNumeric,A,B,0,0);CHKERRQ(ierr); */
293   PetscFunctionReturn(0);
294 }
295 
296 #undef __FUNCT__
297 #define __FUNCT__ "MatSolve_Elemental"
298 static PetscErrorCode MatSolve_Elemental(Mat A,Vec B,Vec X)
299 {
300   Mat_Elemental     *a = (Mat_Elemental*)A->data;
301   PetscErrorCode    ierr;
302   //const PetscScalar *b;
303   PetscScalar       *x;
304   //PetscScalar       one = 1,zero = 0;
305 
306   PetscFunctionBegin;
307   ierr = VecCopy(B,X);CHKERRQ(ierr);
308   ierr = VecGetArray(X,&x);CHKERRQ(ierr);
309   //ierr = VecGetArray(X,&x);CHKERRQ(ierr);
310   { /* Scoping so that constructor is called before pointer is returned */
311     //elem::DistMatrix<PetscScalar,elem::VC,elem::STAR> be(A->rmap->N,1,0,b,A->rmap->n,*a->grid);
312     elem::DistMatrix<PetscScalar,elem::VC,elem::STAR> xe(A->rmap->N,1,0,x,A->rmap->n,*a->grid);
313     elem::DistMatrix<PetscScalar,elem::MC,elem::MR> xer = xe;
314     if ((*a->pivot).AllocatedMemory()) {
315       printf("pivot is not empty.\n");
316       elem::LUSolve(elem::NORMAL,*a->emat,*a->pivot,xer);
317       elem::Copy(xer,xe);
318     }
319     else {
320       printf("pivot is empty.\n");
321       //elem::Gemv(elem::NORMAL,1.0,*a->emat,be,0.0,xe);
322       elem::LUSolve(elem::NORMAL,*a->emat,xer);
323       elem::Copy(xer,xe);
324     }
325   }
326   ierr = VecRestoreArray(X,&x);CHKERRQ(ierr);
327   PetscFunctionReturn(0);
328 }
329 
330 #undef __FUNCT__
331 #define __FUNCT__ "MatMatSolve_Elemental"
332 static PetscErrorCode MatMatSolve_Elemental(Mat A,Mat B,Mat X)
333 {
334   Mat_Elemental *a=(Mat_Elemental*)A->data;
335   Mat_Elemental *b=(Mat_Elemental*)B->data;
336   Mat_Elemental *x=(Mat_Elemental*)X->data;
337 
338   PetscFunctionBegin;
339   elem::Copy(*b->emat,*x->emat);
340   if ((*a->pivot).AllocatedMemory()) {
341     printf("pivot is not empty.\n");
342     elem::LUSolve(elem::NORMAL,*a->emat,*a->pivot,*x->emat);
343   }
344   else {
345     printf("pivot is empty.\n");
346     elem::LUSolve(elem::NORMAL,*a->emat,*x->emat);
347   }
348   PetscFunctionReturn(0);
349 }
350 
351 #undef __FUNCT__
352 #define __FUNCT__ "MatLUFactor_Elemental"
353 static PetscErrorCode MatLUFactor_Elemental(Mat A,IS row,IS col,const MatFactorInfo *info)
354 {
355   Mat_Elemental  *a = (Mat_Elemental*)A->data;
356 
357   PetscFunctionBegin;
358   printf("MatLUFactor_Elemental is called...\n");
359   if (info->dtcol){
360     printf("LUFactor w/ pivoting\n");
361     elem::LU(*a->emat,*a->pivot);
362   } else {
363     printf("LUFactor w/o pivoting\n");
364     elem::LU(*a->emat);
365   }
366   A->factortype = MAT_FACTOR_LU;
367   PetscFunctionReturn(0);
368 }
369 
370 #undef __FUNCT__
371 #define __FUNCT__ "MatLUFactorNumeric_Elemental"
372 static PetscErrorCode  MatLUFactorNumeric_Elemental(Mat F,Mat A,const MatFactorInfo *info)
373 {
374   PetscErrorCode ierr;
375 
376   PetscFunctionBegin;
377   printf("MatLUFactorNumeric_Elemental is called...\n");
378   ierr = MatCopy(A,F,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
379   ierr = MatLUFactor_Elemental(F,0,0,info);CHKERRQ(ierr);
380   PetscFunctionReturn(0);
381 }
382 
383 #undef __FUNCT__
384 #define __FUNCT__ "MatLUFactorSymbolic_Elemental"
385 static PetscErrorCode  MatLUFactorSymbolic_Elemental(Mat F,Mat A,IS r,IS c,const MatFactorInfo *info)
386 {
387   PetscFunctionBegin;
388   /* F is create and allocated by MatGetFactor_elemental_petsc(), skip this routine. */
389   PetscFunctionReturn(0);
390 }
391 
392 #undef __FUNCT__
393 #define __FUNCT__ "MatCholeskyFactor_Elemental"
394 static PetscErrorCode MatCholeskyFactor_Elemental(Mat A,IS perm,const MatFactorInfo *info)
395 {
396   Mat_Elemental  *a = (Mat_Elemental*)A->data;
397 
398   PetscFunctionBegin;
399   printf("MatLUFactor_Elemental is called...\n");
400   if (info->dtcol){
401     printf("LUFactor w/ pivoting\n");
402     elem::LU(*a->emat,*a->pivot);
403   } else {
404     printf("LUFactor w/o pivoting\n");
405     elem::LU(*a->emat);
406   }
407   A->factortype = MAT_FACTOR_LU;
408   PetscFunctionReturn(0);
409 }
410 
411 EXTERN_C_BEGIN
412 #undef __FUNCT__
413 #define __FUNCT__ "MatGetFactor_elemental_petsc"
414 static PetscErrorCode MatGetFactor_elemental_petsc(Mat A,MatFactorType ftype,Mat *F)
415 {
416   Mat            B;
417   PetscErrorCode ierr;
418 
419   PetscFunctionBegin;
420   printf("MatGetFactor_elemental_petsc is called...\n");
421   /* Create the factorization matrix */
422   ierr = MatCreate(((PetscObject)A)->comm,&B);CHKERRQ(ierr);
423   ierr = MatSetSizes(B,A->rmap->n,A->cmap->n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
424   ierr = MatSetType(B,MATELEMENTAL);CHKERRQ(ierr);
425   ierr = MatSetUp(B);CHKERRQ(ierr);
426   B->factortype = ftype;
427   *F            = B;
428   PetscFunctionReturn(0);
429 }
430 EXTERN_C_END
431 
432 #undef __FUNCT__
433 #define __FUNCT__ "MatNorm_Elemental"
434 static PetscErrorCode MatNorm_Elemental(Mat A,NormType type,PetscReal *nrm)
435 {
436   Mat_Elemental *a=(Mat_Elemental*)A->data;
437 
438   PetscFunctionBegin;
439   printf("MatNorm_Elemental is called...\n");
440   switch (type){
441   case NORM_1:
442     *nrm = elem::Norm(*a->emat,elem::ONE_NORM);
443     break;
444   case NORM_FROBENIUS:
445     *nrm = elem::Norm(*a->emat,elem::FROBENIUS_NORM);
446     break;
447   case NORM_INFINITY:
448     *nrm = elem::Norm(*a->emat,elem::INFINITY_NORM);
449     break;
450   default:
451     printf("Error: unsupported norm type!\n");
452   }
453   PetscFunctionReturn(0);
454 }
455 
456 #undef __FUNCT__
457 #define __FUNCT__ "MatZeroEntries_Elemental"
458 static PetscErrorCode MatZeroEntries_Elemental(Mat A)
459 {
460   Mat_Elemental *a=(Mat_Elemental*)A->data;
461 
462   PetscFunctionBegin;
463   elem::Zero(*a->emat);
464   PetscFunctionReturn(0);
465 }
466 
467 EXTERN_C_BEGIN
468 #undef __FUNCT__
469 #define __FUNCT__ "MatGetOwnershipIS_Elemental"
470 static PetscErrorCode MatGetOwnershipIS_Elemental(Mat A,IS *rows,IS *cols)
471 {
472   Mat_Elemental  *a = (Mat_Elemental*)A->data;
473   PetscErrorCode ierr;
474   PetscInt       i,m,shift,stride,*idx;
475 
476   PetscFunctionBegin;
477   if (rows) {
478     m = a->emat->LocalHeight();
479     shift = a->emat->ColShift();
480     stride = a->emat->ColStride();
481     ierr = PetscMalloc(m*sizeof(PetscInt),&idx);CHKERRQ(ierr);
482     for (i=0; i<m; i++) {
483       PetscInt rank,offset;
484       E2RO(A,0,shift+i*stride,&rank,&offset);
485       RO2P(A,0,rank,offset,&idx[i]);
486     }
487     ierr = ISCreateGeneral(PETSC_COMM_SELF,m,idx,PETSC_OWN_POINTER,rows);CHKERRQ(ierr);
488   }
489   if (cols) {
490     m = a->emat->LocalWidth();
491     shift = a->emat->RowShift();
492     stride = a->emat->RowStride();
493     ierr = PetscMalloc(m*sizeof(PetscInt),&idx);CHKERRQ(ierr);
494     for (i=0; i<m; i++) {
495       PetscInt rank,offset;
496       E2RO(A,1,shift+i*stride,&rank,&offset);
497       RO2P(A,1,rank,offset,&idx[i]);
498     }
499     ierr = ISCreateGeneral(PETSC_COMM_SELF,m,idx,PETSC_OWN_POINTER,cols);CHKERRQ(ierr);
500   }
501   PetscFunctionReturn(0);
502 }
503 EXTERN_C_END
504 
505 #undef __FUNCT__
506 #define __FUNCT__ "MatDestroy_Elemental"
507 static PetscErrorCode MatDestroy_Elemental(Mat A)
508 {
509   Mat_Elemental      *a = (Mat_Elemental*)A->data;
510   PetscErrorCode     ierr;
511   Mat_Elemental_Grid *commgrid;
512   PetscBool          flg;
513   MPI_Comm           icomm;
514 
515   PetscFunctionBegin;
516   delete a->interface;
517   delete a->esubmat;
518   delete a->emat;
519   elem::mpi::Comm cxxcomm(((PetscObject)A)->comm);
520 
521   ierr = PetscCommDuplicate(cxxcomm,&icomm,PETSC_NULL);CHKERRQ(ierr);
522   ierr = MPI_Attr_get(icomm,Petsc_Elemental_keyval,(void**)&commgrid,(int*)&flg);CHKERRQ(ierr);
523   if (--commgrid->grid_refct == 0) {
524     delete commgrid->grid;
525     ierr = PetscFree(commgrid);CHKERRQ(ierr);
526   }
527   ierr = PetscCommDestroy(&icomm);CHKERRQ(ierr);
528   ierr = PetscObjectComposeFunctionDynamic((PetscObject)A,"MatGetOwnershipIS_C","",PETSC_NULL);CHKERRQ(ierr);
529   ierr = PetscObjectComposeFunctionDynamic((PetscObject)A,"MatGetFactor_petsc_C","",PETSC_NULL);CHKERRQ(ierr);
530   ierr = PetscFree(A->data);CHKERRQ(ierr);
531   PetscFunctionReturn(0);
532 }
533 
534 #undef __FUNCT__
535 #define __FUNCT__ "MatSetUp_Elemental"
536 PetscErrorCode MatSetUp_Elemental(Mat A)
537 {
538   Mat_Elemental  *a = (Mat_Elemental*)A->data;
539   PetscErrorCode ierr;
540   PetscMPIInt    rsize,csize;
541 
542   PetscFunctionBegin;
543   ierr = PetscLayoutSetUp(A->rmap);CHKERRQ(ierr);
544   ierr = PetscLayoutSetUp(A->cmap);CHKERRQ(ierr);
545 
546   a->emat->ResizeTo(A->rmap->N,A->cmap->N);CHKERRQ(ierr);
547   elem::Zero(*a->emat);
548 
549   ierr = MPI_Comm_size(A->rmap->comm,&rsize);CHKERRQ(ierr);
550   ierr = MPI_Comm_size(A->cmap->comm,&csize);CHKERRQ(ierr);
551   if (csize != rsize) SETERRQ(((PetscObject)A)->comm,PETSC_ERR_ARG_INCOMP,"Cannot use row and column communicators of different sizes");
552   a->commsize = rsize;
553   a->mr[0] = A->rmap->N % rsize; if (!a->mr[0]) a->mr[0] = rsize;
554   a->mr[1] = A->cmap->N % csize; if (!a->mr[1]) a->mr[1] = csize;
555   a->m[0] = A->rmap->N / rsize + (a->mr[0] != rsize);
556   a->m[1] = A->cmap->N / csize + (a->mr[1] != csize);
557   PetscFunctionReturn(0);
558 }
559 
560 #undef __FUNCT__
561 #define __FUNCT__ "MatAssemblyBegin_Elemental"
562 PetscErrorCode MatAssemblyBegin_Elemental(Mat A, MatAssemblyType type)
563 {
564   Mat_Elemental  *a = (Mat_Elemental*)A->data;
565 
566   PetscFunctionBegin;
567   a->interface->Detach();
568   a->interface->Attach(elem::LOCAL_TO_GLOBAL,*(a->emat));
569   PetscFunctionReturn(0);
570 }
571 
572 #undef __FUNCT__
573 #define __FUNCT__ "MatAssemblyEnd_Elemental"
574 PetscErrorCode MatAssemblyEnd_Elemental(Mat A, MatAssemblyType type)
575 {
576   PetscFunctionBegin;
577   /* Currently does nothing */
578   PetscFunctionReturn(0);
579 }
580 
581 /*MC
582    MATELEMENTAL = "elemental" - A matrix type for dense matrices using the Elemental package
583 
584    Options Database Keys:
585 . -mat_type elemental - sets the matrix type to "elemental" during a call to MatSetFromOptions()
586 
587   Level: beginner
588 
589 .seealso: MATDENSE,MatCreateElemental()
590 M*/
591 EXTERN_C_BEGIN
592 #undef __FUNCT__
593 #define __FUNCT__ "MatCreate_Elemental"
594 PETSC_EXTERN_C PetscErrorCode MatCreate_Elemental(Mat A)
595 {
596   Mat_Elemental      *a;
597   PetscErrorCode     ierr;
598   PetscBool          flg;
599   Mat_Elemental_Grid *commgrid;
600   MPI_Comm           icomm;
601 
602   PetscFunctionBegin;
603   ierr = PetscElementalInitializePackage(PETSC_NULL);CHKERRQ(ierr);
604 
605   ierr = PetscNewLog(A,Mat_Elemental,&a);CHKERRQ(ierr);
606   A->data = (void*)a;
607 
608   A->ops->view            = MatView_Elemental;
609   A->ops->destroy         = MatDestroy_Elemental;
610   A->ops->setup           = MatSetUp_Elemental;
611   A->ops->setvalues       = MatSetValues_Elemental;
612   A->ops->mult            = MatMult_Elemental;
613   A->ops->multadd         = MatMultAdd_Elemental;
614   A->ops->matmult         = MatMatMult_Elemental;
615   A->ops->matmultsymbolic = MatMatMultSymbolic_Elemental;
616   A->ops->matmultnumeric  = MatMatMultNumeric_Elemental;
617   A->ops->assemblybegin   = MatAssemblyBegin_Elemental;
618   A->ops->assemblyend     = MatAssemblyEnd_Elemental;
619   A->ops->scale           = MatScale_Elemental;
620   A->ops->axpy            = MatAXPY_Elemental;
621   A->ops->lufactor        = MatLUFactor_Elemental;
622   A->ops->lufactorsymbolic = MatLUFactorSymbolic_Elemental;
623   A->ops->lufactornumeric = MatLUFactorNumeric_Elemental;
624   A->ops->matsolve        = MatMatSolve_Elemental;
625   A->ops->copy            = MatCopy_Elemental;
626   A->ops->transpose       = MatTranspose_Elemental;
627   A->ops->norm            = MatNorm_Elemental;
628   A->ops->solve           = MatSolve_Elemental;
629   A->ops->zeroentries     = MatZeroEntries_Elemental;
630   A->ops->choleskyfactor  = MatCholeskyFactor_Elemental;
631 
632   A->insertmode = NOT_SET_VALUES;
633 
634   /* Set up the elemental matrix */
635   elem::mpi::Comm cxxcomm(((PetscObject)A)->comm);
636 
637   /* Grid needs to be shared between multiple Mats on the same communicator, implement by attribute caching on the MPI_Comm */
638   if (Petsc_Elemental_keyval == MPI_KEYVAL_INVALID) {
639     ierr = MPI_Keyval_create(MPI_NULL_COPY_FN,MPI_NULL_DELETE_FN,&Petsc_Elemental_keyval,(void*)0); // MPI_Keyval_free()?
640   }
641   ierr = PetscCommDuplicate(cxxcomm,&icomm,PETSC_NULL);CHKERRQ(ierr);
642   ierr = MPI_Attr_get(icomm,Petsc_Elemental_keyval,(void**)&commgrid,(int*)&flg);CHKERRQ(ierr);
643   if (!flg) {
644     ierr = PetscNewLog(A,Mat_Elemental_Grid,&commgrid);CHKERRQ(ierr);
645     commgrid->grid       = new elem::Grid(cxxcomm);
646     commgrid->grid_refct = 1;
647     ierr = MPI_Attr_put(icomm,Petsc_Elemental_keyval,(void*)commgrid);CHKERRQ(ierr);
648     printf(" create commgrid ...\n");
649   } else {
650     commgrid->grid_refct++;
651     printf(" share commgrid ...\n");
652   }
653   ierr = PetscCommDestroy(&icomm);CHKERRQ(ierr);
654   a->grid      = commgrid->grid;
655   a->emat      = new elem::DistMatrix<PetscScalar>(*a->grid);
656   a->esubmat   = new elem::Matrix<PetscScalar>(1,1);
657   a->interface = new elem::AxpyInterface<PetscScalar>;
658   a->pivot     = new elem::DistMatrix<PetscInt,elem::VC,elem::STAR>;
659 
660   /* build cache for off array entries formed */
661   a->interface->Attach(elem::LOCAL_TO_GLOBAL,*(a->emat));
662 
663   ierr = PetscObjectComposeFunctionDynamic((PetscObject)A,"MatGetOwnershipIS_C","MatGetOwnershipIS_Elemental",MatGetOwnershipIS_Elemental);CHKERRQ(ierr);
664   ierr = PetscObjectComposeFunctionDynamic((PetscObject)A,"MatGetFactor_petsc_C","MatGetFactor_elemental_petsc",MatGetFactor_elemental_petsc);CHKERRQ(ierr);
665 
666   ierr = PetscObjectChangeTypeName((PetscObject)A,MATELEMENTAL);CHKERRQ(ierr);
667   PetscFunctionReturn(0);
668 }
669 EXTERN_C_END
670