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; }
void FKIN_BAND(int *neq, int *mupper, int *mlower, int *ier) { *ier = KINBand(KIN_kinmem, *neq, *mupper, *mlower); KIN_ls = KIN_LS_BAND; }
int main() { realtype fnormtol, fnorm; N_Vector y, scale; int flag; void *kmem; y = scale = NULL; kmem = NULL; /* ------------------------- * Print problem description * ------------------------- */ printf("\n2D elliptic PDE on unit square\n"); printf(" d^2 u / dx^2 + d^2 u / dy^2 = u^3 - u + 2.0\n"); printf(" + homogeneous Dirichlet boundary conditions\n\n"); printf("Solution method: Anderson accelerated Picard iteration with band linear solver.\n"); printf("Problem size: %2ld x %2ld = %4ld\n", (long int) NX, (long int) NY, (long int) NEQ); /* -------------------------------------- * Create vectors for solution and scales * -------------------------------------- */ y = N_VNew_Serial(NEQ); if (check_flag((void *)y, "N_VNew_Serial", 0)) return(1); scale = N_VNew_Serial(NEQ); if (check_flag((void *)scale, "N_VNew_Serial", 0)) return(1); /* ---------------------------------------------------------------------------------- * Initialize and allocate memory for KINSOL, set parametrs for Anderson acceleration * ---------------------------------------------------------------------------------- */ kmem = KINCreate(); if (check_flag((void *)kmem, "KINCreate", 0)) return(1); /* y is used as a template */ /* Use acceleration with up to 3 prior residuals */ flag = KINSetMAA(kmem, 3); if (check_flag(&flag, "KINSetMAA", 1)) return(1); flag = KINInit(kmem, func, y); if (check_flag(&flag, "KINInit", 1)) return(1); /* ------------------- * Set optional inputs * ------------------- */ /* Specify stopping tolerance based on residual */ fnormtol = FTOL; flag = KINSetFuncNormTol(kmem, fnormtol); if (check_flag(&flag, "KINSetFuncNormTol", 1)) return(1); /* ------------------------- * Attach band linear solver * ------------------------- */ flag = KINBand(kmem, NEQ, NX, NX); if (check_flag(&flag, "KINBand", 1)) return(1); flag = KINDlsSetBandJacFn(kmem, jac); if (check_flag(&flag, "KINDlsBandJacFn", 1)) return(1); /* ------------- * Initial guess * ------------- */ N_VConst_Serial(ZERO, y); IJth(NV_DATA_S(y), 2, 2) = ONE; /* ---------------------------- * Call KINSol to solve problem * ---------------------------- */ /* No scaling used */ N_VConst_Serial(ONE,scale); /* Call main solver */ flag = KINSol(kmem, /* KINSol memory block */ y, /* initial guess on input; solution vector */ KIN_PICARD, /* global strategy choice */ scale, /* scaling vector, for the variable cc */ scale); /* scaling vector for function values fval */ if (check_flag(&flag, "KINSol", 1)) return(1); /* ------------------------------------ * Print solution and solver statistics * ------------------------------------ */ /* Get scaled norm of the system function */ flag = KINGetFuncNorm(kmem, &fnorm); if (check_flag(&flag, "KINGetfuncNorm", 1)) return(1); printf("\nComputed solution (||F|| = %g):\n\n",fnorm); PrintOutput(y); PrintFinalStats(kmem); /* ----------- * Free memory * ----------- */ N_VDestroy_Serial(y); N_VDestroy_Serial(scale); KINFree(&kmem); return(0); }