int parse_imprlist(NLEnergy *p, Tcl_Interp *interp,
Tcl_Obj *const obj, boolean invert) {
char *imprsel = Array_data(&(p->imprsel));
char *invsel = Array_data(&(p->invsel));
char *sel = (invert ? invsel : imprsel);
const int32 nimprs = Topology_impr_array_length(&(p->topo));
int32 id;
Tcl_Obj **objv;
int objc, n;
if (invert) {
memset(invsel, 0, nimprs);
}
if ((id=parse_impr(p,interp,obj)) >= 0) { /* could be a singleton */
sel[id] = TRUE;
}
else { /* its a list of imprs */
if (TCL_ERROR==Tcl_ListObjGetElements(interp, obj, &objc, &objv)) {
return FAIL;
}
for (n = 0; n < objc; n++) {
if ((id=parse_impr(p,interp,objv[n])) < 0) {
return FAIL;
}
sel[id] = TRUE;
}
}
if (invert) {
for (id = 0; id < nimprs; id++) {
if (FALSE==invsel[id]) imprsel[id] = TRUE;
}
}
return OK;
}
CAMLprim value win_write
(value fd, value buf, value ofs, value len, value id) {
CAMLparam4(fd, buf, ofs, len);
struct caml_bigarray *buf_arr = Bigarray_val(buf);
if (Field(fd, 1) == Val_long(0))
overlapped_action (WRITE_OVERLAPPED, Long_val(id), Handle(fd),
Array_data (buf_arr, ofs), Long_val(len));
else
thread_io (WRITE, Long_val(id), Field(fd, 1), Handle(fd),
Array_data (buf_arr, ofs), Long_val(len));
CAMLreturn (Val_unit);
}
CAMLprim value ml_blit_buffer_to_string
(value a, value i, value s, value j, value l)
{
char *src = Array_data(Bigarray_val(a), i);
char *dest = String_val(s) + Long_val(j);
memcpy(dest, src, Long_val(l));
return Val_unit;
}
static int setup_atomid_map(NLEnergy *p, Tcl_Interp *interp, int32 natoms) {
char script[64];
Tcl_Obj *obj;
Tcl_Obj **objv;
int32 *atomid, *extatomid;
int32 atomidlen;
int objc, i, s;
INT(natoms);
if (natoms <= 0) return ERROR(ERR_EXPECT);
if ((s=Array_resize(&(p->extatomid),natoms)) != OK) return ERROR(s);
extatomid = Array_data(&(p->extatomid));
snprintf(script, sizeof(script), "%s list", p->aselname);
if (TCL_OK != Tcl_EvalEx(interp, script, -1, 0) ||
NULL==(obj = Tcl_GetObjResult(interp)) ||
TCL_OK != Tcl_ListObjGetElements(interp, obj, &objc, &objv) ||
objc != natoms) {
return ERROR(ERR_EXPECT);
}
for (i = 0; i < objc; i++) {
long n;
if (TCL_OK != Tcl_GetLongFromObj(interp, objv[i], &n)) {
return ERROR(ERR_EXPECT);
}
extatomid[i] = (int32) n;
ASSERT(0==i || extatomid[i-1] < extatomid[i]);
}
ASSERT(i == natoms);
p->firstid = extatomid[0];
p->lastid = extatomid[natoms-1];
INT(p->firstid);
INT(p->lastid);
atomidlen = p->lastid - p->firstid + 1;
ASSERT(atomidlen >= natoms);
if ((s=Array_resize(&(p->atomid),atomidlen)) != OK) return ERROR(s);
atomid = Array_data(&(p->atomid));
for (i = 0; i < atomidlen; i++) { /* initialize */
atomid[i] = FAIL;
}
for (i = 0; i < natoms; i++) {
atomid[ extatomid[i] - p->firstid ] = i;
}
return OK;
}
int atomlist_contrib(NLEnergy *p) {
char *atomsel = Array_data(&(p->atomsel));
const char *nonbsel = Array_data_const(&(p->nonbsel));
const char *bondsel = Array_data_const(&(p->bondsel));
const char *anglesel = Array_data_const(&(p->anglesel));
const char *dihedsel = Array_data_const(&(p->dihedsel));
const char *imprsel = Array_data_const(&(p->imprsel));
const Topology *topo = &(p->topo);
const Bond *bond = Topology_bond_array(topo);
const Angle *angle = Topology_angle_array(topo);
const Dihed *dihed = Topology_dihed_array(topo);
const Impr *impr = Topology_impr_array(topo);
const int32 natoms = Topology_atom_array_length(topo);
const int32 nbonds = Topology_bond_array_length(topo);
const int32 nangles = Topology_angle_array_length(topo);
const int32 ndiheds = Topology_dihed_array_length(topo);
const int32 nimprs = Topology_impr_array_length(topo);
int32 i;
memset(atomsel, 0, natoms);
for (i = 0; i < natoms; i++) {
if (nonbsel[i]) atomsel[i]=TRUE;
}
for (i = 0; i < nbonds; i++) {
if (bondsel[i]) {
atomsel[ bond[i].atomID[0] ] = TRUE;
atomsel[ bond[i].atomID[1] ] = TRUE;
}
}
for (i = 0; i < nangles; i++) {
if (anglesel[i]) {
atomsel[ angle[i].atomID[0] ] = TRUE;
atomsel[ angle[i].atomID[1] ] = TRUE;
atomsel[ angle[i].atomID[2] ] = TRUE;
}
}
for (i = 0; i < ndiheds; i++) {
if (dihedsel[i]) {
atomsel[ dihed[i].atomID[0] ] = TRUE;
atomsel[ dihed[i].atomID[1] ] = TRUE;
atomsel[ dihed[i].atomID[2] ] = TRUE;
atomsel[ dihed[i].atomID[3] ] = TRUE;
}
}
for (i = 0; i < nimprs; i++) {
if (imprsel[i]) {
atomsel[ impr[i].atomID[0] ] = TRUE;
atomsel[ impr[i].atomID[1] ] = TRUE;
atomsel[ impr[i].atomID[2] ] = TRUE;
atomsel[ impr[i].atomID[3] ] = TRUE;
}
}
return OK;
}
int parse_atomlist(NLEnergy *p, Tcl_Interp *interp,
Tcl_Obj *const obj, boolean invert, int mark) {
char *atomsel = Array_data(&(p->atomsel));
char *nonbsel = Array_data(&(p->nonbsel));
char *asel = (mark > 0 ? nonbsel : atomsel);
char *invsel = Array_data(&(p->invsel));
char *sel = (invert ? invsel : asel);
const int32 natoms = Topology_atom_array_length(&(p->topo));
int32 id;
Tcl_Obj **objv;
int objc, n;
int m = (mark > 0 ? mark : -mark);
if (invert) {
memset(invsel, 0, natoms);
}
if ((id=parse_atom(p,interp,obj)) >= 0) { /* could be a singleton */
sel[id] |= (char)m;
}
else { /* its a list of atoms */
if (TCL_ERROR==Tcl_ListObjGetElements(interp, obj, &objc, &objv)) {
return FAIL;
}
for (n = 0; n < objc; n++) {
if ((id=parse_atom(p,interp,objv[n])) < 0) {
return FAIL;
}
sel[id] |= (char)m;
}
}
if (invert) {
for (id = 0; id < natoms; id++) {
if (FALSE==invsel[id]) asel[id] |= (char)m;
}
}
return OK;
}
CAMLprim value win_readdirtorychanges
(value fd_val, value buf_val, value recursive, value flags, value id_val) {
CAMLparam5(fd_val, buf_val, recursive, flags, id_val);
struct caml_bigarray *buf_arr = Bigarray_val(buf_val);
long id = Long_val(id_val);
HANDLE fd = Handle_val(fd_val);
char * buf = Array_data (buf_arr, 0);
long len = buf_arr->dim[0];
long action = READDIRECTORYCHANGES;
BOOL res;
long err;
int notify_filter = convert_flag_list(flags, notify_filter_flags);
completionData * d = GlobalAlloc(GPTR, sizeof(completionData));
if (d == NULL) {
errno = ENOMEM;
uerror(action_name[action], Nothing);
}
d->id = id;
d->action = action;
D(printf("Starting %s: id %ld, len %ld\n", action_name[action], id, len));
res = ReadDirectoryChangesW (fd, buf, len, Bool_val(recursive),
notify_filter, NULL, &(d->overlapped),
overlapped_completion);
if (!res) {
err = GetLastError ();
if (err != ERROR_IO_PENDING) {
win32_maperr (err);
D(printf("Action %s failed: id %ld -> err %d (errCode %ld)\n",
action_name[action], id, errno, err));
uerror("ReadDirectoryChangesW", Nothing);
}
}
CAMLreturn (Val_unit);
}
CAMLprim value win_parse_directory_changes (value buf_val) {
CAMLparam1(buf_val);
CAMLlocal4(lst, tmp, elt, filename);
struct caml_bigarray *buf_arr = Bigarray_val(buf_val);
char * pos = Array_data (buf_arr, 0);
FILE_NOTIFY_INFORMATION * entry;
lst = Val_long(0);
while (1) {
entry = (FILE_NOTIFY_INFORMATION *)pos;
elt = caml_alloc_tuple(2);
filename = caml_alloc_string(entry->FileNameLength);
memmove(String_val(filename), entry->FileName, entry->FileNameLength);
Store_field (elt, 0, filename);
Store_field (elt, 1, Val_long(entry->Action - 1));
tmp = caml_alloc_tuple(2);
Store_field (tmp, 0, elt);
Store_field (tmp, 1, lst);
lst = tmp;
if (entry->NextEntryOffset == 0) break;
pos += entry->NextEntryOffset;
}
CAMLreturn(lst);
}
int select_from_atomlist(NLEnergy *p) {
char *atomsel = Array_data(&(p->atomsel));
char *nonbsel = Array_data(&(p->nonbsel));
char *bondsel = Array_data(&(p->bondsel));
char *anglesel = Array_data(&(p->anglesel));
char *dihedsel = Array_data(&(p->dihedsel));
char *imprsel = Array_data(&(p->imprsel));
const Topology *topo = &(p->topo);
const Bond *bond = Topology_bond_array(topo);
const Angle *angle = Topology_angle_array(topo);
const Dihed *dihed = Topology_dihed_array(topo);
const Impr *impr = Topology_impr_array(topo);
const int32 natoms = Topology_atom_array_length(topo);
int32 i, id;
Idseq seq;
int32 numelec, numelec_b, numvdw, numvdw_b;
boolean overlap;
int s;
for (i = 0; i < natoms; i++) {
nonbsel[i] |= atomsel[i];
/* select bonds */
if ((s=Idseq_init(&seq, Topology_atom_bondlist(topo, i))) != OK) {
return ERROR(s);
}
while ((id=Idseq_getid(&seq)) >= 0) {
if (atomsel[ bond[id].atomID[0] ]
&& atomsel[ bond[id].atomID[1] ]) {
bondsel[id] = TRUE;
}
}
Idseq_done(&seq);
/* select angles */
if ((s=Idseq_init(&seq, Topology_atom_anglelist(topo, i))) != OK) {
return ERROR(s);
}
while ((id=Idseq_getid(&seq)) >= 0) {
if (atomsel[ angle[id].atomID[0] ]
&& atomsel[ angle[id].atomID[1] ]
&& atomsel[ angle[id].atomID[2] ]) {
anglesel[id] = TRUE;
}
}
Idseq_done(&seq);
/* select dihedrals */
if ((s=Idseq_init(&seq, Topology_atom_dihedlist(topo, i))) != OK) {
return ERROR(s);
}
while ((id=Idseq_getid(&seq)) >= 0) {
if (atomsel[ dihed[id].atomID[0] ]
&& atomsel[ dihed[id].atomID[1] ]
&& atomsel[ dihed[id].atomID[2] ]
&& atomsel[ dihed[id].atomID[3] ]) {
dihedsel[id] = TRUE;
}
}
Idseq_done(&seq);
/* select impropers */
if ((s=Idseq_init(&seq, Topology_atom_imprlist(topo, i))) != OK) {
return ERROR(s);
}
while ((id=Idseq_getid(&seq)) >= 0) {
if (atomsel[ impr[id].atomID[0] ]
&& atomsel[ impr[id].atomID[1] ]
&& atomsel[ impr[id].atomID[2] ]
&& atomsel[ impr[id].atomID[3] ]) {
imprsel[id] = TRUE;
}
}
Idseq_done(&seq);
}
/* check validity of nonbonded selection */
numelec = 0;
numelec_b = 0;
numvdw = 0;
numvdw_b = 0;
overlap = TRUE;
//INT(natoms);
for (i = 0; i < natoms; i++) {
if ((nonbsel[i] & (ASEL_ELEC | ASEL_ELEC_B))
== (ASEL_ELEC | ASEL_ELEC_B) ||
(nonbsel[i] & (ASEL_VDW | ASEL_VDW_B))
== (ASEL_VDW | ASEL_VDW_B)) {
return ERROR(ERR_EXPECT);
}
if (overlap && nonbsel[i] != 0 &&
nonbsel[i] != ASEL_NONB && nonbsel[i] != ASEL_NONB_B) {
overlap = FALSE;
}
//INT(i);
//HEX(nonbsel[i]);
if (nonbsel[i] & ASEL_ELEC) numelec++;
if (nonbsel[i] & ASEL_VDW) numvdw++;
if (nonbsel[i] & ASEL_ELEC_B) numelec_b++;
if (nonbsel[i] & ASEL_VDW_B) numvdw_b++;
}
if ((0==numelec && numelec_b > 0) || (0==numvdw && numvdw_b > 0)) {
INT(numelec);
INT(numelec_b);
INT(numvdw);
INT(numvdw_b);
return ERROR(ERR_EXPECT);
}
INT(numvdw);
p->nb_overlap = overlap;
//INT(p->nb_overlap);
p->fnbcut_all = (natoms==numelec ? FNBCUT_ELEC : 0)
| (natoms==numvdw ? FNBCUT_VDW : 0);
//HEX(p->fnbcut_all);
p->fnbcut_subset =
(0 < numelec && numelec < natoms && 0==numelec_b ? FNBCUT_ELEC : 0)
| (0 < numvdw && numvdw < natoms && 0==numvdw_b ? FNBCUT_VDW : 0);
//HEX(p->fnbcut_subset);
p->fnbcut_disjoint = (numelec > 0 && numelec_b > 0 ? FNBCUT_ELEC : 0)
| (numvdw > 0 && numvdw_b > 0 ? FNBCUT_VDW : 0);
//HEX(p->fnbcut_disjoint);
/* start by resetting all index array lengths */
if ((s=Array_resize(&(p->idnonb), 0)) != OK) return ERROR(s);
if ((s=Array_resize(&(p->idnonb_b), 0)) != OK) return ERROR(s);
if ((s=Array_resize(&(p->idnbvdw), 0)) != OK) return ERROR(s);
if ((s=Array_resize(&(p->idnbvdw_b), 0)) != OK) return ERROR(s);
if ((p->fnbcut_all & FNBCUT_ELEC)==0) {
if ((p->fnbcut_subset & FNBCUT_ELEC) ||
(p->fnbcut_disjoint & FNBCUT_ELEC)) {
if ((s=Array_resize(&(p->idnonb), numelec)) != OK) return ERROR(s);
/* reset uselen for Array_append() */
if ((s=Array_resize(&(p->idnonb), 0)) != OK) return ERROR(s);
for (i = 0; i < natoms; i++) {
if ((nonbsel[i] & ASEL_ELEC)
&& (s=Array_append(&(p->idnonb), &i)) != OK) {
return ERROR(s);
}
}
}
if ((p->fnbcut_disjoint & FNBCUT_ELEC)) {
if ((s=Array_resize(&(p->idnonb_b), numelec_b)) != OK) return ERROR(s);
/* reset uselen for Array_append() */
if ((s=Array_resize(&(p->idnonb_b), 0)) != OK) return ERROR(s);
for (i = 0; i < natoms; i++) {
if ((nonbsel[i] & ASEL_ELEC_B)
&& (s=Array_append(&(p->idnonb_b), &i)) != OK) {
return ERROR(s);
}
}
}
}
if (!overlap && (p->fnbcut_all & FNBCUT_VDW)==0) {
if ((p->fnbcut_subset & FNBCUT_VDW) ||
(p->fnbcut_disjoint & FNBCUT_VDW)) {
if ((s=Array_resize(&(p->idnbvdw), numvdw)) != OK) return ERROR(s);
/* reset uselen for Array_append() */
if ((s=Array_resize(&(p->idnbvdw), 0)) != OK) return ERROR(s);
for (i = 0; i < natoms; i++) {
if ((nonbsel[i] & ASEL_VDW)
&& (s=Array_append(&(p->idnbvdw), &i)) != OK) {
return ERROR(s);
}
}
}
if ((p->fnbcut_disjoint & FNBCUT_VDW)) {
if ((s=Array_resize(&(p->idnbvdw_b), numvdw_b)) != OK) return ERROR(s);
/* reset uselen for Array_append() */
if ((s=Array_resize(&(p->idnbvdw_b), 0)) != OK) return ERROR(s);
for (i = 0; i < natoms; i++) {
if ((nonbsel[i] & ASEL_VDW_B)
&& (s=Array_append(&(p->idnbvdw_b), &i)) != OK) {
return ERROR(s);
}
}
}
}
return OK;
}
int NLEnergy_parse_eval(NLEnergy *p, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[], int evalType) {
enum { KEYWD, ATOM, BOND, ANGLE, DIHED, IMPR, ELEC, VDW, NONB };
const Topology *topo = &(p->topo);
const int32 natoms = Topology_atom_array_length(topo);
const int32 nbonds = Topology_bond_array_length(topo);
const int32 nangles = Topology_angle_array_length(topo);
const int32 ndiheds = Topology_dihed_array_length(topo);
const int32 nimprs = Topology_impr_array_length(topo);
int32 ninvs;
char *atomsel, *nonbsel, *bondsel, *anglesel, *dihedsel, *imprsel, *invsel;
int32 i;
int state = KEYWD, s;
int setnum = 0, mark = FALSE;
boolean invert = FALSE;
TEXT("eval");
if (Array_length(&(p->atomsel)) != natoms
&& (s=Array_resize(&(p->atomsel), natoms)) != OK) return ERROR(s);
atomsel = Array_data(&(p->atomsel));
if (Array_length(&(p->nonbsel)) != natoms
&& (s=Array_resize(&(p->nonbsel), natoms)) != OK) return ERROR(s);
nonbsel = Array_data(&(p->nonbsel));
if (Array_length(&(p->bondsel)) != nbonds
&& (s=Array_resize(&(p->bondsel), nbonds)) != OK) return ERROR(s);
bondsel = Array_data(&(p->bondsel));
if (Array_length(&(p->anglesel)) != nangles
&& (s=Array_resize(&(p->anglesel), nangles)) != OK) return ERROR(s);
anglesel = Array_data(&(p->anglesel));
if (Array_length(&(p->dihedsel)) != ndiheds
&& (s=Array_resize(&(p->dihedsel), ndiheds)) != OK) return ERROR(s);
dihedsel = Array_data(&(p->dihedsel));
if (Array_length(&(p->imprsel)) != nimprs
&& (s=Array_resize(&(p->imprsel), nimprs)) != OK) return ERROR(s);
imprsel = Array_data(&(p->imprsel));
/* find max length for inverse selection array */
ninvs = natoms;
if (ninvs < nbonds) ninvs = nbonds;
if (ninvs < nangles) ninvs = nangles;
if (ninvs < ndiheds) ninvs = ndiheds;
if (ninvs < nimprs) ninvs = nimprs;
if (Array_length(&(p->invsel)) != ninvs
&& (s=Array_resize(&(p->invsel), ninvs)) != OK) return ERROR(s);
invsel = Array_data(&(p->invsel));
if (0 == objc) {
memset(atomsel, 0, natoms);
memset(nonbsel, ASEL_NONB, natoms);
memset(bondsel, TRUE, nbonds);
memset(anglesel, TRUE, nangles);
memset(dihedsel, TRUE, ndiheds);
memset(imprsel, TRUE, nimprs);
}
else {
const char *t = NULL;
state = KEYWD;
memset(atomsel, 0, natoms);
memset(nonbsel, 0, natoms);
memset(bondsel, 0, nbonds);
memset(anglesel, 0, nangles);
memset(dihedsel, 0, ndiheds);
memset(imprsel, 0, nimprs);
i = 0;
INT(objc);
while (i <= objc) {
INT(i);
switch (state) {
case KEYWD:
if (i == objc) { i++; break; }
t = Tcl_GetString(objv[i]);
setnum = 0;
invert = FALSE;
if ('-'==t[0]) { invert = TRUE; t++; }
else if ('+'==t[0]) { t++; }
if (strcmp(t,"atom")==0) state = ATOM;
else if (strcmp(t,"bond")==0) state = BOND;
else if (strcmp(t,"angle")==0) state = ANGLE;
else if (strcmp(t,"dihed")==0) state = DIHED;
else if (strcmp(t,"impr")==0) state = IMPR;
else if (strcmp(t,"elec")==0) state = ELEC;
else if (strcmp(t,"vdw")==0) state = VDW;
else if (strcmp(t,"nonb")==0) state = NONB;
else return ERROR(ERR_EXPECT);
i++;
break;
case BOND:
s = FAIL;
if (i<objc && (s=parse_bondlist(p,interp,objv[i],invert))==OK) i++;
//else if (s < FAIL) return ERROR(s);
else if ( ! invert ) memset(bondsel, TRUE, nbonds);
state = KEYWD;
break;
case ANGLE:
s = FAIL;
if (i<objc && (s=parse_anglelist(p,interp,objv[i],invert))==OK) i++;
//else if (s < FAIL) return ERROR(s);
else if ( ! invert ) memset(anglesel, TRUE, nangles);
state = KEYWD;
break;
case DIHED:
s = FAIL;
if (i<objc && (s=parse_dihedlist(p,interp,objv[i],invert))==OK) i++;
//else if (s < FAIL) return ERROR(s);
else if ( ! invert ) memset(dihedsel, TRUE, ndiheds);
state = KEYWD;
break;
case IMPR:
s = FAIL;
if (i<objc && (s=parse_imprlist(p,interp,objv[i],invert))==OK) i++;
//else if (s < FAIL) return ERROR(s);
else if ( ! invert ) memset(imprsel, TRUE, nimprs);
state = KEYWD;
break;
default: /* ATOM, ELEC, VDW, or NONB */
if (i==objc && setnum > 0) { state = KEYWD; continue; }
if (ATOM==state) mark = (0==setnum ? -ASEL_NONB : -ASEL_NONB_B);
else if (ELEC==state) mark = (0==setnum ? ASEL_ELEC : ASEL_ELEC_B);
else if (VDW==state) mark = (0==setnum ? ASEL_VDW : ASEL_VDW_B);
else mark = (0==setnum ? ASEL_NONB : ASEL_NONB_B);
INT(ASEL_NONB==mark);
INT(ASEL_NONB_B==mark);
s = FAIL;
if (i<objc && (s=parse_atomlist(p,interp,objv[i],invert,mark))==OK) {
i++;
setnum++;
if (invert || 2==setnum) state = KEYWD;
}
#if 0
else if (s < FAIL) {
if (setnum > 0) continue;
else return ERROR(s);
}
#endif
else if (0==setnum && !invert) {
if (mark > 0) {
memset(nonbsel, mark, natoms);
}
else {
memset(atomsel, -mark, natoms);
}
state = KEYWD;
}
else state = KEYWD;
} /* switch */
} /* while */
} /* else */
if ((s=select_from_atomlist(p)) != OK) return ERROR(s);
/* evaluation */
if (EVAL_ENERGY==evalType || EVAL_FORCE==evalType) {
if ((s=NLEnergy_eval_force(p)) != OK) return ERROR(s);
}
else {
/* minimize not yet supported */
return ERROR(ERR_EXPECT);
}
/* output */
if (EVAL_ENERGY==evalType) {
Tcl_Obj *a = NULL;
if ((s=NLEnergy_new_obj_dreal(interp, &a,
p->ener.pe * ENERGY_EXTERNAL)) != OK) {
return ERROR(s);
}
if ((s=NLEnergy_set_obj_result(interp, a)) != OK) return ERROR(s);
}
else if (EVAL_FORCE==evalType || EVAL_MINIMIZE==evalType) {
const dvec *f = Coord_force_const(&(p->coord));
Tcl_Obj *r = NULL; /* return list of lists */
Tcl_Obj *a = NULL; /* list of atom index */
Tcl_Obj *b = NULL; /* list of force or potentials (MINIMIZE) */
if ((s=atomlist_contrib(p)) != OK) return ERROR(s);
if ((s=new_list(interp, &r)) != OK) return ERROR(s);
if ((s=new_list(interp, &a)) != OK) return ERROR(s);
if ((s=new_list(interp, &b)) != OK) return ERROR(s);
for (i = 0; i < natoms; i++) {
if (atomsel[i]) {
if ((s=list_append_atomid(p,interp,a,i)) != OK) return ERROR(s);
if (EVAL_FORCE==evalType) {
dvec fs;
VECMUL(fs, ENERGY_EXTERNAL, f[i]);
if ((s=list_append_dvec(interp,b,&fs)) != OK) return ERROR(s);
}
}
}
if (EVAL_MINIMIZE==evalType) {
return ERROR(ERR_EXPECT);
}
if ((s=list_append_obj(interp, r, a)) != OK) return ERROR(s);
if ((s=list_append_obj(interp, r, b)) != OK) return ERROR(s);
if ((s=set_obj_result(interp, r)) != OK) return ERROR(s);
}
else {
/* nothing else is supported */
return ERROR(ERR_EXPECT);
}
#if 0
if (objc >= 1) {
const char *t = Tcl_GetString(objv[0]);
if (strcmp(t,"bond")==0) {
return NLEnergy_energy_bond(p, interp, objc-1, objv+1);
}
if (strcmp(t,"angle")==0) {
return NLEnergy_energy_angle(p, interp, objc-1, objv+1);
}
if (strcmp(t,"dihed")==0) {
return NLEnergy_energy_dihed(p, interp, objc-1, objv+1);
}
if (strcmp(t,"impr")==0) {
return NLEnergy_energy_impr(p, interp, objc-1, objv+1);
}
if (strcmp(t,"elec")==0) {
return NLEnergy_energy_nonbonded(p, FNBCUT_ELEC, interp, objc-1, objv+1);
}
if (strcmp(t,"vdw")==0) {
return NLEnergy_energy_nonbonded(p, FNBCUT_VDW, interp, objc-1, objv+1);
}
if (strcmp(t,"nonbonded")==0) {
return NLEnergy_energy_nonbonded(p, FNBCUT_ELEC | FNBCUT_VDW,
interp, objc-1, objv+1);
}
}
return ERROR(ERR_EXPECT);
#endif
return OK;
}
int main(int argc, char *argv[]) {
Array arr;
Random ran;
unsigned long seed;
int len, range, i, s, debug;
SortElem *a;
if (argc > 5) {
NL_fprintf(stderr, "syntax: %s [N RANGE SEED debug?]\n", argv[0]);
exit(1);
}
len = (argc >= 2 ? atoi(argv[1]) : DEFLEN);
range = (argc >= 3 ? atoi(argv[2]) : DEFRANGE);
seed = (argc >= 4 ? atoi(argv[3]) : DEFSEED);
debug = (argc >= 5);
if (len <= 0) {
NL_fprintf(stderr, "nelems must be positive\n");
exit(1);
}
if ((s=Array_init(&arr, sizeof(SortElem))) != OK) {
NL_fprintf(stderr, "Array_init() failed\n");
exit(1);
}
if ((s=Array_resize(&arr, len)) != OK) {
NL_fprintf(stderr, "Array_resize() failed for len=%d\n", len);
exit(1);
}
if ((s=Random_initseed(&ran, seed)) != OK) {
NL_fprintf(stderr, "Random_initseed() failed\n");
exit(1);
}
a = (SortElem *) Array_data(&arr);
NL_printf("creating random array of %d elements...\n", len);
for (i = 0; i < len; i++) {
a[i].key = (int32) (Random_uniform(&ran) * range);
a[i].value = i;
}
if (debug) {
for (i = 0; i < len; i++) {
NL_printf(" %d", a[i].key);
}
NL_printf("\n");
}
NL_printf("calling quicksort...\n");
Sort_quick(a, len);
NL_printf("testing sort condition...\n");
if (debug) {
for (i = 0; i < len; i++) {
NL_printf(" %d", a[i].key);
}
NL_printf("\n");
}
for (i = 1; i < len; i++) {
if (a[i-1].key > a[i].key) {
NL_fprintf(stderr, "failed sort condition for pair (%d,%d):\n"
"a[%d]=%d a[%d]=%d\n", i-1, i, i-1, a[i-1].key, i, a[i].key);
exit(1);
}
}
NL_printf("success!\n");
return 0;
}