コード例 #1
0
int KINBBDSpgmr(void *kinmem, int maxl, void *p_data)
{
  KINMem kin_mem;
  int flag;

  flag = KINSpgmr(kinmem, maxl);
  if (flag != KINSPILS_SUCCESS) return(flag);

  kin_mem = (KINMem) kinmem;

  if (p_data == NULL) {
    KINProcessError(kin_mem, KINBBDPRE_PDATA_NULL, "KINBBDPRE", "KINBBDSpgmr", MSGBBD_PDATA_NULL);
    return(KINBBDPRE_PDATA_NULL);
  }

  flag = KINSpilsSetPreconditioner(kinmem,
				   KINBBDPrecSetup,
				   KINBBDPrecSolve,
				   p_data);
  if (flag != KINSPILS_SUCCESS) return(flag);

  return(KINSPILS_SUCCESS);
}
コード例 #2
0
ファイル: kinFoodWeb_kry.c プロジェクト: A1kmm/modml-solver
int main(void)
{
  int globalstrategy;
  realtype fnormtol, scsteptol;
  N_Vector cc, sc, constraints;
  UserData data;
  int flag, maxl, maxlrst;
  void *kmem;

  cc = sc = constraints = NULL;
  kmem = NULL;
  data = NULL;

  /* Allocate memory, and set problem data, initial values, tolerances */ 
  globalstrategy = KIN_NONE;

  data = AllocUserData();
  if (check_flag((void *)data, "AllocUserData", 2)) return(1);
  InitUserData(data);

  /* Create serial vectors of length NEQ */
  cc = N_VNew_Serial(NEQ);
  if (check_flag((void *)cc, "N_VNew_Serial", 0)) return(1);
  sc = N_VNew_Serial(NEQ);
  if (check_flag((void *)sc, "N_VNew_Serial", 0)) return(1);
  data->rates = N_VNew_Serial(NEQ);
  if (check_flag((void *)data->rates, "N_VNew_Serial", 0)) return(1);

  constraints = N_VNew_Serial(NEQ);
  if (check_flag((void *)constraints, "N_VNew_Serial", 0)) return(1);
  N_VConst(TWO, constraints);

  SetInitialProfiles(cc, sc);

  fnormtol=FTOL; scsteptol=STOL;

  /* Call KINCreate/KINInit to initialize KINSOL.
     A pointer to KINSOL problem memory is returned and stored in kmem. */
  kmem = KINCreate();
  if (check_flag((void *)kmem, "KINCreate", 0)) return(1);

  /* Vector cc passed as template vector. */
  flag = KINInit(kmem, func, cc);
  if (check_flag(&flag, "KINInit", 1)) return(1);

  flag = KINSetUserData(kmem, data);
  if (check_flag(&flag, "KINSetUserData", 1)) return(1);
  flag = KINSetConstraints(kmem, constraints);
  if (check_flag(&flag, "KINSetConstraints", 1)) return(1);
  flag = KINSetFuncNormTol(kmem, fnormtol);
  if (check_flag(&flag, "KINSetFuncNormTol", 1)) return(1);
  flag = KINSetScaledStepTol(kmem, scsteptol);
  if (check_flag(&flag, "KINSetScaledStepTol", 1)) return(1);

  /* We no longer need the constraints vector since KINSetConstraints
     creates a private copy for KINSOL to use. */
  N_VDestroy_Serial(constraints);

  /* Call KINSpgmr to specify the linear solver KINSPGMR with preconditioner
     routines PrecSetupBD and PrecSolveBD. */
  maxl = 15; 
  maxlrst = 2;
  flag = KINSpgmr(kmem, maxl);
  if (check_flag(&flag, "KINSpgmr", 1)) return(1);

  flag = KINSpilsSetMaxRestarts(kmem, maxlrst);
  if (check_flag(&flag, "KINSpilsSetMaxRestarts", 1)) return(1);
  flag = KINSpilsSetPreconditioner(kmem,
				   PrecSetupBD,
				   PrecSolveBD);
  if (check_flag(&flag, "KINSpilsSetPreconditioner", 1)) return(1);

  /* Print out the problem size, solution parameters, initial guess. */
  PrintHeader(globalstrategy, maxl, maxlrst, fnormtol, scsteptol);

  /* Call KINSol and print output concentration profile */
  flag = KINSol(kmem,           /* KINSol memory block */
                cc,             /* initial guess on input; solution vector */
                globalstrategy, /* global stragegy choice */
                sc,             /* scaling vector, for the variable cc */
                sc);            /* scaling vector for function values fval */
  if (check_flag(&flag, "KINSol", 1)) return(1);

  printf("\n\nComputed equilibrium species concentrations:\n");
  PrintOutput(cc);

  /* Print final statistics and free memory */  
  PrintFinalStats(kmem);

  N_VDestroy_Serial(cc);
  N_VDestroy_Serial(sc);
  KINFree(&kmem);
  FreeUserData(data);

  return(0);
}
コード例 #3
0
int main(int argc, char *argv[])
{
  MPI_Comm comm;
  void *kmem;
  UserData data;
  N_Vector cc, sc, constraints;
  int globalstrategy;
  long int Nlocal;
  realtype fnormtol, scsteptol, dq_rel_uu;
  int flag, maxl, maxlrst;
  long int mudq, mldq, mukeep, mlkeep;
  int my_pe, npes, npelast = NPEX*NPEY-1;

  data = NULL;
  kmem = NULL;
  cc = sc = constraints = NULL;

  /* Get processor number and total number of pe's */
  MPI_Init(&argc, &argv);
  comm = MPI_COMM_WORLD;
  MPI_Comm_size(comm, &npes);
  MPI_Comm_rank(comm, &my_pe);

  if (npes != NPEX*NPEY) {
    if (my_pe == 0)
      printf("\nMPI_ERROR(0): npes=%d is not equal to NPEX*NPEY=%d\n", npes,
             NPEX*NPEY);
    return(1);
  }

  /* Allocate memory, and set problem data, initial values, tolerances */ 

  /* Set local length */
  Nlocal = NUM_SPECIES*MXSUB*MYSUB;

  /* Allocate and initialize user data block */
  data = AllocUserData();
  if (check_flag((void *)data, "AllocUserData", 2, my_pe)) MPI_Abort(comm, 1);
  InitUserData(my_pe, Nlocal, comm, data);

  /* Choose global strategy */
  globalstrategy = KIN_NONE;

  /* Allocate and initialize vectors */
  cc = N_VNew_Parallel(comm, Nlocal, NEQ);
  if (check_flag((void *)cc, "N_VNew_Parallel", 0, my_pe)) MPI_Abort(comm, 1);
  sc = N_VNew_Parallel(comm, Nlocal, NEQ);
  if (check_flag((void *)sc, "N_VNew_Parallel", 0, my_pe)) MPI_Abort(comm, 1);
  data->rates = N_VNew_Parallel(comm, Nlocal, NEQ);
  if (check_flag((void *)data->rates, "N_VNew_Parallel", 0, my_pe))
      MPI_Abort(comm, 1);
  constraints = N_VNew_Parallel(comm, Nlocal, NEQ);
  if (check_flag((void *)constraints, "N_VNew_Parallel", 0, my_pe))
      MPI_Abort(comm, 1);
  N_VConst(ZERO, constraints);
  
  SetInitialProfiles(cc, sc);

  fnormtol = FTOL; scsteptol = STOL;

  /* Call KINCreate/KINInit to initialize KINSOL: 
     nvSpec  points to machine environment data
     A pointer to KINSOL problem memory is returned and stored in kmem. */
  kmem = KINCreate();
  if (check_flag((void *)kmem, "KINCreate", 0, my_pe)) MPI_Abort(comm, 1);

  /* Vector cc passed as template vector. */
  flag = KINInit(kmem, func, cc);
  if (check_flag(&flag, "KINInit", 1, my_pe)) MPI_Abort(comm, 1);

  flag = KINSetUserData(kmem, data);
  if (check_flag(&flag, "KINSetUserData", 1, my_pe)) MPI_Abort(comm, 1);

  flag = KINSetConstraints(kmem, constraints);
  if (check_flag(&flag, "KINSetConstraints", 1, my_pe)) MPI_Abort(comm, 1);

  /* We no longer need the constraints vector since KINSetConstraints
     creates a private copy for KINSOL to use. */
  N_VDestroy_Parallel(constraints);

  flag = KINSetFuncNormTol(kmem, fnormtol);
  if (check_flag(&flag, "KINSetFuncNormTol", 1, my_pe)) MPI_Abort(comm, 1);

  flag = KINSetScaledStepTol(kmem, scsteptol);
  if (check_flag(&flag, "KINSetScaledStepTol", 1, my_pe)) MPI_Abort(comm, 1);
  
  /* Call KINBBDPrecInit to initialize and allocate memory for the
     band-block-diagonal preconditioner, and specify the local and
     communication functions func_local and gcomm=NULL (all communication
     needed for the func_local is already done in func). */
  dq_rel_uu = ZERO;
  mudq = mldq = 2*NUM_SPECIES - 1;
  mukeep = mlkeep = NUM_SPECIES;

  /* Call KINBBDSpgmr to specify the linear solver KINSPGMR */
  maxl = 20; maxlrst = 2;
  flag = KINSpgmr(kmem, maxl);
  if (check_flag(&flag, "KINSpgmr", 1, my_pe)) MPI_Abort(comm, 1);

  /* Initialize BBD preconditioner */
  flag = KINBBDPrecInit(kmem, Nlocal, mudq, mldq, mukeep, mlkeep,
                        dq_rel_uu, func_local, NULL);
  if (check_flag(&flag, "KINBBDPrecInit", 1, my_pe)) MPI_Abort(comm, 1);


  flag = KINSpilsSetMaxRestarts(kmem, maxlrst);
  if (check_flag(&flag, "KINSpilsSetMaxRestarts", 1, my_pe)) 
    MPI_Abort(comm, 1);

  /* Print out the problem size, solution parameters, initial guess. */
  if (my_pe == 0)
    PrintHeader(globalstrategy, maxl, maxlrst, mudq, mldq, mukeep,
		mlkeep, fnormtol, scsteptol);

  /* call KINSol and print output concentration profile */
  flag = KINSol(kmem,           /* KINSol memory block */
                cc,             /* initial guesss on input; solution vector */
                globalstrategy, /* global stragegy choice */
                sc,             /* scaling vector, for the variable cc */
                sc);            /* scaling vector for function values fval */
  if (check_flag(&flag, "KINSol", 1, my_pe)) MPI_Abort(comm, 1);

  if (my_pe == 0) printf("\n\nComputed equilibrium species concentrations:\n");
  if (my_pe == 0 || my_pe==npelast) PrintOutput(my_pe, comm, cc);
  
  /* Print final statistics and free memory */
  if (my_pe == 0) 
    PrintFinalStats(kmem);

  N_VDestroy_Parallel(cc);
  N_VDestroy_Parallel(sc);

  KINFree(&kmem);
  FreeUserData(data);

  MPI_Finalize();

  return(0);
}
コード例 #4
0
ファイル: fkinsol.c プロジェクト: A1kmm/modml-solver
void FKIN_SPGMR(int *maxl, int *maxlrst, int *ier)
{
  *ier = KINSpgmr(KIN_kinmem, *maxl);
  KINSpilsSetMaxRestarts(KIN_kinmem, *maxlrst);
  KIN_ls = KIN_LS_SPGMR;
}
コード例 #5
0
int main(int argc, char *argv[])

{
  int globalstrategy;
  long int local_N;
  realtype fnormtol, scsteptol;
  N_Vector cc, sc, constraints;
  UserData data;
  int flag, maxl, maxlrst;
  int my_pe, npes, npelast = NPEX*NPEY-1;
  void *kmem;
  MPI_Comm comm;

  cc = sc = constraints = NULL;
  data = NULL;
  kmem = NULL;

  /* Get processor number and total number of pe's */
  MPI_Init(&argc, &argv);
  comm = MPI_COMM_WORLD;
  MPI_Comm_size(comm, &npes);
  MPI_Comm_rank(comm, &my_pe);

  if (npes != NPEX*NPEY) {
    if (my_pe == 0)
      fprintf(stderr, "\nMPI_ERROR(0); npes = %d is not equal to NPEX*NPEY = %d\n",
	      npes,NPEX*NPEY);
    MPI_Finalize();
    return(1);
  }

  /* Allocate memory, and set problem data, initial values, tolerances */ 

  /* Set local vector length */
  local_N = NUM_SPECIES*MXSUB*MYSUB;

  /* Allocate and initialize user data block */
  data = AllocUserData();
  if (check_flag((void *)data, "AllocUserData", 0, my_pe)) MPI_Abort(comm, 1);
  InitUserData(my_pe, comm, data);

  /* Set global strategy flag */
  globalstrategy = KIN_NONE;
  
  /* Allocate and initialize vectors */
  cc = N_VNew_Parallel(comm, local_N, NEQ);
  if (check_flag((void *)cc, "N_VNew_Parallel", 0, my_pe)) MPI_Abort(comm, 1);
  sc = N_VNew_Parallel(comm, local_N, NEQ);
  if (check_flag((void *)sc, "N_VNew_Parallel", 0, my_pe)) MPI_Abort(comm, 1);
  data->rates = N_VNew_Parallel(comm, local_N, NEQ);
  if (check_flag((void *)data->rates, "N_VNew_Parallel", 0, my_pe)) MPI_Abort(comm, 1);
  constraints = N_VNew_Parallel(comm, local_N, NEQ);
  if (check_flag((void *)constraints, "N_VNew_Parallel", 0, my_pe)) MPI_Abort(comm, 1);
  N_VConst(ZERO, constraints);
  
  SetInitialProfiles(cc, sc);

  fnormtol=FTOL; scsteptol=STOL;

 /* Call KINCreate/KINMalloc to initialize KINSOL: 
     nvSpec is the nvSpec pointer used in the parallel version
     A pointer to KINSOL problem memory is returned and stored in kmem. */
  kmem = KINCreate();
  if (check_flag((void *)kmem, "KINCreate", 0, my_pe)) MPI_Abort(comm, 1);
  /* Vector cc passed as template vector. */
  flag = KINMalloc(kmem, funcprpr, cc);
  if (check_flag(&flag, "KINMalloc", 1, my_pe)) MPI_Abort(comm, 1);

  flag = KINSetNumMaxIters(kmem, 250);
  if (check_flag(&flag, "KINSetNumMaxIters", 1, my_pe)) MPI_Abort(comm, 1);
  flag = KINSetFdata(kmem, data);
  if (check_flag(&flag, "KINSetFdata", 1, my_pe)) MPI_Abort(comm, 1);
  flag = KINSetConstraints(kmem, constraints);
  if (check_flag(&flag, "KINSetConstraints", 1, my_pe)) MPI_Abort(comm, 1);
  flag = KINSetFuncNormTol(kmem, fnormtol);
  if (check_flag(&flag, "KINSetFuncNormTol", 1, my_pe)) MPI_Abort(comm, 1);
  flag = KINSetScaledStepTol(kmem, scsteptol);
  if (check_flag(&flag, "KINSetScaledStepTop", 1, my_pe)) MPI_Abort(comm, 1);

  /* We no longer need the constraints vector since KINSetConstraints
     creates a private copy for KINSOL to use. */
  N_VDestroy_Parallel(constraints);

  /* Call KINSpgmr to specify the linear solver KINSPGMR with preconditioner
     routines Precondbd and PSolvebd, and the pointer to the user data block. */
  maxl = 20; maxlrst = 2;
  flag = KINSpgmr(kmem, maxl);
  if (check_flag(&flag, "KINSpgmr", 1, my_pe)) MPI_Abort(comm, 1);

  flag = KINSpilsSetMaxRestarts(kmem, maxlrst);
  if (check_flag(&flag, "KINSpilsSetMaxRestarts", 1, my_pe)) MPI_Abort(comm, 1);
  flag = KINSpilsSetPreconditioner(kmem,
				   Precondbd,
				   PSolvebd,
				   data);
  if (check_flag(&flag, "KINSpilsSetPreconditioner", 1, my_pe)) MPI_Abort(comm, 1);

  /* Print out the problem size, solution parameters, initial guess. */
  if (my_pe == 0) 
    PrintHeader(globalstrategy, maxl, maxlrst, fnormtol, scsteptol);

  /* Call KINSol and print output concentration profile */
  flag = KINSol(kmem,           /* KINSol memory block */
                cc,             /* initial guess on input; solution vector */
                globalstrategy, /* global stragegy choice */
                sc,             /* scaling vector for the variable cc */
                sc);            /* scaling vector for function values fval */
  if (check_flag(&flag, "KINSol", 1, my_pe)) MPI_Abort(comm, 1);

  if (my_pe == 0) 
     printf("\n\nComputed equilibrium species concentrations:\n");
  if (my_pe == 0 || my_pe == npelast) 
     PrintOutput(my_pe, comm, cc);

  /* Print final statistics and free memory */  
  if (my_pe == 0) 
     PrintFinalStats(kmem);

  N_VDestroy_Parallel(cc);
  N_VDestroy_Parallel(sc);
  KINFree(&kmem);
  FreeUserData(data);

  MPI_Finalize();

  return(0);
}
コード例 #6
0
static void KIM_Malloc(int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[])
{
    int status;

    mxArray *mx_in[3], *mx_out[2];

    int mxiter, msbset, msbsetsub, etachoice, mxnbcf;
    double eta, egamma, ealpha, mxnewtstep, relfunc, fnormtol, scsteptol;
    booleantype verbose, noInitSetup, noMinEps;

    double *constraints;
    N_Vector NVconstraints;

    int ptype;
    int mudq, mldq, mupper, mlower;
    int maxl, maxrs;
    double dqrely;

    /*
     * -----------------------------
     * Find out the vector type and
     * then pass it to the vector
     * library.
     * -----------------------------
     */

    /* Send vec_type and mx_comm */

    InitVectors();

    /*
     * -----------------------------
     * Extract stuff from arguments:
     * - SYS function
     * - problem dimension
     * - solver options
     * - user data
     * -----------------------------
     */

    /* Matlab user-provided function */

    mxDestroyArray(mx_SYSfct);
    mx_SYSfct = mxDuplicateArray(prhs[0]);

    /* problem dimension */

    N = (int) mxGetScalar(prhs[1]);

    /* Solver Options -- optional argument */

    status = get_SolverOptions(prhs[2],
                               &verbose,
                               &mxiter, &msbset, &msbsetsub, &etachoice, &mxnbcf,
                               &eta, &egamma, &ealpha, &mxnewtstep,
                               &relfunc, &fnormtol, &scsteptol,
                               &constraints,
                               &noInitSetup, &noMinEps);


    /* User data -- optional argument */

    mxDestroyArray(mx_data);
    mx_data = mxDuplicateArray(prhs[3]);

    /*
     * -----------------------------------------------------
     * Set solution vector (used as a template to KINMAlloc)
     * -----------------------------------------------------
     */

    y = NewVector(N);

    /*
     * ----------------------------------------
     * Create kinsol object and allocate memory
     * ----------------------------------------
     */

    kin_mem = KINCreate();

    /* attach error handler function */
    status = KINSetErrHandlerFn(kin_mem, mtlb_KINErrHandler, NULL);

    if (verbose) {
        status = KINSetPrintLevel(kin_mem,3);
        /* attach info handler function */
        status = KINSetInfoHandlerFn(kin_mem, mtlb_KINInfoHandler, NULL);
        /* initialize the output window */
        mx_in[0] = mxCreateScalarDouble(0);
        mx_in[1] = mxCreateScalarDouble(0); /* ignored */
        mx_in[2] = mxCreateScalarDouble(0); /* ignored */
        mexCallMATLAB(1,mx_out,3,mx_in,"kim_info");
        fig_handle = (int)*mxGetPr(mx_out[0]);
    }

    /* Call KINMalloc */

    status = KINMalloc(kin_mem, mtlb_KINSys, y);

    /* Redirect output */
    status = KINSetErrFile(kin_mem, stdout);

    /* Optional inputs */

    status = KINSetNumMaxIters(kin_mem,mxiter);
    status = KINSetNoInitSetup(kin_mem,noInitSetup);
    status = KINSetNoMinEps(kin_mem,noMinEps);
    status = KINSetMaxSetupCalls(kin_mem,msbset);
    status = KINSetMaxSubSetupCalls(kin_mem,msbsetsub);
    status = KINSetMaxBetaFails(kin_mem,mxnbcf);
    status = KINSetEtaForm(kin_mem,etachoice);
    status = KINSetEtaConstValue(kin_mem,eta);
    status = KINSetEtaParams(kin_mem,egamma,ealpha);
    status = KINSetMaxNewtonStep(kin_mem,mxnewtstep);
    status = KINSetRelErrFunc(kin_mem,relfunc);
    status = KINSetFuncNormTol(kin_mem,fnormtol);
    status = KINSetScaledStepTol(kin_mem,scsteptol);
    if (constraints != NULL) {
        NVconstraints = N_VCloneEmpty(y);
        N_VSetArrayPointer(constraints, NVconstraints);
        status = KINSetConstraints(kin_mem,NVconstraints);
        N_VDestroy(NVconstraints);
    }

    status = get_LinSolvOptions(prhs[2],
                                &mupper, &mlower,
                                &mudq, &mldq, &dqrely,
                                &ptype, &maxrs, &maxl);

    switch (ls) {

    case LS_NONE:

        mexErrMsgTxt("KINMalloc:: no linear solver specified.");

        break;

    case LS_DENSE:

        status = KINDense(kin_mem, N);
        if (!mxIsEmpty(mx_JACfct))
            status = KINDenseSetJacFn(kin_mem, mtlb_KINDenseJac, NULL);

        break;

    case LS_BAND:

        status = KINBand(kin_mem, N, mupper, mlower);
        if (!mxIsEmpty(mx_JACfct))
            status = KINBandSetJacFn(kin_mem, mtlb_KINBandJac, NULL);

        break;

    case LS_SPGMR:

        switch(pm) {
        case PM_NONE:
            status = KINSpgmr(kin_mem, maxl);
            if (!mxIsEmpty(mx_PSOLfct)) {
                if (!mxIsEmpty(mx_PSETfct))
                    status = KINSpilsSetPreconditioner(kin_mem, mtlb_KINSpilsPset, mtlb_KINSpilsPsol, NULL);
                else
                    status = KINSpilsSetPreconditioner(kin_mem, NULL, mtlb_KINSpilsPsol, NULL);
            }
            break;
        case PM_BBDPRE:
            if (!mxIsEmpty(mx_GCOMfct))
                bbd_data = KINBBDPrecAlloc(kin_mem, N, mudq, mldq, mupper, mlower, dqrely, mtlb_KINGloc, mtlb_KINGcom);
            else
                bbd_data = KINBBDPrecAlloc(kin_mem, N, mudq, mldq, mupper, mlower, dqrely, mtlb_KINGloc, NULL);
            status = KINBBDSpgmr(kin_mem, maxl, bbd_data);
            break;
        }

        status = KINSpilsSetMaxRestarts(kin_mem, maxrs);

        if (!mxIsEmpty(mx_JACfct))
            status = KINSpilsSetJacTimesVecFn(kin_mem, mtlb_KINSpilsJac, NULL);

        break;

    case LS_SPBCG:

        switch(pm) {
        case PM_NONE:
            status = KINSpbcg(kin_mem, maxl);
            if (!mxIsEmpty(mx_PSOLfct)) {
                if (!mxIsEmpty(mx_PSETfct))
                    status = KINSpilsSetPreconditioner(kin_mem, mtlb_KINSpilsPset, mtlb_KINSpilsPsol, NULL);
                else
                    status = KINSpilsSetPreconditioner(kin_mem, NULL, mtlb_KINSpilsPsol, NULL);
            }
            break;
        case PM_BBDPRE:
            if (!mxIsEmpty(mx_GCOMfct))
                bbd_data = KINBBDPrecAlloc(kin_mem, N, mudq, mldq, mupper, mlower, dqrely, mtlb_KINGloc, mtlb_KINGcom);
            else
                bbd_data = KINBBDPrecAlloc(kin_mem, N, mudq, mldq, mupper, mlower, dqrely, mtlb_KINGloc, NULL);
            status = KINBBDSpbcg(kin_mem, maxl, bbd_data);
            break;
        }

        if (!mxIsEmpty(mx_JACfct))
            status = KINSpilsSetJacTimesVecFn(kin_mem, mtlb_KINSpilsJac, NULL);

        break;

    case LS_SPTFQMR:

        switch(pm) {
        case PM_NONE:
            status = KINSptfqmr(kin_mem, maxl);
            if (!mxIsEmpty(mx_PSOLfct)) {
                if (!mxIsEmpty(mx_PSETfct))
                    status = KINSpilsSetPreconditioner(kin_mem, mtlb_KINSpilsPset, mtlb_KINSpilsPsol, NULL);
                else
                    status = KINSpilsSetPreconditioner(kin_mem, NULL, mtlb_KINSpilsPsol, NULL);
            }
            break;
        case PM_BBDPRE:
            if (!mxIsEmpty(mx_GCOMfct))
                bbd_data = KINBBDPrecAlloc(kin_mem, N, mudq, mldq, mupper, mlower, dqrely, mtlb_KINGloc, mtlb_KINGcom);
            else
                bbd_data = KINBBDPrecAlloc(kin_mem, N, mudq, mldq, mupper, mlower, dqrely, mtlb_KINGloc, NULL);
            status = KINBBDSptfqmr(kin_mem, maxl, bbd_data);
            break;
        }

        if (!mxIsEmpty(mx_JACfct))
            status = KINSpilsSetJacTimesVecFn(kin_mem, mtlb_KINSpilsJac, NULL);

        break;

    }

    return;
}
コード例 #7
0
ファイル: kinsol_nonlin_solver.c プロジェクト: cvoter/Parflow
PFModule  *KinsolNonlinSolverInitInstanceXtra(
                                              Problem *    problem,
                                              Grid *       grid,
                                              ProblemData *problem_data,
                                              double *     temp_data)
{
  PFModule      *this_module = ThisPFModule;
  PublicXtra    *public_xtra = (PublicXtra*)PFModulePublicXtra(this_module);
  InstanceXtra  *instance_xtra;

  int neq = public_xtra->neq;
  int max_restarts = public_xtra->max_restarts;
  int krylov_dimension = public_xtra->krylov_dimension;
  int max_iter = public_xtra->max_iter;
  int print_flag = public_xtra->print_flag;
  int eta_choice = public_xtra->eta_choice;

  long int     *iopt;
  double       *ropt;

  double eta_value = public_xtra->eta_value;
  double eta_alpha = public_xtra->eta_alpha;
  double eta_gamma = public_xtra->eta_gamma;
  double derivative_epsilon = public_xtra->derivative_epsilon;

  Vector       *fscale;
  Vector       *uscale;

  State        *current_state;

  KINSpgmruserAtimesFn matvec = public_xtra->matvec;
  KINSpgmrPrecondFn pcinit = public_xtra->pcinit;
  KINSpgmrPrecondSolveFn pcsolve = public_xtra->pcsolve;

  KINMem kin_mem;
  FILE                  *kinsol_file;
  char filename[255];

  int i;

  if (PFModuleInstanceXtra(this_module) == NULL)
    instance_xtra = ctalloc(InstanceXtra, 1);
  else
    instance_xtra = (InstanceXtra*)PFModuleInstanceXtra(this_module);

  /*-----------------------------------------------------------------------
   * Initialize module instances
   *-----------------------------------------------------------------------*/

  if (PFModuleInstanceXtra(this_module) == NULL)
  {
    if (public_xtra->precond != NULL)
      instance_xtra->precond =
        PFModuleNewInstanceType(KinsolPCInitInstanceXtraInvoke, public_xtra->precond,
                                (problem, grid, problem_data, temp_data,
                                 NULL, NULL, NULL, 0, 0));
    else
      instance_xtra->precond = NULL;

    instance_xtra->nl_function_eval =
      PFModuleNewInstanceType(NlFunctionEvalInitInstanceXtraInvoke, public_xtra->nl_function_eval,
                              (problem, grid, temp_data));

    if (public_xtra->richards_jacobian_eval != NULL)
      /* Initialize instance for nonsymmetric matrix */
      instance_xtra->richards_jacobian_eval =
        PFModuleNewInstanceType(RichardsJacobianEvalInitInstanceXtraInvoke, public_xtra->richards_jacobian_eval,
                                (problem, grid, problem_data, temp_data, 0));
    else
      instance_xtra->richards_jacobian_eval = NULL;
  }
  else
  {
    if (instance_xtra->precond != NULL)
      PFModuleReNewInstanceType(KinsolPCInitInstanceXtraInvoke,
                                instance_xtra->precond,
                                (problem, grid, problem_data, temp_data,
                                 NULL, NULL, NULL, 0, 0));

    PFModuleReNewInstanceType(NlFunctionEvalInitInstanceXtraInvoke, instance_xtra->nl_function_eval,
                              (problem, grid, temp_data));

    if (instance_xtra->richards_jacobian_eval != NULL)
      PFModuleReNewInstanceType(RichardsJacobianEvalInitInstanceXtraInvoke, instance_xtra->richards_jacobian_eval,
                                (problem, grid, problem_data, temp_data, 0));
  }

  /*-----------------------------------------------------------------------
   * Initialize KINSol input parameters and memory instance
   *-----------------------------------------------------------------------*/

  if (PFModuleInstanceXtra(this_module) == NULL)
  {
    current_state = ctalloc(State, 1);

    /* Set up the grid data for the kinsol stuff */
    SetPf2KinsolData(grid, 1);

    /* Initialize KINSol parameters */
    sprintf(filename, "%s.%s", GlobalsOutFileName, "kinsol.log");
    if (!amps_Rank(amps_CommWorld))
      kinsol_file = fopen(filename, "w");
    else
      kinsol_file = NULL;
    instance_xtra->kinsol_file = kinsol_file;

    /* Initialize KINSol memory */
    kin_mem = (KINMem)KINMalloc(neq, kinsol_file, NULL);

    /* Initialize the gmres linear solver in KINSol */
    KINSpgmr((void*)kin_mem,           /* Memory allocated above */
             krylov_dimension,         /* Max. Krylov dimension */
             max_restarts,             /* Max. no. of restarts - 0 is none */
             1,                        /* Max. calls to PC Solve w/o PC Set */
             pcinit,                   /* PC Set function */
             pcsolve,                  /* PC Solve function */
             matvec,                   /* ATimes routine */
             current_state             /* User data for PC stuff */
             );

    /* Initialize optional arguments for KINSol */
    iopt = instance_xtra->int_optional_input;
    ropt = instance_xtra->real_optional_input;

    // Only print on rank 0
    iopt[PRINTFL] = amps_Rank(amps_CommWorld) ? 0 : print_flag;
    iopt[MXITER] = max_iter;
    iopt[PRECOND_NO_INIT] = 0;
    iopt[NNI] = 0;
    iopt[NFE] = 0;
    iopt[NBCF] = 0;
    iopt[NBKTRK] = 0;
    iopt[ETACHOICE] = eta_choice;
    iopt[NO_MIN_EPS] = 0;

    ropt[MXNEWTSTEP] = 0.0;
    ropt[RELFUNC] = derivative_epsilon;
    ropt[RELU] = 0.0;
    ropt[FNORM] = 0.0;
    ropt[STEPL] = 0.0;
    ropt[ETACONST] = eta_value;
    ropt[ETAALPHA] = eta_alpha;
    /* Put in conditional assignment of eta_gamma since KINSOL aliases */
    /* ETAGAMMA and ETACONST */
    if (eta_value == 0.0)
      ropt[ETAGAMMA] = eta_gamma;

    /* Initialize iteration counts */
    for (i = 0; i < OPT_SIZE; i++)
      instance_xtra->integer_outputs[i] = 0;

    /* Scaling vectors*/
    uscale = NewVectorType(grid, 1, 1, vector_cell_centered);
    InitVectorAll(uscale, 1.0);
    instance_xtra->uscale = uscale;

    fscale = NewVectorType(grid, 1, 1, vector_cell_centered);
    InitVectorAll(fscale, 1.0);
    instance_xtra->fscale = fscale;

    instance_xtra->feval = KINSolFunctionEval;
    instance_xtra->kin_mem = kin_mem;
    instance_xtra->current_state = current_state;
  }


  PFModuleInstanceXtra(this_module) = instance_xtra;
  return this_module;
}