Beispiel #1
0
void FKIN_SOL(realtype *uu, int *globalstrategy, 
              realtype *uscale , realtype *fscale, int *ier)

{
  N_Vector uuvec, uscalevec, fscalevec;

  *ier = 0;
  uuvec = uscalevec = fscalevec = NULL;

  uuvec = F2C_KINSOL_vec;
  N_VSetArrayPointer(uu, uuvec);

  uscalevec = NULL;
  uscalevec = N_VCloneEmpty(F2C_KINSOL_vec);
  if (uscalevec == NULL) {
    *ier = -4;  /* KIN_MEM_FAIL */
    return;
  }
  N_VSetArrayPointer(uscale, uscalevec);

  fscalevec = NULL;
  fscalevec = N_VCloneEmpty(F2C_KINSOL_vec);
  if (fscalevec == NULL) {
    N_VDestroy(uscalevec);
    *ier = -4;  /* KIN_MEM_FAIL */
    return;
  }
  N_VSetArrayPointer(fscale, fscalevec);

  /* Call main solver function */
  *ier = KINSol(KIN_kinmem, uuvec, *globalstrategy, uscalevec, fscalevec);

  N_VSetArrayPointer(NULL, uuvec);

  N_VSetArrayPointer(NULL, uscalevec);
  N_VDestroy(uscalevec);

  N_VSetArrayPointer(NULL, fscalevec);
  N_VDestroy(fscalevec);

  /* load optional outputs into iout[] and rout[] */
  KINGetWorkSpace(KIN_kinmem, &KIN_iout[0], &KIN_iout[1]);   /* LENRW & LENIW */
  KINGetNumNonlinSolvIters(KIN_kinmem, &KIN_iout[2]);        /* NNI */
  KINGetNumFuncEvals(KIN_kinmem, &KIN_iout[3]);              /* NFE */
  KINGetNumBetaCondFails(KIN_kinmem, &KIN_iout[4]);          /* NBCF */
  KINGetNumBacktrackOps(KIN_kinmem, &KIN_iout[5]);           /* NBCKTRK */

  KINGetFuncNorm(KIN_kinmem, &KIN_rout[0]);                  /* FNORM */
  KINGetStepLength(KIN_kinmem, &KIN_rout[1]);                /* SSTEP */

  switch(KIN_ls) {

  case KIN_LS_DENSE:
  case KIN_LS_BAND:
  case KIN_LS_LAPACKDENSE:
  case KIN_LS_LAPACKBAND:
    KINDlsGetWorkSpace(KIN_kinmem, &KIN_iout[6], &KIN_iout[7]); /* LRW & LIW */
    KINDlsGetLastFlag(KIN_kinmem, (int *) &KIN_iout[8]);        /* LSTF */
    KINDlsGetNumFuncEvals(KIN_kinmem, &KIN_iout[9]);            /* NFE */
    KINDlsGetNumJacEvals(KIN_kinmem, &KIN_iout[10]);            /* NJE */    
  case KIN_LS_SPTFQMR:
  case KIN_LS_SPBCG:
  case KIN_LS_SPGMR:
    KINSpilsGetWorkSpace(KIN_kinmem, &KIN_iout[6], &KIN_iout[7]); /* LRW & LIW */
    KINSpilsGetLastFlag(KIN_kinmem, (int *) &KIN_iout[8]);        /* LSTF */
    KINSpilsGetNumFuncEvals(KIN_kinmem, &KIN_iout[9]);            /* NFE */
    KINSpilsGetNumJtimesEvals(KIN_kinmem, &KIN_iout[10]);         /* NJE */
    KINSpilsGetNumPrecEvals(KIN_kinmem, &KIN_iout[11]);           /* NPE */
    KINSpilsGetNumPrecSolves(KIN_kinmem, &KIN_iout[12]);          /* NPS */
    KINSpilsGetNumLinIters(KIN_kinmem, &KIN_iout[13]);            /* NLI */
    KINSpilsGetNumConvFails(KIN_kinmem, &KIN_iout[14]);           /* NCFL */
    break;

  }

  return;
}
static void KIM_Stats(int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[])
{
    const char *fnames_solver[]= {
        "nfe",
        "nni",
        "nbcf",
        "nbops",
        "fnorm",
        "step",
        "LSInfo",
    };
    const char *fnames_dense[]= {
        "name",
        "njeD",
        "nfeD"
    };
    const char *fnames_spils[]= {
        "name",
        "nli",
        "npe",
        "nps",
        "ncfl",
    };

    long int nfe, nni, nbcf, nbops;
    double fnorm, step;

    long int njeD, nfeD;
    long int nli, npe, nps, ncfl;

    int flag;
    mxArray *mx_ls;
    int nfields;

    if (kim_Kdata == NULL) return;

    flag = KINGetNumNonlinSolvIters(kin_mem, &nni);
    flag = KINGetNumFuncEvals(kin_mem, &nfe);
    flag = KINGetNumBetaCondFails(kin_mem, &nbcf);
    flag = KINGetNumBacktrackOps(kin_mem, &nbops);

    flag = KINGetFuncNorm(kin_mem, &fnorm);
    flag = KINGetStepLength(kin_mem, &step);

    nfields = sizeof(fnames_solver)/sizeof(*fnames_solver);
    plhs[0] = mxCreateStructMatrix(1, 1, nfields, fnames_solver);

    mxSetField(plhs[0], 0, "nfe",   mxCreateScalarDouble((double)nfe));
    mxSetField(plhs[0], 0, "nni",   mxCreateScalarDouble((double)nni));
    mxSetField(plhs[0], 0, "nbcf",  mxCreateScalarDouble((double)nbcf));
    mxSetField(plhs[0], 0, "nbops", mxCreateScalarDouble((double)nbops));
    mxSetField(plhs[0], 0, "fnorm", mxCreateScalarDouble(fnorm));
    mxSetField(plhs[0], 0, "step",  mxCreateScalarDouble(step));

    /* Linear Solver Statistics */

    switch(ls) {

    case LS_DENSE:

        flag = KINDenseGetNumJacEvals(kin_mem, &njeD);
        flag = KINDenseGetNumFuncEvals(kin_mem, &nfeD);

        nfields = sizeof(fnames_dense)/sizeof(*fnames_dense);
        mx_ls = mxCreateStructMatrix(1, 1, nfields, fnames_dense);

        mxSetField(mx_ls, 0, "name", mxCreateString("Dense"));
        mxSetField(mx_ls, 0, "njeD", mxCreateScalarDouble((double)njeD));
        mxSetField(mx_ls, 0, "nfeD", mxCreateScalarDouble((double)nfeD));

        break;

    case LS_SPGMR:
    case LS_SPBCG:
    case LS_SPTFQMR:

        flag = KINSpilsGetNumLinIters(kin_mem, &nli);
        flag = KINSpilsGetNumPrecEvals(kin_mem, &npe);
        flag = KINSpilsGetNumPrecSolves(kin_mem, &nps);
        flag = KINSpilsGetNumConvFails(kin_mem, &ncfl);

        nfields = sizeof(fnames_spils)/sizeof(*fnames_spils);
        mx_ls = mxCreateStructMatrix(1, 1, nfields, fnames_spils);

        if (ls == LS_SPGMR)
            mxSetField(mx_ls, 0, "name",  mxCreateString("GMRES"));
        else if (ls == LS_SPBCG)
            mxSetField(mx_ls, 0, "name",  mxCreateString("BiCGStab"));
        else
            mxSetField(mx_ls, 0, "name",  mxCreateString("TFQMR"));

        mxSetField(mx_ls, 0, "nli",   mxCreateScalarDouble((double)nli));
        mxSetField(mx_ls, 0, "npe",   mxCreateScalarDouble((double)npe));
        mxSetField(mx_ls, 0, "nps",   mxCreateScalarDouble((double)nps));
        mxSetField(mx_ls, 0, "ncfl",  mxCreateScalarDouble((double)ncfl));

        break;

    }

    mxSetField(plhs[0], 0, "LSInfo", mx_ls);

    return;
}