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