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