xref: /petsc/src/mat/impls/elemental/matelem.cxx (revision e883f9d546dc26949a479f85ba607bb232859cfb)
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__ "MatMultTranspose_Elemental"
206 static PetscErrorCode MatMultTranspose_Elemental(Mat A,Vec X,Vec Y)
207 {
208   Mat_Elemental     *a = (Mat_Elemental*)A->data;
209   PetscErrorCode    ierr;
210   const PetscScalar *x;
211   PetscScalar       *y;
212   PetscScalar       one = 1,zero = 0;
213 
214   PetscFunctionBegin;
215   ierr = VecGetArrayRead(X,&x);CHKERRQ(ierr);
216   ierr = VecGetArray(Y,&y);CHKERRQ(ierr);
217   { /* Scoping so that constructor is called before pointer is returned */
218     elem::DistMatrix<PetscScalar,elem::VC,elem::STAR> xe(A->rmap->N,1,0,x,A->rmap->n,*a->grid);
219     elem::DistMatrix<PetscScalar,elem::VC,elem::STAR> ye(A->cmap->N,1,0,y,A->cmap->n,*a->grid);
220     elem::Gemv(elem::TRANSPOSE,one,*a->emat,xe,zero,ye);
221   }
222   ierr = VecRestoreArrayRead(X,&x);CHKERRQ(ierr);
223   ierr = VecRestoreArray(Y,&y);CHKERRQ(ierr);
224   PetscFunctionReturn(0);
225 }
226 
227 #undef __FUNCT__
228 #define __FUNCT__ "MatMultAdd_Elemental"
229 static PetscErrorCode MatMultAdd_Elemental(Mat A,Vec X,Vec Y,Vec Z)
230 {
231   Mat_Elemental     *a = (Mat_Elemental*)A->data;
232   PetscErrorCode    ierr;
233   const PetscScalar *x;
234   PetscScalar       *z;
235   PetscScalar       one = 1.0;
236 
237   PetscFunctionBegin;
238   if (Y != Z) {ierr = VecCopy(Y,Z);CHKERRQ(ierr);}
239   ierr = VecGetArrayRead(X,&x);CHKERRQ(ierr);
240   ierr = VecGetArray(Z,&z);CHKERRQ(ierr);
241   { /* Scoping so that constructor is called before pointer is returned */
242     elem::DistMatrix<PetscScalar,elem::VC,elem::STAR> xe(A->cmap->N,1,0,x,A->cmap->n,*a->grid);
243     elem::DistMatrix<PetscScalar,elem::VC,elem::STAR> ze(A->rmap->N,1,0,z,A->rmap->n,*a->grid);
244     elem::Gemv(elem::NORMAL,one,*a->emat,xe,one,ze);
245   }
246   ierr = VecRestoreArrayRead(X,&x);CHKERRQ(ierr);
247   ierr = VecRestoreArray(Z,&z);CHKERRQ(ierr);
248   PetscFunctionReturn(0);
249 }
250 
251 #undef __FUNCT__
252 #define __FUNCT__ "MatMultTransposeAdd_Elemental"
253 static PetscErrorCode MatMultTransposeAdd_Elemental(Mat A,Vec X,Vec Y,Vec Z)
254 {
255   Mat_Elemental     *a = (Mat_Elemental*)A->data;
256   PetscErrorCode    ierr;
257   const PetscScalar *x;
258   PetscScalar       *z;
259   PetscScalar       one = 1.0;
260 
261   PetscFunctionBegin;
262   if (Y != Z) {ierr = VecCopy(Y,Z);CHKERRQ(ierr);}
263   ierr = VecGetArrayRead(X,&x);CHKERRQ(ierr);
264   ierr = VecGetArray(Z,&z);CHKERRQ(ierr);
265   { /* Scoping so that constructor is called before pointer is returned */
266     elem::DistMatrix<PetscScalar,elem::VC,elem::STAR> xe(A->rmap->N,1,0,x,A->rmap->n,*a->grid);
267     elem::DistMatrix<PetscScalar,elem::VC,elem::STAR> ze(A->cmap->N,1,0,z,A->cmap->n,*a->grid);
268     elem::Gemv(elem::TRANSPOSE,one,*a->emat,xe,one,ze);
269   }
270   ierr = VecRestoreArrayRead(X,&x);CHKERRQ(ierr);
271   ierr = VecRestoreArray(Z,&z);CHKERRQ(ierr);
272   PetscFunctionReturn(0);
273 }
274 
275 #undef __FUNCT__
276 #define __FUNCT__ "MatMatMultNumeric_Elemental"
277 static PetscErrorCode MatMatMultNumeric_Elemental(Mat A,Mat B,Mat C)
278 {
279   Mat_Elemental  *a = (Mat_Elemental*)A->data;
280   Mat_Elemental  *b = (Mat_Elemental*)B->data;
281   Mat_Elemental  *c = (Mat_Elemental*)C->data;
282   PetscScalar    one = 1.0,zero = 0.0;
283 
284   PetscFunctionBegin;
285   { /* Scoping so that constructor is called before pointer is returned */
286     elem::Gemm(elem::NORMAL,elem::NORMAL,one,*a->emat,*b->emat,zero,*c->emat);
287   }
288   C->assembled = PETSC_TRUE;
289   PetscFunctionReturn(0);
290 }
291 
292 #undef __FUNCT__
293 #define __FUNCT__ "MatMatMultSymbolic_Elemental"
294 static PetscErrorCode MatMatMultSymbolic_Elemental(Mat A,Mat B,PetscReal fill,Mat *C)
295 {
296   PetscErrorCode ierr;
297   Mat            Ce;
298   MPI_Comm       comm=((PetscObject)A)->comm;
299 
300   PetscFunctionBegin;
301   ierr = MatCreate(comm,&Ce);CHKERRQ(ierr);
302   ierr = MatSetSizes(Ce,A->rmap->n,B->cmap->n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
303   ierr = MatSetType(Ce,MATELEMENTAL);CHKERRQ(ierr);
304   ierr = MatSetUp(Ce);CHKERRQ(ierr);
305   *C = Ce;
306   PetscFunctionReturn(0);
307 }
308 
309 #undef __FUNCT__
310 #define __FUNCT__ "MatMatMult_Elemental"
311 static PetscErrorCode MatMatMult_Elemental(Mat A,Mat B,MatReuse scall,PetscReal fill,Mat *C)
312 {
313   PetscErrorCode ierr;
314 
315   PetscFunctionBegin;
316   if (scall == MAT_INITIAL_MATRIX){
317     ierr = PetscLogEventBegin(MAT_MatMultSymbolic,A,B,0,0);CHKERRQ(ierr);
318     ierr = MatMatMultSymbolic_Elemental(A,B,1.0,C);CHKERRQ(ierr);
319     ierr = PetscLogEventEnd(MAT_MatMultSymbolic,A,B,0,0);CHKERRQ(ierr);
320   }
321   ierr = PetscLogEventBegin(MAT_MatMultNumeric,A,B,0,0);CHKERRQ(ierr);
322   ierr = MatMatMultNumeric_Elemental(A,B,*C);CHKERRQ(ierr);
323   ierr = PetscLogEventEnd(MAT_MatMultNumeric,A,B,0,0);CHKERRQ(ierr);
324   PetscFunctionReturn(0);
325 }
326 
327 #undef __FUNCT__
328 #define __FUNCT__ "MatScale_Elemental"
329 static PetscErrorCode MatScale_Elemental(Mat X,PetscScalar a)
330 {
331   Mat_Elemental  *x = (Mat_Elemental*)X->data;
332 
333   PetscFunctionBegin;
334   elem::Scal(a,*x->emat);
335   PetscFunctionReturn(0);
336 }
337 
338 #undef __FUNCT__
339 #define __FUNCT__ "MatAXPY_Elemental"
340 static PetscErrorCode MatAXPY_Elemental(Mat Y,PetscScalar a,Mat X,MatStructure str)
341 {
342   Mat_Elemental  *x = (Mat_Elemental*)X->data;
343   Mat_Elemental  *y = (Mat_Elemental*)Y->data;
344 
345   PetscFunctionBegin;
346   elem::Axpy(a,*x->emat,*y->emat);
347   PetscFunctionReturn(0);
348 }
349 
350 #undef __FUNCT__
351 #define __FUNCT__ "MatCopy_Elemental"
352 static PetscErrorCode MatCopy_Elemental(Mat A,Mat B,MatStructure str)
353 {
354   Mat_Elemental *a=(Mat_Elemental*)A->data;
355   Mat_Elemental *b=(Mat_Elemental*)B->data;
356 
357   PetscFunctionBegin;
358   elem::Copy(*a->emat,*b->emat);
359   PetscFunctionReturn(0);
360 }
361 
362 #undef __FUNCT__
363 #define __FUNCT__ "MatTranspose_Elemental"
364 static PetscErrorCode MatTranspose_Elemental(Mat A,MatReuse reuse,Mat *B)
365 {
366   /* Only out-of-place supported */
367   Mat            Be;
368   PetscErrorCode ierr;
369   MPI_Comm       comm=((PetscObject)A)->comm;
370   Mat_Elemental  *a = (Mat_Elemental*)A->data, *b;
371 
372   PetscFunctionBegin;
373   if (reuse == MAT_INITIAL_MATRIX){
374     ierr = MatCreate(comm,&Be);CHKERRQ(ierr);
375     ierr = MatSetSizes(Be,A->cmap->n,A->rmap->n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
376     ierr = MatSetType(Be,MATELEMENTAL);CHKERRQ(ierr);
377     ierr = MatSetUp(Be);CHKERRQ(ierr);
378     *B = Be;
379   }
380   b = (Mat_Elemental*)Be->data;
381   elem::Transpose(*a->emat,*b->emat);
382   Be->assembled = PETSC_TRUE;
383   PetscFunctionReturn(0);
384 }
385 
386 #undef __FUNCT__
387 #define __FUNCT__ "MatSolve_Elemental"
388 static PetscErrorCode MatSolve_Elemental(Mat A,Vec B,Vec X)
389 {
390   Mat_Elemental     *a = (Mat_Elemental*)A->data;
391   PetscErrorCode    ierr;
392   PetscScalar       *x;
393 
394   PetscFunctionBegin;
395   ierr = VecCopy(B,X);CHKERRQ(ierr);
396   ierr = VecGetArray(X,&x);CHKERRQ(ierr);
397   elem::DistMatrix<PetscScalar,elem::VC,elem::STAR> xe(A->rmap->N,1,0,x,A->rmap->n,*a->grid);
398   elem::DistMatrix<PetscScalar,elem::MC,elem::MR> xer = xe;
399   switch (A->factortype) {
400   case MAT_FACTOR_LU:
401     if ((*a->pivot).AllocatedMemory()) {
402       elem::SolveAfterLU(elem::NORMAL,*a->emat,*a->pivot,xer);
403       elem::Copy(xer,xe);
404     } else {
405       elem::SolveAfterLU(elem::NORMAL,*a->emat,xer);
406       elem::Copy(xer,xe);
407     }
408     break;
409   case MAT_FACTOR_CHOLESKY:
410     elem::SolveAfterCholesky(elem::UPPER,elem::NORMAL,*a->emat,xer);
411     elem::Copy(xer,xe);
412     break;
413   default:
414     SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Unfactored Matrix or Unsupported MatFactorType");
415     break;
416   }
417   ierr = VecRestoreArray(X,&x);CHKERRQ(ierr);
418   PetscFunctionReturn(0);
419 }
420 
421 #undef __FUNCT__
422 #define __FUNCT__ "MatMatSolve_Elemental"
423 static PetscErrorCode MatMatSolve_Elemental(Mat A,Mat B,Mat X)
424 {
425   Mat_Elemental *a=(Mat_Elemental*)A->data;
426   Mat_Elemental *b=(Mat_Elemental*)B->data;
427   Mat_Elemental *x=(Mat_Elemental*)X->data;
428 
429   PetscFunctionBegin;
430   elem::Copy(*b->emat,*x->emat);
431   switch (A->factortype) {
432   case MAT_FACTOR_LU:
433     if ((*a->pivot).AllocatedMemory()) {
434       elem::SolveAfterLU(elem::NORMAL,*a->emat,*a->pivot,*x->emat);
435     } else {
436       elem::SolveAfterLU(elem::NORMAL,*a->emat,*x->emat);
437     }
438     break;
439   case MAT_FACTOR_CHOLESKY:
440     elem::SolveAfterCholesky(elem::UPPER,elem::NORMAL,*a->emat,*x->emat);
441     break;
442   default:
443     SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Unfactored Matrix or Unsupported MatFactorType");
444     break;
445   }
446   PetscFunctionReturn(0);
447 }
448 
449 #undef __FUNCT__
450 #define __FUNCT__ "MatLUFactor_Elemental"
451 static PetscErrorCode MatLUFactor_Elemental(Mat A,IS row,IS col,const MatFactorInfo *info)
452 {
453   Mat_Elemental  *a = (Mat_Elemental*)A->data;
454 
455   PetscFunctionBegin;
456   if (info->dtcol){
457     elem::LU(*a->emat,*a->pivot);
458   } else {
459     elem::LU(*a->emat);
460   }
461   A->factortype = MAT_FACTOR_LU;
462   A->assembled  = PETSC_TRUE;
463   PetscFunctionReturn(0);
464 }
465 
466 #undef __FUNCT__
467 #define __FUNCT__ "MatLUFactorNumeric_Elemental"
468 static PetscErrorCode  MatLUFactorNumeric_Elemental(Mat F,Mat A,const MatFactorInfo *info)
469 {
470   PetscErrorCode ierr;
471 
472   PetscFunctionBegin;
473   ierr = MatCopy(A,F,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
474   ierr = MatLUFactor_Elemental(F,0,0,info);CHKERRQ(ierr);
475   PetscFunctionReturn(0);
476 }
477 
478 #undef __FUNCT__
479 #define __FUNCT__ "MatLUFactorSymbolic_Elemental"
480 static PetscErrorCode  MatLUFactorSymbolic_Elemental(Mat F,Mat A,IS r,IS c,const MatFactorInfo *info)
481 {
482   PetscFunctionBegin;
483   /* F is create and allocated by MatGetFactor_elemental_petsc(), skip this routine. */
484   PetscFunctionReturn(0);
485 }
486 
487 #undef __FUNCT__
488 #define __FUNCT__ "MatCholeskyFactor_Elemental"
489 static PetscErrorCode MatCholeskyFactor_Elemental(Mat A,IS perm,const MatFactorInfo *info)
490 {
491   Mat_Elemental  *a = (Mat_Elemental*)A->data;
492   elem::DistMatrix<PetscScalar,elem::MC,elem::STAR> d;
493 
494   PetscFunctionBegin;
495   elem::Cholesky(elem::UPPER,*a->emat);
496   // if (info->dtcol){
497   //   /* A = U^T * U for SPD Matrix A */
498   //   printf("Cholesky Factorization for SPD Matrices...\n");
499   //   elem::Cholesky(elem::UPPER,*a->emat);
500   // } else {
501   //   /* A = U^T * D * U * for Symmetric Matrix A */
502   //   printf("LDL^T Factorization for Symmetric Matrices.\n");
503   //   printf("This routine does not pivot. Use with caution.\n");
504   //   elem::LDLT(*a->emat,d);
505   // }
506   A->factortype = MAT_FACTOR_CHOLESKY;
507   A->assembled  = PETSC_TRUE;
508   PetscFunctionReturn(0);
509 }
510 
511 #undef __FUNCT__
512 #define __FUNCT__ "MatCholeskyFactorNumeric_Elemental"
513 static PetscErrorCode MatCholeskyFactorNumeric_Elemental(Mat F,Mat A,const MatFactorInfo *info)
514 {
515   PetscErrorCode ierr;
516 
517   PetscFunctionBegin;
518   ierr = MatCopy(A,F,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
519   ierr = MatCholeskyFactor_Elemental(F,0,info);CHKERRQ(ierr);
520   PetscFunctionReturn(0);
521 }
522 
523 #undef __FUNCT__
524 #define __FUNCT__ "MatCholeskyFactorSymbolic_Elemental"
525 static PetscErrorCode MatCholeskyFactorSymbolic_Elemental(Mat F,Mat A,IS perm,const MatFactorInfo *info)
526 {
527   PetscFunctionBegin;
528   /* F is create and allocated by MatGetFactor_elemental_petsc(), skip this routine. */
529   PetscFunctionReturn(0);
530 }
531 
532 EXTERN_C_BEGIN
533 #undef __FUNCT__
534 #define __FUNCT__ "MatGetFactor_elemental_petsc"
535 static PetscErrorCode MatGetFactor_elemental_petsc(Mat A,MatFactorType ftype,Mat *F)
536 {
537   Mat            B;
538   PetscErrorCode ierr;
539 
540   PetscFunctionBegin;
541   /* Create the factorization matrix */
542   ierr = MatCreate(((PetscObject)A)->comm,&B);CHKERRQ(ierr);
543   ierr = MatSetSizes(B,A->rmap->n,A->cmap->n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
544   ierr = MatSetType(B,MATELEMENTAL);CHKERRQ(ierr);
545   ierr = MatSetUp(B);CHKERRQ(ierr);
546   B->factortype = ftype;
547   *F            = B;
548   PetscFunctionReturn(0);
549 }
550 EXTERN_C_END
551 
552 #undef __FUNCT__
553 #define __FUNCT__ "MatNorm_Elemental"
554 static PetscErrorCode MatNorm_Elemental(Mat A,NormType type,PetscReal *nrm)
555 {
556   Mat_Elemental *a=(Mat_Elemental*)A->data;
557 
558   PetscFunctionBegin;
559   switch (type){
560   case NORM_1:
561     *nrm = elem::Norm(*a->emat,elem::ONE_NORM);
562     break;
563   case NORM_FROBENIUS:
564     *nrm = elem::Norm(*a->emat,elem::FROBENIUS_NORM);
565     break;
566   case NORM_INFINITY:
567     *nrm = elem::Norm(*a->emat,elem::INFINITY_NORM);
568     break;
569   default:
570     printf("Error: unsupported norm type!\n");
571   }
572   PetscFunctionReturn(0);
573 }
574 
575 #undef __FUNCT__
576 #define __FUNCT__ "MatZeroEntries_Elemental"
577 static PetscErrorCode MatZeroEntries_Elemental(Mat A)
578 {
579   Mat_Elemental *a=(Mat_Elemental*)A->data;
580 
581   PetscFunctionBegin;
582   elem::Zero(*a->emat);
583   PetscFunctionReturn(0);
584 }
585 
586 EXTERN_C_BEGIN
587 #undef __FUNCT__
588 #define __FUNCT__ "MatGetOwnershipIS_Elemental"
589 static PetscErrorCode MatGetOwnershipIS_Elemental(Mat A,IS *rows,IS *cols)
590 {
591   Mat_Elemental  *a = (Mat_Elemental*)A->data;
592   PetscErrorCode ierr;
593   PetscInt       i,m,shift,stride,*idx;
594 
595   PetscFunctionBegin;
596   if (rows) {
597     m = a->emat->LocalHeight();
598     shift = a->emat->ColShift();
599     stride = a->emat->ColStride();
600     ierr = PetscMalloc(m*sizeof(PetscInt),&idx);CHKERRQ(ierr);
601     for (i=0; i<m; i++) {
602       PetscInt rank,offset;
603       E2RO(A,0,shift+i*stride,&rank,&offset);
604       RO2P(A,0,rank,offset,&idx[i]);
605     }
606     ierr = ISCreateGeneral(PETSC_COMM_SELF,m,idx,PETSC_OWN_POINTER,rows);CHKERRQ(ierr);
607   }
608   if (cols) {
609     m = a->emat->LocalWidth();
610     shift = a->emat->RowShift();
611     stride = a->emat->RowStride();
612     ierr = PetscMalloc(m*sizeof(PetscInt),&idx);CHKERRQ(ierr);
613     for (i=0; i<m; i++) {
614       PetscInt rank,offset;
615       E2RO(A,1,shift+i*stride,&rank,&offset);
616       RO2P(A,1,rank,offset,&idx[i]);
617     }
618     ierr = ISCreateGeneral(PETSC_COMM_SELF,m,idx,PETSC_OWN_POINTER,cols);CHKERRQ(ierr);
619   }
620   PetscFunctionReturn(0);
621 }
622 EXTERN_C_END
623 
624 #undef __FUNCT__
625 #define __FUNCT__ "MatConvert_Elemental_Dense"
626 static PetscErrorCode MatConvert_Elemental_Dense(Mat A,const MatType newtype,MatReuse reuse,Mat *B)
627 {
628   Mat                Bmpi;
629   Mat_Elemental      *a = (Mat_Elemental*)A->data;
630   MPI_Comm           comm=((PetscObject)A)->comm;
631   PetscErrorCode     ierr;
632   PetscInt           rrank,ridx,crank,cidx,nrows,ncols,i,j;
633   PetscScalar        v;
634 
635   PetscFunctionBegin;
636   if (strcmp(newtype,MATDENSE) && strcmp(newtype,MATSEQDENSE) && strcmp(newtype,MATMPIDENSE)) {
637     SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Unsupported New MatType: must be MATDENSE, MATSEQDENSE or MATMPIDENSE");
638   }
639   if (1){
640     ierr = MatCreate(comm,&Bmpi);CHKERRQ(ierr);
641     ierr = MatSetSizes(Bmpi,A->rmap->n,A->cmap->n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
642     ierr = MatSetType(Bmpi,MATDENSE);CHKERRQ(ierr);
643     ierr = MatSetUp(Bmpi);CHKERRQ(ierr);
644   }
645   ierr = MatGetSize(A,&nrows,&ncols);CHKERRQ(ierr);
646   for (i=0; i<nrows; i++) {
647     PetscInt erow,ecol;
648     P2RO(A,0,i,&rrank,&ridx);
649     RO2E(A,0,rrank,ridx,&erow);
650     if (rrank < 0 || ridx < 0 || erow < 0) SETERRQ(comm,PETSC_ERR_PLIB,"Incorrect row translation");
651     for (j=0; j<ncols; j++) {
652       P2RO(A,1,j,&crank,&cidx);
653       RO2E(A,1,crank,cidx,&ecol);
654       if (crank < 0 || cidx < 0 || ecol < 0) SETERRQ(comm,PETSC_ERR_PLIB,"Incorrect col translation");
655       v = a->emat->Get(erow,ecol);
656       ierr = MatSetValues(Bmpi,1,&i,1,&j,&v,INSERT_VALUES);CHKERRQ(ierr);
657     }
658   }
659   ierr = MatAssemblyBegin(Bmpi,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
660   ierr = MatAssemblyEnd(Bmpi,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr);
661   if (reuse == MAT_REUSE_MATRIX) {
662     //*B = Bmpi;
663     //MatDestroy(&A);
664     ierr = MatHeaderReplace(A,Bmpi);CHKERRQ(ierr);
665   } else {
666     *B = Bmpi;
667   }
668   PetscFunctionReturn(0);
669 }
670 
671 #undef __FUNCT__
672 #define __FUNCT__ "MatDestroy_Elemental"
673 static PetscErrorCode MatDestroy_Elemental(Mat A)
674 {
675   Mat_Elemental      *a = (Mat_Elemental*)A->data;
676   PetscErrorCode     ierr;
677   Mat_Elemental_Grid *commgrid;
678   PetscBool          flg;
679   MPI_Comm           icomm;
680 
681   PetscFunctionBegin;
682   a->interface->Detach();
683   delete a->interface;
684   delete a->esubmat;
685   delete a->emat;
686 
687   elem::mpi::Comm cxxcomm(((PetscObject)A)->comm);
688   ierr = PetscCommDuplicate(cxxcomm,&icomm,PETSC_NULL);CHKERRQ(ierr);
689   ierr = MPI_Attr_get(icomm,Petsc_Elemental_keyval,(void**)&commgrid,(int*)&flg);CHKERRQ(ierr);
690   if (--commgrid->grid_refct == 0) {
691     delete commgrid->grid;
692     ierr = PetscFree(commgrid);CHKERRQ(ierr);
693   }
694   ierr = PetscCommDestroy(&icomm);CHKERRQ(ierr);
695   ierr = PetscObjectComposeFunctionDynamic((PetscObject)A,"MatGetOwnershipIS_C","",PETSC_NULL);CHKERRQ(ierr);
696   ierr = PetscObjectComposeFunctionDynamic((PetscObject)A,"MatGetFactor_petsc_C","",PETSC_NULL);CHKERRQ(ierr);
697   ierr = PetscFree(A->data);CHKERRQ(ierr);
698   PetscFunctionReturn(0);
699 }
700 
701 #undef __FUNCT__
702 #define __FUNCT__ "MatSetUp_Elemental"
703 PetscErrorCode MatSetUp_Elemental(Mat A)
704 {
705   Mat_Elemental  *a = (Mat_Elemental*)A->data;
706   PetscErrorCode ierr;
707   PetscMPIInt    rsize,csize;
708 
709   PetscFunctionBegin;
710   ierr = PetscLayoutSetUp(A->rmap);CHKERRQ(ierr);
711   ierr = PetscLayoutSetUp(A->cmap);CHKERRQ(ierr);
712 
713   a->emat->ResizeTo(A->rmap->N,A->cmap->N);CHKERRQ(ierr);
714   elem::Zero(*a->emat);
715 
716   ierr = MPI_Comm_size(A->rmap->comm,&rsize);CHKERRQ(ierr);
717   ierr = MPI_Comm_size(A->cmap->comm,&csize);CHKERRQ(ierr);
718   if (csize != rsize) SETERRQ(((PetscObject)A)->comm,PETSC_ERR_ARG_INCOMP,"Cannot use row and column communicators of different sizes");
719   a->commsize = rsize;
720   a->mr[0] = A->rmap->N % rsize; if (!a->mr[0]) a->mr[0] = rsize;
721   a->mr[1] = A->cmap->N % csize; if (!a->mr[1]) a->mr[1] = csize;
722   a->m[0] = A->rmap->N / rsize + (a->mr[0] != rsize);
723   a->m[1] = A->cmap->N / csize + (a->mr[1] != csize);
724   PetscFunctionReturn(0);
725 }
726 
727 #undef __FUNCT__
728 #define __FUNCT__ "MatAssemblyBegin_Elemental"
729 PetscErrorCode MatAssemblyBegin_Elemental(Mat A, MatAssemblyType type)
730 {
731   Mat_Elemental  *a = (Mat_Elemental*)A->data;
732 
733   PetscFunctionBegin;
734   a->interface->Detach();
735   a->interface->Attach(elem::LOCAL_TO_GLOBAL,*(a->emat));
736   PetscFunctionReturn(0);
737 }
738 
739 #undef __FUNCT__
740 #define __FUNCT__ "MatAssemblyEnd_Elemental"
741 PetscErrorCode MatAssemblyEnd_Elemental(Mat A, MatAssemblyType type)
742 {
743   PetscFunctionBegin;
744   /* Currently does nothing */
745   PetscFunctionReturn(0);
746 }
747 
748 /* -------------------------------------------------------------------*/
749 static struct _MatOps MatOps_Values = {
750        MatSetValues_Elemental,
751        0,
752        0,
753        MatMult_Elemental,
754 /* 4*/ MatMultAdd_Elemental,
755        MatMultTranspose_Elemental,
756        MatMultTransposeAdd_Elemental,
757        MatSolve_Elemental,
758        0, //MatSolveAdd_Elemental,
759        0, //MatSolveTranspose_Elemental,
760 /*10*/ 0, //MatSolveTransposeAdd_Elemental,
761        MatLUFactor_Elemental,
762        MatCholeskyFactor_Elemental,
763        0,
764        MatTranspose_Elemental,
765 /*15*/ MatGetInfo_Elemental,
766        0,
767        0,
768        0,
769        MatNorm_Elemental,
770 /*20*/ MatAssemblyBegin_Elemental,
771        MatAssemblyEnd_Elemental,
772        0, //MatSetOption_Elemental,
773        MatZeroEntries_Elemental,
774 /*24*/ 0,
775        MatLUFactorSymbolic_Elemental,
776        MatLUFactorNumeric_Elemental,
777        MatCholeskyFactorSymbolic_Elemental,
778        MatCholeskyFactorNumeric_Elemental,
779 /*29*/ MatSetUp_Elemental,
780        0,
781        0,
782        0,
783        0,
784 /*34*/ 0, //MatDuplicate_Elemental,
785        0,
786        0,
787        0,
788        0,
789 /*39*/ MatAXPY_Elemental,
790        0,
791        0,
792        0,
793        MatCopy_Elemental,
794 /*44*/ 0,
795        MatScale_Elemental,
796        0,
797        0,
798        0,
799 /*49*/ 0,
800        0,
801        0,
802        0,
803        0,
804 /*54*/ 0,
805        0,
806        0,
807        0,
808        0,
809 /*59*/ 0,
810        MatDestroy_Elemental,
811        MatView_Elemental,
812        0,
813        0,
814 /*64*/ 0,
815        0,
816        0,
817        0,
818        0,
819 /*69*/ 0,
820        0,
821        MatConvert_Elemental_Dense,
822        0,
823        0,
824 /*74*/ 0,
825        0,
826        0,
827        0,
828        0,
829 /*79*/ 0,
830        0,
831        0,
832        0,
833        0,
834 /*84*/ 0,
835        0,
836        0,
837        0,
838        0,
839 /*89*/ MatMatMult_Elemental,
840        MatMatMultSymbolic_Elemental,
841        MatMatMultNumeric_Elemental,
842        0,
843        0,
844 /*94*/ 0,
845        0, //MatMatTransposeMult_Elemental,
846        0, //MatMatTransposeMultSymbolic_Elemental,
847        0, //MatMatTransposeMultNumeric_Elemental_Elemental,
848        0,
849 /*99*/ 0,
850        0,
851        0,
852        0,
853        0,
854 /*104*/0,
855        0,
856        0,
857        0,
858        0,
859 /*109*/MatMatSolve_Elemental,
860        0,
861        0,
862        0,
863        0,
864 /*114*/0,
865        0,
866        0,
867        0,
868        0,
869 /*119*/0,
870        0,
871        0,
872        0,
873        0,
874 /*124*/0,
875        0,
876        0,
877        0,
878        0,
879 /*129*/0,
880        0,
881        0,
882        0,
883        0,
884 /*134*/0,
885        0,
886        0,
887        0,
888        0
889 };
890 
891 /*MC
892    MATELEMENTAL = "elemental" - A matrix type for dense matrices using the Elemental package
893 
894    Options Database Keys:
895 . -mat_type elemental - sets the matrix type to "elemental" during a call to MatSetFromOptions()
896 
897   Level: beginner
898 
899 .seealso: MATDENSE,MatCreateElemental()
900 M*/
901 EXTERN_C_BEGIN
902 #undef __FUNCT__
903 #define __FUNCT__ "MatCreate_Elemental"
904 PETSC_EXTERN_C PetscErrorCode MatCreate_Elemental(Mat A)
905 {
906   Mat_Elemental      *a;
907   PetscErrorCode     ierr;
908   PetscBool          flg,flg1,flg2;
909   Mat_Elemental_Grid *commgrid;
910   MPI_Comm           icomm;
911   PetscInt           optv1,optv2;
912 
913   PetscFunctionBegin;
914   ierr = PetscElementalInitializePackage(PETSC_NULL);CHKERRQ(ierr);
915   ierr = PetscMemcpy(A->ops,&MatOps_Values,sizeof(struct _MatOps));CHKERRQ(ierr);
916   A->insertmode = NOT_SET_VALUES;
917 
918   ierr = PetscNewLog(A,Mat_Elemental,&a);CHKERRQ(ierr);
919   A->data = (void*)a;
920 
921   /* Set up the elemental matrix */
922   elem::mpi::Comm cxxcomm(((PetscObject)A)->comm);
923   ierr = PetscOptionsBegin(((PetscObject)A)->comm,((PetscObject)A)->prefix,"Elemental Options","Mat");CHKERRQ(ierr);
924 
925   /* Grid needs to be shared between multiple Mats on the same communicator, implement by attribute caching on the MPI_Comm */
926   if (Petsc_Elemental_keyval == MPI_KEYVAL_INVALID) {
927     ierr = MPI_Keyval_create(MPI_NULL_COPY_FN,MPI_NULL_DELETE_FN,&Petsc_Elemental_keyval,(void*)0);
928   }
929   ierr = PetscCommDuplicate(cxxcomm,&icomm,PETSC_NULL);CHKERRQ(ierr);
930   ierr = MPI_Attr_get(icomm,Petsc_Elemental_keyval,(void**)&commgrid,(int*)&flg);CHKERRQ(ierr);
931   if (!flg) {
932     ierr = PetscNewLog(A,Mat_Elemental_Grid,&commgrid);CHKERRQ(ierr);
933     ierr = PetscOptionsInt("-mat_elemental_grid_height","Grid Height","None",elem::mpi::CommSize(cxxcomm),&optv1,&flg1);CHKERRQ(ierr);
934     ierr = PetscOptionsInt("-mat_elemental_grid_width","Grid Width","None",1,&optv2,&flg2);CHKERRQ(ierr);
935     if (flg1 || flg2) {
936       if (optv1*optv2 != elem::mpi::CommSize(cxxcomm)) {
937         SETERRQ(((PetscObject)A)->comm,PETSC_ERR_ARG_INCOMP,"Grid Height times Grid Width must equal CommSize");
938       }
939       commgrid->grid = new elem::Grid(cxxcomm,optv1,optv2);
940     } else {
941       commgrid->grid = new elem::Grid(cxxcomm);
942     }
943     commgrid->grid_refct = 1;
944     ierr = MPI_Attr_put(icomm,Petsc_Elemental_keyval,(void*)commgrid);CHKERRQ(ierr);
945   } else {
946     commgrid->grid_refct++;
947   }
948   ierr = PetscCommDestroy(&icomm);CHKERRQ(ierr);
949   a->grid      = commgrid->grid;
950   a->emat      = new elem::DistMatrix<PetscScalar>(*a->grid);
951   a->esubmat   = new elem::Matrix<PetscScalar>(1,1);
952   a->interface = new elem::AxpyInterface<PetscScalar>;
953   a->pivot     = new elem::DistMatrix<PetscInt,elem::VC,elem::STAR>;
954 
955   /* build cache for off array entries formed */
956   a->interface->Attach(elem::LOCAL_TO_GLOBAL,*(a->emat));
957 
958   ierr = PetscObjectComposeFunctionDynamic((PetscObject)A,"MatGetOwnershipIS_C","MatGetOwnershipIS_Elemental",MatGetOwnershipIS_Elemental);CHKERRQ(ierr);
959   ierr = PetscObjectComposeFunctionDynamic((PetscObject)A,"MatGetFactor_petsc_C","MatGetFactor_elemental_petsc",MatGetFactor_elemental_petsc);CHKERRQ(ierr);
960 
961   ierr = PetscObjectChangeTypeName((PetscObject)A,MATELEMENTAL);CHKERRQ(ierr);
962   PetscOptionsEnd();
963   PetscFunctionReturn(0);
964 }
965 EXTERN_C_END
966