xref: /petsc/src/mat/impls/aij/seq/essl/essl.c (revision 7a4fe282d1b349e95b3be72d69d8dd3d3bcd7bc6)
1 #define PETSCMAT_DLL
2 
3 /*
4         Provides an interface to the IBM RS6000 Essl sparse solver
5 
6 */
7 #include "../src/mat/impls/aij/seq/aij.h"
8 
9 /* #include <essl.h> This doesn't work!  */
10 
11 EXTERN_C_BEGIN
12 void dgss(int*,int*,double*,int*,int*,int*,double*,double*,int*);
13 void dgsf(int*,int*,int*,double*,int*,int*,int*,int*,double*,double*,double*,int*);
14 EXTERN_C_END
15 
16 typedef struct {
17   int         n,nz;
18   PetscScalar *a;
19   int         *ia;
20   int         *ja;
21   int         lna;
22   int         iparm[5];
23   PetscReal   rparm[5];
24   PetscReal   oparm[5];
25   PetscScalar *aux;
26   int         naux;
27 
28   PetscTruth CleanUpESSL;
29 } Mat_Essl;
30 
31 #undef __FUNCT__
32 #define __FUNCT__ "MatDestroy_Essl"
33 PetscErrorCode MatDestroy_Essl(Mat A)
34 {
35   PetscErrorCode ierr;
36   Mat_Essl       *essl=(Mat_Essl*)A->spptr;
37 
38   PetscFunctionBegin;
39   if (essl->CleanUpESSL) {
40     ierr = PetscFree(essl->a);CHKERRQ(ierr);
41   }
42   ierr = PetscFree(essl);CHKERRQ(ierr);
43   ierr = MatDestroy_SeqAIJ(A);CHKERRQ(ierr);
44   PetscFunctionReturn(0);
45 }
46 
47 #undef __FUNCT__
48 #define __FUNCT__ "MatSolve_Essl"
49 PetscErrorCode MatSolve_Essl(Mat A,Vec b,Vec x)
50 {
51   Mat_Essl       *essl = (Mat_Essl*)A->spptr;
52   PetscScalar    *xx;
53   PetscErrorCode ierr;
54   int            m,zero = 0;
55 
56   PetscFunctionBegin;
57   ierr = VecGetLocalSize(b,&m);CHKERRQ(ierr);
58   ierr = VecCopy(b,x);CHKERRQ(ierr);
59   ierr = VecGetArray(x,&xx);CHKERRQ(ierr);
60   dgss(&zero,&A->cmap->n,essl->a,essl->ia,essl->ja,&essl->lna,xx,essl->aux,&essl->naux);
61   ierr = VecRestoreArray(x,&xx);CHKERRQ(ierr);
62   PetscFunctionReturn(0);
63 }
64 
65 #undef __FUNCT__
66 #define __FUNCT__ "MatLUFactorNumeric_Essl"
67 PetscErrorCode MatLUFactorNumeric_Essl(Mat F,Mat A,const MatFactorInfo *info)
68 {
69   Mat_SeqAIJ     *aa=(Mat_SeqAIJ*)(A)->data;
70   Mat_Essl       *essl=(Mat_Essl*)(F)->spptr;
71   PetscErrorCode ierr;
72   int            i,one = 1;
73 
74   PetscFunctionBegin;
75   /* copy matrix data into silly ESSL data structure (1-based Frotran style) */
76   for (i=0; i<A->rmap->n+1; i++) essl->ia[i] = aa->i[i] + 1;
77   for (i=0; i<aa->nz; i++) essl->ja[i]  = aa->j[i] + 1;
78 
79   ierr = PetscMemcpy(essl->a,aa->a,(aa->nz)*sizeof(PetscScalar));CHKERRQ(ierr);
80 
81   /* set Essl options */
82   essl->iparm[0] = 1;
83   essl->iparm[1] = 5;
84   essl->iparm[2] = 1;
85   essl->iparm[3] = 0;
86   essl->rparm[0] = 1.e-12;
87   essl->rparm[1] = 1.0;
88   ierr = PetscOptionsGetReal(((PetscObject)A)->prefix,"-matessl_lu_threshold",&essl->rparm[1],PETSC_NULL);CHKERRQ(ierr);
89 
90   dgsf(&one,&A->rmap->n,&essl->nz,essl->a,essl->ia,essl->ja,&essl->lna,essl->iparm,essl->rparm,essl->oparm,essl->aux,&essl->naux);
91 
92   F->ops->solve = MatSolve_Essl;
93   (F)->assembled = PETSC_TRUE;
94   (F)->preallocated = PETSC_TRUE;
95   PetscFunctionReturn(0);
96 }
97 
98 
99 
100 
101 #undef __FUNCT__
102 #define __FUNCT__ "MatLUFactorSymbolic_Essl"
103 PetscErrorCode MatLUFactorSymbolic_Essl(Mat B,Mat A,IS r,IS c,const MatFactorInfo *info)
104 {
105   Mat_SeqAIJ     *a = (Mat_SeqAIJ*)A->data;
106   PetscErrorCode ierr;
107   int            len;
108   Mat_Essl       *essl;
109   PetscReal      f = 1.0;
110 
111   PetscFunctionBegin;
112   essl = (Mat_Essl *)(B->spptr);
113 
114   /* allocate the work arrays required by ESSL */
115   f = info->fill;
116   essl->nz   = a->nz;
117   essl->lna  = (int)a->nz*f;
118   essl->naux = 100 + 10*A->rmap->n;
119 
120   /* since malloc is slow on IBM we try a single malloc */
121   len               = essl->lna*(2*sizeof(int)+sizeof(PetscScalar)) + essl->naux*sizeof(PetscScalar);
122   ierr              = PetscMalloc(len,&essl->a);CHKERRQ(ierr);
123   essl->aux         = essl->a + essl->lna;
124   essl->ia          = (int*)(essl->aux + essl->naux);
125   essl->ja          = essl->ia + essl->lna;
126   essl->CleanUpESSL = PETSC_TRUE;
127 
128   ierr = PetscLogObjectMemory(B,len);CHKERRQ(ierr);
129   B->ops->lufactornumeric  = MatLUFactorNumeric_Essl;
130   PetscFunctionReturn(0);
131 }
132 
133 EXTERN_C_BEGIN
134 #undef __FUNCT__
135 #define __FUNCT__ "MatFactorGetSolverPackage_essl"
136 PetscErrorCode MatFactorGetSolverPackage_essl(Mat A,const MatSolverPackage *type)
137 {
138   PetscFunctionBegin;
139   *type = MAT_SOLVER_ESSL;
140   PetscFunctionReturn(0);
141 }
142 EXTERN_C_END
143 
144 /*MC
145   MAT_SOLVER_ESSL - "essl" - Provides direct solvers (LU) for sequential matrices
146                               via the external package ESSL.
147 
148   If ESSL is installed (see the manual for
149   instructions on how to declare the existence of external packages),
150 
151   Works with MATSEQAIJ matrices
152 
153    Level: beginner
154 
155 .seealso: PCLU, PCFactorSetMatSolverPackage(), MatSolverPackage
156 M*/
157 
158 #undef __FUNCT__
159 #define __FUNCT__ "MatGetFactor_seqaij_essl"
160 PetscErrorCode MatGetFactor_seqaij_essl(Mat A,MatFactorType ftype,Mat *F)
161 {
162   Mat            B;
163   PetscErrorCode ierr;
164   Mat_Essl       *essl;
165 
166   PetscFunctionBegin;
167   if (A->cmap->N != A->rmap->N) SETERRQ(PETSC_ERR_ARG_SIZ,"matrix must be square");
168   ierr = MatCreate(((PetscObject)A)->comm,&B);CHKERRQ(ierr);
169   ierr = MatSetSizes(B,PETSC_DECIDE,PETSC_DECIDE,A->rmap->n,A->cmap->n);CHKERRQ(ierr);
170   ierr = MatSetType(B,((PetscObject)A)->type_name);CHKERRQ(ierr);
171   ierr = MatSeqAIJSetPreallocation(B,0,PETSC_NULL);CHKERRQ(ierr);
172 
173   ierr = PetscNewLog(B,Mat_Essl,&essl);CHKERRQ(ierr);
174   B->spptr                 = essl;
175   B->ops->lufactorsymbolic = MatLUFactorSymbolic_Essl;
176   ierr = PetscObjectComposeFunctionDynamic((PetscObject)B,"MatFactorGetSolverPackage_C","MatFactorGetSolverPackage_essl",MatFactorGetSolverPackage_essl);CHKERRQ(ierr);
177   B->factor                = MAT_FACTOR_LU;
178   *F                       = B;
179   PetscFunctionReturn(0);
180 }
181