static double queue_mode(void* v) {
hoc_return_type_code = 1; // integer
#if BBTQ == 3 || BBTQ == 4
if (ifarg(1)) {
nrn_use_fifo_queue_ = chkarg(1, 0, 1) ? true : false;
}
return double(nrn_use_fifo_queue_);
#endif
#if BBTQ == 5
if (ifarg(1)) {
nrn_use_bin_queue_ = chkarg(1, 0, 1) ? true : false;
}
if (ifarg(2)) {
#if NRNMPI
nrn_use_selfqueue_ = chkarg(2, 0, 1) ? 1 : 0;
#else
if (chkarg(2, 0, 1)) {
hoc_warning("CVode.queue_mode with second arg == 1 requires",
"configuration --with-mpi or related");
}
#endif
}
return double(nrn_use_bin_queue_ + 2*nrn_use_selfqueue_);
#endif
return 0.;
}
void Cvode::do_ode(NrnThread* _nt){
// all the membrane mechanism ode's
CvodeThreadData& z = CTD(_nt->id);
CvMembList* cml;
Memb_func* mf;
for (cml = z.cv_memb_list_; cml; cml = cml->next) { // probably can start at 6 or hh
mf = memb_func + cml->index;
if (mf->ode_spec) {
Pfridot s = (Pfridot)mf->ode_spec;
Memb_list* ml = cml->ml;
if (mf->hoc_mech) {
int j, count;
count = ml->nodecount;
for (j = 0; j < count; ++j) {
Node* nd = ml->nodelist[j];
(*s)(nd, ml->prop[j]);
}
}else{
(*s)(_nt, ml, cml->index);
}
if (errno) {
if (nrn_errno_check(cml->index)) {
hoc_warning("errno set during ode evaluation", (char*)0);
}
}
}
}
long_difus_solve(1, _nt);
}
void Cvode::do_nonode(NrnThread* _nt) { // all the hacked integrators, etc, in SOLVE procedure
//almost a verbatim copy of nonvint in fadvance.c
if (!_nt) {
if (nrn_nthread > 1) {
nonode_cv = this;
nrn_multithread_job(nonode_thread);
return;
}
_nt = nrn_threads;
}
CvodeThreadData& z = CTD(_nt->id);
CvMembList* cml;
for (cml = z.cv_memb_list_; cml; cml = cml->next) {
Memb_func* mf = memb_func + cml->index;
if (mf->state) {
Memb_list* ml = cml->ml;
if (!mf->ode_spec){
Pfridot s = (Pfridot)mf->state;
(*s)(_nt, ml, cml->index);
#if 0
if (errno) {
if (nrn_errno_check(cml->index)) {
hoc_warning("errno set during calculation of states", (char*)0);
}
}
#endif
}else if (mf->singchan_) {
Pfridot s = (Pfridot)mf->singchan_;
(*s)(_nt, ml, cml->index);
}
}
}
}
void nonvint(NrnThread* _nt)
{
#if VECTORIZE
int i;
double w;
int measure = 0;
NrnThreadMembList* tml;
#if 1 || PARANEURON
/* nrnmpi_v_transfer if needed was done earlier */
if (nrnthread_v_transfer_) {(*nrnthread_v_transfer_)(_nt);}
#endif
if (_nt->id == 0 && nrn_mech_wtime_) { measure = 1; }
errno = 0;
for (tml = _nt->tml; tml; tml = tml->next) if (memb_func[tml->index].state) {
Pfri s = memb_func[tml->index].state;
if (measure) { w = nrnmpi_wtime(); }
(*s)(_nt, tml->ml, tml->index);
if (measure) { nrn_mech_wtime_[tml->index] += nrnmpi_wtime() - w; }
if (errno) {
if (nrn_errno_check(i)) {
hoc_warning("errno set during calculation of states", (char*)0);
}
}
}
long_difus_solve(0, _nt); /* if any longitudinal diffusion */
nrn_nonvint_block_fixed_step_solve(_nt->id);
#endif
}
void Cvode::solvemem(NrnThread* nt) {
// all the membrane mechanism matrices
CvodeThreadData& z = CTD(nt->id);
CvMembList* cml;
for (cml = z.cv_memb_list_; cml; cml = cml->next) { // probably can start at 6 or hh
Memb_func* mf = memb_func + cml->index;
if (mf->ode_matsol) {
Memb_list* ml = cml->ml;
Pfridot s = (Pfridot)mf->ode_matsol;
if (mf->hoc_mech) {
int j, count;
count = ml->nodecount;
for (j = 0; j < count; ++j) {
Node* nd = ml->nodelist[j];
(*s)(nd, ml->prop[j]);
}
}else{
(*s)(nt, ml, cml->index);
}
if (errno) {
if (nrn_errno_check(cml->index)) {
hoc_warning("errno set during ode jacobian solve", (char*)0);
}
}
}
}
long_difus_solve(2, nt);
}
void hoc_audit_from_emacs(const char *bufname, const char *filname)
{
#if !OCSMALL
char fname[200];
char s[256];
FILE* f;
extern char* hoc_pipegets();
static int n=0;
if (!doaudit) {
return;
}
sprintf(fname, "%s/%d/bf%d", AUDIT_DIR, hoc_pid(), n);
if ((f = fopen(fname, "w")) == (FILE*)0) {
hoc_warning("audit:Couldn't open temporary emacs buffer file:", fname);
return;
}
while (hoc_pipegets(s, 256)) {
fprintf(f, "%s", s);
}
fclose(f);
sprintf(s, "%s %s %s", fname, bufname, filname);
pipesend(2, s);
n++;
#endif
}
void hoc_audit_from_hoc_main1(int argc, const char **argv, const char **envp)
{
#if !OCSMALL
/*ARGSUSED*/
int i;
char buf[200];
hoc_on_init_register(hoc_audit_init);
#if 0
if (getenv("HOCAUDIT")) {
doaudit = 1;
printf("auditing\n");
}else{
doaudit = 0;
printf("no auditing\n");
}
#endif
if (!doaudit) {
return;
}
/* since file open for entire session will have to make the name unique*/
sprintf(buf, "if [ ! -d %s ] ; then mkdir %s ; fi", AUDIT_DIR, AUDIT_DIR);
assert(system(buf) >= 0);
sprintf(buf, "mkdir %s/%d", AUDIT_DIR, hoc_pid());
assert(system(buf) >= 0);
sprintf(buf, "%s/hocaudit.sh %d %s", AUDIT_SCRIPT_DIR, hoc_pid(), AUDIT_DIR);
if ((audit_pipe = popen(buf, "w")) == (FILE*)0) {
hoc_warning("Could not connect to hocaudit.sh via pipe:", buf);
doaudit = 0;
return;
}
if (hoc_saveaudit() == 0) {
return;
}
fprintf(faudit, "/*\n");
for (i=0; i < argc; ++i) {
fprintf(faudit, " %s", argv[i]);
}
fprintf(faudit, "\n*/\n");
fflush(faudit);
for (i=1; i < argc; ++i) {
if ( argv[i][0] != '-') {
fprintf(faudit, "xopen(\"%s\")\n", argv[i]);
hoc_audit_from_xopen1(argv[i], (char*)0);
}
}
fprintf(faudit, "\n");
#endif
}
static void pipesend(int type, const char *s)
{
int err;
if (audit_pipe) {
err = fprintf(audit_pipe, "%d %s\n", type, s);
if (err == EOF) {
hoc_warning("auditing failed in pipesend", "turning off");
doaudit = 0;
audit_pipe = 0;
return;
}
fflush(audit_pipe);
}
}
void Cvode::lhs_memb(CvMembList* cmlist, NrnThread* _nt) {
CvMembList* cml;
for (cml = cmlist; cml; cml = cml->next) {
Memb_func* mf = memb_func + cml->index;
Memb_list* ml = cml->ml;
Pfridot s = (Pfridot)mf->jacob;
if (s) {
Pfridot s = (Pfridot)mf->jacob;
(*s)(_nt, ml, cml->index);
if (errno) {
if (nrn_errno_check(cml->index)) {
hoc_warning("errno set during calculation of di/dv", (char*)0);
}
}
}
}
activsynapse_lhs();
activclamp_lhs();
}
void Cvode::rhs_memb(CvMembList* cmlist, NrnThread* _nt) {
CvMembList* cml;
errno = 0;
for (cml = cmlist; cml; cml = cml->next) {
Memb_func* mf = memb_func + cml->index;
Pfridot s = (Pfridot)mf->current;
if (s) {
Memb_list* ml = cml->ml;
(*s)(_nt, ml, cml->index);
if (errno) {
if (nrn_errno_check(cml->index)) {
hoc_warning("errno set during calculation of currents", (char*)0);
}
}
}
}
activsynapse_rhs();
activstim_rhs();
activclamp_rhs();
}
int hoc_saveaudit(void) {
#if !OCSMALL
static int n=0;
char buf[200];
if (hoc_retrieving_audit() || !doaudit) {
return 0;
}
if (faudit) {
fclose(faudit);
faudit = 0;
sprintf(buf, "hocaudit%d", n);
pipesend(3, buf);
++n;
}
sprintf(buf, "%s/%d/hocaudit%d", AUDIT_DIR, hoc_pid(), n);
if ((faudit = fopen(buf, "w")) == (FILE*)0) {
hoc_warning("NO audit. fopen failed for:", buf);
doaudit = 0;
return 0;
}
#endif
return 1;
}
void BBSDirect::start() {
char* client = 0;
int tid, host_mytid;
int i, n, ncpu, nncpu;
struct pvmhostinfo* hostp;
if (started_) { return; }
BBSImpl::start();
mytid_ = pvm_mytid();
nrnmpi_myid = 0;
if (mytid_ < 0) { perror("start"); }
host_mytid = pvm_tidtohost(mytid_);
tid = pvm_parent();
if (tid == PvmSysErr) {
perror("start");
}else if (tid == PvmNoParent) {
is_master_ = true;
pvm_catchout(stdout);
pvm_setopt(PvmRoute, PvmRouteDirect);
pvm_config(&n, NULL, &hostp);
nncpu = 0;
for (i=0; i < n; ++i) {
ncpu = hostp[i].hi_speed;
if (ncpu%1000) {
hoc_warning(hostp[i].hi_name,
" speed in pvm configuration file is not a multiple of 1000. Assuming 1000.");
ncpu = 1000;
}
nncpu += ncpu/1000;
}
nrnmpi_numprocs = nncpu;
ncids = 0;
}else{ // a worker, impossible
assert(false);
}
if (nrnmpi_numprocs > 1 && tid == PvmNoParent) {
char ** sargv;
// args are workingdirectory specialOrNrniv -bbs_nhost nhost args
sargv = new char*[nrn_global_argc + 4];
for (i=1; i < nrn_global_argc; ++i) {
sargv[i+3] = nrn_global_argv[i];
}
sargv[nrn_global_argc + 3] = 0;
sargv[0] = rel_working_dir();
//printf("sargv[0]=|%s|\n", sargv[0]);
sargv[1] = nrn_global_argv[0];
sargv[2] = "-bbs_nhost";
sargv[3] = new char[10];
sprintf(sargv[3], "%d", nrnmpi_numprocs);
cids = new int[nrnmpi_numprocs-1];
if (nrn_global_argv[nrn_global_argc] != 0) {
printf("argv not null terminated\n");
exit(1);
}
BBSDirectServer::server_->start();
bbs_sig_set();
bbs_handle();
//spawn according to number of cpu's (but master has one less)
//printf("%d total number of cpus on %d machines\n", nncpu, n);
int icid = 0;
bool first = true;
while (icid < nrnmpi_numprocs - 1) {
for (i=0; i < n; ++i) {
ncpu = hostp[i].hi_speed;
if (ncpu%1000) {
ncpu = 1000;
}
ncpu /= 1000;
//printf("%d cpu for machine %d (%s)\n", ncpu, i, hostp[i].hi_name);
if (first && hostp[i].hi_tid == host_mytid) {
// spawn one fewer on master first time through
--ncpu;
}
if (icid + ncpu >= nrnmpi_numprocs) {
ncpu = nrnmpi_numprocs - icid - 1;
}
//printf("before spawn %d processes (icid=%d) for machine %d (%s)\n", ncpu, icid, i, hostp[i].hi_name);
if (ncpu) {
ncids = pvm_spawn("bbswork.sh", sargv,
PvmTaskHost, hostp[i].hi_name, ncpu, cids + icid);
if (ncids != ncpu) {
fprintf(stderr, "Tried to spawn %d tasks, only %d succeeded on %s\n", ncpu, ncids, hostp[i].hi_name);
hoc_execerror("Could not spawn all the requested tasks for", hostp[i].hi_name);
}
//printf("spawned %d for %s with cids starting at %d\n", ncpu, hostp[i].hi_name, icid);
icid += ncpu;
}
if (icid >= nrnmpi_numprocs) {
break;
}
}
first = false;
}
ncids = icid;
printf("spawned %d more %s on %d cpus on %d machines\n", ncids, nrn_global_argv[0], nncpu, n);
delete [] sargv[3];
delete [] sargv;
}
}
hoc_parallel_begin() {
#if !OCSMALL
Symbol *sym;
double first, last;
char *method, *getenv();
int parallel_hoc_main();
int i, j;
last = xpop();
first = xpop();
sym = spop();
pushs(sym);
method = getenv("NEURON_PARALLEL_METHOD");
if (!method) {
pushx(first);
pushx(last);
return;
}
if (parallel_seen++) {
hoc_warning("Only one parallel loop per batch run allowed.",
"This loop is being executed serially");
pushx(first);
pushx(last);
return;
}
if (!parallel_sub) { /* if 0 then master */
/* the master instance executes the following portion of the loop */
for (i = ((int)first)+1; i <= (int)last; i++) {
char buf[10], *pnt = parallel_argv;
/* increment pnt to "00000" */
for (j = 0; j < 2; j++) {
/*EMPTY*/
while (*pnt++);
}
/* replace "00000" with actual value */
sprintf(buf, "%5d", i);
strcpy(pnt, buf);
/* farm-out all but the first instance of the loop */
#if LINDA
/* place arguments for eval() into tuple space, Linda
doesn't seem to want to let the fxn in an eval take
arrays as args */
__linda_out("parallel sargs", sargv, senvp);
__linda_out("parallel args", parallel_argv:sargv, parallel_envp:senvp);
__linda_eval("parallel run", parallel_hoc_main(i), i);
#endif
}
#if LINDA
/* do first pass though loop on master node (first to first) */
pushx(first);
pushx(first);
#else
/* run in serial if not LINDA */
pushx(first);
pushx(last);
#endif
/* block until all instances of loop have finished */
#if LINDA
i = (int)last - (int)first;
while (i-- > 0) {
int err_val, err_num;
__linda_in("parallel run", ?err_val, ?err_num);
/* could test err_val != 0 but currently will always equal 0 */
}
#endif
/* assign value of symbol to last+1 as would be upon exiting a serial loop */
if (!ISARRAY(sym)) {
if (sym->subtype == USERDOUBLE) {
pval = sym->u.pval;
} else {
pval = OPVAL(sym);
}
} else {
if (sym->subtype == USERDOUBLE) {
pval = sym->u.pval + araypt(sym, SYMBOL);
} else {
pval = OPVAL(sym) + araypt(sym, OBJECTVAR);
}
}
end_val = last + 1;
} else {
method3_setup_tree_matrix() /* construct diagonal elements */
{
int i;
if (diam_changed) {
recalc_diam();
}
#if _CRAY
#pragma _CRI ivdep
#endif
for (i = 0; i < v_node_count; ++i) {
Node* nd = v_node[i];
NODED(nd) = 0.;
NODERHS(nd) = 0.;
nd->thisnode.GC = 0.;
nd->thisnode.EC = 0.;
}
for (i=0; i < n_memb_func; ++i) if (memb_func[i].current && memb_list[i].nodecount) {
if (memb_func[i].vectorized) {
memb_func[i].current(
memb_list[i].nodecount,
memb_list[i].nodelist,
memb_list[i].data,
memb_list[i].pdata
);
}else{
int j, count;
Pfrd s = memb_func[i].current;
Memb_list* m = memb_list + i;
count = m->nodecount;
if (memb_func[i].is_point) {
for (j = 0; j < count; ++j) {
Node* nd = m->nodelist[j];
NODERHS(nd) -= (*s)(m->data[j], m->pdata[j],
&NODED(nd),nd->v);
};
}else{
for (j = 0; j < count; ++j) {
Node* nd = m->nodelist[j];
nd->thisnode.EC -= (*s)(m->data[j], m->pdata[j],
&nd->thisnode.GC,nd->v);
};
}
}
if (errno) {
if (nrn_errno_check(i)) {
hoc_warning("errno set during calculation of currents", (char*)0);
}
}
}
#if 0 && _CRAY
#pragma _CRI ivdep
#endif
for (i=rootnodecount; i < v_node_count; ++i) {
Node* nd2;
Node* nd = v_node[i];
Node* pnd = v_parent[nd->v_node_index];
double dg, de, dgp, dep, fac;
#if 0
if (i == rootnodecount) {
printf("v0 %g vn %g jstim %g jleft %g jright %g\n",
nd->v, pnd->v, nd->fromparent.current, nd->toparent.current,
nd[1].fromparent.current);
}
#endif
/* dg and de must be second order when used */
if ((nd2 = nd->toparent.nd2) != (Node*)0) {
dgp = -(3*(pnd->thisnode.GC - pnd->thisnode.Cdt)
- 4*(nd->thisnode.GC - nd->thisnode.Cdt)
+(nd2->thisnode.GC - nd2->thisnode.Cdt))/2
;
dep = -(3*(pnd->thisnode.EC - pnd->thisnode.Cdt * pnd->v)
- 4*(nd->thisnode.EC - nd->thisnode.Cdt * nd->v)
+(nd2->thisnode.EC - nd2->thisnode.Cdt * nd2->v))/2
;
}else{
dgp = 0.;
dep = 0.;
}
if ((nd2 = pnd->fromparent.nd2) != (Node*)0) {
dg = -(3*(nd->thisnode.GC - nd->thisnode.Cdt)
- 4*(pnd->thisnode.GC - pnd->thisnode.Cdt)
+(nd2->thisnode.GC - nd2->thisnode.Cdt))/2
;
de = -(3*(nd->thisnode.EC - nd->thisnode.Cdt * nd->v)
- 4*(pnd->thisnode.EC - pnd->thisnode.Cdt * pnd->v)
+(nd2->thisnode.EC - nd2->thisnode.Cdt * nd2->v))/2
;
}else{
dg = 0.;
de = 0.;
}
fac = 1. + nd->toparent.coefjdot * nd->thisnode.GC;
nd->toparent.djdv0 = (
nd->toparent.coefj
+ nd->toparent.coef0 * nd->thisnode.GC
+ nd->toparent.coefdg * dg
)/fac;
NODED(nd) += nd->toparent.djdv0;
nd->toparent.current = (
- nd->toparent.coef0 * nd->thisnode.EC
- nd->toparent.coefn * pnd->thisnode.EC
+ nd->toparent.coefjdot *
nd->thisnode.Cdt * nd->toparent.current
- nd->toparent.coefdg * de
)/fac;
NODERHS(nd) -= nd->toparent.current;
NODEB(nd) = (
- nd->toparent.coefj
+ nd->toparent.coefn * pnd->thisnode.GC
)/fac;
/* this can break cray vectors */
fac = 1. + nd->fromparent.coefjdot * pnd->thisnode.GC;
nd->fromparent.djdv0 = (
nd->fromparent.coefj
+ nd->fromparent.coef0 * pnd->thisnode.GC
+ nd->fromparent.coefdg * dgp
)/fac;
pNODED(nd) += nd->fromparent.djdv0;
nd->fromparent.current = (
- nd->fromparent.coef0 * pnd->thisnode.EC
- nd->fromparent.coefn * nd->thisnode.EC
+ nd->fromparent.coefjdot *
nd->thisnode.Cdt * nd->fromparent.current
- nd->fromparent.coefdg * dep
)/fac;
pNODERHS(nd) -= nd->fromparent.current;
NODEA(nd) = (
- nd->fromparent.coefj
+ nd->fromparent.coefn * nd->thisnode.GC
)/fac;
}
activstim();
activsynapse();
#if SEJNOWSKI
activconnect();
#endif
activclamp();
}
