/*! \fn solve non-linear system with hybrd method * * \param [in] [data] * [sysNumber] index of the corresponing non-linear system * * \author wbraun */ int solveHybrd(DATA *data, threadData_t *threadData, int sysNumber) { NONLINEAR_SYSTEM_DATA* systemData = &(data->simulationInfo->nonlinearSystemData[sysNumber]); DATA_HYBRD* solverData = (DATA_HYBRD*)systemData->solverData; /* * We are given the number of the non-linear system. * We want to look it up among all equations. */ int eqSystemNumber = systemData->equationIndex; int i, j; integer iflag = 1; double xerror, xerror_scaled; int success = 0; double local_tol = 1e-12; double initial_factor = solverData->factor; int nfunc_evals = 0; int continuous = 1; int nonContinuousCase = 0; int giveUp = 0; int retries = 0; int retries2 = 0; int retries3 = 0; int assertCalled = 0; int assertRetries = 0; int assertMessage = 0; modelica_boolean* relationsPreBackup; struct dataAndSys dataAndSysNumber = {data, threadData, sysNumber}; relationsPreBackup = (modelica_boolean*) malloc(data->modelData->nRelations*sizeof(modelica_boolean)); solverData->numberOfFunctionEvaluations = 0; /* debug output */ if(ACTIVE_STREAM(LOG_NLS_V)) { int indexes[2] = {1,eqSystemNumber}; infoStreamPrintWithEquationIndexes(LOG_NLS_V, 1, indexes, "start solving non-linear system >>%d<< at time %g", eqSystemNumber, data->localData[0]->timeValue); for(i=0; i<solverData->n; i++) { infoStreamPrint(LOG_NLS_V, 1, "%d. %s = %f", i+1, modelInfoGetEquation(&data->modelData->modelDataXml,eqSystemNumber).vars[i], systemData->nlsx[i]); infoStreamPrint(LOG_NLS_V, 0, " nominal = %f\nold = %f\nextrapolated = %f", systemData->nominal[i], systemData->nlsxOld[i], systemData->nlsxExtrapolation[i]); messageClose(LOG_NLS_V); } messageClose(LOG_NLS_V); } /* set x vector */ if(data->simulationInfo->discreteCall) memcpy(solverData->x, systemData->nlsx, solverData->n*(sizeof(double))); else memcpy(solverData->x, systemData->nlsxExtrapolation, solverData->n*(sizeof(double))); for(i=0; i<solverData->n; i++){ solverData->xScalefactors[i] = fmax(fabs(solverData->x[i]), systemData->nominal[i]); } /* start solving loop */ while(!giveUp && !success) { for(i=0; i<solverData->n; i++) solverData->xScalefactors[i] = fmax(fabs(solverData->x[i]), systemData->nominal[i]); /* debug output */ if(ACTIVE_STREAM(LOG_NLS_V)) { printVector(solverData->xScalefactors, &(solverData->n), LOG_NLS_V, "scaling factors x vector"); printVector(solverData->x, &(solverData->n), LOG_NLS_V, "Iteration variable values"); } /* Scaling x vector */ if(solverData->useXScaling) { for(i=0; i<solverData->n; i++) { solverData->x[i] = (1.0/solverData->xScalefactors[i]) * solverData->x[i]; } } /* debug output */ if(ACTIVE_STREAM(LOG_NLS_V)) { printVector(solverData->x, &solverData->n, LOG_NLS_V, "Iteration variable values (scaled)"); } /* set residual function continuous */ if(continuous) { ((DATA*)data)->simulationInfo->solveContinuous = 1; } else { ((DATA*)data)->simulationInfo->solveContinuous = 0; } giveUp = 1; /* try */ { int success = 0; #ifndef OMC_EMCC MMC_TRY_INTERNAL(simulationJumpBuffer) #endif hybrj_(wrapper_fvec_hybrj, &solverData->n, solverData->x, solverData->fvec, solverData->fjac, &solverData->ldfjac, &solverData->xtol, &solverData->maxfev, solverData->diag, &solverData->mode, &solverData->factor, &solverData->nprint, &solverData->info, &solverData->nfev, &solverData->njev, solverData->r__, &solverData->lr, solverData->qtf, solverData->wa1, solverData->wa2, solverData->wa3, solverData->wa4, (void*) &dataAndSysNumber); success = 1; if(assertCalled) { infoStreamPrint(LOG_NLS, 0, "After assertions failed, found a solution for which assertions did not fail."); /* re-scaling x vector */ for(i=0; i<solverData->n; i++){ if(solverData->useXScaling) systemData->nlsxOld[i] = solverData->x[i]*solverData->xScalefactors[i]; else systemData->nlsxOld[i] = solverData->x[i]; } } assertRetries = 0; assertCalled = 0; success = 1; #ifndef OMC_EMCC MMC_CATCH_INTERNAL(simulationJumpBuffer) #endif /* catch */ if (!success) { if (!assertMessage) { if (ACTIVE_WARNING_STREAM(LOG_STDOUT)) { if(data->simulationInfo->initial) warningStreamPrint(LOG_STDOUT, 1, "While solving non-linear system an assertion failed during initialization."); else warningStreamPrint(LOG_STDOUT, 1, "While solving non-linear system an assertion failed at time %g.", data->localData[0]->timeValue); warningStreamPrint(LOG_STDOUT, 0, "The non-linear solver tries to solve the problem that could take some time."); warningStreamPrint(LOG_STDOUT, 0, "It could help to provide better start-values for the iteration variables."); if (!ACTIVE_STREAM(LOG_NLS)) warningStreamPrint(LOG_STDOUT, 0, "For more information simulate with -lv LOG_NLS"); messageClose(LOG_STDOUT); } assertMessage = 1; } solverData->info = -1; xerror_scaled = 1; xerror = 1; assertCalled = 1; } } /* set residual function continuous */ if(continuous) { ((DATA*)data)->simulationInfo->solveContinuous = 0; } else { ((DATA*)data)->simulationInfo->solveContinuous = 1; } /* re-scaling x vector */ if(solverData->useXScaling) for(i=0; i<solverData->n; i++) solverData->x[i] = solverData->x[i]*solverData->xScalefactors[i]; /* check for proper inputs */ if(solverData->info == 0) { printErrorEqSyst(IMPROPER_INPUT, modelInfoGetEquation(&data->modelData->modelDataXml, eqSystemNumber), data->localData[0]->timeValue); } if(solverData->info != -1) { /* evaluate with discontinuities */ if(data->simulationInfo->discreteCall){ int scaling = solverData->useXScaling; int success = 0; if(scaling) solverData->useXScaling = 0; ((DATA*)data)->simulationInfo->solveContinuous = 0; /* try */ #ifndef OMC_EMCC MMC_TRY_INTERNAL(simulationJumpBuffer) #endif wrapper_fvec_hybrj(&solverData->n, solverData->x, solverData->fvec, solverData->fjac, &solverData->ldfjac, &iflag, (void*) &dataAndSysNumber); success = 1; #ifndef OMC_EMCC MMC_CATCH_INTERNAL(simulationJumpBuffer) #endif /* catch */ if (!success) { warningStreamPrint(LOG_STDOUT, 0, "Non-Linear Solver try to handle a problem with a called assert."); solverData->info = -1; xerror_scaled = 1; xerror = 1; assertCalled = 1; } if(scaling) solverData->useXScaling = 1; updateRelationsPre(data); } } if(solverData->info != -1) { /* scaling residual vector */ { int l=0; for(i=0; i<solverData->n; i++){ solverData->resScaling[i] = 1e-16; for(j=0; j<solverData->n; j++){ solverData->resScaling[i] = (fabs(solverData->fjacobian[l]) > solverData->resScaling[i]) ? fabs(solverData->fjacobian[l]) : solverData->resScaling[i]; l++; } solverData->fvecScaled[i] = solverData->fvec[i] * (1 / solverData->resScaling[i]); } /* debug output */ if(ACTIVE_STREAM(LOG_NLS_V)) { infoStreamPrint(LOG_NLS_V, 1, "scaling factors for residual vector"); for(i=0; i<solverData->n; i++) { infoStreamPrint(LOG_NLS_V, 1, "scaled residual [%d] : %.20e", i, solverData->fvecScaled[i]); infoStreamPrint(LOG_NLS_V, 0, "scaling factor [%d] : %.20e", i, solverData->resScaling[i]); messageClose(LOG_NLS_V); } messageClose(LOG_NLS_V); } /* debug output */ if(ACTIVE_STREAM(LOG_NLS_JAC)) { char buffer[4096]; infoStreamPrint(LOG_NLS_JAC, 1, "jacobian matrix [%dx%d]", (int)solverData->n, (int)solverData->n); for(i=0; i<solverData->n; i++) { buffer[0] = 0; for(j=0; j<solverData->n; j++) sprintf(buffer, "%s%10g ", buffer, solverData->fjacobian[i*solverData->n+j]); infoStreamPrint(LOG_NLS_JAC, 0, "%s", buffer); } messageClose(LOG_NLS_JAC); } /* check for error */ xerror_scaled = enorm_(&solverData->n, solverData->fvecScaled); xerror = enorm_(&solverData->n, solverData->fvec); } } /* reset non-contunuousCase */ if(nonContinuousCase && xerror > local_tol && xerror_scaled > local_tol) { memcpy(data->simulationInfo->relationsPre, relationsPreBackup, sizeof(modelica_boolean)*data->modelData->nRelations); nonContinuousCase = 0; } if(solverData->info < 4 && xerror > local_tol && xerror_scaled > local_tol) solverData->info = 4; /* solution found */ if(solverData->info == 1 || xerror <= local_tol || xerror_scaled <= local_tol) { int scaling; success = 1; nfunc_evals += solverData->nfev; if(ACTIVE_STREAM(LOG_NLS)) { int indexes[2] = {1,eqSystemNumber}; /* output solution */ infoStreamPrintWithEquationIndexes(LOG_NLS, 1, indexes, "solution for NLS %d at t=%g", eqSystemNumber, data->localData[0]->timeValue); for(i=0; i<solverData->n; ++i) { infoStreamPrint(LOG_NLS, 0, "[%d] %s = %g", i+1, modelInfoGetEquation(&data->modelData->modelDataXml,eqSystemNumber).vars[i], solverData->x[i]); } messageClose(LOG_NLS); }else if (ACTIVE_STREAM(LOG_NLS_V)){ infoStreamPrint(LOG_NLS_V, 1, "system solved"); infoStreamPrint(LOG_NLS_V, 0, "%d retries\n%d restarts", retries, retries2+retries3); messageClose(LOG_NLS_V); printStatus(data, solverData, eqSystemNumber, &nfunc_evals, &xerror, &xerror_scaled, LOG_NLS_V); } scaling = solverData->useXScaling; if(scaling) solverData->useXScaling = 0; /* take the solution */ memcpy(systemData->nlsx, solverData->x, solverData->n*(sizeof(double))); /* try */ { int success = 0; #ifndef OMC_EMCC MMC_TRY_INTERNAL(simulationJumpBuffer) #endif wrapper_fvec_hybrj(&solverData->n, solverData->x, solverData->fvec, solverData->fjac, &solverData->ldfjac, &iflag, (void*) &dataAndSysNumber); success = 1; #ifndef OMC_EMCC MMC_CATCH_INTERNAL(simulationJumpBuffer) #endif /* catch */ if (!success) { warningStreamPrint(LOG_STDOUT, 0, "Non-Linear Solver try to handle a problem with a called assert."); solverData->info = 4; xerror_scaled = 1; xerror = 1; assertCalled = 1; success = 0; giveUp = 0; } } if(scaling) solverData->useXScaling = 1; }
/* Subroutine */ void hybrj1_(void (*fcn)(const int *n, const double *x, double *fvec, double *fjec, const int *ldfjac, int *iflag ), const int *n, double *x, double * fvec, double *fjac, const int *ldfjac, const double *tol, int * info, double *wa, const int *lwa) { /* Initialized data */ const double factor = 100.; /* System generated locals */ int fjac_dim1, fjac_offset, i__1; /* Local variables */ int j, lr, mode, nfev, njev; double xtol; int maxfev, nprint; /* ********** */ /* subroutine hybrj1 */ /* the purpose of hybrj1 is to find a zero of a system of */ /* n nonlinear functions in n variables by a modification */ /* of the powell hybrid method. this is done by using the */ /* more general nonlinear equation solver hybrj. the user */ /* must provide a subroutine which calculates the functions */ /* and the jacobian. */ /* the subroutine statement is */ /* subroutine hybrj1(fcn,n,x,fvec,fjac,ldfjac,tol,info,wa,lwa) */ /* where */ /* fcn is the name of the user-supplied subroutine which */ /* calculates the functions and the jacobian. fcn must */ /* be declared in an external statement in the user */ /* calling program, and should be written as follows. */ /* subroutine fcn(n,x,fvec,fjac,ldfjac,iflag) */ /* integer n,ldfjac,iflag */ /* double precision x(n),fvec(n),fjac(ldfjac,n) */ /* ---------- */ /* if iflag = 1 calculate the functions at x and */ /* return this vector in fvec. do not alter fjac. */ /* if iflag = 2 calculate the jacobian at x and */ /* return this matrix in fjac. do not alter fvec. */ /* --------- */ /* return */ /* end */ /* the value of iflag should not be changed by fcn unless */ /* the user wants to terminate execution of hybrj1. */ /* in this case set iflag to a negative integer. */ /* n is a positive integer input variable set to the number */ /* of functions and variables. */ /* x is an array of length n. on input x must contain */ /* an initial estimate of the solution vector. on output x */ /* contains the final estimate of the solution vector. */ /* fvec is an output array of length n which contains */ /* the functions evaluated at the output x. */ /* fjac is an output n by n array which contains the */ /* orthogonal matrix q produced by the qr factorization */ /* of the final approximate jacobian. */ /* ldfjac is a positive integer input variable not less than n */ /* which specifies the leading dimension of the array fjac. */ /* tol is a nonnegative input variable. termination occurs */ /* when the algorithm estimates that the relative error */ /* between x and the solution is at most tol. */ /* info is an integer output variable. if the user has */ /* terminated execution, info is set to the (negative) */ /* value of iflag. see description of fcn. otherwise, */ /* info is set as follows. */ /* info = 0 improper input parameters. */ /* info = 1 algorithm estimates that the relative error */ /* between x and the solution is at most tol. */ /* info = 2 number of calls to fcn with iflag = 1 has */ /* reached 100*(n+1). */ /* info = 3 tol is too small. no further improvement in */ /* the approximate solution x is possible. */ /* info = 4 iteration is not making good progress. */ /* wa is a work array of length lwa. */ /* lwa is a positive integer input variable not less than */ /* (n*(n+13))/2. */ /* subprograms called */ /* user-supplied ...... fcn */ /* minpack-supplied ... hybrj */ /* argonne national laboratory. minpack project. march 1980. */ /* burton s. garbow, kenneth e. hillstrom, jorge j. more */ /* ********** */ /* Parameter adjustments */ --fvec; --x; fjac_dim1 = *ldfjac; fjac_offset = 1 + fjac_dim1 * 1; fjac -= fjac_offset; --wa; /* Function Body */ *info = 0; /* check the input parameters for errors. */ if (*n <= 0 || *ldfjac < *n || *tol < 0. || *lwa < *n * (*n + 13) / 2) { /* goto L20; */ return; } /* call hybrj. */ maxfev = (*n + 1) * 100; xtol = *tol; mode = 2; i__1 = *n; for (j = 1; j <= i__1; ++j) { wa[j] = 1.; /* L10: */ } nprint = 0; lr = *n * (*n + 1) / 2; hybrj_(fcn, n, &x[1], &fvec[1], &fjac[fjac_offset], ldfjac, &xtol, & maxfev, &wa[1], &mode, &factor, &nprint, info, &nfev, &njev, &wa[* n * 6 + 1], &lr, &wa[*n + 1], &wa[(*n << 1) + 1], &wa[*n * 3 + 1], &wa[(*n << 2) + 1], &wa[*n * 5 + 1]); if (*info == 5) { *info = 4; } /* L20: */ return; /* last card of subroutine hybrj1. */ } /* hybrj1_ */