/* solve the matrix equation */
void nrn_solve_minimal(NrnThread* _nt) {
if (use_solve_interleave) {
solve_interleaved(_nt->id);
} else {
triang(_nt);
bksub(_nt);
}
}
int Cvode::solvex_thread(double* b, double* y, NrnThread* nt){
//printf("Cvode::solvex_thread %d t=%g t_=%g\n", nt->id, nt->t, t_);
//printf("Cvode::solvex_thread %d %g\n", nt->id, gam());
//printf("\tenter b\n");
//for (int i=0; i < neq_; ++i) { printf("\t\t%d %g\n", i, b[i]);}
int i;
CvodeThreadData& z = CTD(nt->id);
nt->cj = 1./gam();
nt->_dt = gam();
if (z.nvsize_ == 0) { return 0; }
lhs(nt); // special version for cvode.
scatter_ydot(b, nt->id);
nrn_mul_capacity(nt, z.cmlcap_->ml);
for (i=0; i < z.no_cap_count_; ++i) {
NODERHS(z.no_cap_node_[i]) = 0.;
}
// solve it
#if PARANEURON
if (nrn_multisplit_solve_) {
(*nrn_multisplit_solve_)();
}else
#endif
{
triang(nt);
bksub(nt);
}
//for (i=0; i < v_node_count; ++i) {
// printf("%d rhs %d %g t=%g\n", nrnmpi_myid, i, VEC_RHS(i), t);
//}
if (ncv_->stiff() == 2) {
solvemem(nt);
}else{
// bug here should multiply by gam
}
gather_ydot(b, nt->id);
//printf("\texit b\n");
//for (i=0; i < neq_; ++i) { printf("\t\t%d %g\n", i, b[i]);}
return 0;
}
void glp_adv_basis(glp_prob *P, int flags)
{ int i, j, k, m, n, min_mn, size, *rn, *cn;
char *flag;
if (flags != 0)
xerror("glp_adv_basis: flags = %d; invalid flags\n", flags);
m = P->m; /* number of rows */
n = P->n; /* number of columns */
if (m == 0 || n == 0)
{ /* trivial case */
glp_std_basis(P);
goto done;
}
xprintf("Constructing initial basis...\n");
/* allocate working arrays */
min_mn = (m < n ? m : n);
rn = talloc(1+min_mn, int);
cn = talloc(1+min_mn, int);
flag = talloc(1+m, char);
/* make the basis empty */
for (i = 1; i <= m; i++)
{ flag[i] = 0;
glp_set_row_stat(P, i, GLP_NS);
}
for (j = 1; j <= n; j++)
glp_set_col_stat(P, j, GLP_NS);
/* find maximal triangular part of the constraint matrix;
to prevent including non-fixed rows and fixed columns in the
triangular part, such rows and columns are temporarily made
empty by the routine mat */
#if 1 /* FIXME: tolerance */
size = triang(m, n, mat, P, 0.001, rn, cn);
#endif
xassert(0 <= size && size <= min_mn);
/* include in the basis non-fixed structural variables, whose
columns constitute the triangular part */
for (k = 1; k <= size; k++)
{ i = rn[k];
xassert(1 <= i && i <= m);
flag[i] = 1;
j = cn[k];
xassert(1 <= j && j <= n);
glp_set_col_stat(P, j, GLP_BS);
}
/* include in the basis appropriate auxiliary variables, whose
unity columns preserve triangular form of the basis matrix */
for (i = 1; i <= m; i++)
{ if (flag[i] == 0)
{ glp_set_row_stat(P, i, GLP_BS);
if (P->row[i]->type != GLP_FX)
size++;
}
}
/* size of triangular part = (number of rows) - (number of basic
fixed auxiliary variables) */
xprintf("Size of triangular part is %d\n", size);
/* deallocate working arrays */
tfree(rn);
tfree(cn);
tfree(flag);
done: return;
}
void adv_basis(glp_prob *lp)
{ int m = lpx_get_num_rows(lp);
int n = lpx_get_num_cols(lp);
int i, j, jj, k, size;
int *rn, *cn, *rn_inv, *cn_inv;
int typx, *tagx = xcalloc(1+m+n, sizeof(int));
double lb, ub;
xprintf("Crashing...\n");
if (m == 0)
xerror("glp_adv_basis: problem has no rows\n");
if (n == 0)
xerror("glp_adv_basis: problem has no columns\n");
/* use the routine triang (see above) to find maximal triangular
part of the augmented constraint matrix A~ = (I|-A); in order
to prevent columns of fixed variables to be included in the
triangular part, such columns are implictly removed from the
matrix A~ by the routine adv_mat */
rn = xcalloc(1+m, sizeof(int));
cn = xcalloc(1+m+n, sizeof(int));
size = triang(m, m+n, lp, mat, rn, cn);
if (lpx_get_int_parm(lp, LPX_K_MSGLEV) >= 3)
xprintf("Size of triangular part = %d\n", size);
/* the first size rows and columns of the matrix P*A~*Q (where
P and Q are permutation matrices defined by the arrays rn and
cn) form a lower triangular matrix; build the arrays (rn_inv
and cn_inv), which define the matrices inv(P) and inv(Q) */
rn_inv = xcalloc(1+m, sizeof(int));
cn_inv = xcalloc(1+m+n, sizeof(int));
for (i = 1; i <= m; i++) rn_inv[rn[i]] = i;
for (j = 1; j <= m+n; j++) cn_inv[cn[j]] = j;
/* include the columns of the matrix A~, which correspond to the
first size columns of the matrix P*A~*Q, in the basis */
for (k = 1; k <= m+n; k++) tagx[k] = -1;
for (jj = 1; jj <= size; jj++)
{ j = cn_inv[jj];
/* the j-th column of A~ is the jj-th column of P*A~*Q */
tagx[j] = LPX_BS;
}
/* if size < m, we need to add appropriate columns of auxiliary
variables to the basis */
for (jj = size + 1; jj <= m; jj++)
{ /* the jj-th column of P*A~*Q should be replaced by the column
of the auxiliary variable, for which the only unity element
is placed in the position [jj,jj] */
i = rn_inv[jj];
/* the jj-th row of P*A~*Q is the i-th row of A~, but in the
i-th row of A~ the unity element belongs to the i-th column
of A~; therefore the disired column corresponds to the i-th
auxiliary variable (note that this column doesn't belong to
the triangular part found by the routine triang) */
xassert(1 <= i && i <= m);
xassert(cn[i] > size);
tagx[i] = LPX_BS;
}
/* free working arrays */
xfree(rn);
xfree(cn);
xfree(rn_inv);
xfree(cn_inv);
/* build tags of non-basic variables */
for (k = 1; k <= m+n; k++)
{ if (tagx[k] != LPX_BS)
{ if (k <= m)
lpx_get_row_bnds(lp, k, &typx, &lb, &ub);
else
lpx_get_col_bnds(lp, k-m, &typx, &lb, &ub);
switch (typx)
{ case LPX_FR:
tagx[k] = LPX_NF; break;
case LPX_LO:
tagx[k] = LPX_NL; break;
case LPX_UP:
tagx[k] = LPX_NU; break;
case LPX_DB:
tagx[k] =
(fabs(lb) <= fabs(ub) ? LPX_NL : LPX_NU);
break;
case LPX_FX:
tagx[k] = LPX_NS; break;
default:
xassert(typx != typx);
}
}
}
for (k = 1; k <= m+n; k++)
{ if (k <= m)
lpx_set_row_stat(lp, k, tagx[k]);
else
lpx_set_col_stat(lp, k-m, tagx[k]);
}
xfree(tagx);
return;
}
void test1(int n)
{
Normal nn;
Uniform uniform;
cout <<
"Print 20 N(0,1) random numbers - should be the same as in sample output" <<
endl;
{
Format F; F.FormatType(Format::DEC_FIGS); F.Precision(12); F.Width(15);
for (int i=0; i<20; i++) cout << F << nn.Next() << endl;
}
cout << endl;
cout << "Print histograms of data from a variety distributions" << endl;
cout << "Histograms should be close to those in sample output" << endl;
cout << "s. mean and s. var should be close to p. mean and s. mean" << endl << endl;
{ Constant c(5.0); Histogram(&c, n); }
{ Uniform u; Histogram(&u, n); }
{ SumRandom sr=uniform(3)-1.5; Histogram(&sr, n); }
{ SumRandom sr=uniform-uniform; Histogram(&sr, n); }
{ Normal normal; Histogram(&normal, n); }
{ Cauchy cauchy; Histogram(&cauchy, n); }
{ AsymGenX normal10(NORMAL10, 10.0); Histogram(&normal10, n); }
cout << "Mean and variance should be 10.0 and 4.0" << endl;
{ AsymGenX uniform2(UNIF,0.5); Histogram(&uniform2, n); }
cout << "Mean and variance should be 0.5 and 0.083333" << endl;
{ SymGenX triang(TRIANG); Histogram(&triang, n); }
cout << "Mean and variance should be 0 and 0.16667" << endl;
{ Poisson p(0.25); Histogram(&p, n); }
{ Poisson p(10.0); Histogram(&p, n); }
{ Poisson p(16.0); Histogram(&p, n); }
{ Binomial b(18,0.3); Histogram(&b, n); }
{ Binomial b(19,0.3); Histogram(&b, n); }
{ Binomial b(20,0.3); Histogram(&b, n); }
{ Binomial b(58,0.3); Histogram(&b, n); }
{ Binomial b(59,0.3); Histogram(&b, n); }
{ Binomial b(60,0.3); Histogram(&b, n); }
{ Binomial b(18,0.05); Histogram(&b, n); }
{ Binomial b(19,0.05); Histogram(&b, n); }
{ Binomial b(20,0.05); Histogram(&b, n); }
{ Binomial b(98,0.01); Histogram(&b, n); }
{ Binomial b(99,0.01); Histogram(&b, n); }
{ Binomial b(100,0.01); Histogram(&b, n); }
{ Binomial b(18,0.95); Histogram(&b, n); }
{ Binomial b(19,0.95); Histogram(&b, n); }
{ Binomial b(20,0.95); Histogram(&b, n); }
{ Binomial b(98,0.99); Histogram(&b, n); }
{ Binomial b(99,0.99); Histogram(&b, n); }
{ Binomial b(100,0.99); Histogram(&b, n); }
{ NegativeBinomial nb(100,6.0); Histogram(&nb, n); }
{ NegativeBinomial nb(11,9.0); Histogram(&nb, n); }
{ NegativeBinomial nb(11,1.9); Histogram(&nb, n); }
{ NegativeBinomial nb(11,0.10); Histogram(&nb, n); }
{ NegativeBinomial nb(1.5,1.9); Histogram(&nb, n); }
{ NegativeBinomial nb(1.0,1.9); Histogram(&nb, n); }
{ NegativeBinomial nb(0.3,19); Histogram(&nb, n); }
{ NegativeBinomial nb(0.3,1.9); Histogram(&nb, n); }
{ NegativeBinomial nb(0.3,0.05); Histogram(&nb, n); }
{ NegativeBinomial nb(100.8,0.18); Histogram(&nb, n); }
{ ChiSq c(1,2.0); Histogram(&c, n); }
{ ChiSq c(2,2.0); Histogram(&c, n); }
{ ChiSq c(3,2.0); Histogram(&c, n); }
{ ChiSq c(4,2.0); Histogram(&c, n); }
{ ChiSq c(1 ); Histogram(&c, n); }
{ ChiSq c(2 ); Histogram(&c, n); }
{ ChiSq c(3 ); Histogram(&c, n); }
{ ChiSq c(4 ); Histogram(&c, n); }
{ Gamma g1(1.0); Histogram(&g1, n); }
{ Gamma g2(0.5); Histogram(&g2, n); }
{ Gamma g3(1.01); Histogram(&g3, n); }
{ Gamma g4(2.0); Histogram(&g4, n); }
{ Pareto p1(0.5); Histogram(&p1, n); }
{ Pareto p2(1.5); Histogram(&p2, n); }
{ Pareto p3(2.5); Histogram(&p3, n); }
{ Pareto p4(4.5); Histogram(&p4, n); }
Real probs[]={.1,.3,.05,.11,.05,.04,.05,.05,.1,.15};
Real val[]={2,3,4,6,8,12,16,24,32,48};
{ DiscreteGen discrete(10,probs); Histogram(&discrete, n); }
{ DiscreteGen discrete(10,probs,val); Histogram(&discrete, n); }
}
/* Design FIR filter using the Window method
n filter length must be odd for HP and BS filters
w buffer for the filter taps (must be n long)
fc cutoff frequencies (1 for LP and HP, 2 for BP and BS)
0 < fc < 1 where 1 <=> Fs/2
flags window and filter type as defined in filter.h
variables are ored together: i.e. LP|HAMMING will give a
low pass filter designed using a hamming window
opt beta constant used only when designing using kaiser windows
returns 0 if OK, -1 if fail
*/
TfirFilter::_ftype_t* TfirFilter::design_fir(unsigned int *n, _ftype_t* fc, int type, int window, _ftype_t opt)
{
unsigned int o = *n & 1; // Indicator for odd filter length
unsigned int end = ((*n + 1) >> 1) - o; // Loop end
unsigned int i; // Loop index
_ftype_t k1 = 2 * _ftype_t(M_PI); // 2*pi*fc1
_ftype_t k2 = 0.5f * (_ftype_t)(1 - o);// Constant used if the filter has even length
_ftype_t k3; // 2*pi*fc2 Constant used in BP and BS design
_ftype_t g = 0.0f; // Gain
_ftype_t t1,t2,t3; // Temporary variables
_ftype_t fc1,fc2; // Cutoff frequencies
// Sanity check
if(*n==0) return NULL;
fc[0]=limit(fc[0],_ftype_t(0.001),_ftype_t(1));
if (!o && (type==TfirSettings::BANDSTOP || type==TfirSettings::HIGHPASS))
(*n)++;
_ftype_t *w=(_ftype_t*)aligned_calloc(sizeof(_ftype_t),*n);
// Get window coefficients
switch(window){
case(TfirSettings::WINDOW_BOX):
boxcar(*n,w); break;
case(TfirSettings::WINDOW_TRIANGLE):
triang(*n,w); break;
case(TfirSettings::WINDOW_HAMMING):
hamming(*n,w); break;
case(TfirSettings::WINDOW_HANNING):
hanning(*n,w); break;
case(TfirSettings::WINDOW_BLACKMAN):
blackman(*n,w); break;
case(TfirSettings::WINDOW_FLATTOP):
flattop(*n,w); break;
case(TfirSettings::WINDOW_KAISER):
kaiser(*n,w,opt); break;
default:
{
delete []w;
return NULL;
}
}
if(type==TfirSettings::LOWPASS || type==TfirSettings::HIGHPASS){
fc1=*fc;
// Cutoff frequency must be < 0.5 where 0.5 <=> Fs/2
fc1 = ((fc1 <= 1.0) && (fc1 > 0.0)) ? fc1/2 : 0.25f;
k1 *= fc1;
if(type==TfirSettings::LOWPASS){ // Low pass filter
// If the filter length is odd, there is one point which is exactly
// in the middle. The value at this point is 2*fCutoff*sin(x)/x,
// where x is zero. To make sure nothing strange happens, we set this
// value separately.
if (o){
w[end] = fc1 * w[end] * 2.0f;
g=w[end];
}
// Create filter
for (i=0 ; i<end ; i++){
t1 = (_ftype_t)(i+1) - k2;
w[end-i-1] = w[*n-end+i] = _ftype_t(w[end-i-1] * sin(k1 * t1)/(M_PI * t1)); // Sinc
g += 2*w[end-i-1]; // Total gain in filter
}
}
else{ // High pass filter
//if (!o) // High pass filters must have odd length
// return -1;
w[end] = _ftype_t(1.0 - (fc1 * w[end] * 2.0));
g= w[end];
// Create filter
for (i=0 ; i<end ; i++){
t1 = (_ftype_t)(i+1);
w[end-i-1] = w[*n-end+i] = _ftype_t(-1 * w[end-i-1] * sin(k1 * t1)/(M_PI * t1)); // Sinc
g += ((i&1) ? (2*w[end-i-1]) : (-2*w[end-i-1])); // Total gain in filter
}
}
}
if(type==TfirSettings::BANDPASS || type==TfirSettings::BANDSTOP){
fc1=fc[0];
fc2=limit(fc[1],_ftype_t(0.001),_ftype_t(1));
// Cutoff frequencies must be < 1.0 where 1.0 <=> Fs/2
fc1 = ((fc1 <= 1.0) && (fc1 > 0.0)) ? fc1/2 : 0.25f;
fc2 = ((fc2 <= 1.0) && (fc2 > 0.0)) ? fc2/2 : 0.25f;
k3 = k1 * fc2; // 2*pi*fc2
k1 *= fc1; // 2*pi*fc1
if(type==TfirSettings::BANDPASS){ // Band pass
// Calculate center tap
if (o){
g=w[end]*(fc1+fc2);
w[end] = (fc2 - fc1) * w[end] * 2.0f;
}
// Create filter
for (i=0 ; i<end ; i++){
t1 = (_ftype_t)(i+1) - k2;
t2 = _ftype_t(sin(k3 * t1)/(M_PI * t1)); // Sinc fc2
t3 = _ftype_t(sin(k1 * t1)/(M_PI * t1)); // Sinc fc1
g += w[end-i-1] * (t3 + t2); // Total gain in filter
w[end-i-1] = w[*n-end+i] = w[end-i-1] * (t2 - t3);
}
}
else{ // Band stop
//if (!o) // Band stop filters must have odd length
// return -1;
w[end] = _ftype_t(1.0 - (fc2 - fc1) * w[end] * 2.0);
g= w[end];
// Create filter
for (i=0 ; i<end ; i++){
t1 = (_ftype_t)(i+1);
t2 = _ftype_t(sin(k1 * t1)/(M_PI * t1)); // Sinc fc1
t3 = _ftype_t(sin(k3 * t1)/(M_PI * t1)); // Sinc fc2
w[end-i-1] = w[*n-end+i] = w[end-i-1] * (t2 - t3);
g += 2*w[end-i-1]; // Total gain in filter
}
}
}
// Normalize gain
g=1/g;
for (i=0; i<*n; i++)
w[i] *= g;
return w;
}
