xref: /petsc/src/mat/impls/elemental/matelem.cxx (revision 40d92e34033625cc050d0b4124df52c3b467f9de)
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 /* -------------------------------------------------------------------*/
695 static struct _MatOps MatOps_Values = {
696        MatSetValues_Elemental,
697        0,
698        0,
699        MatMult_Elemental,
700 /* 4*/ MatMultAdd_Elemental,
701        0, //MatMultTranspose_Elemental,
702        0, //MatMultTransposeAdd_Elemental,
703        MatSolve_Elemental,
704        0, //MatSolveAdd_Elemental,
705        0, //MatSolveTranspose_Elemental,
706 /*10*/ 0, //MatSolveTransposeAdd_Elemental,
707        MatLUFactor_Elemental,
708        MatCholeskyFactor_Elemental,
709        0,
710        MatTranspose_Elemental,
711 /*15*/ MatGetInfo_Elemental,
712        0,
713        0,
714        0,
715        MatNorm_Elemental,
716 /*20*/ MatAssemblyBegin_Elemental,
717        MatAssemblyEnd_Elemental,
718        0, //MatSetOption_Elemental,
719        MatZeroEntries_Elemental,
720 /*24*/ 0,
721        MatLUFactorSymbolic_Elemental,
722        MatLUFactorNumeric_Elemental,
723        MatCholeskyFactorSymbolic_Elemental,
724        MatCholeskyFactorNumeric_Elemental,
725 /*29*/ MatSetUp_Elemental,
726        0,
727        0,
728        0,
729        0,
730 /*34*/ 0, //MatDuplicate_Elemental,
731        0,
732        0,
733        0,
734        0,
735 /*39*/ MatAXPY_Elemental,
736        0,
737        0,
738        0,
739        MatCopy_Elemental,
740 /*44*/ 0,
741        MatScale_Elemental,
742        0,
743        0,
744        0,
745 /*49*/ 0,
746        0,
747        0,
748        0,
749        0,
750 /*54*/ 0,
751        0,
752        0,
753        0,
754        0,
755 /*59*/ 0,
756        MatDestroy_Elemental,
757        MatView_Elemental,
758        0,
759        0,
760 /*64*/ 0,
761        0,
762        0,
763        0,
764        0,
765 /*69*/ 0,
766        0,
767        MatConvert_Elemental_MPIDense,
768        0,
769        0,
770 /*74*/ 0,
771        0,
772        0,
773        0,
774        0,
775 /*79*/ 0,
776        0,
777        0,
778        0,
779        0,
780 /*84*/ 0,
781        0,
782        0,
783        0,
784        0,
785 /*89*/ MatMatMult_Elemental,
786        MatMatMultSymbolic_Elemental,
787        MatMatMultNumeric_Elemental,
788        0,
789        0,
790 /*94*/ 0,
791        0, //MatMatTransposeMult_Elemental,
792        0, //MatMatTransposeMultSymbolic_Elemental,
793        0, //MatMatTransposeMultNumeric_Elemental_Elemental,
794        0,
795 /*99*/ 0,
796        0,
797        0,
798        0,
799        0,
800 /*104*/0,
801        0,
802        0,
803        0,
804        0,
805 /*109*/MatMatSolve_Elemental,
806        0,
807        0,
808        0,
809        0,
810 /*114*/0,
811        0,
812        0,
813        0,
814        0,
815 /*119*/0,
816        0,
817        0,
818        0,
819        0,
820 /*124*/0,
821        0,
822        0,
823        0,
824        0,
825 /*129*/0,
826        0,
827        0,
828        0,
829        0,
830 /*134*/0,
831        0,
832        0,
833        0,
834        0
835 };
836 
837 /*MC
838    MATELEMENTAL = "elemental" - A matrix type for dense matrices using the Elemental package
839 
840    Options Database Keys:
841 . -mat_type elemental - sets the matrix type to "elemental" during a call to MatSetFromOptions()
842 
843   Level: beginner
844 
845 .seealso: MATDENSE,MatCreateElemental()
846 M*/
847 EXTERN_C_BEGIN
848 #undef __FUNCT__
849 #define __FUNCT__ "MatCreate_Elemental"
850 PETSC_EXTERN_C PetscErrorCode MatCreate_Elemental(Mat A)
851 {
852   Mat_Elemental      *a;
853   PetscErrorCode     ierr;
854   PetscBool          flg,flg1,flg2;
855   Mat_Elemental_Grid *commgrid;
856   MPI_Comm           icomm;
857   PetscInt           optv1,optv2;
858 
859   PetscFunctionBegin;
860   ierr = PetscElementalInitializePackage(PETSC_NULL);CHKERRQ(ierr);
861   ierr = PetscMemcpy(A->ops,&MatOps_Values,sizeof(struct _MatOps));CHKERRQ(ierr);
862   A->insertmode = NOT_SET_VALUES;
863 
864   ierr = PetscNewLog(A,Mat_Elemental,&a);CHKERRQ(ierr);
865   A->data = (void*)a;
866 
867   /* Set up the elemental matrix */
868   elem::mpi::Comm cxxcomm(((PetscObject)A)->comm);
869   ierr = PetscOptionsBegin(((PetscObject)A)->comm,((PetscObject)A)->prefix,"Elemental Options","Mat");CHKERRQ(ierr);
870 
871   /* Grid needs to be shared between multiple Mats on the same communicator, implement by attribute caching on the MPI_Comm */
872   if (Petsc_Elemental_keyval == MPI_KEYVAL_INVALID) {
873     ierr = MPI_Keyval_create(MPI_NULL_COPY_FN,MPI_NULL_DELETE_FN,&Petsc_Elemental_keyval,(void*)0);
874   }
875   ierr = PetscCommDuplicate(cxxcomm,&icomm,PETSC_NULL);CHKERRQ(ierr);
876   ierr = MPI_Attr_get(icomm,Petsc_Elemental_keyval,(void**)&commgrid,(int*)&flg);CHKERRQ(ierr);
877   if (!flg) {
878     ierr = PetscNewLog(A,Mat_Elemental_Grid,&commgrid);CHKERRQ(ierr);
879     commgrid->grid       = new elem::Grid(cxxcomm);
880     ierr = PetscOptionsInt("-mat_elemental_grid_height","Gird Height","None",commgrid->grid->Height(),&optv1,&flg1);CHKERRQ(ierr);
881     ierr = PetscOptionsInt("-mat_elemental_grid_width","Gird Width","None",commgrid->grid->Width(),&optv2,&flg2);CHKERRQ(ierr);
882     if (flg1 || flg2) {
883       if (optv1*optv2 != elem::mpi::CommSize(cxxcomm)) {
884         SETERRQ(((PetscObject)A)->comm,PETSC_ERR_ARG_INCOMP,"Gird Height times Grid Width must equal CommSize");
885       }
886       delete commgrid->grid;
887       commgrid->grid = new elem::Grid(cxxcomm,optv1,optv2);
888     }
889     commgrid->grid_refct = 1;
890     ierr = MPI_Attr_put(icomm,Petsc_Elemental_keyval,(void*)commgrid);CHKERRQ(ierr);
891   } else {
892     commgrid->grid_refct++;
893   }
894   ierr = PetscCommDestroy(&icomm);CHKERRQ(ierr);
895   a->grid      = commgrid->grid;
896   a->emat      = new elem::DistMatrix<PetscScalar>(*a->grid);
897   a->esubmat   = new elem::Matrix<PetscScalar>(1,1);
898   a->interface = new elem::AxpyInterface<PetscScalar>;
899   a->pivot     = new elem::DistMatrix<PetscInt,elem::VC,elem::STAR>;
900 
901   /* build cache for off array entries formed */
902   a->interface->Attach(elem::LOCAL_TO_GLOBAL,*(a->emat));
903 
904   ierr = PetscObjectComposeFunctionDynamic((PetscObject)A,"MatGetOwnershipIS_C","MatGetOwnershipIS_Elemental",MatGetOwnershipIS_Elemental);CHKERRQ(ierr);
905   ierr = PetscObjectComposeFunctionDynamic((PetscObject)A,"MatGetFactor_petsc_C","MatGetFactor_elemental_petsc",MatGetFactor_elemental_petsc);CHKERRQ(ierr);
906 
907   ierr = PetscObjectChangeTypeName((PetscObject)A,MATELEMENTAL);CHKERRQ(ierr);
908   PetscOptionsEnd();
909   PetscFunctionReturn(0);
910 }
911 EXTERN_C_END
912