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