예제 #1
0
void FKIN_SETRIN(char key_name[], realtype *rval, int *ier, int key_len)
{

  if (!strncmp(key_name,"FNORM_TOL", (size_t)key_len)) 
    *ier = KINSetFuncNormTol(KIN_kinmem, *rval);
  else if (!strncmp(key_name,"SSTEP_TOL", (size_t)key_len)) 
    *ier = KINSetScaledStepTol(KIN_kinmem, *rval);
  else if (!strncmp(key_name,"MAX_STEP", (size_t)key_len)) 
    *ier = KINSetMaxNewtonStep(KIN_kinmem, *rval);
  else if (!strncmp(key_name,"RERR_FUNC", (size_t)key_len)) 
    *ier = KINSetRelErrFunc(KIN_kinmem, *rval);
  else if (!strncmp(key_name,"ETA_CONST", (size_t)key_len)) 
    *ier = KINSetEtaConstValue(KIN_kinmem, *rval);
  else if (!strncmp(key_name,"ETA_PARAMS", (size_t)key_len)) 
    *ier = KINSetEtaParams(KIN_kinmem, rval[0], rval[1]);
  else if (!strncmp(key_name,"RMON_CONST", (size_t)key_len)) 
    *ier = KINSetResMonConstValue(KIN_kinmem, *rval);
  else if (!strncmp(key_name,"RMON_PARAMS", (size_t)key_len)) 
    *ier = KINSetResMonParams(KIN_kinmem, rval[0], rval[1]);
  else {
    *ier = -99;
    printf("FKINSETRIN: Unrecognized key.\n\n");
  }

}
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;
}