Actual source code: essl.c
1: /*$Id: essl.c,v 1.49 2001/08/07 03:02:47 balay Exp $*/
3: /*
4: Provides an interface to the IBM RS6000 Essl sparse solver
6: */
7: #include src/mat/impls/aij/seq/aij.h
9: #if defined(PETSC_HAVE_ESSL) && !defined(__cplusplus)
10: /* #include <essl.h> This doesn't work! */
12: typedef struct {
13: int n,nz;
14: PetscScalar *a;
15: int *ia;
16: int *ja;
17: int lna;
18: int iparm[5];
19: PetscReal rparm[5];
20: PetscReal oparm[5];
21: PetscScalar *aux;
22: int naux;
23: } Mat_SeqAIJ_Essl;
26: EXTERN int MatDestroy_SeqAIJ(Mat);
28: int MatDestroy_SeqAIJ_Essl(Mat A)
29: {
30: Mat_SeqAIJ *a = (Mat_SeqAIJ*)A->data;
31: Mat_SeqAIJ_Essl *essl = (Mat_SeqAIJ_Essl*)a->spptr;
32: int ierr;
35: /* free the Essl datastructures */
36: PetscFree(essl->a);
37: MatDestroy_SeqAIJ(A);
38: return(0);
39: }
41: int MatSolve_SeqAIJ_Essl(Mat A,Vec b,Vec x)
42: {
43: Mat_SeqAIJ *a = (Mat_SeqAIJ*)A->data;
44: Mat_SeqAIJ_Essl *essl = (Mat_SeqAIJ_Essl*)a->spptr;
45: PetscScalar *xx;
46: int ierr,m,zero = 0;
49: VecGetLocalSize(b,&m);
50: VecCopy(b,x);
51: VecGetArray(x,&xx);
52: dgss(&zero,&A->n,essl->a,essl->ia,essl->ja,&essl->lna,xx,essl->aux,&essl->naux);
53: VecRestoreArray(x,&xx);
54: return(0);
55: }
57: int MatLUFactorNumeric_SeqAIJ_Essl(Mat A,Mat *F)
58: {
59: Mat_SeqAIJ *a = (Mat_SeqAIJ*)(*F)->data;
60: Mat_SeqAIJ *aa = (Mat_SeqAIJ*)(A)->data;
61: Mat_SeqAIJ_Essl *essl = (Mat_SeqAIJ_Essl*)a->spptr;
62: int i,ierr,one = 1;
65: /* copy matrix data into silly ESSL data structure */
66: if (!a->indexshift) {
67: for (i=0; i<A->m+1; i++) essl->ia[i] = aa->i[i] + 1;
68: for (i=0; i<aa->nz; i++) essl->ja[i] = aa->j[i] + 1;
69: } else {
70: PetscMemcpy(essl->ia,aa->i,(A->m+1)*sizeof(int));
71: PetscMemcpy(essl->ja,aa->j,(aa->nz)*sizeof(int));
72: }
73: PetscMemcpy(essl->a,aa->a,(aa->nz)*sizeof(PetscScalar));
74:
75: /* set Essl options */
76: essl->iparm[0] = 1;
77: essl->iparm[1] = 5;
78: essl->iparm[2] = 1;
79: essl->iparm[3] = 0;
80: essl->rparm[0] = 1.e-12;
81: essl->rparm[1] = A->lupivotthreshold;
83: dgsf(&one,&A->m,&essl->nz,essl->a,essl->ia,essl->ja,&essl->lna,essl->iparm,
84: essl->rparm,essl->oparm,essl->aux,&essl->naux);
86: return(0);
87: }
89: int MatLUFactorSymbolic_SeqAIJ_Essl(Mat A,IS r,IS c,MatLUInfo *info,Mat *F)
90: {
91: Mat B;
92: Mat_SeqAIJ *a = (Mat_SeqAIJ*)A->data,*b;
93: int ierr,*ridx,*cidx,i,len;
94: Mat_SeqAIJ_Essl *essl;
95: PetscReal f = 1.0;
98: if (A->N != A->M) SETERRQ(PETSC_ERR_ARG_SIZ,"matrix must be square");
99: ierr = MatCreateSeqAIJ(A->comm,A->m,A->n,0,PETSC_NULL,F);
100: B = *F;
101: B->ops->solve = MatSolve_SeqAIJ_Essl;
102: B->ops->destroy = MatDestroy_SeqAIJ_Essl;
103: B->ops->lufactornumeric = MatLUFactorNumeric_SeqAIJ_Essl;
104: B->factor = FACTOR_LU;
105: b = (Mat_SeqAIJ*)B->data;
106: ierr = PetscNew(Mat_SeqAIJ_Essl,&essl);
107: b->spptr = (void*)essl;
109: /* allocate the work arrays required by ESSL */
110: if (info) f = info->fill;
111: essl->nz = a->nz;
112: essl->lna = (int)a->nz*f;
113: essl->naux = 100 + 10*A->m;
115: /* since malloc is slow on IBM we try a single malloc */
116: len = essl->lna*(2*sizeof(int)+sizeof(PetscScalar)) + essl->naux*sizeof(PetscScalar);
117: ierr = PetscMalloc(len,&essl->a);
118: essl->aux = essl->a + essl->lna;
119: essl->ia = (int*)(essl->aux + essl->naux);
120: essl->ja = essl->ia + essl->lna;
122: PetscLogObjectMemory(B,len+sizeof(Mat_SeqAIJ_Essl));
123: return(0);
124: }
126: int MatUseEssl_SeqAIJ(Mat A)
127: {
129: A->ops->lufactorsymbolic = MatLUFactorSymbolic_SeqAIJ_Essl;
130: PetscLogInfo(0,"Using ESSL for SeqAIJ LU factorization and solves");
131: return(0);
132: }
134: #else
136: int MatUseEssl_SeqAIJ(Mat A)
137: {
139: return(0);
140: }
142: #endif