Actual source code: dscorder.c
1: /*$Id: dscorder.c,v 1.7 2001/08/06 21:16:17 bsmith Exp $*/
2: /*
3: Provides an interface to the DSCPACK-S ordering routines.
4: */
5: #include petscmat.h
6: #if defined(PETSC_HAVE_DSCPACKS) && !defined(__cplusplus) && !defined(PETSC_USE_SINGLE)
7: extern int dsc_s_nz; /* golbal communication mechanism for dscpack */
9: EXTERN_C_BEGIN
10: #include "dscmain.h"
12: #undef __FUNCT__
14: int MatOrdering_DSC(Mat mat,MatOrderingType type,IS *row,IS *col)
15: {
16: int ierr,order_code,m,*ai,*aj;
17: int s_nz, *perm, *iperm;
18: PetscTruth flg;
22: PetscStrcmp(type,MATORDERING_DSC_ND,&flg);
23: if (flg) {
24: order_code = 1;
25: } else {
26: PetscStrcmp(type,MATORDERING_DSC_MMD,&flg);
27: if (flg) {
28: order_code = 2;
29: } else {
30: PetscStrcmp(type,MATORDERING_DSC_MDF,&flg);
31: if (flg) {
32: order_code = 3;
33: } else {
34: printf(" default ordering: MATORDERING_DSC_ND is used n");
35: order_code = 1;
36: }
37: }
38: }
39:
40: MatGetRowIJ(mat,0,PETSC_TRUE,&m,&ai,&aj,&flg);
41: if (!flg) SETERRQ1(PETSC_ERR_SUP,"Cannot get rows for matrix type %s",((PetscObject)mat)->type_name);
43: /* check for multiple calls? something like PetscInitialize() ? **/
44: DSC_Open0();
46: DSC_Order(order_code, m, ai, aj, &s_nz, &perm, &iperm);
47: if (DSC_STATUS.cont_or_stop == DSC_STOP_TYPE) goto ERROR_HANDLE;
48: /* fix the error handling? */
50: ISCreateGeneral(PETSC_COMM_SELF,m,perm,row);
51: ISCreateGeneral(PETSC_COMM_SELF,m,perm,col);
52:
53: /* set some global structures in case they are required by DSC-ICC */
54: dsc_s_nz = s_nz;
56: ERROR_HANDLE:
57: if (DSC_STATUS.error_code != DSC_NO_ERROR) {
58: DSC_Error_Display();
59: SETERRQ(PETSC_ERR_ARG_SIZ, "DSC_ERROR");
60: }
62: MatRestoreRowIJ(mat,0,PETSC_TRUE,&m,&ai,&aj,&flg);
63: return(0);
64: }
66: EXTERN_C_END
68: #endif