Exemplo n.º 1
0
static int SolveIt(void *kmem, N_Vector u, N_Vector s, int glstr, int mset)
{
  int flag;

  printf("\n");

  if (mset==1)
    printf("Exact Newton");
  else
    printf("Modified Newton");

  if (glstr == KIN_NONE)
    printf("\n");
  else
    printf(" with line search\n");

  flag = KINSetMaxSetupCalls(kmem, mset);
  if (check_flag(&flag, "KINSetMaxSetupCalls", 1)) return(1);

  flag = KINSol(kmem, u, glstr, s, s);
  if (check_flag(&flag, "KINSol", 1)) return(1);

  printf("Solution:\n  [x1,x2] = ");
  PrintOutput(u);

  PrintFinalStats(kmem);

  return(0);

}
static void KIM_Solve(int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[])
{
    double *y0, *ys, *fs;
    N_Vector yscale, fscale;
    int buflen, status, strategy;
    char *bufval;

    if ( kim_Kdata == NULL) return ;
    /* Exract y0 and load initial guess in y */
    y0 = mxGetPr(prhs[0]);
    PutData(y, y0, N);

    /* Extract strategy */
    buflen = mxGetM(prhs[1]) * mxGetN(prhs[1]) + 1;
    bufval = mxCalloc(buflen, sizeof(char));
    status = mxGetString(prhs[1], bufval, buflen);
    if(!strcmp(bufval,"None")) strategy = KIN_NONE;
    if(!strcmp(bufval,"LineSearch")) strategy = KIN_LINESEARCH;

    /* Extract yscale */
    ys = mxGetPr(prhs[2]);
    yscale = N_VCloneEmpty(y);
    N_VSetArrayPointer(ys, yscale);

    /* Extract fscale */
    fs = mxGetPr(prhs[3]);
    fscale = N_VCloneEmpty(y);
    N_VSetArrayPointer(fs, fscale);

    /* call KINSol() */
    status = KINSol(kin_mem, y, strategy, yscale, fscale);

    /* KINSOL return flag */
    plhs[0] = mxCreateScalarDouble((double)status);

    /* Solution vector */
    plhs[1] = mxCreateDoubleMatrix(N,1,mxREAL);
    GetData(y, mxGetPr(plhs[1]), N);

    /* Free temporary N_Vectors */
    N_VDestroy(yscale);
    N_VDestroy(fscale);

    return;
}
Exemplo n.º 3
0
int nlsKinsolSolve(DATA *data, threadData_t *threadData, int sysNumber)
{
  NONLINEAR_SYSTEM_DATA *nlsData = &(data->simulationInfo->nonlinearSystemData[sysNumber]);
  NLS_KINSOL_DATA *kinsolData = (NLS_KINSOL_DATA*)nlsData->solverData;
  long eqSystemNumber = nlsData->equationIndex;
  int indexes[2] = {1,eqSystemNumber};

  int flag, i;
  long nFEval;
  int success = 0;
  int retry = 0;
  double *xStart = NV_DATA_S(kinsolData->initialGuess);
  double *xScaling = NV_DATA_S(kinsolData->xScale);
  double *fScaling = NV_DATA_S(kinsolData->fScale);
  double fNormValue;


  /* set user data */
  kinsolData->userData.data = data;
  kinsolData->userData.threadData = threadData;
  kinsolData->userData.sysNumber = sysNumber;

  /* reset configuration settings */
  nlsKinsolConfigSetup(kinsolData);

  infoStreamPrint(LOG_NLS, 0, "------------------------------------------------------");
  infoStreamPrintWithEquationIndexes(LOG_NLS, 1, indexes, "Start solving non-linear system >>%ld<< using Kinsol solver at time %g", eqSystemNumber, data->localData[0]->timeValue);

  nlsKinsolResetInitial(data, kinsolData, nlsData, INITIAL_EXTRAPOLATION);

  /* set x scaling */
  nlsKinsolXScaling(data, kinsolData, nlsData, SCALING_NOMINALSTART);

  /* set f scaling */
  _omc_fillVector(_omc_createVector(nlsData->size, fScaling), 1.);

  /*  */
  do{
    /* dump configuration */
    nlsKinsolConfigPrint(kinsolData, nlsData);

    flag = KINSol(kinsolData->kinsolMemory,           /* KINSol memory block */
                  kinsolData->initialGuess,           /* initial guess on input; solution vector */
                  kinsolData->kinsolStrategy,         /* global strategy choice */
                  kinsolData->xScale,                 /* scaling vector, for the variable cc */
                  kinsolData->fScale);                /* scaling vector for function values fval */

    infoStreamPrint(LOG_NLS_V, 0, "KINSol finished with errorCode %d.", flag);
    /* check for errors */
    if(flag < 0)
    {
      retry = nlsKinsolErrorHandler(flag, data, nlsData, kinsolData);
    }

    /* solution found */
    if ((flag == KIN_SUCCESS) || (flag == KIN_INITIAL_GUESS_OK) || (flag ==  KIN_STEP_LT_STPTOL))
    {
      success = 1;
    }
    kinsolData->retries++;

    /* write statistics */
    KINGetNumNonlinSolvIters(kinsolData->kinsolMemory, &nFEval);
    nlsData->numberOfIterations += nFEval;
    nlsData->numberOfFEval += kinsolData->countResCalls;

    infoStreamPrint(LOG_NLS_V, 0, "Next try? success = %d, retry = %d, retries = %d = %s\n", success, retry, kinsolData->retries,!success && !(retry<1) && kinsolData->retries<RETRY_MAX ? "true" : "false" );
  }while(!success && !(retry<0) && kinsolData->retries < RETRY_MAX);

  /* solution found */
  if (success)
  {
    /* check if solution really solves the residuals */
    nlsKinsolResiduals(kinsolData->initialGuess, kinsolData->fRes, &kinsolData->userData);
    fNormValue = N_VWL2Norm(kinsolData->fRes, kinsolData->fRes);
    infoStreamPrint(LOG_NLS, 0, "scaled Euclidean norm of F(u) = %e", fNormValue);
    if (FTOL_WITH_LESS_ACCURANCY<fNormValue)
    {
      warningStreamPrint(LOG_NLS, 0, "False positive solution. FNorm is too small.");
      success = 0;
    }
    else /* solved system for reuse linear solver information */
    {
      kinsolData->solved = 1;
    }
    /* copy solution */
    memcpy(nlsData->nlsx, xStart, nlsData->size*(sizeof(double)));
    /* dump solution */
    if(ACTIVE_STREAM(LOG_NLS))
    {
      infoStreamPrintWithEquationIndexes(LOG_NLS, 1, indexes, "solution for NLS %ld at t=%g", eqSystemNumber, kinsolData->userData.data->localData[0]->timeValue);
      for(i=0; i<nlsData->size; ++i)
      {
        infoStreamPrintWithEquationIndexes(LOG_NLS, 0, indexes, "[%d] %s = %g", i+1, modelInfoGetEquation(&kinsolData->userData.data->modelData->modelDataXml,eqSystemNumber).vars[i], nlsData->nlsx[i]);
      }
      messageClose(LOG_NLS);
    }
  }

  messageClose(LOG_NLS);

  return success;
}
Exemplo n.º 4
0
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);
}
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);
}
Exemplo n.º 6
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;
}
Exemplo n.º 7
0
int main()
{
  realtype fnormtol, scsteptol;
  N_Vector y, scale, constraints;
  int mset, flag, i;
  void *kmem;
  SUNMatrix J;
  SUNLinearSolver LS;

  y = scale = constraints = NULL;
  kmem = NULL;
  J = NULL;
  LS = NULL;

  printf("\nRobot Kinematics Example\n");
  printf("8 variables; -1 <= x_i <= 1\n");
  printf("KINSOL problem size: 8 + 2*8 = 24 \n\n");

  /* Create vectors for solution, scales, and constraints */

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

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

  /* Initialize and allocate memory for KINSOL */

  kmem = KINCreate();
  if (check_flag((void *)kmem, "KINCreate", 0)) return(1);

  flag = KINInit(kmem, func, y); /* y passed as a template */
  if (check_flag(&flag, "KINInit", 1)) return(1);

  /* Set optional inputs */

  N_VConst_Serial(ZERO,constraints);
  for (i = NVAR+1; i <= NEQ; i++) Ith(constraints, i) = ONE;
  
  flag = KINSetConstraints(kmem, constraints);
  if (check_flag(&flag, "KINSetConstraints", 1)) return(1);

  fnormtol  = FTOL; 
  flag = KINSetFuncNormTol(kmem, fnormtol);
  if (check_flag(&flag, "KINSetFuncNormTol", 1)) return(1);

  scsteptol = STOL;
  flag = KINSetScaledStepTol(kmem, scsteptol);
  if (check_flag(&flag, "KINSetScaledStepTol", 1)) return(1);

  /* Create dense SUNMatrix */
  J = SUNDenseMatrix(NEQ, NEQ);
  if(check_flag((void *)J, "SUNDenseMatrix", 0)) return(1);

  /* Create dense SUNLinearSolver object */
  LS = SUNLinSol_Dense(y, J);
  if(check_flag((void *)LS, "SUNLinSol_Dense", 0)) return(1);

  /* Attach the matrix and linear solver to KINSOL */
  flag = KINSetLinearSolver(kmem, LS, J);
  if(check_flag(&flag, "KINSetLinearSolver", 1)) return(1);

  /* Set the Jacobian function */
  flag = KINSetJacFn(kmem, jac);
  if (check_flag(&flag, "KINSetJacFn", 1)) return(1);

  /* Indicate exact Newton */

  mset = 1;
  flag = KINSetMaxSetupCalls(kmem, mset);
  if (check_flag(&flag, "KINSetMaxSetupCalls", 1)) return(1);

  /* Initial guess */

  N_VConst_Serial(ONE, y);
  for(i = 1; i <= NVAR; i++) Ith(y,i) = SUNRsqrt(TWO)/TWO;

  printf("Initial guess:\n");
  PrintOutput(y);

  /* Call KINSol to solve problem */

  N_VConst_Serial(ONE,scale);
  flag = KINSol(kmem,           /* KINSol memory block */
                y,              /* initial guess on input; solution vector */
                KIN_LINESEARCH, /* 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);

  printf("\nComputed solution:\n");
  PrintOutput(y);

  /* Print final statistics and free memory */  

  PrintFinalStats(kmem);

  N_VDestroy_Serial(y);
  N_VDestroy_Serial(scale);
  N_VDestroy_Serial(constraints);
  KINFree(&kmem);
  SUNLinSolFree(LS);
  SUNMatDestroy(J);

  return(0);
}
Exemplo n.º 8
0
  /*! \fn kinsol_initialization
   *
   *  \param [ref] [data]
   *  \param [in]  [initData]
   *  \param [ref] [initialResiduals]
   *
   *  \author lochel
   */
  int kinsol_initialization(DATA* data, INIT_DATA* initData, int useScaling)
  {
    long i, indz;
    KINSOL_DATA* kdata = NULL;
    double fnormtol  = 1.e-9;     /* function tolerance */
    double scsteptol = 1.e-9;     /* step tolerance */

    long int nni, nfe, nje, nfeD;

    N_Vector z = NULL;
    N_Vector sVars = NULL;
    N_Vector sEqns = NULL;
    N_Vector c = NULL;

    int glstr = KIN_NONE;   /* globalization strategy applied to the Newton method. It must be one of KIN_NONE or KIN_LINESEARCH */
    long int mset = 1;      /* maximum number of nonlinear iterations without a call to the preconditioner setup function. Pass 0 to indicate the default [10]. */
    void *kmem = NULL;
    int error_code = -1;

    ASSERT(data->modelData.nInitResiduals == initData->nz, "The number of initial equations are not consistent with the number of unfixed variables. Select a different initialization.");

    do /* Try it first with KIN_NONE. If that fails, try it with KIN_LINESEARCH. */
    {
      if(mset == 1 && glstr == KIN_NONE)
        DEBUG_INFO(LOG_INIT, "using exact Newton");
      else if(mset == 1)
        DEBUG_INFO(LOG_INIT, "using exact Newton with line search");
      else if(glstr == KIN_NONE)
        DEBUG_INFO(LOG_INIT, "using modified Newton");
      else
        DEBUG_INFO(LOG_INIT, "using modified Newton with line search");

      DEBUG_INFO_AL1(LOG_INIT, "| mset               = %10ld", mset);
      DEBUG_INFO_AL1(LOG_INIT, "| function tolerance = %10.6g", fnormtol);
      DEBUG_INFO_AL1(LOG_INIT, "| step tolerance     = %10.6g", scsteptol);

      kdata = (KINSOL_DATA*)malloc(sizeof(KINSOL_DATA));
      ASSERT(kdata, "out of memory");

      kdata->initData = initData;
      kdata->data = data;

      z = N_VNew_Serial(3*initData->nz);
      ASSERT(z, "out of memory");

      sVars = N_VNew_Serial(3*initData->nz);
      ASSERT(sVars, "out of memory");

      sEqns = N_VNew_Serial(3*initData->nz);
      ASSERT(sEqns, "out of memory");

      c = N_VNew_Serial(3*initData->nz);
      ASSERT(c, "out of memory");

      /* initial guess */
      for(i=0; i<initData->nz; ++i)
      {
        NV_Ith_S(z, i) = initData->start[i];
        NV_Ith_S(z, initData->nInitResiduals+2*i+0) = NV_Ith_S(z, i) - initData->min[i];
        NV_Ith_S(z, initData->nInitResiduals+2*i+1) = NV_Ith_S(z, i) - initData->max[i];
      }

      kdata->useScaling=useScaling;
      if(useScaling)
      {
        computeInitialResidualScalingCoefficients(data, initData);
        for(i=0; i<initData->nz; ++i)
        {
          NV_Ith_S(sVars, i) = 1.0 / (initData->nominal[i] == 0.0 ? 1.0 : initData->nominal[i]);
          NV_Ith_S(sVars, initData->nInitResiduals+2*i+0) = NV_Ith_S(sVars, i);
          NV_Ith_S(sVars, initData->nInitResiduals+2*i+1) = NV_Ith_S(sVars, i);

          NV_Ith_S(sEqns, i) = 1.0 / (initData->residualScalingCoefficients[i] == 0.0 ? 1.0 : initData->residualScalingCoefficients[i]);
          NV_Ith_S(sEqns, initData->nInitResiduals+2*i+0) = NV_Ith_S(sEqns, i);
          NV_Ith_S(sEqns, initData->nInitResiduals+2*i+1) = NV_Ith_S(sEqns, i);
        }
      }
      else
      {
        N_VConst_Serial(1.0, sVars);        /* no scaling */
        N_VConst_Serial(1.0, sEqns);        /* no scaling */
      }

      for(i=0; i<initData->nz; ++i)
      {
        NV_Ith_S(c, i) =  0.0;        /* no constraint on z[i] */
        NV_Ith_S(c, initData->nInitResiduals+2*i+0) = 1.0;
        NV_Ith_S(c, initData->nInitResiduals+2*i+1) = -1.0;
      }

      kmem = KINCreate();
      ASSERT(kmem, "out of memory");

      KINSetErrHandlerFn(kmem, kinsol_errorHandler, NULL);
      KINSetUserData(kmem, kdata);
      KINSetConstraints(kmem, c);
      KINSetFuncNormTol(kmem, fnormtol);
      KINSetScaledStepTol(kmem, scsteptol);
      KINInit(kmem, kinsol_residuals, z);

      /* Call KINDense to specify the linear solver */
      KINDense(kmem, 3*initData->nz);

      KINSetMaxSetupCalls(kmem, mset);
      /*KINSetNumMaxIters(kmem, 2000);*/

      globalInitialResiduals = initData->initialResiduals;

      error_code = KINSol(kmem,           /* KINSol memory block */
             z,              /* initial guess on input; solution vector */
             glstr,          /* global stragegy choice */
             sVars,          /* scaling vector, for the variable cc */
             sEqns);         /* scaling vector for function values fval */

      globalInitialResiduals = NULL;

      KINGetNumNonlinSolvIters(kmem, &nni);
      KINGetNumFuncEvals(kmem, &nfe);
      KINDlsGetNumJacEvals(kmem, &nje);
      KINDlsGetNumFuncEvals(kmem, &nfeD);

      DEBUG_INFO(LOG_INIT, "final kinsol statistics");
      DEBUG_INFO_AL1(LOG_INIT, "| KINGetNumNonlinSolvIters = %5ld", nni);
      DEBUG_INFO_AL1(LOG_INIT, "| KINGetNumFuncEvals       = %5ld", nfe);
      DEBUG_INFO_AL1(LOG_INIT, "| KINDlsGetNumJacEvals     = %5ld", nje);
      DEBUG_INFO_AL1(LOG_INIT, "| KINDlsGetNumFuncEvals    = %5ld", nfeD);

      /* Free memory */
      N_VDestroy_Serial(z);
      N_VDestroy_Serial(sVars);
      N_VDestroy_Serial(sEqns);
      N_VDestroy_Serial(c);
      KINFree(&kmem);
      free(kdata);

      if(error_code < 0)
        glstr++;  /* try next globalization strategy */
    }while(error_code < 0 && glstr <= KIN_LINESEARCH);

    /* debug output */
    indz = 0;
    DEBUG_INFO(LOG_INIT, "solution");
    for(i=0; i<data->modelData.nStates; ++i)
      if(data->modelData.realVarsData[i].attribute.fixed==0)
        DEBUG_INFO_AL2(LOG_INIT, "| %s = %g", initData->name[indz++], data->localData[0]->realVars[i]);

    for(i=0; i<data->modelData.nParametersReal; ++i)
      if(data->modelData.realParameterData[i].attribute.fixed == 0)
        DEBUG_INFO_AL2(LOG_INIT, "| %s = %g", initData->name[indz++], data->simulationInfo.realParameter[i]);

    if(error_code < 0)
      THROW("kinsol failed. see last warning. use [-lv LOG_INIT] for more output.");

    return 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);
}
Exemplo n.º 10
0
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);
}
Exemplo n.º 11
0
int KinsolNonlinSolver(Vector *pressure, Vector *density, Vector *old_density, Vector *saturation, Vector *old_saturation, double t, double dt, ProblemData *problem_data, Vector *old_pressure, Vector *evap_trans, Vector *ovrl_bc_flx, Vector *x_velocity, Vector *y_velocity, Vector *z_velocity)
{
  PFModule     *this_module = ThisPFModule;
  PublicXtra   *public_xtra = (PublicXtra*)PFModulePublicXtra(this_module);
  InstanceXtra *instance_xtra = (InstanceXtra*)PFModuleInstanceXtra(this_module);

  Matrix       *jacobian_matrix = (instance_xtra->jacobian_matrix);
  Matrix       *jacobian_matrix_C = (instance_xtra->jacobian_matrix_C);

  Vector       *uscale = (instance_xtra->uscale);
  Vector       *fscale = (instance_xtra->fscale);

  PFModule  *nl_function_eval = instance_xtra->nl_function_eval;
  PFModule  *richards_jacobian_eval = instance_xtra->richards_jacobian_eval;
  PFModule  *precond = instance_xtra->precond;

  State        *current_state = (instance_xtra->current_state);

  int globalization = (public_xtra->globalization);
  int neq = (public_xtra->neq);

  double residual_tol = (public_xtra->residual_tol);
  double step_tol = (public_xtra->step_tol);

  SysFn feval = (instance_xtra->feval);
  KINMem kin_mem = (instance_xtra->kin_mem);
  FILE         *kinsol_file = (instance_xtra->kinsol_file);

  long int     *integer_outputs = (instance_xtra->integer_outputs);
  long int     *iopt = (instance_xtra->int_optional_input);
  double       *ropt = (instance_xtra->real_optional_input);

  int ret = 0;

  StateFunc(current_state) = nl_function_eval;
  StateProblemData(current_state) = problem_data;
  StateTime(current_state) = t;
  StateDt(current_state) = dt;
  StateOldDensity(current_state) = old_density;
  StateOldPressure(current_state) = old_pressure;
  StateOldSaturation(current_state) = old_saturation;
  StateDensity(current_state) = density;
  StateSaturation(current_state) = saturation;
  StateJacEval(current_state) = richards_jacobian_eval;
  StateJac(current_state) = jacobian_matrix;
  StateJacC(current_state) = jacobian_matrix_C;           //dok
  StatePrecond(current_state) = precond;
  StateEvapTrans(current_state) = evap_trans;       /*sk*/
  StateOvrlBcFlx(current_state) = ovrl_bc_flx;      /*sk*/
  StateXvel(current_state) = x_velocity;           //jjb
  StateYvel(current_state) = y_velocity;           //jjb
  StateZvel(current_state) = z_velocity;           //jjb

  if (!amps_Rank(amps_CommWorld))
    fprintf(kinsol_file, "\nKINSOL starting step for time %f\n", t);

  BeginTiming(public_xtra->time_index);

  ret = KINSol((void*)kin_mem,          /* Memory allocated above */
               neq,                     /* Dummy variable here */
               pressure,                /* Initial guess @ this was "pressure before" */
               feval,                   /* Nonlinear function */
               globalization,           /* Globalization method */
               uscale,                  /* Scalings for the variable */
               fscale,                  /* Scalings for the function */
               residual_tol,            /* Stopping tolerance on func */
               step_tol,                /* Stop tol. for sucessive steps */
               NULL,                    /* Constraints */
               TRUE,                    /* Optional inputs */
               iopt,                    /* Opt. integer inputs */
               ropt,                    /* Opt. double inputs */
               current_state            /* User-supplied input */
               );

  EndTiming(public_xtra->time_index);

  integer_outputs[NNI] += iopt[NNI];
  integer_outputs[NFE] += iopt[NFE];
  integer_outputs[NBCF] += iopt[NBCF];
  integer_outputs[NBKTRK] += iopt[NBKTRK];
  integer_outputs[SPGMR_NLI] += iopt[SPGMR_NLI];
  integer_outputs[SPGMR_NPE] += iopt[SPGMR_NPE];
  integer_outputs[SPGMR_NPS] += iopt[SPGMR_NPS];
  integer_outputs[SPGMR_NCFL] += iopt[SPGMR_NCFL];

  if (!amps_Rank(amps_CommWorld))
    PrintFinalStats(kinsol_file, iopt, integer_outputs);

  if (ret == KINSOL_SUCCESS || ret == KINSOL_INITIAL_GUESS_OK)
  {
    ret = 0;
  }

  return(ret);
}
Exemplo n.º 12
0
bool kinsol_solve(void) {
	double fnormtol;
	N_Vector y, scale, constraints;
	int mset, flag;
	void *kmem;

	y = scale = constraints = NULL;
	kmem = NULL;

	/* Create vectors for solution, scales, and constraints */

	y = N_VMake_Serial(nvariables, variables);
	if (y == NULL) goto cleanup;

	scale = N_VNew_Serial(nvariables);
	if (scale == NULL) goto cleanup;

	constraints = N_VNew_Serial(nvariables);
	if (constraints == NULL) goto cleanup;

	/* Initialize and allocate memory for KINSOL */

	kmem = KINCreate();
	if (kmem == NULL) goto cleanup;

	flag = KINInit(kmem, _f, y); 
	if (flag < 0) goto cleanup;

	// This constrains metabolites >= 0
	N_VConst_Serial(1.0, constraints);
	flag = KINSetConstraints(kmem, constraints);
	if (flag < 0) goto cleanup;

	fnormtol  = ARGS.ABSTOL; 
	flag = KINSetFuncNormTol(kmem, fnormtol);
	if (flag < 0) goto cleanup;

	//scsteptol = ARGS.RELTOL;
	//flag = KINSetScaledStepTol(kmem, scsteptol);
	//if (flag < 0) goto cleanup;

	/* Attach dense linear solver */

	flag = KINDense(kmem, nvariables);
	if (flag < 0) goto cleanup;

	flag = KINDlsSetDenseJacFn(kmem, _dfdy);
	if (flag < 0) goto cleanup;

	/* Indicate exact Newton */

	//This makes sure that the user-supplied Jacobian gets evaluated onevery step.
	mset = 1;
	flag = KINSetMaxSetupCalls(kmem, mset);
	if (flag < 0) goto cleanup;

	/* Initial guess is the intial variable concentrations */

	/* Call KINSol to solve problem */

	N_VConst_Serial(1.0,scale);
	flag = KINSol(kmem,           /* KINSol memory block */
	              y,              /* initial guess on input; solution vector */
	              KIN_NONE, /* basic Newton iteration */
	              scale,          /* scaling vector, for the variable cc */
	              scale);         /* scaling vector for function values fval */
	if((ARGS.MODE != ABC) and (ARGS.MODE != ABCSIM) and (ARGS.MODE != Prior))
		OUT_nums();
	if (flag < 0) goto cleanup;


	N_VDestroy_Serial(y);
	N_VDestroy_Serial(scale);
	N_VDestroy_Serial(constraints);
	KINFree(&kmem);

	return true;
	
	 cleanup:
	error("Could not integrate!\n");
	if (y!=NULL) N_VDestroy_Serial(y);
	if (scale!=NULL) N_VDestroy_Serial(scale);
	if (constraints!=NULL) N_VDestroy_Serial(constraints);
	if (kmem!=NULL) KINFree(&kmem);
	return false;
}
Exemplo n.º 13
0
void KinsolSolver::solve() const
{
    // Solve the linear system

    KINSol(mSolver, mParametersVector, KIN_LINESEARCH, mOnesVector, mOnesVector);
}