void nrn_print_matrix(NrnThread* _nt) {
extern int section_count;
extern Section** secorder;
int isec, inode;
Section* sec;
Node* nd;
if (use_sparse13) {
if(ifarg(1) && chkarg(1, 0., 1.) == 0.) {
spPrint(_nt->_sp13mat, 1, 0, 1);
}else{
int i, n = spGetSize(_nt->_sp13mat, 0);
spPrint(_nt->_sp13mat, 1, 1, 1);
for (i=1; i <= n; ++i) {
printf("%d %g\n", i, _nt->_actual_rhs[i]);
}
}
}else if (_nt) {
for (inode = 0; inode < _nt->end; ++inode) {
nd = _nt->_v_node[inode];
printf("%d %g %g %g %g\n", inode, ClassicalNODEB(nd), ClassicalNODEA(nd), NODED(nd), NODERHS(nd));
}
}else{
for (isec = 0; isec < section_count; ++isec) {
sec = secorder[isec];
for (inode = 0; inode < sec->nnode; ++inode) {
nd = sec->pnode[inode];
printf("%d %d %g %g %g %g\n", isec, inode, ClassicalNODEB(nd), ClassicalNODEA(nd), NODED(nd), NODERHS(nd));
}
}
}
}
int
pgDCAnalysis(Circuit *ckt)
{
FILE *pf;
char line[1024];
assert(ckt->theDeviceList);
/* build the MNA matrix */
if( pgBuildMNAEquation(ckt) == -1)
return -1;
/* print the matrix in asiic form */
/*
spPrint(theMatrix, 0, 1, 1);
*/
printf("External size of the matrix: %d\n",spGetSize(theMatrix,1));
printf("Internal size of the matrix: %d\n",spGetSize(theMatrix,0));
fflush(stdout);
/* LU decomposition */
if( spFactor(theMatrix) != spOKAY )
{
error_mesg(INT_ERROR,"Matrix factorization error.");
return -1;
}
/* solve it */
spSolve(theMatrix, theRhs, theSol);
/* store the outcome */
if(!ckt->theNodeArray)
pgBuildNodeArray(ckt);
pgComputeStateFromRes(ckt);
pgPrintResult(theSol, ckt->nMatrixSize);
// Following statements will cause crash in linux 7/9/02 Sheldon
//spDestroy(theMatrix);
//free(theRhs);
//free(theSol);
}
/*
* SMPmatSize()
*/
int
SMPmatSize(SMPmatrix *Matrix)
{
return spGetSize( (void *)Matrix, 1 );
}
void Cvode::daspk_init_eqn(){
// DASPK equation order is exactly the same order as the
// fixed step method for current balance (including
// extracellular nodes) and linear mechanism. Remaining ode
// equations are same order as for Cvode. Thus, daspk differs from
// cvode order primarily in that cap and no-cap nodes are not
// distinguished.
// note that only one thread is allowed for sparse right now.
NrnThread* _nt = nrn_threads;
CvodeThreadData&z = ctd_[0];
double vtol;
//printf("Cvode::daspk_init_eqn\n");
int i, j, in, ie, k, neq_v;
// how many equations are there?
Memb_func* mf;
CvMembList* cml;
//start with all the equations for the fixed step method.
if (use_sparse13 == 0 || diam_changed != 0) {
recalc_diam();
}
z.neq_v_ = spGetSize(_nt->_sp13mat, 0);
z.nvsize_ = z.neq_v_;
// now add the membrane mechanism ode's to the count
for (cml = z.cv_memb_list_; cml; cml = cml->next) {
Pfridot s = (Pfridot)memb_func[cml->index].ode_count;
if (s) {
z.nvsize_ += cml->ml->nodecount * (*s)(cml->index);
}
}
neq_ = z.nvsize_;
//printf("Cvode::daspk_init_eqn: neq_v_=%d neq_=%d\n", neq_v_, neq_);
if (z.pv_) {
delete [] z.pv_;
delete [] z.pvdot_;
}
z.pv_ = new double*[z.nvsize_];
z.pvdot_ = new double*[z.nvsize_];
atolvec_alloc(neq_);
double* atv = n_vector_data(atolnvec_, 0);
for (i=0; i < neq_; ++i) {
atv[i] = ncv_->atol();
}
vtol = 1.;
if (!vsym) {
vsym = hoc_table_lookup("v", hoc_built_in_symlist);
}
if (vsym->extra) {
double x;
x = vsym->extra->tolerance;
if (x != 0 && x < vtol) {
vtol = x;
}
}
// deal with voltage and extracellular and linear circuit nodes
// for daspk the order is the same
assert(use_sparse13);
if (use_sparse13) {
for (in = 0; in < _nt->end; ++in) {
Node* nd; Extnode* nde;
nd = _nt->_v_node[in];
nde = nd->extnode;
i = nd->eqn_index_ - 1; // the sparse matrix index starts at 1
z.pv_[i] = &NODEV(nd);
z.pvdot_[i] = nd->_rhs;
if (nde) {
for (ie=0; ie < nlayer; ++ie) {
k = i + ie + 1;
z.pv_[k] = nde->v + ie;
z.pvdot_[k] = nde->_rhs[ie];
}
}
}
linmod_dkmap(z.pv_, z.pvdot_);
for (i=0; i < z.neq_v_; ++i) {
atv[i] *= vtol;
}
}
// map the membrane mechanism ode state and dstate pointers
int ieq = z.neq_v_;
for (cml = z.cv_memb_list_; cml; cml = cml->next) {
int n;
mf = memb_func + cml->index;
Pfridot sc = (Pfridot)mf->ode_count;
if (sc && ( (n = (*sc)(cml->index)) > 0)) {
Memb_list* ml = cml->ml;
Pfridot s = (Pfridot)mf->ode_map;
if (mf->hoc_mech) {
for (j=0; j < ml->nodecount; ++j) {
(*s)(ieq, z.pv_ + ieq, z.pvdot_ + ieq, ml->prop[j], atv + ieq);
ieq += n;
}
}else{
for (j=0; j < ml->nodecount; ++j) {
(*s)(ieq, z.pv_ + ieq, z.pvdot_ + ieq, ml->data[j], ml->pdata[j], atv + ieq, cml->index);
ieq += n;
}
}
}
}
structure_change_ = false;
}
int sens_sens(CKTcircuit *ckt, int restart)
{
SENS_AN *sen_info = ((SENS_AN *) ckt->CKTcurJob);
static int size;
static double *delta_I, *delta_iI,
*delta_I_delta_Y, *delta_iI_delta_Y;
sgen *sg;
static double freq;
static int nfreqs;
static int i;
static SMPmatrix *delta_Y = NULL, *Y;
static double step_size;
double *E, *iE;
IFvalue value, nvalue;
double *output_values;
IFcomplex *output_cvalues;
double delta_var;
int (*fn)( );
static int is_dc;
int k, j, n;
int num_vars, branch_eq;
char *sen_data;
char namebuf[513];
IFuid *output_names, freq_name;
int bypass;
int type;
#ifndef notdef
double *save_states[8];
#ifdef notdef
for (sg = sgen_init(ckt, 0); sg; sgen_next(&sg)) {
if (sg->is_instparam)
printf("%s:%s:%s -> param %s\n",
DEVices[sg->dev]->DEVpublic.name,
sg->model->GENmodName,
sg->instance->GENname,
sg->ptable[sg->param].keyword);
else
printf("%s:%s:%s -> mparam %s\n",
DEVices[sg->dev]->DEVpublic.name,
sg->model->GENmodName,
sg->instance->GENname,
sg->ptable[sg->param].keyword);
}
#endif
#ifdef ASDEBUG
DEBUG(1)
printf(">>> restart : %d\n", restart);
#endif
/* get to work */
restart = 1;
if (restart) {
freq = 0.0;
is_dc = (sen_info->step_type == SENS_DC);
nfreqs = count_steps(sen_info->step_type, sen_info->start_freq,
sen_info->stop_freq, sen_info->n_freq_steps,
&step_size);
if (!is_dc)
freq = sen_info->start_freq;
error = CKTop(ckt,
(ckt->CKTmode & MODEUIC) | MODEDCOP | MODEINITJCT,
(ckt->CKTmode & MODEUIC) | MODEDCOP | MODEINITFLOAT,
ckt->CKTdcMaxIter);
#ifdef notdef
ckt->CKTmode = (ckt->CKTmode & MODEUIC)
| MODEDCOP | MODEINITSMSIG;
#endif
if (error)
return error;
size = spGetSize(ckt->CKTmatrix, 1);
/* Create the perturbation matrix */
/* XXX check error return, '1' is complex -- necessary?
* only in ac */
delta_Y = spCreate(size, !is_dc, &error);
size += 1;
/* Create an extra rhs */
delta_I = NEWN(double, size);
delta_iI = NEWN(double, size);
delta_I_delta_Y = NEWN(double, size);
delta_iI_delta_Y = NEWN(double, size);
num_vars = 0;
for (sg = sgen_init(ckt, is_dc); sg; sgen_next(&sg)) {
num_vars += 1;
}
if (!num_vars)
return OK; /* XXXX Should be E_ something */
k = 0;
output_names = NEWN(IFuid, num_vars);
for (sg = sgen_init(ckt, is_dc); sg; sgen_next(&sg)) {
if (!sg->is_instparam) {
sprintf(namebuf, "%s:%s",
sg->instance->GENname,
sg->ptable[sg->param].keyword);
} else if ((sg->ptable[sg->param].dataType
& IF_PRINCIPAL) && sg->is_principle == 1)
{
sprintf(namebuf, "%s", sg->instance->GENname);
} else {
sprintf(namebuf, "%s_%s",
sg->instance->GENname,
sg->ptable[sg->param].keyword);
}
(*SPfrontEnd->IFnewUid)((GENERIC *) ckt,
output_names + k, NULL,
namebuf, UID_OTHER, NULL);
k += 1;
}
if (is_dc) {
type = IF_REAL;
freq_name = NULL;
} else {
type = IF_COMPLEX;
(*SPfrontEnd->IFnewUid)((GENERIC *) ckt,
&freq_name, NULL,
"frequency", UID_OTHER, NULL);
}
error = (*SPfrontEnd->OUTpBeginPlot)((GENERIC *) ckt,
(GENERIC *) ckt->CKTcurJob,
ckt->CKTcurJob->JOBname, freq_name, IF_REAL, num_vars,
output_names, type, (GENERIC **) &sen_data);
if (error)
return error;
FREE(output_names);
if (is_dc) {
output_values = NEWN(double, num_vars);
output_cvalues = NULL;
} else {
output_values = NULL;
output_cvalues = NEWN(IFcomplex, num_vars);
if (sen_info->step_type != SENS_LINEAR)
(*(SPfrontEnd->OUTattributes))((GENERIC *)sen_data,
NULL, OUT_SCALE_LOG, NULL);
}
} else {
