Actual source code: dsc.c
1: /*$Id: dsc.c,v 1.7 2001/08/06 21:15:14 bsmith Exp $*/
2: /*
3: Provides an interface to the DSCPACK-S
4: */
6: #include src/mat/impls/aij/seq/aij.h
7: #if defined(PETSC_HAVE_DSCPACKS) && !defined(__cplusplus) && !defined(PETSC_USE_SINGLE)
8: EXTERN_C_BEGIN
9: #include "dscmain.h"
10: extern int Initialize_A_Nonz(int,int*,int*,real_number_type*,int,int*,int*,real_number_type**);
11: EXTERN_C_END
13: extern int MatDestroy_SeqAIJ(Mat);
15: /* golbal data for DSCPACK communcation between reordering and factorization */
16: int dsc_s_nz = 0; /* num of nonzeros in lower/upper half of the matrix */
17: int dsc_pass = 0; /* num of numeric factorizations for a single symbolic factorization */
19: int MatDestroy_SeqAIJ_DSC_Fac(Mat A)
20: {
24: MatDestroy_SeqAIJ(A);
25: DSC_Final_Free_All(); /* free Cholesky factor and other relevant data structures */
26: /* DSC_Do_Stats(); */
27: DSC_Clean_Up(); /* terminate DSC solver */
29: return(0);
30: }
32: int MatSolve_SeqAIJ_DSC(Mat A,Vec b,Vec x)
33: {
34: double *rhs_vec, *solution_vec;
35: int ierr;
36:
38: VecGetArray(x, &solution_vec);
39: VecGetArray(b, &rhs_vec);
40:
41: DSC_Input_Rhs(rhs_vec, A->m);
42: DSC_N_Solve();
43: if (DSC_STATUS.cont_or_stop == DSC_STOP_TYPE) goto ERROR_HANDLE;
45: DSC_Get_Solution(solution_vec);
46: if (DSC_STATUS.cont_or_stop == DSC_STOP_TYPE) goto ERROR_HANDLE;
47:
48: VecRestoreArray(x, &solution_vec);
49: VecRestoreArray(b, &rhs_vec);
51: ERROR_HANDLE:
52: if (DSC_STATUS.error_code != DSC_NO_ERROR) {
53: DSC_Error_Display();
54: SETERRQ(PETSC_ERR_ARG_SIZ, "DSC ERROR");
55: }
57: return(0);
58: }
60: int MatCholeskyFactorNumeric_SeqAIJ_DSC(Mat A, Mat *F)
61: {
62: Mat_SeqAIJ *a=(Mat_SeqAIJ*)A->data, *fac=(Mat_SeqAIJ*)(*F)->data;
63: IS iscol = fac->col,isicol = fac->icol;
64: PetscTruth flg;
65: int m,ierr;
66: int *ai = a->i, *aj = a->j;
67: int *perm, *iperm;
68: real_number_type *a_nonz = a->a, *s_a_nonz;
71: m = A->m;
72: if (dsc_pass == 0){ /* check the arguments */
73: if (m != A->n) SETERRQ(PETSC_ERR_ARG_SIZ, "matrix must be square");
74: PetscTypeCompare((PetscObject)A,MATSEQAIJ,&flg);
75: if (!flg) SETERRQ(PETSC_ERR_ARG_SIZ, "matrix must be Seq_AIJ");
76: if (m != (*F)->m) SETERRQ(PETSC_ERR_ARG_SIZ, "factorization struct inconsistent");
78: } else { /* frees up Cholesky factor used by previous numeric factorization */
79: DSC_N_Fact_Free();
80: DSC_Re_Init();
81: }
83: ISGetIndices(iscol,&perm);
84: ISGetIndices(isicol,&iperm);
85: Initialize_A_Nonz(m,ai,aj,a_nonz,dsc_s_nz,perm,iperm, &s_a_nonz);
86: if (ierr <0) SETERRQ(PETSC_ERR_ARG_SIZ, "Error setting up permuted nonzero vector");
87:
88: DSC_N_Fact(s_a_nonz);
90: free ((char *) s_a_nonz);
91: dsc_pass++;
92: return(0);
93: }
95: int MatCholeskyFactorSymbolic_SeqAIJ_DSC(Mat A,IS perm,PetscReal f,Mat *F)
96: {
97: /************************************************************************/
98: /* Input */
99: /* A - matrix to factor */
100: /* perm - row/col permutation (ignored) */
101: /* f - fill (ignored) */
102: /* */
103: /* Output */
104: /* F - matrix storing partial information for factorization */
105: /************************************************************************/
107: int ierr,m;
108: int max_mem_estimate, max_single_malloc_blk,MAX_MEM_ALLOWED=800;
109: PetscTruth flg;
110: IS iperm;
111: Mat_SeqAIJ *b;
112:
114: m = A->m;
115: if (m != A->n) SETERRQ(PETSC_ERR_ARG_SIZ, "matrix must be square");
116: PetscTypeCompare((PetscObject)A,MATSEQAIJ,&flg);
117: if (!flg) SETERRQ(PETSC_ERR_ARG_SIZ, "matrix must be Seq_AIJ");
119: /* Create the factorization */
120: MatCreateSeqAIJ(A->comm, m, m, 0, PETSC_NULL, F);
121:
122: (*F)->ops->destroy = MatDestroy_SeqAIJ_DSC_Fac;
123: (*F)->ops->choleskyfactornumeric = MatCholeskyFactorNumeric_SeqAIJ_DSC;
124: (*F)->ops->solve = MatSolve_SeqAIJ_DSC;
125: (*F)->factor = FACTOR_CHOLESKY;
127: b = (Mat_SeqAIJ*)(*F)->data;
128: ISInvertPermutation(perm,PETSC_DECIDE,&iperm);
129: (b)->col = perm;
130: (b)->icol = iperm;
132: /* Symbolic factorization */
133: DSC_S_Fact (&max_mem_estimate, &max_single_malloc_blk, MAX_MEM_ALLOWED);
134: if (DSC_STATUS.cont_or_stop == DSC_STOP_TYPE) goto ERROR_HANDLE;
136: ERROR_HANDLE:
137: if (DSC_STATUS.error_code != DSC_NO_ERROR) {
138: DSC_Error_Display();
139: SETERRQ(PETSC_ERR_ARG_SIZ, "DSC_ERROR");
140: }
142: return(0);
143: }
145: int MatSeqAIJUseDSC(Mat A)
146: {
147: int ierr;
148: PetscTruth flg;
149:
152: if (A->m != A->n) SETERRQ(PETSC_ERR_ARG_SIZ, "matrix must be square");
154: PetscTypeCompare((PetscObject)A,MATSEQAIJ,&flg);
155: if (!flg) SETERRQ(PETSC_ERR_ARG_SIZ, "matrix must be SeqAIJ");
156:
157: A->ops->choleskyfactorsymbolic = MatCholeskyFactorSymbolic_SeqAIJ_DSC;
158: PetscLogInfo(0,"Using DSC for SeqAIJ Cholesky factorization and solve.");
159: return(0);
160: }
162: #else
164: int MatSeqAIJUseDSC(Mat A)
165: {
168: PetscLogInfo(0,"DSCPACK not istalled. Not using DSC.");
169: return(0);
170: }
172: #endif