Actual source code: plapack.c
1: #define PETSCMAT_DLL
3: /*
4: Provides an interface to the PLAPACKR32 dense solver
5: */
7: #include src/mat/impls/dense/seq/dense.h
8: #include src/mat/impls/dense/mpi/mpidense.h
11: #include "PLA.h"
12: #include "PLA_prototypes.h"
15: typedef struct {
16: MPI_Comm comm_2d;
17: PLA_Obj A,pivots;
18: PLA_Template templ;
19: MPI_Datatype datatype;
20: PetscInt nb,nb_alg,ierror,rstart;
21: VecScatter ctx;
22: IS is_pla,is_petsc;
23: PetscTruth pla_solved;
24: MatStructure mstruct;
25: PetscMPIInt nprows,npcols;
27: /* A few function pointers for inheritance */
28: PetscErrorCode (*MatDuplicate)(Mat,MatDuplicateOption,Mat*);
29: PetscErrorCode (*MatView)(Mat,PetscViewer);
30: PetscErrorCode (*MatAssemblyEnd)(Mat,MatAssemblyType);
31: PetscErrorCode (*MatLUFactorSymbolic)(Mat,IS,IS,MatFactorInfo*,Mat*);
32: PetscErrorCode (*MatCholeskyFactorSymbolic)(Mat,IS,MatFactorInfo*,Mat*);
33: PetscErrorCode (*MatDestroy)(Mat);
35: /* Flag to clean up (non-global) Plapack objects during Destroy */
36: PetscTruth CleanUpPlapack;
37: } Mat_Plapack;
39: EXTERN PetscErrorCode MatDuplicate_Plapack(Mat,MatDuplicateOption,Mat*);
44: PetscErrorCode MatConvert_Plapack_Dense(Mat A,MatType type,MatReuse reuse,Mat *newmat)
45: {
47: PetscErrorCode ierr;
48: Mat B=*newmat;
49: Mat_Plapack *lu=(Mat_Plapack *)A->spptr;
52: if (reuse == MAT_INITIAL_MATRIX) {
53: MatDuplicate(A,MAT_COPY_VALUES,&B);
54: }
55: /* Reset the original function pointers */
56: B->ops->duplicate = lu->MatDuplicate;
57: B->ops->view = lu->MatView;
58: B->ops->assemblyend = lu->MatAssemblyEnd;
59: B->ops->lufactorsymbolic = lu->MatLUFactorSymbolic;
60: B->ops->destroy = lu->MatDestroy;
61: PetscFree(lu);
62: A->spptr = PETSC_NULL;
64: PetscObjectComposeFunction((PetscObject)B,"MatConvert_seqdense_plapack_C","",PETSC_NULL);
65: PetscObjectComposeFunction((PetscObject)B,"MatConvert_plapack_seqdense_C","",PETSC_NULL);
66: PetscObjectComposeFunction((PetscObject)B,"MatConvert_mpidense_plapack_C","",PETSC_NULL);
67: PetscObjectComposeFunction((PetscObject)B,"MatConvert_plapack_mpidense_C","",PETSC_NULL);
69: PetscObjectChangeTypeName((PetscObject)B,type);
70: *newmat = B;
71: return(0);
72: }
77: PetscErrorCode MatDestroy_Plapack(Mat A)
78: {
80: PetscMPIInt size;
81: Mat_Plapack *lu=(Mat_Plapack*)A->spptr;
82:
84: if (lu->CleanUpPlapack) {
85: /* Deallocate Plapack storage */
86: PLA_Obj_free(&lu->A);
87: PLA_Obj_free (&lu->pivots);
88: PLA_Temp_free(&lu->templ);
89: PLA_Finalize();
91: ISDestroy(lu->is_pla);
92: ISDestroy(lu->is_petsc);
93: VecScatterDestroy(lu->ctx);
94: }
95: MPI_Comm_size(A->comm,&size);
96: if (size == 1) {
97: MatConvert_Plapack_Dense(A,MATSEQDENSE,MAT_REUSE_MATRIX,&A);
98: } else {
99: MatConvert_Plapack_Dense(A,MATMPIDENSE,MAT_REUSE_MATRIX,&A);
100: }
101: (*A->ops->destroy)(A);
102: return(0);
103: }
107: PetscErrorCode MatSolve_Plapack(Mat A,Vec b,Vec x)
108: {
109: MPI_Comm comm = A->comm;
110: Mat_Plapack *lu = (Mat_Plapack*)A->spptr;
112: PetscInt M=A->rmap.N,m=A->rmap.n,rstart,i,j,*idx_pla,*idx_petsc,loc_m,loc_stride;
113: PetscScalar *array;
114: PetscReal one = 1.0;
115: PetscMPIInt size,rank,r_rank,r_nproc,c_rank,c_nproc;;
116: PLA_Obj v_pla = NULL;
117: PetscScalar *loc_buf;
118: Vec loc_x;
119:
121: MPI_Comm_size(comm,&size);
122: MPI_Comm_rank(comm,&rank);
124: /* Create PLAPACK vector objects, then copy b into PLAPACK b */
125: PLA_Mvector_create(lu->datatype,M,1,lu->templ,PLA_ALIGN_FIRST,&v_pla);
126: PLA_Obj_set_to_zero(v_pla);
128: /* Copy b into rhs_pla */
129: PLA_API_begin();
130: PLA_Obj_API_open(v_pla);
131: VecGetArray(b,&array);
132: PLA_API_axpy_vector_to_global(m,&one,(void *)array,1,v_pla,lu->rstart);
133: VecRestoreArray(b,&array);
134: PLA_Obj_API_close(v_pla);
135: PLA_API_end();
137: if (A->factor == FACTOR_LU){
138: /* Apply the permutations to the right hand sides */
139: PLA_Apply_pivots_to_rows (v_pla,lu->pivots);
141: /* Solve L y = b, overwriting b with y */
142: PLA_Trsv( PLA_LOWER_TRIANGULAR,PLA_NO_TRANSPOSE,PLA_UNIT_DIAG,lu->A,v_pla );
144: /* Solve U x = y (=b), overwriting b with x */
145: PLA_Trsv( PLA_UPPER_TRIANGULAR,PLA_NO_TRANSPOSE,PLA_NONUNIT_DIAG,lu->A,v_pla );
146: } else { /* FACTOR_CHOLESKY */
147: PLA_Trsv( PLA_LOWER_TRIANGULAR,PLA_NO_TRANSPOSE,PLA_NONUNIT_DIAG,lu->A,v_pla);
148: PLA_Trsv( PLA_LOWER_TRIANGULAR,(lu->datatype == MPI_DOUBLE ? PLA_TRANSPOSE : PLA_CONJUGATE_TRANSPOSE),
149: PLA_NONUNIT_DIAG,lu->A,v_pla);
150: }
152: /* Copy PLAPACK x into Petsc vector x */
153: PLA_Obj_local_length(v_pla, &loc_m);
154: PLA_Obj_local_buffer(v_pla, (void**)&loc_buf);
155: PLA_Obj_local_stride(v_pla, &loc_stride);
156: /*
157: PetscPrintf(PETSC_COMM_SELF," [%d] b - local_m %d local_stride %d, loc_buf: %g %g, nb: %d\n",rank,loc_m,loc_stride,loc_buf[0],loc_buf[(loc_m-1)*loc_stride],lu->nb);
158: */
159: VecCreateSeqWithArray(PETSC_COMM_SELF,loc_m*loc_stride,loc_buf,&loc_x);
160: if (!lu->pla_solved){
161:
162: PLA_Temp_comm_row_info(lu->templ,&lu->comm_2d,&r_rank,&r_nproc);
163: PLA_Temp_comm_col_info(lu->templ,&lu->comm_2d,&c_rank,&c_nproc);
164: /* printf(" [%d] rank: %d %d, nproc: %d %d\n",rank,r_rank,c_rank,r_nproc,c_nproc); */
166: /* Create IS and cts for VecScatterring */
167: PLA_Obj_local_length(v_pla, &loc_m);
168: PLA_Obj_local_stride(v_pla, &loc_stride);
169: PetscMalloc((2*loc_m+1)*sizeof(PetscInt),&idx_pla);
170: idx_petsc = idx_pla + loc_m;
172: rstart = (r_rank*c_nproc+c_rank)*lu->nb;
173: for (i=0; i<loc_m; i+=lu->nb){
174: j = 0;
175: while (j < lu->nb && i+j < loc_m){
176: idx_petsc[i+j] = rstart + j; j++;
177: }
178: rstart += size*lu->nb;
179: }
181: for (i=0; i<loc_m; i++) idx_pla[i] = i*loc_stride;
183: ISCreateGeneral(PETSC_COMM_SELF,loc_m,idx_pla,&lu->is_pla);
184: ISCreateGeneral(PETSC_COMM_SELF,loc_m,idx_petsc,&lu->is_petsc);
185: PetscFree(idx_pla);
186: VecScatterCreate(loc_x,lu->is_pla,x,lu->is_petsc,&lu->ctx);
187: }
188: VecScatterBegin(lu->ctx,loc_x,x,INSERT_VALUES,SCATTER_FORWARD);
189: VecScatterEnd(lu->ctx,loc_x,x,INSERT_VALUES,SCATTER_FORWARD);
190:
191: /* Free data */
192: VecDestroy(loc_x);
193: PLA_Obj_free(&v_pla);
195: lu->pla_solved = PETSC_TRUE;
196: return(0);
197: }
201: PetscErrorCode MatLUFactorNumeric_Plapack(Mat A,MatFactorInfo *info,Mat *F)
202: {
203: Mat_Plapack *lu = (Mat_Plapack*)(*F)->spptr;
205: PetscInt M=A->rmap.N,m=A->rmap.n,rstart,rend;
206: PetscInt info_pla=0;
207: PetscScalar *array,one = 1.0;
210: if (lu->mstruct == SAME_NONZERO_PATTERN){
211: PLA_Obj_free(&lu->A);
212: PLA_Obj_free (&lu->pivots);
213: }
214: /* Create PLAPACK matrix object */
215: lu->A = NULL; lu->pivots = NULL;
216: PLA_Matrix_create(lu->datatype,M,M,lu->templ,PLA_ALIGN_FIRST,PLA_ALIGN_FIRST,&lu->A);
217: PLA_Obj_set_to_zero(lu->A);
218: PLA_Mvector_create(MPI_INT,M,1,lu->templ,PLA_ALIGN_FIRST,&lu->pivots);
220: /* Copy A into lu->A */
221: PLA_API_begin();
222: PLA_Obj_API_open(lu->A);
223: MatGetOwnershipRange(A,&rstart,&rend);
224: MatGetArray(A,&array);
225: PLA_API_axpy_matrix_to_global(m,M, &one,(void *)array,m,lu->A,rstart,0);
226: MatRestoreArray(A,&array);
227: PLA_Obj_API_close(lu->A);
228: PLA_API_end();
230: /* Factor P A -> L U overwriting lower triangular portion of A with L, upper, U */
231: info_pla = PLA_LU(lu->A,lu->pivots);
232: if (info_pla != 0)
233: SETERRQ1(PETSC_ERR_MAT_LU_ZRPVT,"Zero pivot encountered at row %d from PLA_LU()",info_pla);
235: lu->CleanUpPlapack = PETSC_TRUE;
236: lu->rstart = rstart;
237: lu->mstruct = SAME_NONZERO_PATTERN;
238:
239: (*F)->assembled = PETSC_TRUE; /* required by -ksp_view */
240: return(0);
241: }
245: PetscErrorCode MatCholeskyFactorNumeric_Plapack(Mat A,MatFactorInfo *info,Mat *F)
246: {
247: Mat_Plapack *lu = (Mat_Plapack*)(*F)->spptr;
249: PetscInt M=A->rmap.N,m=A->rmap.n,rstart,rend;
250: PetscInt info_pla=0;
251: PetscScalar *array,one = 1.0;
254: if (lu->mstruct == SAME_NONZERO_PATTERN){
255: PLA_Obj_free(&lu->A);
256: }
257: /* Create PLAPACK matrix object */
258: lu->A = NULL;
259: lu->pivots = NULL;
260: PLA_Matrix_create(lu->datatype,M,M,lu->templ,PLA_ALIGN_FIRST,PLA_ALIGN_FIRST,&lu->A);
262: /* Copy A into lu->A */
263: PLA_API_begin();
264: PLA_Obj_API_open(lu->A);
265: MatGetOwnershipRange(A,&rstart,&rend);
266: MatGetArray(A,&array);
267: PLA_API_axpy_matrix_to_global(m,M, &one,(void *)array,m,lu->A,rstart,0);
268: MatRestoreArray(A,&array);
269: PLA_Obj_API_close(lu->A);
270: PLA_API_end();
272: /* Factor P A -> Chol */
273: info_pla = PLA_Chol(PLA_LOWER_TRIANGULAR,lu->A);
274: if (info_pla != 0)
275: SETERRQ1( PETSC_ERR_MAT_CH_ZRPVT,"Nonpositive definite matrix detected at row %d from PLA_Chol()",info_pla);
277: lu->CleanUpPlapack = PETSC_TRUE;
278: lu->rstart = rstart;
279: lu->mstruct = SAME_NONZERO_PATTERN;
280:
281: (*F)->assembled = PETSC_TRUE; /* required by -ksp_view */
282: return(0);
283: }
287: PetscErrorCode MatFactorSymbolic_Plapack_Private(Mat A,MatFactorInfo *info,Mat *F)
288: {
289: Mat B;
290: Mat_Plapack *lu;
292: PetscInt M=A->rmap.N,N=A->cmap.N;
293: MPI_Comm comm=A->comm,comm_2d;
294: PetscMPIInt size;
295: PetscInt ierror;
298: /* Create the factorization matrix */
299: MatCreate(A->comm,&B);
300: MatSetSizes(B,A->rmap.n,A->cmap.n,M,N);
301: MatSetType(B,A->type_name);
303: B->ops->solve = MatSolve_Plapack;
304: lu = (Mat_Plapack*)(B->spptr);
306: /* Set default Plapack parameters */
307: MPI_Comm_size(comm,&size);
308: lu->nprows = 1; lu->npcols = size;
309: ierror = 0;
310: lu->nb = M/size;
311: if (M - lu->nb*size) lu->nb++; /* without cyclic distribution */
312:
313: /* Set runtime options */
314: PetscOptionsBegin(A->comm,A->prefix,"PLAPACK Options","Mat");
315: PetscOptionsInt("-mat_plapack_nprows","row dimension of 2D processor mesh","None",lu->nprows,&lu->nprows,PETSC_NULL);
316: PetscOptionsInt("-mat_plapack_npcols","column dimension of 2D processor mesh","None",lu->npcols,&lu->npcols,PETSC_NULL);
317:
318: PetscOptionsInt("-mat_plapack_nb","block size of template vector","None",lu->nb,&lu->nb,PETSC_NULL);
319: PetscOptionsInt("-mat_plapack_ckerror","error checking flag","None",ierror,&ierror,PETSC_NULL);
320: if (ierror){
321: PLA_Set_error_checking(ierror,PETSC_TRUE,PETSC_TRUE,PETSC_FALSE );
322: } else {
323: PLA_Set_error_checking(ierror,PETSC_FALSE,PETSC_FALSE,PETSC_FALSE );
324: }
325: lu->ierror = ierror;
326:
327: lu->nb_alg = 0;
328: PetscOptionsInt("-mat_plapack_nb_alg","algorithmic block size","None",lu->nb_alg,&lu->nb_alg,PETSC_NULL);
329: if (lu->nb_alg){
330: pla_Environ_set_nb_alg (PLA_OP_ALL_ALG,lu->nb_alg);
331: }
332: PetscOptionsEnd();
335: /* Create a 2D communicator */
336: PLA_Comm_1D_to_2D(comm,lu->nprows,lu->npcols,&comm_2d);
337: lu->comm_2d = comm_2d;
339: /* Initialize PLAPACK */
340: PLA_Init(comm_2d);
342: /* Create object distribution template */
343: lu->templ = NULL;
344: PLA_Temp_create(lu->nb, 0, &lu->templ);
346: /* Use suggested nb_alg if it is not provided by user */
347: if (lu->nb_alg == 0){
348: PLA_Environ_nb_alg(PLA_OP_PAN_PAN,lu->templ,&lu->nb_alg);
349: pla_Environ_set_nb_alg(PLA_OP_ALL_ALG,lu->nb_alg);
350: }
352: /* Set the datatype */
353: #if defined(PETSC_USE_COMPLEX)
354: lu->datatype = MPI_DOUBLE_COMPLEX;
355: #else
356: lu->datatype = MPI_DOUBLE;
357: #endif
359: lu->pla_solved = PETSC_FALSE; /* MatSolve_Plapack() is called yet */
360: lu->mstruct = DIFFERENT_NONZERO_PATTERN;
361: lu->CleanUpPlapack = PETSC_TRUE;
362: *F = B;
363: return(0);
364: }
366: /* Note the Petsc r and c permutations are ignored */
369: PetscErrorCode MatLUFactorSymbolic_Plapack(Mat A,IS r,IS c,MatFactorInfo *info,Mat *F)
370: {
374: MatFactorSymbolic_Plapack_Private(A,info,F);
375: (*F)->ops->lufactornumeric = MatLUFactorNumeric_Plapack;
376: (*F)->factor = FACTOR_LU;
377: return(0);
378: }
380: /* Note the Petsc perm permutation is ignored */
383: PetscErrorCode MatCholeskyFactorSymbolic_Plapack(Mat A,IS perm,MatFactorInfo *info,Mat *F)
384: {
386: PetscTruth issymmetric,set;
389: MatIsSymmetricKnown(A,&set,&issymmetric);
390: if (!set || !issymmetric) SETERRQ(PETSC_ERR_USER,"Matrix must be set as MAT_SYMMETRIC for CholeskyFactor()");
391: MatFactorSymbolic_Plapack_Private(A,info,F);
392: (*F)->ops->choleskyfactornumeric = MatCholeskyFactorNumeric_Plapack;
393: (*F)->factor = FACTOR_CHOLESKY;
394: return(0);
395: }
399: PetscErrorCode MatAssemblyEnd_Plapack(Mat A,MatAssemblyType mode)
400: {
401: PetscErrorCode ierr;
402: Mat_Plapack *lu=(Mat_Plapack*)(A->spptr);
405: (*lu->MatAssemblyEnd)(A,mode);
406: lu->MatLUFactorSymbolic = A->ops->lufactorsymbolic;
407: A->ops->lufactorsymbolic = MatLUFactorSymbolic_Plapack;
408: lu->MatCholeskyFactorSymbolic = A->ops->choleskyfactorsymbolic;
409: A->ops->choleskyfactorsymbolic = MatCholeskyFactorSymbolic_Plapack;
410: return(0);
411: }
415: PetscErrorCode MatFactorInfo_Plapack(Mat A,PetscViewer viewer)
416: {
417: Mat_Plapack *lu=(Mat_Plapack*)A->spptr;
418: PetscErrorCode ierr;
421: /* check if matrix is plapack type */
422: if (A->ops->solve != MatSolve_Plapack) return(0);
424: PetscViewerASCIIPrintf(viewer,"PLAPACK run parameters:\n");
425: PetscViewerASCIIPrintf(viewer," Processor mesh: nprows %d, npcols %d\n",lu->nprows, lu->npcols);
426: PetscViewerASCIIPrintf(viewer," Distr. block size nb: %d \n",lu->nb);
427: PetscViewerASCIIPrintf(viewer," Error checking: %d\n",lu->ierror);
428: PetscViewerASCIIPrintf(viewer," Algorithmic block size: %d\n",lu->nb_alg);
429: return(0);
430: }
434: PetscErrorCode MatView_Plapack(Mat A,PetscViewer viewer)
435: {
436: PetscErrorCode ierr;
437: PetscTruth iascii;
438: PetscViewerFormat format;
439: /* Mat_Plapack *lu=(Mat_Plapack*)(A->spptr); */
442: /* (*lu->MatView)(A,viewer); MatView_MPIDense() crash! */
443: PetscTypeCompare((PetscObject)viewer,PETSC_VIEWER_ASCII,&iascii);
444: if (iascii) {
445: PetscViewerGetFormat(viewer,&format);
446: if (format == PETSC_VIEWER_ASCII_INFO) {
447: MatFactorInfo_Plapack(A,viewer);
448: }
449: }
450: return(0);
451: }
456: PetscErrorCode MatConvert_Dense_Plapack(Mat A,MatType type,MatReuse reuse,Mat *newmat)
457: {
458: /* This routine is only called to convert to MATPLAPACK from MATDENSE, so we ignore 'MatType type'. */
460: PetscMPIInt size;
461: Mat B=*newmat;
462: Mat_Plapack *lu;
465: if (reuse == MAT_INITIAL_MATRIX) {
466: MatDuplicate(A,MAT_COPY_VALUES,&B);
467: }
469: PetscNew(Mat_Plapack,&lu);
470: lu->MatDuplicate = A->ops->duplicate;
471: lu->MatView = A->ops->view;
472: lu->MatAssemblyEnd = A->ops->assemblyend;
473: lu->MatLUFactorSymbolic = A->ops->lufactorsymbolic;
474: lu->MatDestroy = A->ops->destroy;
475: lu->CleanUpPlapack = PETSC_FALSE;
477: B->spptr = (void*)lu;
478: B->ops->duplicate = MatDuplicate_Plapack;
479: B->ops->view = MatView_Plapack;
480: B->ops->assemblyend = MatAssemblyEnd_Plapack;
481: B->ops->lufactorsymbolic = MatLUFactorSymbolic_Plapack;
482: B->ops->choleskyfactorsymbolic = MatCholeskyFactorSymbolic_Plapack;
483: B->ops->destroy = MatDestroy_Plapack;
484:
485: MPI_Comm_size(A->comm,&size);
486: if (size == 1) {
487: PetscObjectComposeFunctionDynamic((PetscObject)B,"MatConvert_seqdense_plapack_C",
488: "MatConvert_Dense_Plapack",MatConvert_Dense_Plapack);
489: PetscObjectComposeFunctionDynamic((PetscObject)B,"MatConvert_plapack_seqdense_C",
490: "MatConvert_Plapack_Dense",MatConvert_Plapack_Dense);
491: } else {
492: PetscObjectComposeFunctionDynamic((PetscObject)B,"MatConvert_mpidense_plapack_C",
493: "MatConvert_Dense_Plapack",MatConvert_Dense_Plapack);
494: PetscObjectComposeFunctionDynamic((PetscObject)B,"MatConvert_plapack_mpidense_C",
495: "MatConvert_Plapack_Dense",MatConvert_Plapack_Dense);
496: }
497: PetscInfo(0,"Using Plapack for dense LU factorization and solves.\n");
498: PetscObjectChangeTypeName((PetscObject)B,MATPLAPACK);
499: *newmat = B;
500: return(0);
501: }
506: PetscErrorCode MatDuplicate_Plapack(Mat A, MatDuplicateOption op, Mat *M)
507: {
509: Mat_Plapack *lu=(Mat_Plapack *)A->spptr;
512: (*lu->MatDuplicate)(A,op,M);
513: PetscMemcpy((*M)->spptr,lu,sizeof(Mat_Plapack));
514: return(0);
515: }
517: /*MC
518: MATPLAPACK - MATPLAPACK = "plapack" - A matrix type providing direct solvers (LU, Cholesky, and QR)
519: for parallel dense matrices via the external package PLAPACK.
521: If PLAPACK is installed (see the manual for
522: instructions on how to declare the existence of external packages),
523: a matrix type can be constructed which invokes PLAPACK solvers.
524: After calling MatCreate(...,A), simply call MatSetType(A,MATPLAPACK).
526: This matrix inherits from MATSEQDENSE when constructed with a single process communicator,
527: and from MATMPIDENSE otherwise. One can also call MatConvert for an inplace
528: conversion to or from the MATSEQDENSE or MATMPIDENSE type (depending on the communicator size)
529: without data copy.
531: Options Database Keys:
532: + -mat_type plapack - sets the matrix type to "plapack" during a call to MatSetFromOptions()
533: . -mat_plapack_nprows <n> - number of rows in processor partition
534: . -mat_plapack_npcols <n> - number of columns in processor partition
535: . -mat_plapack_nb <n> - block size of template vector
536: . -mat_plapack_nb_alg <n> - algorithmic block size
537: - -mat_plapack_ckerror <n> - error checking flag
539: Level: beginner
541: .seealso: MATDENSE, PCLU, PCCHOLESKY
542: M*/
547: PetscErrorCode MatCreate_Plapack(Mat A)
548: {
550: PetscMPIInt size;
553: MPI_Comm_size(A->comm,&size);
554: if (size == 1) {
555: MatSetType(A,MATSEQDENSE);
556: } else {
557: MatSetType(A,MATMPIDENSE);
558: }
559: MatConvert_Dense_Plapack(A,MATPLAPACK,MAT_REUSE_MATRIX,&A);
560: return(0);
561: }