/*! \fn wrapper function of the residual Function
* non-linear solver calls this subroutine fcn(n, x, fvec, iflag, data)
*
*
*/
static int wrapper_fvec_hybrj(integer* n, double* x, double* f, double* fjac, integer* ldjac, integer* iflag, void* data, int sysNumber)
{
int i;
NONLINEAR_SYSTEM_DATA* systemData = &(((DATA*)data)->simulationInfo.nonlinearSystemData[sysNumber]);
DATA_HYBRD* solverData = (DATA_HYBRD*)(systemData->solverData);
int continuous = ((DATA*)data)->simulationInfo.solveContinuous;
switch(*iflag)
{
case 1:
/* re-scaling x vector */
if(solverData->useXScaling)
for(i=0; i<*n; i++)
x[i] = x[i]*solverData->xScalefactors[i];
/* call residual function */
(systemData->residualFunc)(data, x, f, iflag);
/* Scaling x vector */
if(solverData->useXScaling)
for(i=0; i<*n; i++)
x[i] = (1.0/solverData->xScalefactors[i]) * x[i];
break;
case 2:
/* set residual function continuous for jacobian calculation */
if(continuous)
((DATA*)data)->simulationInfo.solveContinuous = 0;
/* call apropreated jacobain function */
if(systemData->jacobianIndex != -1)
getAnalyticalJacobian(data, fjac, sysNumber);
else
getNumericalJacobian(data, fjac, x, f, sysNumber);
/* reset residual function again */
if(continuous)
((DATA*)data)->simulationInfo.solveContinuous = 1;
break;
default:
THROW1("Well, this is embarrasing. The non-linear solver should never call this case.%d", *iflag);
break;
}
return 0;
}
/*! \fn wrapper function of the residual Function
* non-linear solver calls this subroutine fcn(n, x, fvec, iflag, data)
*
*
*/
static int wrapper_fvec_hybrj(const integer* n, const double* x, double* f, double* fjac, const integer* ldjac, const integer* iflag, void* dataAndSysNum)
{
int i,j;
struct dataAndSys *dataSys = (struct dataAndSys*) dataAndSysNum;
DATA *data = (dataSys->data);
void *dataAndThreadData[2] = {data, dataSys->threadData};
NONLINEAR_SYSTEM_DATA* systemData = &(data->simulationInfo->nonlinearSystemData[dataSys->sysNumber]);
DATA_HYBRD* solverData = (DATA_HYBRD*)(systemData->solverData);
int continuous = data->simulationInfo->solveContinuous;
switch(*iflag)
{
case 1:
/* re-scaling x vector */
if(solverData->useXScaling)
for(i=0; i<*n; i++)
solverData->xScaled[i] = x[i]*solverData->xScalefactors[i];
/* debug output */
if(ACTIVE_STREAM(LOG_NLS_RES)) {
infoStreamPrint(LOG_NLS_RES, 0, "-- residual function call %d -- scaling = %d", (int)solverData->nfev, solverData->useXScaling);
printVector(x, n, LOG_NLS_RES, "x vector (scaled)");
printVector(solverData->xScaled, n, LOG_NLS_RES, "x vector");
}
/* call residual function */
if(solverData->useXScaling){
(systemData->residualFunc)(dataAndThreadData, (const double*) solverData->xScaled, f, (const int*)iflag);
} else {
(systemData->residualFunc)(dataAndThreadData, x, f, (const int*)iflag);
}
/* debug output */
if(ACTIVE_STREAM(LOG_NLS_RES)) {
printVector(f, n, LOG_NLS_RES, "residuals");
infoStreamPrint(LOG_NLS_RES, 0, "-- end of residual function call %d --", (int)solverData->nfev);
}
solverData->numberOfFunctionEvaluations++;
break;
case 2:
/* set residual function continuous for jacobian calculation */
if(continuous)
data->simulationInfo->solveContinuous = 0;
if(ACTIVE_STREAM(LOG_NLS_RES))
infoStreamPrint(LOG_NLS_RES, 0, "-- begin calculating jacobian --");
/* call apropreated jacobian function */
if(systemData->jacobianIndex != -1){
integer iflagtmp = 1;
wrapper_fvec_hybrj(n, x, f, fjac, ldjac, &iflagtmp, dataSys);
getAnalyticalJacobian(dataSys, fjac);
}
else{
getNumericalJacobian(dataSys, fjac, x, f);
}
/* debug output */
if (ACTIVE_STREAM(LOG_NLS_RES)) {
infoStreamPrint(LOG_NLS_RES, 0, "-- end calculating jacobian --");
if(ACTIVE_STREAM(LOG_NLS_JAC))
{
char buffer[16384];
infoStreamPrint(LOG_NLS_JAC, 1, "jacobian matrix [%dx%d]", (int)*n, (int)*n);
for(i=0; i<*n; i++)
{
buffer[0] = 0;
for(j=0; j<*n; j++)
sprintf(buffer, "%s%20.12g ", buffer, fjac[i*solverData->n+j]);
infoStreamPrint(LOG_NLS_JAC, 0, "%s", buffer);
}
messageClose(LOG_NLS_JAC);
}
}
/* reset residual function again */
if(continuous)
data->simulationInfo->solveContinuous = 1;
break;
default:
throwStreamPrint(NULL, "Well, this is embarrasing. The non-linear solver should never call this case.%d", (int)*iflag);
break;
}
return 0;
}
/*! \fn solve linear system with Klu method
*
* \param [in] [data]
* [sysNumber] index of the corresponding linear system
*
*
* author: wbraun
*/
int
solveKlu(DATA *data, threadData_t *threadData, int sysNumber)
{
void *dataAndThreadData[2] = {data, threadData};
LINEAR_SYSTEM_DATA* systemData = &(data->simulationInfo->linearSystemData[sysNumber]);
DATA_KLU* solverData = (DATA_KLU*)systemData->solverData;
int i, j, status = 0, success = 0, n = systemData->size, eqSystemNumber = systemData->equationIndex, indexes[2] = {1,eqSystemNumber};
infoStreamPrintWithEquationIndexes(LOG_LS, 0, indexes, "Start solving Linear System %d (size %d) at time %g with Klu Solver",
eqSystemNumber, (int) systemData->size,
data->localData[0]->timeValue);
rt_ext_tp_tick(&(solverData->timeClock));
if (0 == systemData->method)
{
/* set A matrix */
solverData->Ap[0] = 0;
systemData->setA(data, threadData, systemData);
solverData->Ap[solverData->n_row] = solverData->nnz;
if (ACTIVE_STREAM(LOG_LS_V))
{
infoStreamPrint(LOG_LS_V, 1, "Matrix A");
printMatrixCSR(solverData->Ap, solverData->Ai, solverData->Ax, n);
messageClose(LOG_LS_V);
}
/* set b vector */
systemData->setb(data, threadData, systemData);
} else {
solverData->Ap[0] = 0;
/* calculate jacobian -> matrix A*/
if(systemData->jacobianIndex != -1){
getAnalyticalJacobian(data, threadData, sysNumber);
} else {
assertStreamPrint(threadData, 1, "jacobian function pointer is invalid" );
}
solverData->Ap[solverData->n_row] = solverData->nnz;
/* calculate vector b (rhs) */
memcpy(solverData->work, systemData->x, sizeof(double)*solverData->n_row);
residual_wrapper(solverData->work, systemData->b, dataAndThreadData, sysNumber);
}
infoStreamPrint(LOG_LS, 0, "### %f time to set Matrix A and vector b.", rt_ext_tp_tock(&(solverData->timeClock)));
if (ACTIVE_STREAM(LOG_LS_V))
{
if (ACTIVE_STREAM(LOG_LS_V))
{
infoStreamPrint(LOG_LS_V, 1, "Old solution x:");
for(i = 0; i < solverData->n_row; ++i)
infoStreamPrint(LOG_LS_V, 0, "[%d] %s = %g", i+1, modelInfoGetEquation(&data->modelData->modelDataXml,eqSystemNumber).vars[i], systemData->x[i]);
messageClose(LOG_LS_V);
}
infoStreamPrint(LOG_LS_V, 1, "Matrix A n_rows = %d", solverData->n_row);
for (i=0; i<solverData->n_row; i++){
infoStreamPrint(LOG_LS_V, 0, "%d. Ap => %d -> %d", i, solverData->Ap[i], solverData->Ap[i+1]);
for (j=solverData->Ap[i]; j<solverData->Ap[i+1]; j++){
infoStreamPrint(LOG_LS_V, 0, "A[%d,%d] = %f", i, solverData->Ai[j], solverData->Ax[j]);
}
}
messageClose(LOG_LS_V);
for (i=0; i<solverData->n_row; i++)
infoStreamPrint(LOG_LS_V, 0, "b[%d] = %e", i, systemData->b[i]);
}
rt_ext_tp_tick(&(solverData->timeClock));
/* symbolic pre-ordering of A to reduce fill-in of L and U */
if (0 == solverData->numberSolving)
{
infoStreamPrint(LOG_LS_V, 0, "Perform analyze settings:\n - ordering used: %d\n - current status: %d", solverData->common.ordering, solverData->common.status);
solverData->symbolic = klu_analyze(solverData->n_col, solverData->Ap, solverData->Ai, &solverData->common);
}
/* compute the LU factorization of A */
if (0 == solverData->common.status){
solverData->numeric = klu_factor(solverData->Ap, solverData->Ai, solverData->Ax, solverData->symbolic, &solverData->common);
}
if (0 == solverData->common.status){
if (1 == systemData->method){
if (klu_solve(solverData->symbolic, solverData->numeric, solverData->n_col, 1, systemData->b, &solverData->common)){
success = 1;
}
} else {
if (klu_tsolve(solverData->symbolic, solverData->numeric, solverData->n_col, 1, systemData->b, &solverData->common)){
success = 1;
}
}
}
infoStreamPrint(LOG_LS, 0, "Solve System: %f", rt_ext_tp_tock(&(solverData->timeClock)));
/* print solution */
if (1 == success){
if (1 == systemData->method){
/* take the solution */
for(i = 0; i < solverData->n_row; ++i)
systemData->x[i] += systemData->b[i];
/* update inner equations */
residual_wrapper(systemData->x, solverData->work, dataAndThreadData, sysNumber);
} else {
/* the solution is automatically in x */
memcpy(systemData->x, systemData->b, sizeof(double)*systemData->size);
}
if (ACTIVE_STREAM(LOG_LS_V))
{
infoStreamPrint(LOG_LS_V, 1, "Solution x:");
infoStreamPrint(LOG_LS_V, 0, "System %d numVars %d.", eqSystemNumber, modelInfoGetEquation(&data->modelData->modelDataXml,eqSystemNumber).numVar);
for(i = 0; i < systemData->size; ++i)
infoStreamPrint(LOG_LS_V, 0, "[%d] %s = %g", i+1, modelInfoGetEquation(&data->modelData->modelDataXml,eqSystemNumber).vars[i], systemData->x[i]);
messageClose(LOG_LS_V);
}
}
else
{
warningStreamPrint(LOG_STDOUT, 0,
"Failed to solve linear system of equations (no. %d) at time %f, system status %d.",
(int)systemData->equationIndex, data->localData[0]->timeValue, status);
}
solverData->numberSolving += 1;
return success;
}