xref: /petsc/src/mat/impls/elemental/matelem.cxx (revision 2ef0cf242e6192d0f4439dbd5110d1cfd8de74ab)
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_Dense"
579 static PetscErrorCode MatConvert_Elemental_Dense(Mat A,const MatType newtype,MatReuse reuse,Mat *B)
580 {
581   Mat                Bmpi;
582   Mat_Elemental      *a = (Mat_Elemental*)A->data;
583   MPI_Comm           comm=((PetscObject)A)->comm;
584   PetscErrorCode     ierr;
585   PetscInt           rrank,ridx,crank,cidx,nrows,ncols,i,j;
586   PetscScalar        v;
587 
588   PetscFunctionBegin;
589   if (reuse == MAT_INITIAL_MATRIX){
590     ierr = MatCreate(comm,&Bmpi);CHKERRQ(ierr);
591     ierr = MatSetSizes(Bmpi,A->rmap->n,A->cmap->n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
592     ierr = MatSetType(Bmpi,MATDENSE);CHKERRQ(ierr);
593     ierr = MatSetUp(Bmpi);CHKERRQ(ierr);
594     *B = Bmpi;
595   }
596   ierr = MatGetSize(A,&nrows,&ncols);CHKERRQ(ierr);
597   for (i=0; i<nrows; i++) {
598     PetscInt erow,ecol;
599     P2RO(A,0,i,&rrank,&ridx);
600     RO2E(A,0,rrank,ridx,&erow);
601     if (rrank < 0 || ridx < 0 || erow < 0) SETERRQ(comm,PETSC_ERR_PLIB,"Incorrect row translation");
602     for (j=0; j<ncols; j++) {
603       P2RO(A,1,j,&crank,&cidx);
604       RO2E(A,1,crank,cidx,&ecol);
605       if (crank < 0 || cidx < 0 || ecol < 0) SETERRQ(comm,PETSC_ERR_PLIB,"Incorrect col translation");
606       v = a->emat->Get(erow,ecol);
607       ierr = MatSetValues(Bmpi,1,&i,1,&j,&v,INSERT_VALUES);CHKERRQ(ierr);
608     }
609   }
610   ierr = MatAssemblyBegin(Bmpi,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
611   ierr = MatAssemblyEnd(Bmpi,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
612   PetscFunctionReturn(0);
613 }
614 
615 #undef __FUNCT__
616 #define __FUNCT__ "MatDestroy_Elemental"
617 static PetscErrorCode MatDestroy_Elemental(Mat A)
618 {
619   Mat_Elemental      *a = (Mat_Elemental*)A->data;
620   PetscErrorCode     ierr;
621   Mat_Elemental_Grid *commgrid;
622   PetscBool          flg;
623   MPI_Comm           icomm;
624 
625   PetscFunctionBegin;
626   a->interface->Detach();
627   delete a->interface;
628   delete a->esubmat;
629   delete a->emat;
630 
631   elem::mpi::Comm cxxcomm(((PetscObject)A)->comm);
632   ierr = PetscCommDuplicate(cxxcomm,&icomm,PETSC_NULL);CHKERRQ(ierr);
633   ierr = MPI_Attr_get(icomm,Petsc_Elemental_keyval,(void**)&commgrid,(int*)&flg);CHKERRQ(ierr);
634   if (--commgrid->grid_refct == 0) {
635     delete commgrid->grid;
636     ierr = PetscFree(commgrid);CHKERRQ(ierr);
637   }
638   ierr = PetscCommDestroy(&icomm);CHKERRQ(ierr);
639   ierr = PetscObjectComposeFunctionDynamic((PetscObject)A,"MatGetOwnershipIS_C","",PETSC_NULL);CHKERRQ(ierr);
640   ierr = PetscObjectComposeFunctionDynamic((PetscObject)A,"MatGetFactor_petsc_C","",PETSC_NULL);CHKERRQ(ierr);
641   ierr = PetscFree(A->data);CHKERRQ(ierr);
642   PetscFunctionReturn(0);
643 }
644 
645 #undef __FUNCT__
646 #define __FUNCT__ "MatSetUp_Elemental"
647 PetscErrorCode MatSetUp_Elemental(Mat A)
648 {
649   Mat_Elemental  *a = (Mat_Elemental*)A->data;
650   PetscErrorCode ierr;
651   PetscMPIInt    rsize,csize;
652 
653   PetscFunctionBegin;
654   ierr = PetscLayoutSetUp(A->rmap);CHKERRQ(ierr);
655   ierr = PetscLayoutSetUp(A->cmap);CHKERRQ(ierr);
656 
657   a->emat->ResizeTo(A->rmap->N,A->cmap->N);CHKERRQ(ierr);
658   elem::Zero(*a->emat);
659 
660   ierr = MPI_Comm_size(A->rmap->comm,&rsize);CHKERRQ(ierr);
661   ierr = MPI_Comm_size(A->cmap->comm,&csize);CHKERRQ(ierr);
662   if (csize != rsize) SETERRQ(((PetscObject)A)->comm,PETSC_ERR_ARG_INCOMP,"Cannot use row and column communicators of different sizes");
663   a->commsize = rsize;
664   a->mr[0] = A->rmap->N % rsize; if (!a->mr[0]) a->mr[0] = rsize;
665   a->mr[1] = A->cmap->N % csize; if (!a->mr[1]) a->mr[1] = csize;
666   a->m[0] = A->rmap->N / rsize + (a->mr[0] != rsize);
667   a->m[1] = A->cmap->N / csize + (a->mr[1] != csize);
668   PetscFunctionReturn(0);
669 }
670 
671 #undef __FUNCT__
672 #define __FUNCT__ "MatAssemblyBegin_Elemental"
673 PetscErrorCode MatAssemblyBegin_Elemental(Mat A, MatAssemblyType type)
674 {
675   Mat_Elemental  *a = (Mat_Elemental*)A->data;
676 
677   PetscFunctionBegin;
678   a->interface->Detach();
679   a->interface->Attach(elem::LOCAL_TO_GLOBAL,*(a->emat));
680   PetscFunctionReturn(0);
681 }
682 
683 #undef __FUNCT__
684 #define __FUNCT__ "MatAssemblyEnd_Elemental"
685 PetscErrorCode MatAssemblyEnd_Elemental(Mat A, MatAssemblyType type)
686 {
687   PetscFunctionBegin;
688   /* Currently does nothing */
689   PetscFunctionReturn(0);
690 }
691 
692 /* -------------------------------------------------------------------*/
693 static struct _MatOps MatOps_Values = {
694        MatSetValues_Elemental,
695        0,
696        0,
697        MatMult_Elemental,
698 /* 4*/ MatMultAdd_Elemental,
699        0, //MatMultTranspose_Elemental,
700        0, //MatMultTransposeAdd_Elemental,
701        MatSolve_Elemental,
702        0, //MatSolveAdd_Elemental,
703        0, //MatSolveTranspose_Elemental,
704 /*10*/ 0, //MatSolveTransposeAdd_Elemental,
705        MatLUFactor_Elemental,
706        MatCholeskyFactor_Elemental,
707        0,
708        MatTranspose_Elemental,
709 /*15*/ MatGetInfo_Elemental,
710        0,
711        0,
712        0,
713        MatNorm_Elemental,
714 /*20*/ MatAssemblyBegin_Elemental,
715        MatAssemblyEnd_Elemental,
716        0, //MatSetOption_Elemental,
717        MatZeroEntries_Elemental,
718 /*24*/ 0,
719        MatLUFactorSymbolic_Elemental,
720        MatLUFactorNumeric_Elemental,
721        MatCholeskyFactorSymbolic_Elemental,
722        MatCholeskyFactorNumeric_Elemental,
723 /*29*/ MatSetUp_Elemental,
724        0,
725        0,
726        0,
727        0,
728 /*34*/ 0, //MatDuplicate_Elemental,
729        0,
730        0,
731        0,
732        0,
733 /*39*/ MatAXPY_Elemental,
734        0,
735        0,
736        0,
737        MatCopy_Elemental,
738 /*44*/ 0,
739        MatScale_Elemental,
740        0,
741        0,
742        0,
743 /*49*/ 0,
744        0,
745        0,
746        0,
747        0,
748 /*54*/ 0,
749        0,
750        0,
751        0,
752        0,
753 /*59*/ 0,
754        MatDestroy_Elemental,
755        MatView_Elemental,
756        0,
757        0,
758 /*64*/ 0,
759        0,
760        0,
761        0,
762        0,
763 /*69*/ 0,
764        0,
765        MatConvert_Elemental_Dense,
766        0,
767        0,
768 /*74*/ 0,
769        0,
770        0,
771        0,
772        0,
773 /*79*/ 0,
774        0,
775        0,
776        0,
777        0,
778 /*84*/ 0,
779        0,
780        0,
781        0,
782        0,
783 /*89*/ MatMatMult_Elemental,
784        MatMatMultSymbolic_Elemental,
785        MatMatMultNumeric_Elemental,
786        0,
787        0,
788 /*94*/ 0,
789        0, //MatMatTransposeMult_Elemental,
790        0, //MatMatTransposeMultSymbolic_Elemental,
791        0, //MatMatTransposeMultNumeric_Elemental_Elemental,
792        0,
793 /*99*/ 0,
794        0,
795        0,
796        0,
797        0,
798 /*104*/0,
799        0,
800        0,
801        0,
802        0,
803 /*109*/MatMatSolve_Elemental,
804        0,
805        0,
806        0,
807        0,
808 /*114*/0,
809        0,
810        0,
811        0,
812        0,
813 /*119*/0,
814        0,
815        0,
816        0,
817        0,
818 /*124*/0,
819        0,
820        0,
821        0,
822        0,
823 /*129*/0,
824        0,
825        0,
826        0,
827        0,
828 /*134*/0,
829        0,
830        0,
831        0,
832        0
833 };
834 
835 /*MC
836    MATELEMENTAL = "elemental" - A matrix type for dense matrices using the Elemental package
837 
838    Options Database Keys:
839 . -mat_type elemental - sets the matrix type to "elemental" during a call to MatSetFromOptions()
840 
841   Level: beginner
842 
843 .seealso: MATDENSE,MatCreateElemental()
844 M*/
845 EXTERN_C_BEGIN
846 #undef __FUNCT__
847 #define __FUNCT__ "MatCreate_Elemental"
848 PETSC_EXTERN_C PetscErrorCode MatCreate_Elemental(Mat A)
849 {
850   Mat_Elemental      *a;
851   PetscErrorCode     ierr;
852   PetscBool          flg,flg1,flg2;
853   Mat_Elemental_Grid *commgrid;
854   MPI_Comm           icomm;
855   PetscInt           optv1,optv2;
856 
857   PetscFunctionBegin;
858   ierr = PetscElementalInitializePackage(PETSC_NULL);CHKERRQ(ierr);
859   ierr = PetscMemcpy(A->ops,&MatOps_Values,sizeof(struct _MatOps));CHKERRQ(ierr);
860   A->insertmode = NOT_SET_VALUES;
861 
862   ierr = PetscNewLog(A,Mat_Elemental,&a);CHKERRQ(ierr);
863   A->data = (void*)a;
864 
865   /* Set up the elemental matrix */
866   elem::mpi::Comm cxxcomm(((PetscObject)A)->comm);
867   ierr = PetscOptionsBegin(((PetscObject)A)->comm,((PetscObject)A)->prefix,"Elemental Options","Mat");CHKERRQ(ierr);
868 
869   /* Grid needs to be shared between multiple Mats on the same communicator, implement by attribute caching on the MPI_Comm */
870   if (Petsc_Elemental_keyval == MPI_KEYVAL_INVALID) {
871     ierr = MPI_Keyval_create(MPI_NULL_COPY_FN,MPI_NULL_DELETE_FN,&Petsc_Elemental_keyval,(void*)0);
872   }
873   ierr = PetscCommDuplicate(cxxcomm,&icomm,PETSC_NULL);CHKERRQ(ierr);
874   ierr = MPI_Attr_get(icomm,Petsc_Elemental_keyval,(void**)&commgrid,(int*)&flg);CHKERRQ(ierr);
875   if (!flg) {
876     ierr = PetscNewLog(A,Mat_Elemental_Grid,&commgrid);CHKERRQ(ierr);
877     ierr = PetscOptionsInt("-mat_elemental_grid_height","Grid Height","None",elem::mpi::CommSize(cxxcomm),&optv1,&flg1);CHKERRQ(ierr);
878     ierr = PetscOptionsInt("-mat_elemental_grid_width","Grid Width","None",1,&optv2,&flg2);CHKERRQ(ierr);
879     if (flg1 || flg2) {
880       if (optv1*optv2 != elem::mpi::CommSize(cxxcomm)) {
881         SETERRQ(((PetscObject)A)->comm,PETSC_ERR_ARG_INCOMP,"Grid Height times Grid Width must equal CommSize");
882       }
883       commgrid->grid = new elem::Grid(cxxcomm,optv1,optv2);
884     } else {
885       commgrid->grid = new elem::Grid(cxxcomm);
886     }
887     commgrid->grid_refct = 1;
888     ierr = MPI_Attr_put(icomm,Petsc_Elemental_keyval,(void*)commgrid);CHKERRQ(ierr);
889   } else {
890     commgrid->grid_refct++;
891   }
892   ierr = PetscCommDestroy(&icomm);CHKERRQ(ierr);
893   a->grid      = commgrid->grid;
894   a->emat      = new elem::DistMatrix<PetscScalar>(*a->grid);
895   a->esubmat   = new elem::Matrix<PetscScalar>(1,1);
896   a->interface = new elem::AxpyInterface<PetscScalar>;
897   a->pivot     = new elem::DistMatrix<PetscInt,elem::VC,elem::STAR>;
898 
899   /* build cache for off array entries formed */
900   a->interface->Attach(elem::LOCAL_TO_GLOBAL,*(a->emat));
901 
902   ierr = PetscObjectComposeFunctionDynamic((PetscObject)A,"MatGetOwnershipIS_C","MatGetOwnershipIS_Elemental",MatGetOwnershipIS_Elemental);CHKERRQ(ierr);
903   ierr = PetscObjectComposeFunctionDynamic((PetscObject)A,"MatGetFactor_petsc_C","MatGetFactor_elemental_petsc",MatGetFactor_elemental_petsc);CHKERRQ(ierr);
904 
905   ierr = PetscObjectChangeTypeName((PetscObject)A,MATELEMENTAL);CHKERRQ(ierr);
906   PetscOptionsEnd();
907   PetscFunctionReturn(0);
908 }
909 EXTERN_C_END
910