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