Actual source code: essl.c
petsc-3.9.4 2018-09-11
2: /*
3: Provides an interface to the IBM RS6000 Essl sparse solver
5: */
6: #include <../src/mat/impls/aij/seq/aij.h>
8: /* #include <essl.h> This doesn't work! */
10: PETSC_EXTERN void dgss(int*,int*,double*,int*,int*,int*,double*,double*,int*);
11: PETSC_EXTERN void dgsf(int*,int*,int*,double*,int*,int*,int*,int*,double*,double*,double*,int*);
13: typedef struct {
14: int n,nz;
15: PetscScalar *a;
16: int *ia;
17: int *ja;
18: int lna;
19: int iparm[5];
20: PetscReal rparm[5];
21: PetscReal oparm[5];
22: PetscScalar *aux;
23: int naux;
25: PetscBool CleanUpESSL;
26: } Mat_Essl;
28: PetscErrorCode MatDestroy_Essl(Mat A)
29: {
31: Mat_Essl *essl=(Mat_Essl*)A->data;
34: if (essl->CleanUpESSL) {
35: PetscFree4(essl->a,essl->aux,essl->ia,essl->ja);
36: }
37: PetscFree(A->data);
38: return(0);
39: }
41: PetscErrorCode MatSolve_Essl(Mat A,Vec b,Vec x)
42: {
43: Mat_Essl *essl = (Mat_Essl*)A->data;
44: PetscScalar *xx;
46: int nessl,zero = 0;
49: PetscBLASIntCast(A->cmap->n,&nessl);
50: VecCopy(b,x);
51: VecGetArray(x,&xx);
52: dgss(&zero,&nessl,essl->a,essl->ia,essl->ja,&essl->lna,xx,essl->aux,&essl->naux);
53: VecRestoreArray(x,&xx);
54: return(0);
55: }
57: PetscErrorCode MatLUFactorNumeric_Essl(Mat F,Mat A,const MatFactorInfo *info)
58: {
59: Mat_SeqAIJ *aa =(Mat_SeqAIJ*)(A)->data;
60: Mat_Essl *essl=(Mat_Essl*)(F)->data;
62: int nessl,i,one = 1;
65: PetscBLASIntCast(A->rmap->n,&nessl);
66: /* copy matrix data into silly ESSL data structure (1-based Frotran style) */
67: for (i=0; i<A->rmap->n+1; i++) essl->ia[i] = aa->i[i] + 1;
68: for (i=0; i<aa->nz; i++) essl->ja[i] = aa->j[i] + 1;
70: PetscMemcpy(essl->a,aa->a,(aa->nz)*sizeof(PetscScalar));
72: /* set Essl options */
73: essl->iparm[0] = 1;
74: essl->iparm[1] = 5;
75: essl->iparm[2] = 1;
76: essl->iparm[3] = 0;
77: essl->rparm[0] = 1.e-12;
78: essl->rparm[1] = 1.0;
80: PetscOptionsGetReal(NULL,((PetscObject)A)->prefix,"-matessl_lu_threshold",&essl->rparm[1],NULL);
82: dgsf(&one,&nessl,&essl->nz,essl->a,essl->ia,essl->ja,&essl->lna,essl->iparm,essl->rparm,essl->oparm,essl->aux,&essl->naux);
84: F->ops->solve = MatSolve_Essl;
85: (F)->assembled = PETSC_TRUE;
86: (F)->preallocated = PETSC_TRUE;
87: return(0);
88: }
93: PetscErrorCode MatLUFactorSymbolic_Essl(Mat B,Mat A,IS r,IS c,const MatFactorInfo *info)
94: {
95: Mat_SeqAIJ *a = (Mat_SeqAIJ*)A->data;
97: Mat_Essl *essl;
98: PetscReal f = 1.0;
101: essl = (Mat_Essl*)(B->data);
103: /* allocate the work arrays required by ESSL */
104: f = info->fill;
105: PetscBLASIntCast(a->nz,&essl->nz);
106: PetscBLASIntCast((PetscInt)(a->nz*f),&essl->lna);
107: PetscBLASIntCast(100 + 10*A->rmap->n,&essl->naux);
109: /* since malloc is slow on IBM we try a single malloc */
110: PetscMalloc4(essl->lna,&essl->a,essl->naux,&essl->aux,essl->lna,&essl->ia,essl->lna,&essl->ja);
112: essl->CleanUpESSL = PETSC_TRUE;
114: PetscLogObjectMemory((PetscObject)B,essl->lna*(2*sizeof(int)+sizeof(PetscScalar)) + essl->naux*sizeof(PetscScalar));
116: B->ops->lufactornumeric = MatLUFactorNumeric_Essl;
117: return(0);
118: }
120: PetscErrorCode MatFactorGetSolverType_essl(Mat A,MatSolverType *type)
121: {
123: *type = MATSOLVERESSL;
124: return(0);
125: }
127: /*MC
128: MATSOLVERESSL - "essl" - Provides direct solvers (LU) for sequential matrices
129: via the external package ESSL.
131: If ESSL is installed (see the manual for
132: instructions on how to declare the existence of external packages),
134: Works with MATSEQAIJ matrices
136: Level: beginner
138: .seealso: PCLU, PCFactorSetMatSolverType(), MatSolverType
139: M*/
141: PETSC_EXTERN PetscErrorCode MatGetFactor_seqaij_essl(Mat A,MatFactorType ftype,Mat *F)
142: {
143: Mat B;
145: Mat_Essl *essl;
148: if (A->cmap->N != A->rmap->N) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"matrix must be square");
149: MatCreate(PetscObjectComm((PetscObject)A),&B);
150: MatSetSizes(B,PETSC_DECIDE,PETSC_DECIDE,A->rmap->n,A->cmap->n);
151: PetscStrallocpy("essl",&((PetscObject)B)->type_name);
152: MatSetUp(B);
154: PetscNewLog(B,&essl);
156: B->data = essl;
157: B->ops->lufactorsymbolic = MatLUFactorSymbolic_Essl;
158: B->ops->destroy = MatDestroy_Essl;
159: B->ops->getinfo = MatGetInfo_External;
161: PetscObjectComposeFunction((PetscObject)B,"MatFactorGetSolverType_C",MatFactorGetSolverType_essl);
163: B->factortype = MAT_FACTOR_LU;
164: PetscFree(B->solvertype);
165: PetscStrallocpy(MATSOLVERESSL,&B->solvertype);
167: *F = B;
168: return(0);
169: }
171: PETSC_EXTERN PetscErrorCode MatSolverTypeRegister_Essl(void)
172: {
175: MatSolverTypeRegister(MATSOLVERESSL,MATSEQAIJ, MAT_FACTOR_LU,MatGetFactor_seqaij_essl);
176: return(0);
177: }