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