xref: /petsc/src/mat/impls/elemental/matelem.cxx (revision fc54b460d10ee9db1e3515ebc8f079b9f0f05f9b)
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   elem::Scal(a,*x->emat);
237   PetscFunctionReturn(0);
238 }
239 
240 #undef __FUNCT__
241 #define __FUNCT__ "MatAXPY_Elemental"
242 static PetscErrorCode MatAXPY_Elemental(Mat Y,PetscScalar a,Mat X,MatStructure str)
243 {
244   Mat_Elemental  *x = (Mat_Elemental*)X->data;
245   Mat_Elemental  *y = (Mat_Elemental*)Y->data;
246 
247   PetscFunctionBegin;
248   elem::Axpy(a,*x->emat,*y->emat);
249   PetscFunctionReturn(0);
250 }
251 
252 #undef __FUNCT__
253 #define __FUNCT__ "MatCopy_Elemental"
254 static PetscErrorCode MatCopy_Elemental(Mat A,Mat B,MatStructure str)
255 {
256   Mat_Elemental *a=(Mat_Elemental*)A->data;
257   Mat_Elemental *b=(Mat_Elemental*)B->data;
258 
259   PetscFunctionBegin;
260   elem::Copy(*a->emat,*b->emat);
261   PetscFunctionReturn(0);
262 }
263 
264 #undef __FUNCT__
265 #define __FUNCT__ "MatTranspose_Elemental"
266 static PetscErrorCode MatTranspose_Elemental(Mat A,MatReuse reuse,Mat *B)
267 {
268   Mat            Be;
269   PetscErrorCode ierr;
270   MPI_Comm       comm=((PetscObject)A)->comm;
271 
272   PetscFunctionBegin;
273   if (reuse == MAT_INITIAL_MATRIX){
274     ierr = MatCreate(comm,&Be);CHKERRQ(ierr);
275     ierr = MatSetSizes(Be,A->cmap->n,A->rmap->n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
276     ierr = MatSetType(Be,MATELEMENTAL);CHKERRQ(ierr);
277     ierr = MatSetUp(Be);CHKERRQ(ierr);
278     *B = Be;
279   }
280   Mat_Elemental     *a = (Mat_Elemental*)A->data;
281   Mat_Elemental     *b = (Mat_Elemental*)Be->data;
282   elem::Transpose(*a->emat,*b->emat);
283   Be->assembled = PETSC_TRUE;
284   PetscFunctionReturn(0);
285 }
286 
287 #undef __FUNCT__
288 #define __FUNCT__ "MatSolve_Elemental"
289 static PetscErrorCode MatSolve_Elemental(Mat A,Vec B,Vec X)
290 {
291   Mat_Elemental     *a = (Mat_Elemental*)A->data;
292   PetscErrorCode    ierr;
293   PetscScalar       *x;
294 
295   PetscFunctionBegin;
296   ierr = VecCopy(B,X);CHKERRQ(ierr);
297   ierr = VecGetArray(X,&x);CHKERRQ(ierr);
298   elem::DistMatrix<PetscScalar,elem::VC,elem::STAR> xe(A->rmap->N,1,0,x,A->rmap->n,*a->grid);
299   elem::DistMatrix<PetscScalar,elem::MC,elem::MR> xer = xe;
300   switch (A->factortype) {
301   case MAT_FACTOR_LU:
302     if ((*a->pivot).AllocatedMemory()) {
303       elem::SolveAfterLU(elem::NORMAL,*a->emat,*a->pivot,xer);
304       elem::Copy(xer,xe);
305     } else {
306       elem::SolveAfterLU(elem::NORMAL,*a->emat,xer);
307       elem::Copy(xer,xe);
308     }
309     break;
310   case MAT_FACTOR_CHOLESKY:
311     elem::SolveAfterCholesky(elem::UPPER,elem::NORMAL,*a->emat,xer);
312     elem::Copy(xer,xe);
313     break;
314   default:
315     printf("Error: Unfactored Matrix or Unsupported MatFactorType!\n");
316     break;
317   }
318   ierr = VecRestoreArray(X,&x);CHKERRQ(ierr);
319   PetscFunctionReturn(0);
320 }
321 
322 #undef __FUNCT__
323 #define __FUNCT__ "MatMatSolve_Elemental"
324 static PetscErrorCode MatMatSolve_Elemental(Mat A,Mat B,Mat X)
325 {
326   Mat_Elemental *a=(Mat_Elemental*)A->data;
327   Mat_Elemental *b=(Mat_Elemental*)B->data;
328   Mat_Elemental *x=(Mat_Elemental*)X->data;
329 
330   PetscFunctionBegin;
331   elem::Copy(*b->emat,*x->emat);
332   switch (A->factortype) {
333   case MAT_FACTOR_LU:
334     if ((*a->pivot).AllocatedMemory()) {
335       elem::SolveAfterLU(elem::NORMAL,*a->emat,*a->pivot,*x->emat);
336     } else {
337       elem::SolveAfterLU(elem::NORMAL,*a->emat,*x->emat);
338     }
339     break;
340   case MAT_FACTOR_CHOLESKY:
341     elem::SolveAfterCholesky(elem::UPPER,elem::NORMAL,*a->emat,*x->emat);
342     break;
343   default:
344     printf("Error: Unfactored Matrix or Unsupported MatFactorType!\n");
345     break;
346   }
347   PetscFunctionReturn(0);
348 }
349 
350 #undef __FUNCT__
351 #define __FUNCT__ "MatLUFactor_Elemental"
352 static PetscErrorCode MatLUFactor_Elemental(Mat A,IS row,IS col,const MatFactorInfo *info)
353 {
354   Mat_Elemental  *a = (Mat_Elemental*)A->data;
355 
356   PetscFunctionBegin;
357   if (info->dtcol){
358     elem::LU(*a->emat,*a->pivot);
359   } else {
360     elem::LU(*a->emat);
361   }
362   A->factortype = MAT_FACTOR_LU;
363   PetscFunctionReturn(0);
364 }
365 
366 #undef __FUNCT__
367 #define __FUNCT__ "MatLUFactorNumeric_Elemental"
368 static PetscErrorCode  MatLUFactorNumeric_Elemental(Mat F,Mat A,const MatFactorInfo *info)
369 {
370   PetscErrorCode ierr;
371 
372   PetscFunctionBegin;
373   ierr = MatCopy(A,F,SAME_NONZERO_PATTERN);CHKERRQ(ierr);
374   ierr = MatLUFactor_Elemental(F,0,0,info);CHKERRQ(ierr);
375   PetscFunctionReturn(0);
376 }
377 
378 #undef __FUNCT__
379 #define __FUNCT__ "MatLUFactorSymbolic_Elemental"
380 static PetscErrorCode  MatLUFactorSymbolic_Elemental(Mat F,Mat A,IS r,IS c,const MatFactorInfo *info)
381 {
382   PetscFunctionBegin;
383   /* F is create and allocated by MatGetFactor_elemental_petsc(), skip this routine. */
384   PetscFunctionReturn(0);
385 }
386 
387 #undef __FUNCT__
388 #define __FUNCT__ "MatCholeskyFactor_Elemental"
389 static PetscErrorCode MatCholeskyFactor_Elemental(Mat A,IS perm,const MatFactorInfo *info)
390 {
391   Mat_Elemental  *a = (Mat_Elemental*)A->data;
392 
393   PetscFunctionBegin;
394   printf("MatCholeskyFactor_Elemental is called...\n");
395   if (info->dtcol){
396     /* A = U^T * U for SPD Matrix A */
397     printf("Cholesky Factorization for SPD Matrices...\n");
398     elem::Cholesky(elem::UPPER,*a->emat);
399   } else {
400     /* A = U^T * D * U * for Symmetric Matrix A */
401     printf("LDL^H Factorization for Symmetric Matrices\n");
402     //elem::LU(*a->emat);
403   }
404   A->factortype = MAT_FACTOR_CHOLESKY;
405   PetscFunctionReturn(0);
406 }
407 
408 EXTERN_C_BEGIN
409 #undef __FUNCT__
410 #define __FUNCT__ "MatGetFactor_elemental_petsc"
411 static PetscErrorCode MatGetFactor_elemental_petsc(Mat A,MatFactorType ftype,Mat *F)
412 {
413   Mat            B;
414   PetscErrorCode ierr;
415 
416   PetscFunctionBegin;
417   /* Create the factorization matrix */
418   ierr = MatCreate(((PetscObject)A)->comm,&B);CHKERRQ(ierr);
419   ierr = MatSetSizes(B,A->rmap->n,A->cmap->n,PETSC_DECIDE,PETSC_DECIDE);CHKERRQ(ierr);
420   ierr = MatSetType(B,MATELEMENTAL);CHKERRQ(ierr);
421   ierr = MatSetUp(B);CHKERRQ(ierr);
422   B->factortype = ftype;
423   *F            = B;
424   PetscFunctionReturn(0);
425 }
426 EXTERN_C_END
427 
428 #undef __FUNCT__
429 #define __FUNCT__ "MatNorm_Elemental"
430 static PetscErrorCode MatNorm_Elemental(Mat A,NormType type,PetscReal *nrm)
431 {
432   Mat_Elemental *a=(Mat_Elemental*)A->data;
433 
434   PetscFunctionBegin;
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