int BasicWriterImpl::open_writable(int flags)
{
if (flags | O_TRUNC)
update_(std::string(""));
return 0;
}
void
Checksum::update(Packet *pkt) const {
// is it a good idea to put this in the implementation; should the deparser be
// aware that nothing was updated?
if (!is_checksum_condition_met(*pkt)) {
BMLOG_TRACE_PKT(
*pkt, "Skipping checksum '{}' update because condition not met",
get_name());
} else {
BMLOG_DEBUG_PKT(*pkt, "Updating checksum '{}'", get_name());
update_(pkt);
}
}
void UpdateDictThread::run_()
{
try
{
while (true)
{
boost::this_thread::sleep(boost::posix_time::seconds(checkInterval_));
update_();
}
}
catch (boost::thread_interrupted& e)
{
return;
}
}
void Commander::add(Special key)
{
switch (key)
{
case Special::Escape: clear(); break;
case Special::Enter:
case Special::Right: activate(key); break;
case Special::Left:
case Special::Up:
case Special::Down: move(key); break;
case Special::CtrlDelete:
case Special::Delete: removeSelected(key); break;
default: dispatchEvent(key); break;
}
update_();
}
void RRCSSensor::Run() {
auto thread_lambda = [this]() -> void {
std::cout << "Starting " << name_ << std::endl;
time_ = std::chrono::high_resolution_clock::now();
time_ += std::chrono::milliseconds(10000);
bool queue_status = true;
RRCSSensorMeasurement d;
while(!abort_() && queue_status) {
std::this_thread::sleep_until(time_);
ReadSensor(d, time_);
time_ += rate_;
queue_status = update_(d);
}
};
thread_ = std::thread(thread_lambda);
}
int BasicWriterImpl::write
(std::string *h, char const *src, statefs_size_t len, statefs_off_t off)
{
if (len) {
auto max_sz = len + off;
if (max_sz > h->size()) {
h->resize(max_sz);
size_ = max_sz;
}
std::copy(src, src + len, &(h->at(off)));
} else if (!off) {
*h = "";
} else {
return len;
}
update_(*h);
return len;
}
void
nest::SimulationManager::resume_( size_t num_active_nodes )
{
assert( kernel().is_initialized() );
std::ostringstream os;
double_t t_sim = to_do_ * Time::get_resolution().get_ms();
os << "Number of local nodes: " << num_active_nodes << std::endl;
os << "Simulaton time (ms): " << t_sim;
#ifdef _OPENMP
os << std::endl
<< "Number of OpenMP threads: " << kernel().vp_manager.get_num_threads();
#else
os << std::endl
<< "Not using OpenMP";
#endif
#ifdef HAVE_MPI
os << std::endl
<< "Number of MPI processes: " << kernel().mpi_manager.get_num_processes();
#else
os << std::endl
<< "Not using MPI";
#endif
LOG( M_INFO, "SimulationManager::resume", os.str() );
terminate_ = false;
if ( to_do_ == 0 )
return;
if ( print_time_ )
{
// TODO: Remove direct output
std::cout << std::endl;
print_progress_();
}
simulating_ = true;
simulated_ = true;
update_();
simulating_ = false;
if ( print_time_ )
std::cout << std::endl;
kernel().mpi_manager.synchronize();
if ( terminate_ )
{
LOG( M_ERROR,
"SimulationManager::resume",
"Exiting on error or user signal." );
LOG( M_ERROR,
"SimulationManager::resume",
"SimulationManager: Use 'ResumeSimulation' to resume." );
if ( SLIsignalflag != 0 )
{
SystemSignal signal( SLIsignalflag );
SLIsignalflag = 0;
throw signal;
}
else
throw SimulationError();
}
LOG( M_INFO, "SimulationManager::resume", "Simulation finished." );
}
// parameter type i/o description
// --------- ---- --- -----------
//
// SUBROUTINE INITIAL_ (ns, m, emax, x, hx, hpx, lb, xlb, ub, xub, ifault, iwv, rwv)
//
// ns integer input upper limit for number of
// points defining hulls (defines
// lengths of working vectors: see
// below; ns=10 should be ample). // ample = hojny (CZ)
//
// m integer input number of starting abscissae
// (m=2 is usually enough)
//
// emax double precision input a large number for which
// exp(emax) and exp(-emax) can be
// calculated
//
// x double precision input starting abscissae
// array size m
//
// hx double precision input log density at starting
// array size m abscissae
//
// hpx double precision input gradients of log density at
// array size m starting abscissae
//
// lb logical input true if domain is bounded below
//
// xlb double precision input lower bound of domain
// (if lb = true)
//
// ub logical input true if domain is bounded above
//
// xub double precision input upper bound of domain
// (if ub = true)
//
// ifault integer output 0: successful initialisation
// 1: not enough starting points
// 2: ns is less than m
// 3: no abscissae to left of mode
// (if lb = false)
// 4: no abscissae to right of
// mode (if ub = false)
// 5: non-log-concavity detected
//
// iwv integer array output working vector
// size ns+7
//
// rwv double precision output working vector
// array size 6*ns+15 = 6*(ns+1)+9
//
void
initial_(const int *ns, const int *m, const double *emax, const double *x, const double *hx, const double *hpx,
const int *lb, double *xlb, const int *ub, double *xub, int *ifault, int *iwv, double *rwv)
{
bool test = false;
/* System generated locals */
static int i__1;
static double d__1, d__2;
/* Local variables */
static double alcu, hulb, huub;
static int iipt, ihpx, ilow, ihuz, i__, ihigh, iscum;
static bool horiz;
static double cu;
static int nn, ix, iz;
static double huzmax, eps;
static int ihx;
/* Parameter adjustments */
--rwv;
--iwv;
--hpx;
--hx;
--x;
/* Function Body */
d__1 = -(*emax);
eps = expon_(&d__1, emax);
*ifault = 0;
ilow = 1;
ihigh = 1;
nn = *ns + 1;
/* at least one starting point */
if (*m < 1) {
*ifault = 1;
}
huzmax = hx[1];
if (! (*ub)) {
*xub = (double)0.0;
}
if (! (*lb)) {
*xlb = (double)0.0;
}
hulb = (*xlb - x[1]) * hpx[1] + hx[1];
huub = (*xub - x[1]) * hpx[1] + hx[1];
/* if bounded on both sides */
if (*ub && *lb) {
huzmax = (huub > hulb ? huub : hulb);
horiz = fabs(hpx[1]) < eps;
if (horiz) {
d__1 = (huub + hulb) * (double)0.5 - huzmax;
cu = expon_(&d__1, emax) * (*xub - *xlb);
} else {
d__1 = huub - huzmax;
d__2 = hulb - huub;
cu = expon_(&d__1, emax) * (1 - expon_(&d__2, emax)) / hpx[1];
}
} else if (*ub && ! (*lb)) {
/* if bounded on the right and unbounded on the left */
huzmax = huub;
cu = (double)1.0 / hpx[1];
} else if (! (*ub) && *lb) {
/* if bounded on the left and unbounded on the right */
huzmax = hulb;
cu = (double)-1.0 / hpx[1];
/* if unbounded at least 2 starting points */
} else {
cu = (double)0.0;
if (*m < 2) {
*ifault = 1;
}
}
if (cu > (double)0.0) {
alcu = log(cu);
}
/* set pointers */
iipt = 6;
iz = 9;
ihuz = nn + iz;
iscum = nn + ihuz;
ix = nn + iscum;
ihx = nn + ix;
ihpx = nn + ihx;
/* store values in working vectors */
iwv[1] = ilow;
iwv[2] = ihigh;
iwv[3] = *ns;
iwv[4] = 1;
if (*lb) {
iwv[5] = 1;
} else {
iwv[5] = 0;
}
if (*ub) {
iwv[6] = 1;
} else {
iwv[6] = 0;
}
if (*ns < *m) {
*ifault = 2;
}
iwv[iipt + 1] = 0;
rwv[1] = hulb;
rwv[2] = huub;
rwv[3] = *emax;
rwv[4] = eps;
rwv[5] = cu;
rwv[6] = alcu;
rwv[7] = huzmax;
rwv[8] = *xlb;
rwv[9] = *xub;
rwv[iscum + 1] = (double)1.0;
i__1 = *m;
for (i__ = 1; i__ <= i__1; ++i__) {
rwv[ix + i__] = x[i__];
rwv[ihx + i__] = hx[i__];
rwv[ihpx + i__] = hpx[i__];
/* L9: */
}
/* create lower and upper hulls */
i__ = 1;
//test=0;
if (test){
printf("\n*m = %d, i__ = %d; ", *m, i__);
printf("x = "); for(int i = 1; i <= 1+(*ns); i++) printf("%f, ", rwv[ix+i]); printf("\n");
printf("iwv = "); for(int i = 1; i <= 6; i++) printf("%d, ", iwv[i]); printf("\n");
printf("ipt = "); for(int i = 7; i <= 7+(*ns); i++) printf("%d, ", iwv[i]); printf("\n");
}
while (i__ < *m) {
update_(&iwv[4], &iwv[1], &iwv[2], &iwv[iipt + 1], &rwv[iscum + 1],
&rwv[5], &rwv[ix + 1], &rwv[ihx + 1], &rwv[ihpx + 1], &rwv[iz + 1],
&rwv[ihuz + 1], &rwv[7], &rwv[3], lb, &rwv[8],
&rwv[1], ub, &rwv[9], &rwv[2], ifault,
&rwv[4], &rwv[6]);
i__ = iwv[4];
if (test){
printf("\ni__=%d; ", i__);
printf("x = "); for(int i = 1; i <= 1+(*ns); i++) printf("%f, ", rwv[ix+i]); printf("\n");
printf("iwv = "); for(int i = 1; i <= 6; i++) printf("%d, ", iwv[i]); printf("\n");
printf("ipt = "); for(int i = 7; i <= 7+(*ns); i++) printf("%d, ", iwv[i]); printf("\n");
}
if (*ifault != 0) return;
}
/* test for wrong starting points */
if (! (*lb) && hpx[iwv[1]] < eps) {
*ifault = 3;
}
if (! (*ub) && hpx[iwv[2]] > -eps) {
*ifault = 4;
}
return;
} /* end of the routine initial_ */
void InstrumentVisualizer::undo_()
{
update_();
}
void update(signed long long int u, signed long long v, signed long long k)
{
update_(u, k);
update_(v+1, -k);
}
void spl1_(const int *ns, int *n, int *ilow, int *ihigh, int *ipt,
double *scum, double *cu, double *x, double *hx, double *hpx,
double *z__, double *huz, double *huzmax,
const int *lb, double *xlb, double *hulb, const int *ub, double *xub, double *huub,
void *mydata, void *mydataprima, double *beta, int *ifault, const double *emax, const double *eps, double *alcu)
{
const int max_attempt = 3*(*ns); // maximal number of attempts to sample a value
// (usually (not necessarily) is something wrong if this number is reached)
/* Local variables */
static double alhl, alhu;
static int i__, j, n1;
static double u1, u2, fx;
static bool sampld;
static double alu1;
//Necesario para poder utilizar los generadores de numeros aleatorios del R
//srand((unsigned)time(0));
/* Parameter adjustments */
--huz;
--z__;
--hpx;
--hx;
--x;
--scum;
--ipt;
/* Function Body */
*ifault = 0;
sampld = false;
int attempts = 0;
while (! sampld && attempts < max_attempt) {
// u2 = random_(&l);
u2 = u_random();
/* test for zero random number */
if (u2 == (double)0.0) {
*ifault = 6;
return;
}
splhull_(&u2, &ipt[1], ilow, lb, xlb,
hulb, huzmax, alcu, &x[1], &hx[1],
&hpx[1], &z__[1], &huz[1], &scum[1], eps,
emax, beta, &i__, &j);
//std::cout << "beta = " <<*beta << std::endl;
/* sample u1 to compute rejection */
u1 = u_random();
if (u1 == (double)0.0) {
*ifault = 6;
}
alu1 = log(u1);
/* compute alhu: upper hull at point u1 */
alhu = hpx[i__] * (*beta - x[i__]) + hx[i__] - *huzmax;
if (*beta > x[*ilow] && *beta < x[*ihigh]) {
/* compute alhl: value of the lower hull at point u1 */
if (*beta > x[i__]) {
j = i__;
i__ = ipt[i__];
}
alhl = hx[i__] + (*beta - x[i__]) * (hx[i__] - hx[j]) / (x[i__] - x[j]) - *huzmax;
/* squeezing test */
if (alhl - alhu > alu1) {
sampld = true;
}
//else{
// printf("alhl=%e, alhu=%e, alu1=%e\n", alhl, alhu, alu1);
//}
}
/* if not sampled evaluate the function, do the rejection test and update */
if (! sampld) {
n1 = *n + 1;
x[n1] = *beta;
hx[n1]=evalhx(x[n1], mydata);
hpx[n1]=evalhprimax(x[n1], mydataprima);
fx = hx[n1] - *huzmax;
if (alu1 < fx - alhu) {
sampld = true;
}
// else{
// Rprintf("alu1=%e, fx=%e, alhu=%e\n", alu1, fx, alhu);
// }
/* update while the number of points defining the hulls is lower than ns */
if (*n < *ns) {
update_(n, ilow, ihigh, &ipt[1], &scum[1],
cu, &x[1], &hx[1], &hpx[1], &z__[1],
&huz[1], huzmax, emax, lb, xlb,
hulb, ub, xub, huub, ifault,
eps, alcu);
}
if (*ifault != 0) {
return;
}
}
attempts++;
} /** end of while (! sampld) **/
//Necesario al terminar de utilizar los generadores de numeros aleatorios del R
//PutRNGstate();
if (attempts >= max_attempt) {
Rprintf("Error message from the Adaptive Rejection Sampler - for parameters uCAR (spatial term) or nu (survival response)");
Rprintf("Trap in ARS: Maximum number of attempts reached by routine spl1_");
}
return;
} /* end of the routine spl1_ */
void InstrumentSettingsVisualizer::undo_()
{
update_();
}
void SampleVisualizer::undo_()
{
update_();
}
bool xtionni::BaseManager::update()
{
bool result = update_();
isUpdated_ = result;
return result;
}
void Commander::clear()
{
LOG_SM_(Debug, clear, "");
dispatchEvent(Special::Escape);
update_();
}
const char* read( char* buf ) // quick and dirty
{
comma::csv::format::traits< comma::uint32 >::to_bin( value_, buf );
update_();
return buf;
}
const std::string* read()
{
serialized_ = boost::lexical_cast< std::string >( value_ );
update_();
return &serialized_;
}
void TaggingVisualizer::undo_()
{
update_();
}
/* Subroutine */ int newuob_(integer *n, integer *npt, doublereal *x,
doublereal *rhobeg, doublereal *rhoend, integer *iprint, integer *
maxfun, doublereal *xbase, doublereal *xopt, doublereal *xnew,
doublereal *xpt, doublereal *fval, doublereal *gq, doublereal *hq,
doublereal *pq, doublereal *bmat, doublereal *zmat, integer *ndim,
doublereal *d__, doublereal *vlag, doublereal *w, S_fp calfun)
{
/* Format strings */
static char fmt_320[] = "(/4x,\002Return from NEWUOA because CALFUN has "
"been\002,\002 called MAXFUN times.\002)";
static char fmt_330[] = "(/4x,\002Function number\002,i6,\002 F =\002"
",1pd18.10,\002 The corresponding X is:\002/(2x,5d15.6))";
static char fmt_370[] = "(/4x,\002Return from NEWUOA because a trus"
"t\002,\002 region step has failed to reduce Q.\002)";
static char fmt_500[] = "(5x)";
static char fmt_510[] = "(/4x,\002New RHO =\002,1pd11.4,5x,\002Number o"
"f\002,\002 function values =\002,i6)";
static char fmt_520[] = "(4x,\002Least value of F =\002,1pd23.15,9x,\002"
"The corresponding X is:\002/(2x,5d15.6))";
static char fmt_550[] = "(/4x,\002At the return from NEWUOA\002,5x,\002N"
"umber of function values =\002,i6)";
/* System generated locals */
integer xpt_dim1, xpt_offset, bmat_dim1, bmat_offset, zmat_dim1,
zmat_offset, i__1, i__2, i__3;
doublereal d__1, d__2, d__3;
/* Builtin functions */
double sqrt(doublereal);
integer s_wsfe(cilist *), e_wsfe(void), do_fio(integer *, char *, ftnlen);
/* Local variables */
static doublereal f;
static integer i__, j, k, ih, nf, nh, ip, jp;
static doublereal dx;
static integer np, nfm;
static doublereal one;
static integer idz;
static doublereal dsq, rho;
static integer ipt, jpt;
static doublereal sum, fbeg, diff, half, beta;
static integer nfmm;
static doublereal gisq;
static integer knew;
static doublereal temp, suma, sumb, fopt, bsum, gqsq;
static integer kopt, nptm;
static doublereal zero, xipt, xjpt, sumz, diffa, diffb, diffc, hdiag,
alpha, delta, recip, reciq, fsave;
static integer ksave, nfsav, itemp;
static doublereal dnorm, ratio, dstep, tenth, vquad;
static integer ktemp;
static doublereal tempq;
static integer itest;
static doublereal rhosq;
extern /* Subroutine */ int biglag_(integer *, integer *, doublereal *,
doublereal *, doublereal *, doublereal *, integer *, integer *,
integer *, doublereal *, doublereal *, doublereal *, doublereal *,
doublereal *, doublereal *, doublereal *, doublereal *), bigden_(
integer *, integer *, doublereal *, doublereal *, doublereal *,
doublereal *, integer *, integer *, integer *, integer *,
doublereal *, doublereal *, doublereal *, doublereal *,
doublereal *, doublereal *, doublereal *), update_(integer *,
integer *, doublereal *, doublereal *, integer *, integer *,
doublereal *, doublereal *, integer *, doublereal *);
static doublereal detrat, crvmin;
static integer nftest;
static doublereal distsq;
extern /* Subroutine */ int trsapp_(integer *, integer *, doublereal *,
doublereal *, doublereal *, doublereal *, doublereal *,
doublereal *, doublereal *, doublereal *, doublereal *,
doublereal *, doublereal *, doublereal *);
static doublereal xoptsq;
/* Fortran I/O blocks */
static cilist io___55 = { 0, 6, 0, fmt_320, 0 };
static cilist io___56 = { 0, 6, 0, fmt_330, 0 };
static cilist io___61 = { 0, 6, 0, fmt_370, 0 };
static cilist io___68 = { 0, 6, 0, fmt_500, 0 };
static cilist io___69 = { 0, 6, 0, fmt_510, 0 };
static cilist io___70 = { 0, 6, 0, fmt_520, 0 };
static cilist io___71 = { 0, 6, 0, fmt_550, 0 };
static cilist io___72 = { 0, 6, 0, fmt_520, 0 };
/* The arguments N, NPT, X, RHOBEG, RHOEND, IPRINT and MAXFUN are identical */
/* to the corresponding arguments in SUBROUTINE NEWUOA. */
/* XBASE will hold a shift of origin that should reduce the contributions */
/* from rounding errors to values of the model and Lagrange functions. */
/* XOPT will be set to the displacement from XBASE of the vector of */
/* variables that provides the least calculated F so far. */
/* XNEW will be set to the displacement from XBASE of the vector of */
/* variables for the current calculation of F. */
/* XPT will contain the interpolation point coordinates relative to XBASE. */
/* FVAL will hold the values of F at the interpolation points. */
/* GQ will hold the gradient of the quadratic model at XBASE. */
/* HQ will hold the explicit second derivatives of the quadratic model. */
/* PQ will contain the parameters of the implicit second derivatives of */
/* the quadratic model. */
/* BMAT will hold the last N columns of H. */
/* ZMAT will hold the factorization of the leading NPT by NPT submatrix of */
/* H, this factorization being ZMAT times Diag(DZ) times ZMAT^T, where */
/* the elements of DZ are plus or minus one, as specified by IDZ. */
/* NDIM is the first dimension of BMAT and has the value NPT+N. */
/* D is reserved for trial steps from XOPT. */
/* VLAG will contain the values of the Lagrange functions at a new point X. */
/* They are part of a product that requires VLAG to be of length NDIM. */
/* The array W will be used for working space. Its length must be at least */
/* 10*NDIM = 10*(NPT+N). */
/* Set some constants. */
/* Parameter adjustments */
zmat_dim1 = *npt;
zmat_offset = 1 + zmat_dim1;
zmat -= zmat_offset;
xpt_dim1 = *npt;
xpt_offset = 1 + xpt_dim1;
xpt -= xpt_offset;
--x;
--xbase;
--xopt;
--xnew;
--fval;
--gq;
--hq;
--pq;
bmat_dim1 = *ndim;
bmat_offset = 1 + bmat_dim1;
bmat -= bmat_offset;
--d__;
--vlag;
--w;
/* Function Body */
half = .5;
one = 1.;
tenth = .1;
zero = 0.;
np = *n + 1;
nh = *n * np / 2;
nptm = *npt - np;
nftest = max(*maxfun,1);
/* Set the initial elements of XPT, BMAT, HQ, PQ and ZMAT to zero. */
i__1 = *n;
for(j = 1; j <= i__1; ++j) {
xbase[j] = x[j];
i__2 = *npt;
for(k = 1; k <= i__2; ++k) {
/* L10: */
xpt[k + j * xpt_dim1] = zero;
}
i__2 = *ndim;
for(i__ = 1; i__ <= i__2; ++i__) {
/* L20: */
bmat[i__ + j * bmat_dim1] = zero;
}
}
i__2 = nh;
for(ih = 1; ih <= i__2; ++ih) {
/* L30: */
hq[ih] = zero;
}
i__2 = *npt;
for(k = 1; k <= i__2; ++k) {
pq[k] = zero;
i__1 = nptm;
for(j = 1; j <= i__1; ++j) {
/* L40: */
zmat[k + j * zmat_dim1] = zero;
}
}
/* Begin the initialization procedure. NF becomes one more than the number */
/* of function values so far. The coordinates of the displacement of the */
/* next initial interpolation point from XBASE are set in XPT(NF,.). */
rhosq = *rhobeg * *rhobeg;
recip = one / rhosq;
reciq = sqrt(half) / rhosq;
nf = 0;
L50:
nfm = nf;
nfmm = nf - *n;
++nf;
if(nfm <= *n << 1) {
if(nfm >= 1 && nfm <= *n) {
xpt[nf + nfm * xpt_dim1] = *rhobeg;
} else if(nfm > *n) {
xpt[nf + nfmm * xpt_dim1] = -(*rhobeg);
}
} else {
itemp = (nfmm - 1) / *n;
jpt = nfm - itemp * *n - *n;
ipt = jpt + itemp;
if(ipt > *n) {
itemp = jpt;
jpt = ipt - *n;
ipt = itemp;
}
xipt = *rhobeg;
if(fval[ipt + np] < fval[ipt + 1]) {
xipt = -xipt;
}
xjpt = *rhobeg;
if(fval[jpt + np] < fval[jpt + 1]) {
xjpt = -xjpt;
}
xpt[nf + ipt * xpt_dim1] = xipt;
xpt[nf + jpt * xpt_dim1] = xjpt;
}
/* Calculate the next value of F, label 70 being reached immediately */
/* after this calculation. The least function value so far and its index */
/* are required. */
i__1 = *n;
for(j = 1; j <= i__1; ++j) {
/* L60: */
x[j] = xpt[nf + j * xpt_dim1] + xbase[j];
}
goto L310;
L70:
fval[nf] = f;
if(nf == 1) {
fbeg = f;
fopt = f;
kopt = 1;
} else if(f < fopt) {
fopt = f;
kopt = nf;
}
/* Set the nonzero initial elements of BMAT and the quadratic model in */
/* the cases when NF is at most 2*N+1. */
if(nfm <= *n << 1) {
if(nfm >= 1 && nfm <= *n) {
gq[nfm] = (f - fbeg) / *rhobeg;
if(*npt < nf + *n) {
bmat[nfm * bmat_dim1 + 1] = -one / *rhobeg;
bmat[nf + nfm * bmat_dim1] = one / *rhobeg;
bmat[*npt + nfm + nfm * bmat_dim1] = -half * rhosq;
}
} else if(nfm > *n) {
bmat[nf - *n + nfmm * bmat_dim1] = half / *rhobeg;
bmat[nf + nfmm * bmat_dim1] = -half / *rhobeg;
zmat[nfmm * zmat_dim1 + 1] = -reciq - reciq;
zmat[nf - *n + nfmm * zmat_dim1] = reciq;
zmat[nf + nfmm * zmat_dim1] = reciq;
ih = nfmm * (nfmm + 1) / 2;
temp = (fbeg - f) / *rhobeg;
hq[ih] = (gq[nfmm] - temp) / *rhobeg;
gq[nfmm] = half * (gq[nfmm] + temp);
}
/* Set the off-diagonal second derivatives of the Lagrange functions and */
/* the initial quadratic model. */
} else {
ih = ipt * (ipt - 1) / 2 + jpt;
if(xipt < zero) {
ipt += *n;
}
if(xjpt < zero) {
jpt += *n;
}
zmat[nfmm * zmat_dim1 + 1] = recip;
zmat[nf + nfmm * zmat_dim1] = recip;
zmat[ipt + 1 + nfmm * zmat_dim1] = -recip;
zmat[jpt + 1 + nfmm * zmat_dim1] = -recip;
hq[ih] = (fbeg - fval[ipt + 1] - fval[jpt + 1] + f) / (xipt * xjpt);
}
if(nf < *npt) {
goto L50;
}
/* Begin the iterative procedure, because the initial model is complete. */
rho = *rhobeg;
delta = rho;
idz = 1;
diffa = zero;
diffb = zero;
itest = 0;
xoptsq = zero;
i__1 = *n;
for(i__ = 1; i__ <= i__1; ++i__) {
xopt[i__] = xpt[kopt + i__ * xpt_dim1];
/* L80: */
/* Computing 2nd power */
d__1 = xopt[i__];
xoptsq += d__1 * d__1;
}
L90:
nfsav = nf;
/* Generate the next trust region step and test its length. Set KNEW */
/* to -1 if the purpose of the next F will be to improve the model. */
L100:
knew = 0;
trsapp_(n, npt, &xopt[1], &xpt[xpt_offset], &gq[1], &hq[1], &pq[1], &
delta, &d__[1], &w[1], &w[np], &w[np + *n], &w[np + (*n << 1)], &
crvmin);
dsq = zero;
i__1 = *n;
for(i__ = 1; i__ <= i__1; ++i__) {
/* L110: */
/* Computing 2nd power */
d__1 = d__[i__];
dsq += d__1 * d__1;
}
/* Computing MIN */
d__1 = delta, d__2 = sqrt(dsq);
dnorm = min(d__1,d__2);
if(dnorm < half * rho) {
knew = -1;
delta = tenth * delta;
ratio = -1.;
if(delta <= rho * 1.5) {
delta = rho;
}
if(nf <= nfsav + 2) {
goto L460;
}
temp = crvmin * .125 * rho * rho;
/* Computing MAX */
d__1 = max(diffa,diffb);
if(temp <= max(d__1,diffc)) {
goto L460;
}
goto L490;
}
/* Shift XBASE if XOPT may be too far from XBASE. First make the changes */
/* to BMAT that do not depend on ZMAT. */
L120:
if(dsq <= xoptsq * .001) {
tempq = xoptsq * .25;
i__1 = *npt;
for(k = 1; k <= i__1; ++k) {
sum = zero;
i__2 = *n;
for(i__ = 1; i__ <= i__2; ++i__) {
/* L130: */
sum += xpt[k + i__ * xpt_dim1] * xopt[i__];
}
temp = pq[k] * sum;
sum -= half * xoptsq;
w[*npt + k] = sum;
i__2 = *n;
for(i__ = 1; i__ <= i__2; ++i__) {
gq[i__] += temp * xpt[k + i__ * xpt_dim1];
xpt[k + i__ * xpt_dim1] -= half * xopt[i__];
vlag[i__] = bmat[k + i__ * bmat_dim1];
w[i__] = sum * xpt[k + i__ * xpt_dim1] + tempq * xopt[i__];
ip = *npt + i__;
i__3 = i__;
for(j = 1; j <= i__3; ++j) {
/* L140: */
bmat[ip + j * bmat_dim1] = bmat[ip + j * bmat_dim1] +
vlag[i__] * w[j] + w[i__] * vlag[j];
}
}
}
/* Then the revisions of BMAT that depend on ZMAT are calculated. */
i__3 = nptm;
for(k = 1; k <= i__3; ++k) {
sumz = zero;
i__2 = *npt;
for(i__ = 1; i__ <= i__2; ++i__) {
sumz += zmat[i__ + k * zmat_dim1];
/* L150: */
w[i__] = w[*npt + i__] * zmat[i__ + k * zmat_dim1];
}
i__2 = *n;
for(j = 1; j <= i__2; ++j) {
sum = tempq * sumz * xopt[j];
i__1 = *npt;
for(i__ = 1; i__ <= i__1; ++i__) {
/* L160: */
sum += w[i__] * xpt[i__ + j * xpt_dim1];
}
vlag[j] = sum;
if(k < idz) {
sum = -sum;
}
i__1 = *npt;
for(i__ = 1; i__ <= i__1; ++i__) {
/* L170: */
bmat[i__ + j * bmat_dim1] += sum * zmat[i__ + k *
zmat_dim1];
}
}
i__1 = *n;
for(i__ = 1; i__ <= i__1; ++i__) {
ip = i__ + *npt;
temp = vlag[i__];
if(k < idz) {
temp = -temp;
}
i__2 = i__;
for(j = 1; j <= i__2; ++j) {
/* L180: */
bmat[ip + j * bmat_dim1] += temp * vlag[j];
}
}
}
/* The following instructions complete the shift of XBASE, including */
/* the changes to the parameters of the quadratic model. */
ih = 0;
i__2 = *n;
for(j = 1; j <= i__2; ++j) {
w[j] = zero;
i__1 = *npt;
for(k = 1; k <= i__1; ++k) {
w[j] += pq[k] * xpt[k + j * xpt_dim1];
/* L190: */
xpt[k + j * xpt_dim1] -= half * xopt[j];
}
i__1 = j;
for(i__ = 1; i__ <= i__1; ++i__) {
++ih;
if(i__ < j) {
gq[j] += hq[ih] * xopt[i__];
}
gq[i__] += hq[ih] * xopt[j];
hq[ih] = hq[ih] + w[i__] * xopt[j] + xopt[i__] * w[j];
/* L200: */
bmat[*npt + i__ + j * bmat_dim1] = bmat[*npt + j + i__ *
bmat_dim1];
}
}
i__1 = *n;
for(j = 1; j <= i__1; ++j) {
xbase[j] += xopt[j];
/* L210: */
xopt[j] = zero;
}
xoptsq = zero;
}
/* Pick the model step if KNEW is positive. A different choice of D */
/* may be made later, if the choice of D by BIGLAG causes substantial */
/* cancellation in DENOM. */
if(knew > 0) {
biglag_(n, npt, &xopt[1], &xpt[xpt_offset], &bmat[bmat_offset], &zmat[
zmat_offset], &idz, ndim, &knew, &dstep, &d__[1], &alpha, &
vlag[1], &vlag[*npt + 1], &w[1], &w[np], &w[np + *n]);
}
/* Calculate VLAG and BETA for the current choice of D. The first NPT */
/* components of W_check will be held in W. */
i__1 = *npt;
for(k = 1; k <= i__1; ++k) {
suma = zero;
sumb = zero;
sum = zero;
i__2 = *n;
for(j = 1; j <= i__2; ++j) {
suma += xpt[k + j * xpt_dim1] * d__[j];
sumb += xpt[k + j * xpt_dim1] * xopt[j];
/* L220: */
sum += bmat[k + j * bmat_dim1] * d__[j];
}
w[k] = suma * (half * suma + sumb);
/* L230: */
vlag[k] = sum;
}
beta = zero;
i__1 = nptm;
for(k = 1; k <= i__1; ++k) {
sum = zero;
i__2 = *npt;
for(i__ = 1; i__ <= i__2; ++i__) {
/* L240: */
sum += zmat[i__ + k * zmat_dim1] * w[i__];
}
if(k < idz) {
beta += sum * sum;
sum = -sum;
} else {
beta -= sum * sum;
}
i__2 = *npt;
for(i__ = 1; i__ <= i__2; ++i__) {
/* L250: */
vlag[i__] += sum * zmat[i__ + k * zmat_dim1];
}
}
bsum = zero;
dx = zero;
i__2 = *n;
for(j = 1; j <= i__2; ++j) {
sum = zero;
i__1 = *npt;
for(i__ = 1; i__ <= i__1; ++i__) {
/* L260: */
sum += w[i__] * bmat[i__ + j * bmat_dim1];
}
bsum += sum * d__[j];
jp = *npt + j;
i__1 = *n;
for(k = 1; k <= i__1; ++k) {
/* L270: */
sum += bmat[jp + k * bmat_dim1] * d__[k];
}
vlag[jp] = sum;
bsum += sum * d__[j];
/* L280: */
dx += d__[j] * xopt[j];
}
beta = dx * dx + dsq * (xoptsq + dx + dx + half * dsq) + beta - bsum;
vlag[kopt] += one;
/* If KNEW is positive and if the cancellation in DENOM is unacceptable, */
/* then BIGDEN calculates an alternative model step, XNEW being used for */
/* working space. */
if(knew > 0) {
/* Computing 2nd power */
d__1 = vlag[knew];
temp = one + alpha * beta / (d__1 * d__1);
if(abs(temp) <= .8) {
bigden_(n, npt, &xopt[1], &xpt[xpt_offset], &bmat[bmat_offset], &
zmat[zmat_offset], &idz, ndim, &kopt, &knew, &d__[1], &w[
1], &vlag[1], &beta, &xnew[1], &w[*ndim + 1], &w[*ndim *
6 + 1]);
}
}
/* Calculate the next value of the objective function. */
L290:
i__2 = *n;
for(i__ = 1; i__ <= i__2; ++i__) {
xnew[i__] = xopt[i__] + d__[i__];
/* L300: */
x[i__] = xbase[i__] + xnew[i__];
}
++nf;
L310:
if(nf > nftest) {
--nf;
if(*iprint > 0) {
s_wsfe(&io___55);
e_wsfe();
}
goto L530;
}
(*calfun)(n, &x[1], &f);
if(*iprint == 3) {
s_wsfe(&io___56);
do_fio(&c__1, (char *)&nf, (ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&f, (ftnlen)sizeof(doublereal));
i__2 = *n;
for(i__ = 1; i__ <= i__2; ++i__) {
do_fio(&c__1, (char *)&x[i__], (ftnlen)sizeof(doublereal));
}
e_wsfe();
}
if(nf <= *npt) {
goto L70;
}
if(knew == -1) {
goto L530;
}
/* Use the quadratic model to predict the change in F due to the step D, */
/* and set DIFF to the error of this prediction. */
vquad = zero;
ih = 0;
i__2 = *n;
for(j = 1; j <= i__2; ++j) {
vquad += d__[j] * gq[j];
i__1 = j;
for(i__ = 1; i__ <= i__1; ++i__) {
++ih;
temp = d__[i__] * xnew[j] + d__[j] * xopt[i__];
if(i__ == j) {
temp = half * temp;
}
/* L340: */
vquad += temp * hq[ih];
}
}
i__1 = *npt;
for(k = 1; k <= i__1; ++k) {
/* L350: */
vquad += pq[k] * w[k];
}
diff = f - fopt - vquad;
diffc = diffb;
diffb = diffa;
diffa = abs(diff);
if(dnorm > rho) {
nfsav = nf;
}
/* Update FOPT and XOPT if the new F is the least value of the objective */
/* function so far. The branch when KNEW is positive occurs if D is not */
/* a trust region step. */
fsave = fopt;
if(f < fopt) {
fopt = f;
xoptsq = zero;
i__1 = *n;
for(i__ = 1; i__ <= i__1; ++i__) {
xopt[i__] = xnew[i__];
/* L360: */
/* Computing 2nd power */
d__1 = xopt[i__];
xoptsq += d__1 * d__1;
}
}
ksave = knew;
if(knew > 0) {
goto L410;
}
/* Pick the next value of DELTA after a trust region step. */
if(vquad >= zero) {
if(*iprint > 0) {
s_wsfe(&io___61);
e_wsfe();
}
goto L530;
}
ratio = (f - fsave) / vquad;
if(ratio <= tenth) {
delta = half * dnorm;
} else if(ratio <= .7) {
/* Computing MAX */
d__1 = half * delta;
delta = max(d__1,dnorm);
} else {
/* Computing MAX */
d__1 = half * delta, d__2 = dnorm + dnorm;
delta = max(d__1,d__2);
}
if(delta <= rho * 1.5) {
delta = rho;
}
/* Set KNEW to the index of the next interpolation point to be deleted. */
/* Computing MAX */
d__2 = tenth * delta;
/* Computing 2nd power */
d__1 = max(d__2,rho);
rhosq = d__1 * d__1;
ktemp = 0;
detrat = zero;
if(f >= fsave) {
ktemp = kopt;
detrat = one;
}
i__1 = *npt;
for(k = 1; k <= i__1; ++k) {
hdiag = zero;
i__2 = nptm;
for(j = 1; j <= i__2; ++j) {
temp = one;
if(j < idz) {
temp = -one;
}
/* L380: */
/* Computing 2nd power */
d__1 = zmat[k + j * zmat_dim1];
hdiag += temp * (d__1 * d__1);
}
/* Computing 2nd power */
d__2 = vlag[k];
temp = (d__1 = beta * hdiag + d__2 * d__2, abs(d__1));
distsq = zero;
i__2 = *n;
for(j = 1; j <= i__2; ++j) {
/* L390: */
/* Computing 2nd power */
d__1 = xpt[k + j * xpt_dim1] - xopt[j];
distsq += d__1 * d__1;
}
if(distsq > rhosq) {
/* Computing 3rd power */
d__1 = distsq / rhosq;
temp *= d__1 * (d__1 * d__1);
}
if(temp > detrat && k != ktemp) {
detrat = temp;
knew = k;
}
/* L400: */
}
if(knew == 0) {
goto L460;
}
/* Update BMAT, ZMAT and IDZ, so that the KNEW-th interpolation point */
/* can be moved. Begin the updating of the quadratic model, starting */
/* with the explicit second derivative term. */
L410:
update_(n, npt, &bmat[bmat_offset], &zmat[zmat_offset], &idz, ndim, &vlag[
1], &beta, &knew, &w[1]);
fval[knew] = f;
ih = 0;
i__1 = *n;
for(i__ = 1; i__ <= i__1; ++i__) {
temp = pq[knew] * xpt[knew + i__ * xpt_dim1];
i__2 = i__;
for(j = 1; j <= i__2; ++j) {
++ih;
/* L420: */
hq[ih] += temp * xpt[knew + j * xpt_dim1];
}
}
pq[knew] = zero;
/* Update the other second derivative parameters, and then the gradient */
/* vector of the model. Also include the new interpolation point. */
i__2 = nptm;
for(j = 1; j <= i__2; ++j) {
temp = diff * zmat[knew + j * zmat_dim1];
if(j < idz) {
temp = -temp;
}
i__1 = *npt;
for(k = 1; k <= i__1; ++k) {
/* L440: */
pq[k] += temp * zmat[k + j * zmat_dim1];
}
}
gqsq = zero;
i__1 = *n;
for(i__ = 1; i__ <= i__1; ++i__) {
gq[i__] += diff * bmat[knew + i__ * bmat_dim1];
/* Computing 2nd power */
d__1 = gq[i__];
gqsq += d__1 * d__1;
/* L450: */
xpt[knew + i__ * xpt_dim1] = xnew[i__];
}
/* If a trust region step makes a small change to the objective function, */
/* then calculate the gradient of the least Frobenius norm interpolant at */
/* XBASE, and store it in W, using VLAG for a vector of right hand sides. */
if(ksave == 0 && delta == rho) {
if(abs(ratio) > .01) {
itest = 0;
} else {
i__1 = *npt;
for(k = 1; k <= i__1; ++k) {
/* L700: */
vlag[k] = fval[k] - fval[kopt];
}
gisq = zero;
i__1 = *n;
for(i__ = 1; i__ <= i__1; ++i__) {
sum = zero;
i__2 = *npt;
for(k = 1; k <= i__2; ++k) {
/* L710: */
sum += bmat[k + i__ * bmat_dim1] * vlag[k];
}
gisq += sum * sum;
/* L720: */
w[i__] = sum;
}
/* Test whether to replace the new quadratic model by the least Frobenius */
/* norm interpolant, making the replacement if the test is satisfied. */
++itest;
if(gqsq < gisq * 100.) {
itest = 0;
}
if(itest >= 3) {
i__1 = *n;
for(i__ = 1; i__ <= i__1; ++i__) {
/* L730: */
gq[i__] = w[i__];
}
i__1 = nh;
for(ih = 1; ih <= i__1; ++ih) {
/* L740: */
hq[ih] = zero;
}
i__1 = nptm;
for(j = 1; j <= i__1; ++j) {
w[j] = zero;
i__2 = *npt;
for(k = 1; k <= i__2; ++k) {
/* L750: */
w[j] += vlag[k] * zmat[k + j * zmat_dim1];
}
/* L760: */
if(j < idz) {
w[j] = -w[j];
}
}
i__1 = *npt;
for(k = 1; k <= i__1; ++k) {
pq[k] = zero;
i__2 = nptm;
for(j = 1; j <= i__2; ++j) {
/* L770: */
pq[k] += zmat[k + j * zmat_dim1] * w[j];
}
}
itest = 0;
}
}
}
if(f < fsave) {
kopt = knew;
}
/* If a trust region step has provided a sufficient decrease in F, then */
/* branch for another trust region calculation. The case KSAVE>0 occurs */
/* when the new function value was calculated by a model step. */
if(f <= fsave + tenth * vquad) {
goto L100;
}
if(ksave > 0) {
goto L100;
}
/* Alternatively, find out if the interpolation points are close enough */
/* to the best point so far. */
knew = 0;
L460:
distsq = delta * 4. * delta;
i__2 = *npt;
for(k = 1; k <= i__2; ++k) {
sum = zero;
i__1 = *n;
for(j = 1; j <= i__1; ++j) {
/* L470: */
/* Computing 2nd power */
d__1 = xpt[k + j * xpt_dim1] - xopt[j];
sum += d__1 * d__1;
}
if(sum > distsq) {
knew = k;
distsq = sum;
}
/* L480: */
}
/* If KNEW is positive, then set DSTEP, and branch back for the next */
/* iteration, which will generate a "model step". */
if(knew > 0) {
/* Computing MAX */
/* Computing MIN */
d__2 = tenth * sqrt(distsq), d__3 = half * delta;
d__1 = min(d__2,d__3);
dstep = max(d__1,rho);
dsq = dstep * dstep;
goto L120;
}
if(ratio > zero) {
goto L100;
}
if(max(delta,dnorm) > rho) {
goto L100;
}
/* The calculations with the current value of RHO are complete. Pick the */
/* next values of RHO and DELTA. */
L490:
if(rho > *rhoend) {
delta = half * rho;
ratio = rho / *rhoend;
if(ratio <= 16.) {
rho = *rhoend;
} else if(ratio <= 250.) {
rho = sqrt(ratio) * *rhoend;
} else {
rho = tenth * rho;
}
delta = max(delta,rho);
if(*iprint >= 2) {
if(*iprint >= 3) {
s_wsfe(&io___68);
e_wsfe();
}
s_wsfe(&io___69);
do_fio(&c__1, (char *)&rho, (ftnlen)sizeof(doublereal));
do_fio(&c__1, (char *)&nf, (ftnlen)sizeof(integer));
e_wsfe();
s_wsfe(&io___70);
do_fio(&c__1, (char *)&fopt, (ftnlen)sizeof(doublereal));
i__2 = *n;
for(i__ = 1; i__ <= i__2; ++i__) {
d__1 = xbase[i__] + xopt[i__];
do_fio(&c__1, (char *)&d__1, (ftnlen)sizeof(doublereal));
}
e_wsfe();
}
goto L90;
}
/* Return from the calculation, after another Newton-Raphson step, if */
/* it is too short to have been tried before. */
if(knew == -1) {
goto L290;
}
L530:
if(fopt <= f) {
i__2 = *n;
for(i__ = 1; i__ <= i__2; ++i__) {
/* L540: */
x[i__] = xbase[i__] + xopt[i__];
}
f = fopt;
}
if(*iprint >= 1) {
s_wsfe(&io___71);
do_fio(&c__1, (char *)&nf, (ftnlen)sizeof(integer));
e_wsfe();
s_wsfe(&io___72);
do_fio(&c__1, (char *)&f, (ftnlen)sizeof(doublereal));
i__2 = *n;
for(i__ = 1; i__ <= i__2; ++i__) {
do_fio(&c__1, (char *)&x[i__], (ftnlen)sizeof(doublereal));
}
e_wsfe();
}
return 0;
} /* newuob_ */
void MassAnalyzerVisualizer::undo_()
{
update_();
}
void ModificationVisualizer::undo_()
{
update_();
}
void AcquisitionInfoVisualizer::undo_()
{
update_();
}
void SoftwareVisualizer::undo_()
{
update_();
}
void Commander::add(char ch)
{
dispatchEvent(ch);
update_();
}
void ProductVisualizer::undo_()
{
update_();
}
void ContactPersonVisualizer::undo_()
{
update_();
}
void PrecursorVisualizer::undo_()
{
update_();
}
static void solve(FluidState &fluidState,
ParameterCache ¶mCache,
int phaseIdx,
const ComponentVector &targetFug)
{
typedef MathToolbox<Evaluation> Toolbox;
// use a much more efficient method in case the phase is an
// ideal mixture
if (FluidSystem::isIdealMixture(phaseIdx)) {
solveIdealMix_(fluidState, paramCache, phaseIdx, targetFug);
return;
}
//Dune::FMatrixPrecision<Scalar>::set_singular_limit(1e-25);
// save initial composition in case something goes wrong
Dune::FieldVector<Evaluation, numComponents> xInit;
for (int i = 0; i < numComponents; ++i) {
xInit[i] = fluidState.moleFraction(phaseIdx, i);
}
/////////////////////////
// Newton method
/////////////////////////
// Jacobian matrix
Dune::FieldMatrix<Evaluation, numComponents, numComponents> J;
// solution, i.e. phase composition
Dune::FieldVector<Evaluation, numComponents> x;
// right hand side
Dune::FieldVector<Evaluation, numComponents> b;
paramCache.updatePhase(fluidState, phaseIdx);
// maximum number of iterations
const int nMax = 25;
for (int nIdx = 0; nIdx < nMax; ++nIdx) {
// calculate Jacobian matrix and right hand side
linearize_(J, b, fluidState, paramCache, phaseIdx, targetFug);
Valgrind::CheckDefined(J);
Valgrind::CheckDefined(b);
/*
std::cout << FluidSystem::phaseName(phaseIdx) << "Phase composition: ";
for (int i = 0; i < FluidSystem::numComponents; ++i)
std::cout << fluidState.moleFraction(phaseIdx, i) << " ";
std::cout << "\n";
std::cout << FluidSystem::phaseName(phaseIdx) << "Phase phi: ";
for (int i = 0; i < FluidSystem::numComponents; ++i)
std::cout << fluidState.fugacityCoefficient(phaseIdx, i) << " ";
std::cout << "\n";
*/
// Solve J*x = b
x = Toolbox::createConstant(0.0);
try { J.solve(x, b); }
catch (Dune::FMatrixError e)
{ throw Opm::NumericalIssue(e.what()); }
//std::cout << "original delta: " << x << "\n";
Valgrind::CheckDefined(x);
/*
std::cout << FluidSystem::phaseName(phaseIdx) << "Phase composition: ";
for (int i = 0; i < FluidSystem::numComponents; ++i)
std::cout << fluidState.moleFraction(phaseIdx, i) << " ";
std::cout << "\n";
std::cout << "J: " << J << "\n";
std::cout << "rho: " << fluidState.density(phaseIdx) << "\n";
std::cout << "delta: " << x << "\n";
std::cout << "defect: " << b << "\n";
std::cout << "J: " << J << "\n";
std::cout << "---------------------------\n";
*/
// update the fluid composition. b is also used to store
// the defect for the next iteration.
Scalar relError = update_(fluidState, paramCache, x, b, phaseIdx, targetFug);
if (relError < 1e-9) {
const Evaluation& rho = FluidSystem::density(fluidState, paramCache, phaseIdx);
fluidState.setDensity(phaseIdx, rho);
//std::cout << "num iterations: " << nIdx << "\n";
return;
}
}
OPM_THROW(Opm::NumericalIssue,
"Calculating the " << FluidSystem::phaseName(phaseIdx)
<< "Phase composition failed. Initial {x} = {"
<< xInit
<< "}, {fug_t} = {" << targetFug << "}, p = " << fluidState.pressure(phaseIdx)
<< ", T = " << fluidState.temperature(phaseIdx));
}
void IonSourceVisualizer::undo_()
{
update_();
}
void ProteinHitVisualizer::undo_()
{
update_();
}
