Actual source code: essl.c
petsc-3.10.5 2019-03-28
Report Typos and Errors

      2: /*
      3:         Provides an interface to the IBM RS6000 Essl sparse solver

      5: */
      6:  #include <../src/mat/impls/aij/seq/aij.h>

      8: /* #include <essl.h> This doesn't work!  */

     10: PETSC_EXTERN void dgss(int*,int*,double*,int*,int*,int*,double*,double*,int*);
     11: PETSC_EXTERN void dgsf(int*,int*,int*,double*,int*,int*,int*,int*,double*,double*,double*,int*);

     13: typedef struct {
     14:   int         n,nz;
     15:   PetscScalar *a;
     16:   int         *ia;
     17:   int         *ja;
     18:   int         lna;
     19:   int         iparm[5];
     20:   PetscReal   rparm[5];
     21:   PetscReal   oparm[5];
     22:   PetscScalar *aux;
     23:   int         naux;

     25:   PetscBool   CleanUpESSL;
     26: } Mat_Essl;

     28: PetscErrorCode MatDestroy_Essl(Mat A)
     29: {
     31:   Mat_Essl       *essl=(Mat_Essl*)A->data;

     34:   if (essl->CleanUpESSL) {
     35:     PetscFree4(essl->a,essl->aux,essl->ia,essl->ja);
     36:   }
     37:   PetscFree(A->data);
     38:   return(0);
     39: }

     41: PetscErrorCode MatSolve_Essl(Mat A,Vec b,Vec x)
     42: {
     43:   Mat_Essl       *essl = (Mat_Essl*)A->data;
     44:   PetscScalar    *xx;
     46:   int            nessl,zero = 0;

     49:   PetscBLASIntCast(A->cmap->n,&nessl);
     50:   VecCopy(b,x);
     51:   VecGetArray(x,&xx);
     52:   dgss(&zero,&nessl,essl->a,essl->ia,essl->ja,&essl->lna,xx,essl->aux,&essl->naux);
     53:   VecRestoreArray(x,&xx);
     54:   return(0);
     55: }

     57: PetscErrorCode MatLUFactorNumeric_Essl(Mat F,Mat A,const MatFactorInfo *info)
     58: {
     59:   Mat_SeqAIJ     *aa  =(Mat_SeqAIJ*)(A)->data;
     60:   Mat_Essl       *essl=(Mat_Essl*)(F)->data;
     62:   int            nessl,i,one = 1;

     65:   PetscBLASIntCast(A->rmap->n,&nessl);
     66:   /* copy matrix data into silly ESSL data structure (1-based Frotran style) */
     67:   for (i=0; i<A->rmap->n+1; i++) essl->ia[i] = aa->i[i] + 1;
     68:   for (i=0; i<aa->nz; i++) essl->ja[i] = aa->j[i] + 1;

     70:   PetscMemcpy(essl->a,aa->a,(aa->nz)*sizeof(PetscScalar));

     72:   /* set Essl options */
     73:   essl->iparm[0] = 1;
     74:   essl->iparm[1] = 5;
     75:   essl->iparm[2] = 1;
     76:   essl->iparm[3] = 0;
     77:   essl->rparm[0] = 1.e-12;
     78:   essl->rparm[1] = 1.0;

     80:   PetscOptionsGetReal(NULL,((PetscObject)A)->prefix,"-matessl_lu_threshold",&essl->rparm[1],NULL);

     82:   dgsf(&one,&nessl,&essl->nz,essl->a,essl->ia,essl->ja,&essl->lna,essl->iparm,essl->rparm,essl->oparm,essl->aux,&essl->naux);

     84:   F->ops->solve     = MatSolve_Essl;
     85:   (F)->assembled    = PETSC_TRUE;
     86:   (F)->preallocated = PETSC_TRUE;
     87:   return(0);
     88: }

     93: PetscErrorCode MatLUFactorSymbolic_Essl(Mat B,Mat A,IS r,IS c,const MatFactorInfo *info)
     94: {
     95:   Mat_SeqAIJ     *a = (Mat_SeqAIJ*)A->data;
     97:   Mat_Essl       *essl;
     98:   PetscReal      f = 1.0;

    101:   essl = (Mat_Essl*)(B->data);

    103:   /* allocate the work arrays required by ESSL */
    104:   f    = info->fill;
    105:   PetscBLASIntCast(a->nz,&essl->nz);
    106:   PetscBLASIntCast((PetscInt)(a->nz*f),&essl->lna);
    107:   PetscBLASIntCast(100 + 10*A->rmap->n,&essl->naux);

    109:   /* since malloc is slow on IBM we try a single malloc */
    110:   PetscMalloc4(essl->lna,&essl->a,essl->naux,&essl->aux,essl->lna,&essl->ia,essl->lna,&essl->ja);

    112:   essl->CleanUpESSL = PETSC_TRUE;

    114:   PetscLogObjectMemory((PetscObject)B,essl->lna*(2*sizeof(int)+sizeof(PetscScalar)) + essl->naux*sizeof(PetscScalar));

    116:   B->ops->lufactornumeric = MatLUFactorNumeric_Essl;
    117:   return(0);
    118: }

    120: PetscErrorCode MatFactorGetSolverType_essl(Mat A,MatSolverType *type)
    121: {
    123:   *type = MATSOLVERESSL;
    124:   return(0);
    125: }

    127: /*MC
    128:   MATSOLVERESSL - "essl" - Provides direct solvers (LU) for sequential matrices
    129:                               via the external package ESSL.

    131:   If ESSL is installed (see the manual for
    132:   instructions on how to declare the existence of external packages),

    134:   Works with MATSEQAIJ matrices

    136:    Level: beginner

    138: .seealso: PCLU, PCFactorSetMatSolverType(), MatSolverType
    139: M*/

    141: PETSC_EXTERN PetscErrorCode MatGetFactor_seqaij_essl(Mat A,MatFactorType ftype,Mat *F)
    142: {
    143:   Mat            B;
    145:   Mat_Essl       *essl;

    148:   if (A->cmap->N != A->rmap->N) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"matrix must be square");
    149:   MatCreate(PetscObjectComm((PetscObject)A),&B);
    150:   MatSetSizes(B,PETSC_DECIDE,PETSC_DECIDE,A->rmap->n,A->cmap->n);
    151:   PetscStrallocpy("essl",&((PetscObject)B)->type_name);
    152:   MatSetUp(B);

    154:   PetscNewLog(B,&essl);

    156:   B->data                  = essl;
    157:   B->ops->lufactorsymbolic = MatLUFactorSymbolic_Essl;
    158:   B->ops->destroy          = MatDestroy_Essl;
    159:   B->ops->getinfo          = MatGetInfo_External;

    161:   PetscObjectComposeFunction((PetscObject)B,"MatFactorGetSolverType_C",MatFactorGetSolverType_essl);

    163:   B->factortype = MAT_FACTOR_LU;
    164:   PetscFree(B->solvertype);
    165:   PetscStrallocpy(MATSOLVERESSL,&B->solvertype);

    167:   *F            = B;
    168:   return(0);
    169: }

    171: PETSC_EXTERN PetscErrorCode MatSolverTypeRegister_Essl(void)
    172: {
    175:   MatSolverTypeRegister(MATSOLVERESSL,MATSEQAIJ,          MAT_FACTOR_LU,MatGetFactor_seqaij_essl);
    176:   return(0);
    177: }