NAMD
ScriptTcl.C
Go to the documentation of this file.
1 
7 /*
8  Modifies SimParameters settings during run.
9 */
10 
11 #include "InfoStream.h"
12 #include "BackEnd.h"
13 #include "ScriptTcl.h"
14 #include "Broadcasts.h"
15 #include "ConfigList.h"
16 #include "Node.h"
17 #include "PDB.h"
18 #include "WorkDistrib.h"
19 #include "NamdState.h"
20 #include "Output.h"
21 #include "Controller.h"
22 #include "SimParameters.h"
23 #include "Thread.h"
24 #include "ProcessorPrivate.h"
25 #include "PatchMgr.h"
26 #include "PatchMap.h"
27 #include "Measure.h"
28 #include "colvarmodule.h"
29 #include "colvarscript.h"
30 #include "DumpBench.h"
31 #include <errno.h>
32 #include <stdio.h>
33 #include <ctype.h> // for isspace
34 #ifndef WIN32
35 #include <strings.h>
36 #endif
37 
38 #include "qd.h"
39 
40 #ifdef NAMD_TCL
41 #include <tcl.h>
42 #endif
43 #include "TclCommands.h"
44 
45 #include "ProcessorPrivate.h"
46 #include "DataExchanger.h"
47 
48 //#define DEBUGM
49 #define MIN_DEBUG_LEVEL 4
50 #include "Debug.h"
51 
52 #include "molfile_plugin.h"
53 #include "libmolfile_plugin.h"
54 
55 static molfile_plugin_t *dcdplugin;
56 static int register_cb(void *v, vmdplugin_t *p) {
57  dcdplugin = (molfile_plugin_t *)p;
58  return 0;
59 }
60 
61 //
62 // XXX static and global variables are unsafe for shared memory builds.
63 //
64 static int numatoms;
65 static void *filehandle;
66 static float *coords;
67 static Vector *vcoords;
68 
69 
70 void ScriptTcl::suspend() {
72 }
73 
74 void ScriptTcl::barrier() {
76 }
77 
78 void ScriptTcl::initcheck() {
79  if ( initWasCalled == 0 ) {
80 #ifdef NAMD_TCL
81  CkPrintf("TCL: Suspending until startup complete.\n");
82  Tcl_CreateCommand(interp, "param", Tcl_param,
83  (ClientData) this, (Tcl_CmdDeleteProc *) NULL);
84  Tcl_CreateCommand(interp, "unknown", Tcl_param,
85  (ClientData) this, (Tcl_CmdDeleteProc *) NULL);
86  Tcl_CreateCommand(interp, "isset", Tcl_isset_param,
87  (ClientData) this, (Tcl_CmdDeleteProc *) NULL);
88  Tcl_CreateCommand(interp, "istrue", Tcl_istrue_param,
89  (ClientData) this, (Tcl_CmdDeleteProc *) NULL);
90  Tcl_CreateCommand(interp, "structure", Tcl_reloadStructure,
91  (ClientData) this, (Tcl_CmdDeleteProc *) NULL);
92 #endif
93  initWasCalled = 1;
94 
95  state->configListInit(config);
97 #ifdef NAMD_TCL
99  simParams->tclIsThreaded =
100  ! ! Tcl_GetVar2(interp, "tcl_platform", "threaded", TCL_GLOBAL_ONLY);
101 #endif
103  suspend();
104  }
105 }
106 
107 void ScriptTcl::runController(int task) {
108  scriptBarrier.publish(barrierStep++,task);
109  suspend();
110 #ifdef NAMD_TCL
111  if ( task == SCRIPT_RUN || task == SCRIPT_CONTINUE || task == SCRIPT_MINIMIZE ) {
112  doCallback(state->callback_labelstring.c_str(),
113  state->callback_valuestring.c_str());
114  }
115 #endif
116 }
117 
118 void ScriptTcl::setParameter(const char* param, const char* value) {
119  ScriptParamMsg *msg = new ScriptParamMsg;
120  strncpy(msg->param,param,MAX_SCRIPT_PARAM_SIZE);
121  strncpy(msg->value,value,MAX_SCRIPT_PARAM_SIZE);
122  (CProxy_Node(CkpvAccess(BOCclass_group).node)).scriptParam(msg);
123  barrier();
124 }
125 
126 void ScriptTcl::setParameter(const char* param, int value) {
127  ScriptParamMsg *msg = new ScriptParamMsg;
128  strncpy(msg->param,param,MAX_SCRIPT_PARAM_SIZE);
129  sprintf(msg->value,"%d",value);
130  (CProxy_Node(CkpvAccess(BOCclass_group).node)).scriptParam(msg);
131  barrier();
132 }
133 
134 void ScriptTcl::reinitAtoms(const char *basename) {
135  Node::Object()->workDistrib->reinitAtoms(basename);
136  barrier();
137 }
138 
139 #ifdef NAMD_TCL
140 
141 #ifdef NAMD_PYTHON
142 #include <Python.h>
143 
144 #if PY_MAJOR_VERSION >= 3
145 
146 #define PYINT_CHECK PyLong_Check
147 #define PYINT_ASLONG PyLong_AsLong
148 #define PYSTRING_CHECK PyUnicode_Check
149 // Encode the string as UTF8, hoping we are in the ASCII region
150 #define PYSTRING_ASSTRING PyUnicode_AsUTF8
151 
152 #else
153 
154 #define PYINT_CHECK PyInt_Check
155 #define PYINT_ASLONG PyInt_AsLong
156 #define PYSTRING_CHECK PyString_Check
157 #define PYSTRING_ASSTRING PyString_AsString
158 
159 #endif
160 
161 static Tcl_Obj* python_tcl_convert(PyObject *obj) {
162 
163  if ( PYINT_CHECK(obj) ) {
164  return Tcl_NewLongObj(PYINT_ASLONG(obj));
165  }
166  if ( PyFloat_Check(obj) ) {
167  return Tcl_NewDoubleObj(PyFloat_AsDouble(obj));
168  }
169  if ( PYSTRING_CHECK(obj) ) {
170  return Tcl_NewStringObj(PYSTRING_ASSTRING(obj), -1);
171  }
172  if ( PySequence_Check(obj) ) {
173  PyObject *iter = PyObject_GetIter(obj);
174  if ( ! iter ) NAMD_bug("python_tcl_convert failed to get iterator");
175  Tcl_Obj *rlist = Tcl_NewListObj(0,0);
176  while ( PyObject *item = PyIter_Next(iter) ) {
177  Tcl_ListObjAppendElement(0, rlist, python_tcl_convert(item));
178  Py_DECREF(item);
179  }
180  Py_DECREF(iter);
181  return rlist;
182  }
183  PyObject *str = PyObject_Str(obj);
184  Tcl_Obj *robj = Tcl_NewStringObj(PYSTRING_ASSTRING(str), -1);
185  Py_DECREF(str);
186  return robj;
187 }
188 
189 static int atoBool(const char *s);
190 
191 static PyObject* tcl_python_convert(Tcl_Obj *obj) {
192  long rlong;
193  if ( TCL_OK == Tcl_GetLongFromObj(0, obj, &rlong) )
194  return Py_BuildValue("l", rlong);
195  double rdouble;
196  if ( TCL_OK == Tcl_GetDoubleFromObj(0, obj, &rdouble) )
197  return Py_BuildValue("d", rdouble);
198  const char *rstring = Tcl_GetString(obj);
199  if ( rstring[0] == '\0' )
200  return Py_None;
201  int rbool = atoBool(rstring);
202  if ( rbool >= 0 )
203  return PyBool_FromLong(rbool);
204  return Py_BuildValue("s", rstring);
205 }
206 
207 static Tcl_Interp *static_interp;
208 
209 static PyObject* python_tcl_call(PyObject *self, PyObject *args) {
210  Tcl_Interp *interp = static_interp;
211  Tcl_Obj *command = python_tcl_convert(args);
212  Tcl_IncrRefCount(command);
213  if ( TCL_OK != Tcl_EvalObjEx(interp,command,TCL_EVAL_DIRECT) ) {
214  PyErr_SetString(PyExc_RuntimeError, Tcl_GetStringResult(interp));
215  Tcl_DecrRefCount(command);
216  return 0;
217  }
218  Tcl_DecrRefCount(command);
219  return tcl_python_convert(Tcl_GetObjResult(interp));
220 }
221 
222 static PyObject* python_tcl_eval(PyObject *self, PyObject *args) {
223  Tcl_Interp *interp = static_interp;
224  const char *command;
225  if ( ! PyArg_ParseTuple(args, "s", &command) ) return 0;
226  if ( TCL_OK != Tcl_EvalEx(interp,command,-1,TCL_EVAL_DIRECT) ) {
227  PyErr_SetString(PyExc_RuntimeError, Tcl_GetStringResult(interp));
228  return 0;
229  }
230  return tcl_python_convert(Tcl_GetObjResult(interp));
231 }
232 
233 static PyObject* python_tcl_write(PyObject *self, PyObject *args) {
234  const char *string;
235  if ( ! PyArg_ParseTuple(args, "s", &string) ) return 0;
236  CkPrintf("%s", string);
237  return Py_None;
238 }
239 
240 static PyMethodDef namdPython_methods[] = {
241  {"eval", python_tcl_eval, METH_VARARGS,
242  "Evaluate string in Tcl interpreter."},
243  {"call", python_tcl_call, METH_VARARGS,
244  "Call command and arguments in Tcl interpreter."},
245  {"write", python_tcl_write, METH_VARARGS,
246  "Write string using CkPrintf."},
247  {NULL, NULL, 0, NULL}
248 };
249 
250 static PyMethodDef namdPython_methods_empty[] = {
251  {NULL, NULL, 0, NULL}
252 };
253 
254 #if PY_MAJOR_VERSION >= 3
255 
256 struct module_state {
257  PyObject *error;
258 };
259 
260 static int namdPython_traverse(PyObject *m, visitproc visit, void *arg);
261 static int namdPython_clear(PyObject *m);
262 PyObject *namdPythonModule;
263 
264 static int namdPython_traverse(PyObject *m, visitproc visit, void *arg) {
265  Py_VISIT(((struct module_state*)PyModule_GetState(m))->error);
266  return 0;
267 }
268 
269 static int namdPython_clear(PyObject *m) {
270  Py_CLEAR(((struct module_state*)PyModule_GetState(m))->error);
271  return 0;
272 }
273 
274 static struct PyModuleDef moduledef = {
275  PyModuleDef_HEAD_INIT,
276  "tcl",
277  NULL,
278  sizeof(struct module_state),
279  namdPython_methods,
280  NULL,
281  namdPython_traverse,
282  namdPython_clear,
283  NULL
284 };
285 
286 static PyObject* PyInit_tcl(void) {
287  PyObject *module;
288  module = PyModule_Create(&moduledef);
289  if (module == NULL) {
290  NAMD_bug("Failed to create Python tcl module");
291  }
292  return module;
293 }
294 
295 static struct PyModuleDef namdmoduledef = {
296  PyModuleDef_HEAD_INIT,
297  "namd",
298  NULL,
299  sizeof(struct module_state),
300  namdPython_methods_empty,
301  NULL,
302  namdPython_traverse,
303  namdPython_clear,
304  NULL
305 };
306 
307 static PyObject* PyInit_namd(void) {
308  PyObject *module;
309  module = PyModule_Create(&namdmoduledef);
310  if (module == NULL) {
311  NAMD_bug("Failed to create Python namd module");
312  }
313  return module;
314 }
315 
316 
317 #endif // Python 3
318 
319 static void namd_python_initialize(void *interp) {
320  if ( static_interp ) return;
321  static_interp = (Tcl_Interp*) interp;
322 
323  #if PY_MAJOR_VERSION >= 3
324  PyImport_AppendInittab("tcl", &PyInit_tcl);
325  PyImport_AppendInittab("namd", &PyInit_namd);
326  Py_InitializeEx(0); // do not initialize signal handlers
327  #else
328  Py_InitializeEx(0); // do not initialize signal handlers
329  Py_InitModule("tcl", namdPython_methods);
330  Py_InitModule("namd", namdPython_methods_empty);
331  #endif
332 
333  const char * python_code = "\n"
334 "import sys\n"
335 "import tcl\n"
336 "sys.stdout = tcl\n"
337 "\n"
338 "class _namd_wrapper(object):\n"
339 " tcl = __import__('tcl')\n"
340 " class _wrapped(object):\n"
341 " def __init__(self,_name):\n"
342 " self.name = _name\n"
343 " def __call__(self,*args):\n"
344 " return self.tcl.call(self.name,*args)\n"
345 " def __getattr__(self,name):\n"
346 " if self.tcl.call('info','commands',name) == name:\n"
347 " return self._wrapped(name)\n"
348 " else:\n"
349 " return self.tcl.call('param',name)\n"
350 " def __setattr__(self,name,val):\n"
351 " if self.tcl.call('info','commands',name) == name:\n"
352 " raise AttributeError\n"
353 " return self.tcl.call('param',name,val)\n"
354 " def __call__(self, **args):\n"
355 " for (name,val) in args.items():\n"
356 " self.tcl.call('param',name,val)\n"
357 "\n"
358 "sys.modules[__name__] = _namd_wrapper()\n"
359 "\n";
360 
361  PyObject* mainmod = PyImport_AddModule("__main__");
362  PyObject* globalDictionary = PyModule_GetDict(mainmod);
363  PyObject* namdmod = PyImport_AddModule("namd");
364  PyObject* localDictionary = PyModule_GetDict(namdmod);
365  PyObject* result = PyRun_String(python_code, Py_file_input, globalDictionary, localDictionary);
366 
367  if ( 0 != PyRun_SimpleString("import tcl\nimport namd\n") ) {
368  NAMD_bug("namd_python_initialize failed");
369  }
370 }
371 
372 int ScriptTcl::Tcl_python(ClientData, Tcl_Interp *interp, int argc, const char **argv) {
373  if ( argc < 2 ) {
374  Tcl_SetResult(interp,(char*)"args: script",TCL_VOLATILE);
375  return TCL_ERROR;
376  }
377  namd_python_initialize(interp);
378  PyObject *dict = PyModule_GetDict(PyImport_AddModule("__main__"));
379 
380  const char *script = argv[1];
381  int token = Py_eval_input;
382 
383  Tcl_DString scr;
384  Tcl_DStringInit(&scr);
385  if ( argc > 2 ) {
386  Tcl_DStringAppend(&scr,argv[1],-1);
387  for ( int i = 2; i < argc; ++i ) {
388  Tcl_DStringAppend(&scr," ",-1);
389  Tcl_DStringAppend(&scr,argv[i],-1);
390  }
391  script = Tcl_DStringValue(&scr);
392  } else {
393  while ( script[0] == ' ' || script[0] == '\t' ) ++script;
394  for ( int i=0; script[i]; ++i ) {
395  if ( script[i] == '\n' ) {
396  token = Py_file_input;
397  script = argv[1];
398  break;
399  }
400  }
401  }
402 
403  PyObject *result = PyRun_String(script, token, dict, dict);
404  Tcl_ResetResult(interp); // Python may have called Tcl
405  Tcl_DStringFree(&scr);
406 
407  if ( PyErr_Occurred() ) {
408  if ( result ) NAMD_bug("PyErr_Occurred indicates error but PyRun does not");
409  // PyErr_Print();
410  Tcl_AppendResult(interp, "error from python interpreter\n", NULL);
411  PyObject *type, *value, *traceback, *str;
412  PyErr_Fetch(&type, &value, &traceback);
413 
414  if ( ! traceback ) {
415  traceback = Py_None;
416  Py_INCREF(Py_None);
417  }
418 
419  PyObject *mod = PyImport_ImportModule("traceback");
420  if ( ! mod ) return TCL_ERROR;
421 
422  PyObject *func = PyObject_GetAttrString(mod, "format_exception");
423  if ( ! func ) return TCL_ERROR;
424 
425  // TODO understand why this call fails in Python3 in cases where the
426  // traceback is not None
427  PyObject *list = PyObject_CallFunctionObjArgs(func, type, value, traceback, NULL);
428  if ( ! list ) return TCL_ERROR;
429 
430  Py_DECREF(mod);
431  Py_DECREF(func);
432  Py_DECREF(type);
433  Py_DECREF(value);
434  Py_DECREF(traceback);
435 
436  PyObject *iter = PyObject_GetIter(list);
437  if ( ! iter ) return TCL_ERROR;
438  while ( PyObject *item = PyIter_Next(iter) ) {
439  str = PyObject_Str(item);
440  Tcl_AppendResult(interp, PYSTRING_ASSTRING(str), "\n", NULL);
441  Py_DECREF(str);
442  Py_DECREF(item);
443  }
444  Py_DECREF(iter);
445  Py_DECREF(list);
446 
447  return TCL_ERROR;
448  } else if ( ! result ) {
449  NAMD_bug("PyRun indicates error but PyErr_Occurred does not");
450  }
451  if ( result != Py_None ) {
452  Tcl_SetObjResult(interp, python_tcl_convert(result));
453  }
454  Py_DECREF(result);
455  return TCL_OK;
456 }
457 
458 #else // NAMD_PYTHON
459 
460 int ScriptTcl::Tcl_python(ClientData, Tcl_Interp *interp, int argc, const char **argv) {
461  Tcl_SetResult(interp,(char*)"python not enabled",TCL_VOLATILE);
462  return TCL_ERROR;
463 }
464 
465 #endif // NAMD_PYTHON
466 
467 int ScriptTcl::Tcl_startup(ClientData clientData,
468  Tcl_Interp *interp, int argc, const char *argv[]) {
469  if ( argc > 1 ) {
470  Tcl_SetResult(interp,(char*)"no arguments needed",TCL_VOLATILE);
471  return TCL_ERROR;
472  }
473  ScriptTcl *script = (ScriptTcl *)clientData;
474  script->initcheck();
475  return TCL_OK;
476 }
477 
478 int ScriptTcl::Tcl_exit(ClientData clientData,
479  Tcl_Interp *interp, int argc, const char *argv[]) {
480  ScriptTcl *script = (ScriptTcl *)clientData;
481  if ( CmiNumPartitions() > 1 ) {
482  if ( ! script->initWasCalled ) CkPrintf("TCL: Running startup before exit due to replicas.\n");
483  script->initcheck();
484  }
485  CkPrintf("TCL: Exiting due to exit command.\n");
486 #if CMK_HAS_PARTITION
487  replica_barrier();
488 #endif
489  if ( script->runWasCalled ) script->runController(SCRIPT_END);
490  if (argc > 2) {
491  Tcl_SetResult(interp,(char*)"wrong # args: should be \"exit ?returnCode?\"",TCL_VOLATILE);
492  return TCL_ERROR;
493  }
494  int status = 0;
495  if (argc > 1 && Tcl_GetInt(interp,argv[1],&status) != TCL_OK) {
496  return TCL_ERROR;
497  }
498  BackEnd::exit(status);
499  return TCL_OK;
500 }
501 
502 int ScriptTcl::Tcl_abort(ClientData,
503  Tcl_Interp *, int argc, const char *argv[]) {
504  Tcl_DString msg;
505  Tcl_DStringInit(&msg);
506  Tcl_DStringAppend(&msg,"TCL:",-1);
507  if ( argc == 1 ) Tcl_DStringAppend(&msg," abort called",-1);
508  for ( int i = 1; i < argc; ++i ) {
509  Tcl_DStringAppend(&msg," ",-1);
510  Tcl_DStringAppend(&msg,argv[i],-1);
511  }
512  NAMD_die(Tcl_DStringValue(&msg));
513  Tcl_DStringFree(&msg);
514  return TCL_OK;
515 }
516 
517 int ScriptTcl::Tcl_numPes(ClientData, Tcl_Interp *interp, int argc, const char **) {
518  if ( argc > 1 ) {
519  Tcl_SetResult(interp,(char*)"no arguments needed",TCL_VOLATILE);
520  return TCL_ERROR;
521  }
522  Tcl_SetObjResult(interp, Tcl_NewIntObj(CkNumPes()));
523  return TCL_OK;
524 }
525 
526 int ScriptTcl::Tcl_numNodes(ClientData, Tcl_Interp *interp, int argc, const char **) {
527  if ( argc > 1 ) {
528  Tcl_SetResult(interp,(char*)"no arguments needed",TCL_VOLATILE);
529  return TCL_ERROR;
530  }
531  Tcl_SetObjResult(interp, Tcl_NewIntObj(CkNumNodes()));
532  return TCL_OK;
533 }
534 
535 int ScriptTcl::Tcl_numPhysicalNodes(ClientData, Tcl_Interp *interp, int argc, const char **) {
536  if ( argc > 1 ) {
537  Tcl_SetResult(interp,(char*)"no arguments needed",TCL_VOLATILE);
538  return TCL_ERROR;
539  }
540  Tcl_SetObjResult(interp, Tcl_NewIntObj(CmiNumPhysicalNodes()));
541  return TCL_OK;
542 }
543 
544 int ScriptTcl::Tcl_numReplicas(ClientData, Tcl_Interp *interp, int argc, const char **) {
545  if ( argc > 1 ) {
546  Tcl_SetResult(interp,(char*)"no arguments needed",TCL_VOLATILE);
547  return TCL_ERROR;
548  }
549  Tcl_SetObjResult(interp, Tcl_NewIntObj(CmiNumPartitions()));
550  return TCL_OK;
551 }
552 
553 int ScriptTcl::Tcl_myReplica(ClientData, Tcl_Interp *interp, int argc, const char **) {
554  if ( argc > 1 ) {
555  Tcl_SetResult(interp,(char*)"no arguments needed",TCL_VOLATILE);
556  return TCL_ERROR;
557  }
558  Tcl_SetObjResult(interp, Tcl_NewIntObj(CmiMyPartition()));
559  return TCL_OK;
560 }
561 
562 #define CHECK_REPLICA(REP) do {\
563  if ( (REP) < 0 ) { \
564  Tcl_SetResult(interp,(char*)"negative replica index",TCL_VOLATILE); \
565  return TCL_ERROR; \
566  } \
567  if ( (REP) >= CmiNumPartitions() ) { \
568  Tcl_SetResult(interp,(char*)"non-existent replica index",TCL_VOLATILE); \
569  return TCL_ERROR; \
570  } \
571 } while ( 0 )
572 
573 int ScriptTcl::Tcl_replicaEval(ClientData, Tcl_Interp *interp, int argc, const char **argv) {
574  if ( argc != 3 ) {
575  Tcl_SetResult(interp,(char*)"args: dest script",TCL_VOLATILE);
576  return TCL_ERROR;
577  }
578  int dest = atoi(argv[1]);
579  CHECK_REPLICA(dest);
580 #if CMK_HAS_PARTITION
581  Tcl_DString recvstr;
582  Tcl_DStringInit(&recvstr);
583  DataMessage *recvMsg = NULL;
584  replica_eval(argv[2], dest, CkMyPe(), &recvMsg);
585  CmiAssert(recvMsg != NULL);
586  int code = recvMsg->code;
587  Tcl_DStringAppend(&recvstr, recvMsg->data, recvMsg->size);
588  Tcl_DStringResult(interp, &recvstr);
589  Tcl_DStringFree(&recvstr);
590  CmiFree(recvMsg);
591  return code;
592 #else
593  return Tcl_EvalEx(interp,argv[2],-1,TCL_EVAL_GLOBAL);
594 #endif
595 }
596 
597 int ScriptTcl::Tcl_replicaYield(ClientData, Tcl_Interp *interp, int argc, const char **argv) {
598  if ( argc > 2 ) {
599  Tcl_SetResult(interp,(char*)"args: ?seconds?",TCL_VOLATILE);
600  return TCL_ERROR;
601  }
602  double time = 0.;
603  if ( argc == 2 ) {
604  if ( sscanf(argv[1],"%lf",&time) != 1 ) {
605  Tcl_SetResult(interp,(char*)"args: ?seconds?",TCL_VOLATILE);
606  return TCL_ERROR;
607  }
608  }
609  if ( time > 0. ) {
610  time += CmiWallTimer();
611  do { CsdSchedulePoll(); } while ( CmiWallTimer() < time );
612  } else {
613  CsdSchedulePoll();
614  }
615  return TCL_OK;
616 }
617 
618 
619 int ScriptTcl::Tcl_replicaSendrecv(ClientData, Tcl_Interp *interp, int argc, const char **argv) {
620  if ( argc < 3 || argc > 4 ) {
621  Tcl_SetResult(interp,(char*)"args: data dest ?source?",TCL_VOLATILE);
622  return TCL_ERROR;
623  }
624  Tcl_DString recvstr;
625  Tcl_DStringInit(&recvstr);
626  int sendcount = strlen(argv[1]);
627  int recvcount = 0;
628  int dest = atoi(argv[2]);
629  int source = -1;
630  if ( argc > 3 ) source = atoi(argv[3]);
631 #if CMK_HAS_PARTITION
632  if (dest == CmiMyPartition()) {
633  Tcl_DStringSetLength(&recvstr,sendcount);
634  memcpy(Tcl_DStringValue(&recvstr),argv[1],sendcount);
635  } else {
636  DataMessage *recvMsg = NULL;
637  replica_sendRecv(argv[1], sendcount, dest, CkMyPe(), &recvMsg, source, CkMyPe());
638  CmiAssert(recvMsg != NULL);
639  Tcl_DStringAppend(&recvstr, recvMsg->data, recvMsg->size);
640  CmiFree(recvMsg);
641  }
642 #endif
643  Tcl_DStringResult(interp, &recvstr);
644  Tcl_DStringFree(&recvstr);
645  return TCL_OK;
646 }
647 
648 int ScriptTcl::Tcl_replicaSend(ClientData, Tcl_Interp *interp, int argc, const char **argv) {
649  if ( argc != 3 ) {
650  Tcl_SetResult(interp,(char*)"args: data dest",TCL_VOLATILE);
651  return TCL_ERROR;
652  }
653  int sendcount = strlen(argv[1]);
654  int dest = atoi(argv[2]);
655 #if CMK_HAS_PARTITION
656  replica_send(argv[1], sendcount, dest, CkMyPe());
657 #endif
658  return TCL_OK;
659 }
660 
661 int ScriptTcl::Tcl_replicaRecv(ClientData, Tcl_Interp *interp, int argc, const char **argv) {
662  if (argc != 2 ) {
663  Tcl_SetResult(interp,(char*)"args: source",TCL_VOLATILE);
664  return TCL_ERROR;
665  }
666  Tcl_DString recvstr;
667  Tcl_DStringInit(&recvstr);
668  int recvcount = 0;
669  int source = atoi(argv[1]);
670 #if CMK_HAS_PARTITION
671  DataMessage *recvMsg = NULL;
672  replica_recv(&recvMsg, source, CkMyPe());
673  CmiAssert(recvMsg != NULL);
674  Tcl_DStringAppend(&recvstr, recvMsg->data, recvMsg->size);
675  CmiFree(recvMsg);
676 #endif
677  Tcl_DStringResult(interp, &recvstr);
678  Tcl_DStringFree(&recvstr);
679  return TCL_OK;
680 }
681 
682 int ScriptTcl::Tcl_replicaBarrier(ClientData, Tcl_Interp *interp, int argc, const char **) {
683  if ( argc > 1 ) {
684  Tcl_SetResult(interp,(char*)"no arguments needed",TCL_VOLATILE);
685  return TCL_ERROR;
686  }
687 #if CMK_HAS_PARTITION
688  replica_barrier();
689 #endif
690  return TCL_OK;
691 }
692 
693 int ScriptTcl::Tcl_replicaAtomSendrecv(ClientData clientData, Tcl_Interp *interp, int argc, const char **argv) {
694  ScriptTcl *script = (ScriptTcl *)clientData;
695  script->initcheck();
696  if ( ! Node::Object()->simParameters->replicaUniformPatchGrids ) {
697  Tcl_SetResult(interp,
698  (char*)"replicaUniformPatchGrids is required for atom exchange",
699  TCL_VOLATILE);
700  return TCL_ERROR;
701  }
702  if ( argc < 2 || argc > 3 ) {
703  Tcl_SetResult(interp,
704  (char*)"bad arg count; args: dest ?source?",TCL_VOLATILE);
705  return TCL_ERROR;
706  }
707  int dest = -1;
708  if ( sscanf(argv[1], "%d", &dest) != 1 ) {
709  Tcl_SetResult(interp,(char*)"bad dest; args: dest ?source?",TCL_VOLATILE);
710  return TCL_ERROR;
711  }
712  int source = -1;
713  if ( argc == 3 ) {
714  if ( sscanf(argv[2], "%d", &source) != 1 ) {
715  Tcl_SetResult(interp,
716  (char*)"bad source; args: dest ?source?",TCL_VOLATILE);
717  return TCL_ERROR;
718  }
719  }
720 
721 #if CMK_HAS_PARTITION
722  if (dest != CmiMyPartition()) {
723  DataMessage *recvMsg = NULL;
724  replica_sendRecv((char*)&(script->state->lattice), sizeof(Lattice), dest, CkMyPe(), &recvMsg, source, CkMyPe());
725  CmiAssert(recvMsg != NULL);
726  memcpy(&(script->state->lattice), recvMsg->data, recvMsg->size);
727  CmiFree(recvMsg);
728  }
729 #endif
730 
731  char str[40];
732  sprintf(str, "%d", dest);
733  script->setParameter("scriptArg1", str);
734  sprintf(str, "%d", source);
735  script->setParameter("scriptArg2", str);
736 
737  CkpvAccess(_qd)->create(2 * PatchMap::Object()->numPatches());
738 
739  script->runController(SCRIPT_ATOMSENDRECV);
740 
741 #if CMK_HAS_PARTITION
742  if (dest != CmiMyPartition()) {
743  DataMessage *recvMsg = NULL;
744  ControllerState *cstate = script->state->controller;
745  replica_sendRecv((char*)cstate, sizeof(ControllerState), dest, CkMyPe(), &recvMsg, source, CkMyPe());
746  CmiAssert(recvMsg != NULL);
747  memcpy(cstate, recvMsg->data, recvMsg->size);
748  CmiFree(recvMsg);
749  }
750 #endif
751 
752  return TCL_OK;
753 }
754 
755 int ScriptTcl::Tcl_replicaAtomSend(ClientData clientData, Tcl_Interp *interp, int argc, const char **argv) {
756  ScriptTcl *script = (ScriptTcl *)clientData;
757  script->initcheck();
758  if ( ! Node::Object()->simParameters->replicaUniformPatchGrids ) {
759  Tcl_SetResult(interp,
760  (char*)"replicaUniformPatchGrids is required for atom exchange",
761  TCL_VOLATILE);
762  return TCL_ERROR;
763  }
764  if ( argc != 2 ) {
765  Tcl_SetResult(interp,(char*)"bad arg count; args: dest",TCL_VOLATILE);
766  return TCL_ERROR;
767  }
768  int dest = -1;
769  if ( sscanf(argv[1], "%d", &dest) != 1 ) {
770  Tcl_SetResult(interp,(char*)"bad dest; args: dest",TCL_VOLATILE);
771  return TCL_ERROR;
772  }
773 
774 #if CMK_HAS_PARTITION
775  replica_send((char*)&(script->state->lattice), sizeof(Lattice), dest, CkMyPe());
776 #endif
777 
778  char str[40];
779  sprintf(str, "%d", dest);
780  script->setParameter("scriptArg1", str);
781 
782  CkpvAccess(_qd)->create(PatchMap::Object()->numPatches());
783 
784  script->runController(SCRIPT_ATOMSEND);
785 
786 #if CMK_HAS_PARTITION
787  ControllerState *cstate = script->state->controller;
788  replica_send((char*)cstate, sizeof(ControllerState), dest, CkMyPe());
789 #endif
790 
791  return TCL_OK;
792 }
793 
794 int ScriptTcl::Tcl_replicaAtomRecv(ClientData clientData, Tcl_Interp *interp, int argc, const char **argv) {
795  ScriptTcl *script = (ScriptTcl *)clientData;
796  script->initcheck();
797  if ( ! Node::Object()->simParameters->replicaUniformPatchGrids ) {
798  Tcl_SetResult(interp,
799  (char*)"replicaUniformPatchGrids is required for atom exchange",
800  TCL_VOLATILE);
801  return TCL_ERROR;
802  }
803  if ( argc > 2 ) {
804  Tcl_SetResult(interp,(char*)"bad arg count; args: ?source?",TCL_VOLATILE);
805  return TCL_ERROR;
806  }
807  int source = -1;
808  if ( argc == 2 ) {
809  if ( sscanf(argv[1], "%d", &source) != 1 ) {
810  Tcl_SetResult(interp,(char*)"bad source; args: ?source?",TCL_VOLATILE);
811  return TCL_ERROR;
812  }
813  }
814 
815 #if CMK_HAS_PARTITION
816  DataMessage *recvMsg = NULL;
817  replica_recv(&recvMsg, source, CkMyPe());
818  CmiAssert(recvMsg != NULL);
819  memcpy(&(script->state->lattice), recvMsg->data, recvMsg->size);
820  CmiFree(recvMsg);
821 #endif
822 
823  char str[40];
824  sprintf(str, "%d", source);
825  script->setParameter("scriptArg2", str);
826 
827  CkpvAccess(_qd)->create(PatchMap::Object()->numPatches());
828 
829  script->runController(SCRIPT_ATOMRECV);
830 
831 #if CMK_HAS_PARTITION
832  recvMsg = NULL;
833  ControllerState *cstate = script->state->controller;
834  replica_recv(&recvMsg, source, CkMyPe());
835  CmiAssert(recvMsg != NULL);
836  memcpy(cstate, recvMsg->data, recvMsg->size);
837  CmiFree(recvMsg);
838 #endif
839 
840  return TCL_OK;
841 }
842 
843 
844 int ScriptTcl::Tcl_stdout(ClientData,
845  Tcl_Interp *interp, int argc, const char *argv[]) {
846  if (argc != 2) {
847  Tcl_SetResult(interp,(char*)"wrong # args",TCL_VOLATILE);
848  return TCL_ERROR;
849  }
850 
851  const char *filename= argv[1];
852  CkPrintf("TCL: redirecting stdout to file %s\n", filename);
853 
854  if ( ! freopen(filename, "a", stdout) ) {
855  Tcl_SetResult(interp, strerror(errno), TCL_VOLATILE);
856  return TCL_ERROR;
857  }
858  return TCL_OK;
859 }
860 
861 int ScriptTcl::Tcl_print(ClientData,
862  Tcl_Interp *, int argc, const char *argv[]) {
863  Tcl_DString msg;
864  Tcl_DStringInit(&msg);
865  for ( int i = 1; i < argc; ++i ) {
866  Tcl_DStringAppend(&msg," ",-1);
867  Tcl_DStringAppend(&msg,argv[i],-1);
868  }
869  CkPrintf("TCL:%s\n",Tcl_DStringValue(&msg));
870  Tcl_DStringFree(&msg);
871  return TCL_OK;
872 }
873 
874 int ScriptTcl::Tcl_config(ClientData clientData,
875  Tcl_Interp *interp, int argc, const char *argv[]) {
876 
877 // Needs to handle the following cases as passed in by Tcl:
878 // name data #comment
879 // name=data #comment
880 // name= data #comment
881 // name =data #comment
882 // name = data #comment
883 // name data1 data2 data3 #comment
884 // name=data1 data2 data3 #comment
885 // name= data1 data2 data3 #comment
886 // name =data1 data2 data3 #comment
887 // name = data1 data2 data3 #comment
888 // name { data1 data2 data3 } #comment
889 // name { data1 data2 data3 } #comment
890 // name { data1 data2 # data3 } #comment
891 // name {data1 data2 # data3 } #comment
892 // Do not try to handle "data#comment" in any form.
893 // The '#' start of any comments will *always* be a new argv.
894 // The name will *always* be contained in argv[1].
895 
896  // allocate storage for data string
897  int arglen = 1; int ai;
898  for (ai=1; ai<argc; ++ai) { arglen += strlen(argv[ai]) + 1; }
899  char *data = new char[arglen]; *data = 0;
900  char *name = new char[arglen]; *name = 0;
901 
902  // find the end of the name
903  const char *s = argv[1];
904  char *sn = name;
905  for ( ; *s && *s != '='; *(sn++) = *(s++) );
906  *sn = 0;
907 
908  // eliminate any comment
909  for (ai=2; ai<argc; ++ai) { if (argv[ai][0] == '#') argc = ai; }
910 
911  // concatenate all the data items
912  ai = 2;
913  if ( *s ) { ++s; strcat(data,s); } // name=data or name=
914  else if ( ai < argc && argv[ai][0] == '=' ) { // name =data or name =
915  strcat(data,argv[ai]+1);
916  ++ai;
917  }
918  for ( ; ai<argc; ++ai) {
919  if ( data[0] ) { strcat(data," "); }
920  strcat(data,argv[ai]);
921  }
922 
923  if ( ! *name ) {
924  delete [] data;
925  delete [] name;
926  Tcl_SetResult(interp,(char*)"error parsing config file",TCL_VOLATILE);
927  return TCL_ERROR;
928  }
929 
930  ScriptTcl *script = (ScriptTcl *)clientData;
931 
932  if ( *data ) {
933  script->config->add_element( name, strlen(name), data, strlen(data) );
934  delete [] data;
935  delete [] name;
936  return TCL_OK;
937  }
938  delete [] data;
939 
940  StringList *strlist = script->config->find(name);
941  delete [] name;
942 
943  if ( ! strlist ) {
944  Tcl_SetResult(interp,
945  (char*)"tried before startup to read config file parameter "
946  "that was not set",TCL_VOLATILE);
947  return TCL_ERROR;
948  }
949  Tcl_SetResult(interp,strlist->data,TCL_VOLATILE);
950  return TCL_OK;
951 }
952 
953 int ScriptTcl::Tcl_isset_config(ClientData clientData,
954  Tcl_Interp *interp, int argc, const char *argv[]) {
955  if (argc != 2) {
956  Tcl_SetResult(interp,(char*)"wrong # args",TCL_VOLATILE);
957  return TCL_ERROR;
958  }
959 
960  const char *param = argv[1];
961  ScriptTcl *script = (ScriptTcl *)clientData;
962  StringList *strlist = script->config->find(param);
963  Tcl_SetResult(interp, (char*)(strlist ? "1" : "0"), TCL_VOLATILE);
964  return TCL_OK;
965 }
966 
967 static int atoBool(const char *s)
968 {
969  if (!strcasecmp(s, "on")) return 1;
970  if (!strcasecmp(s, "off")) return 0;
971  if (!strcasecmp(s, "true")) return 1;
972  if (!strcasecmp(s, "false")) return 0;
973  if (!strcasecmp(s, "yes")) return 1;
974  if (!strcasecmp(s, "no")) return 0;
975  if (!strcasecmp(s, "1")) return 1;
976  if (!strcasecmp(s, "0")) return 0;
977  return -1;
978 }
979 
980 int ScriptTcl::Tcl_istrue_config(ClientData clientData,
981  Tcl_Interp *interp, int argc, const char *argv[]) {
982  if (argc != 2) {
983  Tcl_SetResult(interp,(char*)"wrong # args",TCL_VOLATILE);
984  return TCL_ERROR;
985  }
986 
987  const char *param = argv[1];
988  ScriptTcl *script = (ScriptTcl *)clientData;
989  StringList *strlist = script->config->find(param);
990  if ( ! strlist ) {
991  Tcl_SetResult(interp,(char*)"parameter value is not set",TCL_VOLATILE);
992  return TCL_ERROR;
993  }
994  int val = atoBool(strlist->data);
995  if ( val < 0 ) {
996  Tcl_SetResult(interp,(char*)"parameter value is not boolean",TCL_VOLATILE);
997  return TCL_ERROR;
998  }
999  Tcl_SetResult(interp, (char*)(val ? "1" : "0"), TCL_VOLATILE);
1000  return TCL_OK;
1001 }
1002 
1003 int ScriptTcl::Tcl_istrue_param(ClientData clientData,
1004  Tcl_Interp *interp, int argc, const char *argv[]) {
1005  if (argc != 2) {
1006  Tcl_SetResult(interp,(char*)"wrong # args",TCL_VOLATILE);
1007  return TCL_ERROR;
1008  }
1009 
1010  const char *param = argv[1];
1012  int val = simParams->istrueinparseopts(param);
1013  if ( val == -1 ) {
1014  Tcl_SetResult(interp,(char*)"unknown parameter",TCL_VOLATILE);
1015  return TCL_ERROR;
1016  }
1017  if ( val == -2 ) {
1018  Tcl_SetResult(interp,(char*)"parameter is not boolean",TCL_VOLATILE);
1019  return TCL_ERROR;
1020  }
1021  if ( val == -3 ) {
1022  Tcl_SetResult(interp,(char*)"parameter value is not set",TCL_VOLATILE);
1023  return TCL_ERROR;
1024  }
1025  if ( val != 0 && val != 1 ) {
1026  Tcl_SetResult(interp,(char*)"bug in Tcl_istrue_param",TCL_VOLATILE);
1027  return TCL_ERROR;
1028  }
1029  Tcl_SetResult(interp, (char*)(val ? "1" : "0"), TCL_VOLATILE);
1030  return TCL_OK;
1031 }
1032 
1033 int ScriptTcl::Tcl_isset_param(ClientData clientData,
1034  Tcl_Interp *interp, int argc, const char *argv[]) {
1035  if (argc != 2) {
1036  Tcl_SetResult(interp,(char*)"wrong # args",TCL_VOLATILE);
1037  return TCL_ERROR;
1038  }
1039 
1040  const char *param = argv[1];
1041  SimParameters *simParams = Node::Object()->simParameters;
1042  int val = simParams->issetinparseopts(param);
1043  if ( val < 0 ) {
1044  Tcl_SetResult(interp,(char*)"unknown parameter",TCL_VOLATILE);
1045  return TCL_ERROR;
1046  }
1047  Tcl_SetResult(interp, (char*)(val ? "1" : "0"), TCL_VOLATILE);
1048  return TCL_OK;
1049 }
1050 
1051 int ScriptTcl::Tcl_param(ClientData clientData,
1052  Tcl_Interp *interp, int argc, const char *argv[]) {
1053  if (argc != 2 && argc != 3 && argc != 5) {
1054  Tcl_SetResult(interp,
1055  (char*)"wrong # args for NAMD config parameter",TCL_VOLATILE);
1056  return TCL_ERROR;
1057  }
1058 
1059  const char *param = argv[1];
1060  if ( strlen(param) + 1 > MAX_SCRIPT_PARAM_SIZE ) {
1061  Tcl_SetResult(interp,
1062  (char*)"parameter name too long for NAMD config parameter",
1063  TCL_VOLATILE);
1064  return TCL_ERROR;
1065  }
1066 
1067  if ( argc == 2 ) { // get param value
1068  char buf[MAX_SCRIPT_PARAM_SIZE];
1069  SimParameters *simParams = Node::Object()->simParameters;
1070  char *result = simParams->getfromparseopts(param,buf);
1071  if ( result ) {
1072  Tcl_SetResult(interp, result, TCL_VOLATILE);
1073  return TCL_OK;
1074  } else {
1075  Tcl_SetResult(interp,
1076  (char*)"parameter unknown for NAMD config parameter",TCL_VOLATILE);
1077  return TCL_ERROR;
1078  }
1079  }
1080 
1081  char value[MAX_SCRIPT_PARAM_SIZE];
1082  int arglen = strlen(argv[2]) + 1;
1083  if ( argc == 5 ) arglen += strlen(argv[3]) + strlen(argv[4]) + 2;
1084  if ( arglen > MAX_SCRIPT_PARAM_SIZE ) {
1085  Tcl_SetResult(interp,
1086  (char*)"parameter value too long for NAMD config parameter",
1087  TCL_VOLATILE);
1088  return TCL_ERROR;
1089  }
1090  if ( argc == 3 ) sprintf(value,"%s",argv[2]);
1091  if ( argc == 5 ) sprintf(value,"%s %s %s",argv[2],argv[3],argv[4]);
1092 
1093  iout << "TCL: Setting parameter " << param << " to " << value << "\n" << endi;
1094 
1095  ScriptTcl *script = (ScriptTcl *)clientData;
1096  script->setParameter(param,value);
1097 
1098  // deal with some possible specifics
1099  if ( ! strncasecmp(param,"soluteScalingFactor",MAX_SCRIPT_PARAM_SIZE) ||
1100  ! strncasecmp(param,"soluteScalingFactorCharge",MAX_SCRIPT_PARAM_SIZE)) {
1101  script->runController(SCRIPT_RESCALESOLUTECHARGES);
1102  }
1103 
1104  return TCL_OK;
1105 }
1106 
1107 int ScriptTcl::Tcl_reinitvels(ClientData clientData,
1108  Tcl_Interp *interp, int argc, const char *argv[]) {
1109  ScriptTcl *script = (ScriptTcl *)clientData;
1110  script->initcheck();
1111  if (argc != 2) {
1112  Tcl_SetResult(interp,(char*)"wrong # args",TCL_VOLATILE);
1113  return TCL_ERROR;
1114  }
1115  const char *temp = argv[1];
1116 
1117  script->setParameter("initialTemp",temp);
1118 
1119  script->runController(SCRIPT_REINITVELS);
1120 
1121  return TCL_OK;
1122 }
1123 
1124 int ScriptTcl::Tcl_rescalevels(ClientData clientData,
1125  Tcl_Interp *interp, int argc, const char *argv[]) {
1126  ScriptTcl *script = (ScriptTcl *)clientData;
1127  script->initcheck();
1128  if (argc != 2) {
1129  Tcl_SetResult(interp,(char*)"wrong # args",TCL_VOLATILE);
1130  return TCL_ERROR;
1131  }
1132  const char *factor = argv[1];
1133 
1134  script->setParameter("scriptArg1",factor);
1135 
1136  script->runController(SCRIPT_RESCALEVELS);
1137 
1138  return TCL_OK;
1139 }
1140 
1141 int ScriptTcl::Tcl_run(ClientData clientData,
1142  Tcl_Interp *interp, int argc, const char *argv[]) {
1143  ScriptTcl *script = (ScriptTcl *)clientData;
1144  script->initcheck();
1145  if (argc < 2) {
1146  Tcl_SetResult(interp,(char*)"too few args",TCL_VOLATILE);
1147  return TCL_ERROR;
1148  }
1149  if (argc > 3) {
1150  Tcl_SetResult(interp,(char*)"too many args",TCL_VOLATILE);
1151  return TCL_ERROR;
1152  }
1153  int norepeat = 0;
1154  if (argc == 3) {
1155  if ( ! strcmp(argv[1], "norepeat") ) {
1156  if ( script->runWasCalled ) { norepeat = 1; }
1157  } else {
1158  Tcl_SetResult(interp,(char*)"first arg not norepeat",TCL_VOLATILE);
1159  return TCL_ERROR;
1160  }
1161  }
1162  int numstepsarg = argc-1;
1163  int numsteps;
1164  if (Tcl_GetInt(interp,argv[numstepsarg],&numsteps) != TCL_OK) {
1165  return TCL_ERROR;
1166  }
1167  if (numsteps < 0) {
1168  Tcl_SetResult(interp,
1169  (char*)"number of steps must be non-negative",TCL_VOLATILE);
1170  return TCL_ERROR;
1171  }
1172  SimParameters *simParams = Node::Object()->simParameters;
1173  if (numsteps && simParams->firstTimestep % simParams->stepsPerCycle) {
1174  Tcl_SetResult(interp,
1175  (char*)"firstTimestep must be a multiple of stepsPerCycle",
1176  TCL_VOLATILE);
1177  return TCL_ERROR;
1178  }
1179  if (numsteps % simParams->stepsPerCycle) {
1180  Tcl_SetResult(interp,
1181  (char*)"number of steps must be a multiple of stepsPerCycle",
1182  TCL_VOLATILE);
1183  return TCL_ERROR;
1184  }
1185  if ( simParams->minimizeCGOn ) {
1186  Tcl_SetResult(interp,
1187  (char*)"run called with minimization enabled; "
1188  "use minimize command instead",TCL_VOLATILE);
1189  return TCL_ERROR;
1190  }
1191  if ( simParams->N != simParams->firstTimestep ) {
1192  iout << "TCL: Original numsteps " << simParams->N
1193  << " will be ignored.\n";
1194  }
1195  iout << "TCL: Running for " << numsteps << " steps";
1196  if ( norepeat ) iout << " without repeating first step";
1197  iout << "\n" << endi;
1198 
1199  script->setParameter("numsteps",simParams->firstTimestep + numsteps);
1200 
1201  script->runController(norepeat ? SCRIPT_CONTINUE : SCRIPT_RUN);
1202  script->runWasCalled = 1;
1203 
1204  script->setParameter("firsttimestep",simParams->N);
1205 
1206  return TCL_OK;
1207 }
1208 
1209 int ScriptTcl::Tcl_minimize(ClientData clientData,
1210  Tcl_Interp *interp, int argc, const char *argv[]) {
1211  ScriptTcl *script = (ScriptTcl *)clientData;
1212  script->initcheck();
1213  if (argc != 2) {
1214  Tcl_SetResult(interp,(char*)"wrong # args",TCL_VOLATILE);
1215  return TCL_ERROR;
1216  }
1217  int numsteps;
1218  if (Tcl_GetInt(interp,argv[1],&numsteps) != TCL_OK) {
1219  return TCL_ERROR;
1220  }
1221  if (numsteps < 0) {
1222  Tcl_SetResult(interp,
1223  (char*)"number of steps must be non-negative",TCL_VOLATILE);
1224  return TCL_ERROR;
1225  }
1226  SimParameters *simParams = Node::Object()->simParameters;
1227  if (numsteps && simParams->firstTimestep % simParams->stepsPerCycle) {
1228  Tcl_SetResult(interp,
1229  (char*)"firstTimestep must be a multiple of stepsPerCycle",
1230  TCL_VOLATILE);
1231  return TCL_ERROR;
1232  }
1233  if (numsteps % simParams->stepsPerCycle) {
1234  Tcl_SetResult(interp,
1235  (char*)"number of steps must be a multiple of stepsPerCycle",
1236  TCL_VOLATILE);
1237  return TCL_ERROR;
1238  }
1239  if ( simParams->N != simParams->firstTimestep ) {
1240  iout << "TCL: Original numsteps " << simParams->N
1241  << " will be ignored.\n";
1242  }
1243  iout << "TCL: Minimizing for " << numsteps << " steps\n" << endi;
1244 
1245  script->setParameter("numsteps",simParams->firstTimestep + numsteps);
1246 
1247  script->runController(SCRIPT_MINIMIZE);
1248  script->runWasCalled = 1;
1249 
1250  script->setParameter("firsttimestep",simParams->N);
1251 
1252  return TCL_OK;
1253 }
1254 
1255 // move all atoms by a given vector
1256 int ScriptTcl::Tcl_moveallby(ClientData clientData,
1257  Tcl_Interp *interp, int argc, const char *argv[]) {
1258  ScriptTcl *script = (ScriptTcl *)clientData;
1259  script->initcheck();
1260  if (argc != 2) {
1261  Tcl_SetResult(interp,(char*)"wrong # args",TCL_VOLATILE);
1262  return TCL_ERROR;
1263  }
1264  const char **fstring;
1265  int fnum;
1266  double x, y, z;
1267  if (Tcl_SplitList(interp, argv[1], &fnum, &fstring) != TCL_OK)
1268  return TCL_ERROR;
1269  if ( (fnum != 3) ||
1270  (Tcl_GetDouble(interp, fstring[0],&x) != TCL_OK) ||
1271  (Tcl_GetDouble(interp, fstring[1],&y) != TCL_OK) ||
1272  (Tcl_GetDouble(interp, fstring[2],&z) != TCL_OK) ) {
1273  Tcl_SetResult(interp,(char*)"argument not a vector",TCL_VOLATILE);
1274  Tcl_Free((char*)fstring);
1275  return TCL_ERROR;
1276  }
1277  Tcl_Free((char*)fstring);
1278 
1279  MoveAllByMsg *msg = new MoveAllByMsg;
1280  msg->offset = Vector(x,y,z);
1281  (CProxy_PatchMgr(CkpvAccess(BOCclass_group).patchMgr)).moveAllBy(msg);
1282 
1283  script->barrier();
1284  return TCL_OK;
1285 }
1286 
1287 int ScriptTcl::Tcl_move(ClientData clientData,
1288  Tcl_Interp *interp, int argc, const char *argv[]) {
1289  ScriptTcl *script = (ScriptTcl *)clientData;
1290  script->initcheck();
1291  if (argc != 4) {
1292  Tcl_SetResult(interp,(char*)"wrong # args",TCL_VOLATILE);
1293  return TCL_ERROR;
1294  }
1295  const char **fstring; int fnum; int atomid; int moveto; double x, y, z;
1296  if (Tcl_GetInt(interp,argv[1],&atomid) != TCL_OK) return TCL_ERROR;
1297  if (argv[2][0]=='t' && argv[2][1]=='o' && argv[2][2]==0) moveto = 1;
1298  else if (argv[2][0]=='b' && argv[2][1]=='y' && argv[2][2]==0) moveto = 0;
1299  else {
1300  Tcl_SetResult(interp,
1301  (char*)"syntax is 'move <id> to|by {<x> <y> <z>}'",TCL_VOLATILE);
1302  return TCL_ERROR;
1303  }
1304  if (Tcl_SplitList(interp, argv[3], &fnum, &fstring) != TCL_OK) {
1305  return TCL_ERROR;
1306  }
1307  if ( (fnum != 3) ||
1308  (Tcl_GetDouble(interp, fstring[0],&x) != TCL_OK) ||
1309  (Tcl_GetDouble(interp, fstring[1],&y) != TCL_OK) ||
1310  (Tcl_GetDouble(interp, fstring[2],&z) != TCL_OK) ) {
1311  Tcl_SetResult(interp,(char*)"third argument not a vector",TCL_VOLATILE);
1312  Tcl_Free((char*)fstring);
1313  return TCL_ERROR;
1314  }
1315  Tcl_Free((char*)fstring);
1316 
1317  SimParameters *simParams = Node::Object()->simParameters;
1318 
1319  iout << "TCL: Moving atom " << atomid << " ";
1320  if ( moveto ) iout << "to"; else iout << "by";
1321  iout << " " << Vector(x,y,z) << ".\n" << endi;
1322 
1323  MoveAtomMsg *msg = new MoveAtomMsg;
1324  msg->atomid = atomid - 1;
1325  msg->moveto = moveto;
1326  msg->coord = Vector(x,y,z);
1327  (CProxy_PatchMgr(CkpvAccess(BOCclass_group).patchMgr)).moveAtom(msg);
1328 
1329  script->barrier();
1330 
1331  return TCL_OK;
1332 }
1333 
1334 int ScriptTcl::Tcl_output(ClientData clientData,
1335  Tcl_Interp *interp, int argc, const char *argv[]) {
1336  ScriptTcl *script = (ScriptTcl *)clientData;
1337  script->initcheck();
1338  if (argc < 2) {
1339  Tcl_SetResult(interp,(char*)"too few args",TCL_VOLATILE);
1340  return TCL_ERROR;
1341  }
1342  if (argc > 3) {
1343  Tcl_SetResult(interp,(char*)"too many args",TCL_VOLATILE);
1344  return TCL_ERROR;
1345  }
1346  int filenamearg = argc-1;
1347  if (strlen(argv[filenamearg]) > MAX_SCRIPT_PARAM_SIZE) {
1348  Tcl_SetResult(interp,(char*)"file name too long",TCL_VOLATILE);
1349  return TCL_ERROR;
1350  }
1351  int dorestart = 1;
1352  int doforces = 0;
1353  if (argc == 3) {
1354  if ( ! strcmp(argv[1], "withforces") ) {
1355  doforces = 1;
1356  } else if ( ! strcmp(argv[1], "onlyforces") ) {
1357  dorestart = 0;
1358  doforces = 1;
1359  } else {
1360  Tcl_SetResult(interp,
1361  (char*)"first arg not withforces or onlyforces",TCL_VOLATILE);
1362  return TCL_ERROR;
1363  }
1364  }
1365 
1366  SimParameters *simParams = Node::Object()->simParameters;
1367 
1368  char oldname[MAX_SCRIPT_PARAM_SIZE+1];
1369  strncpy(oldname,simParams->outputFilename,MAX_SCRIPT_PARAM_SIZE);
1370 
1371  script->setParameter("outputname",argv[filenamearg]);
1372 
1373  iout << "TCL: Writing to files with basename " <<
1374  simParams->outputFilename << ".\n" << endi;
1375 
1376  if ( doforces && ! script->runWasCalled ) NAMD_die(
1377  "No forces to output; must call run or minimize first.");
1378 
1379  if ( dorestart ) script->runController(SCRIPT_OUTPUT);
1380  if ( doforces ) script->runController(SCRIPT_FORCEOUTPUT);
1381 
1382  script->setParameter("outputname",oldname);
1383 
1384  return TCL_OK;
1385 }
1386 
1388  Measure::createCommands(interp);
1389  Node::Object()->coords = c;
1390  measure_result = Tcl_Eval(interp,measure_command);
1391  Node::Object()->coords = 0;
1392  Measure::deleteCommands(interp);
1393 }
1394 
1395 int ScriptTcl::Tcl_measure(ClientData clientData,
1396  Tcl_Interp *interp, int argc, const char *argv[]) {
1397  ScriptTcl *script = (ScriptTcl *)clientData;
1398  script->initcheck();
1399  if (argc != 2) {
1400  Tcl_SetResult(interp,(char*)"wrong # args",TCL_VOLATILE);
1401  return TCL_ERROR;
1402  }
1403  script->measure_command = argv[1];
1404 
1405  script->runController(SCRIPT_MEASURE);
1406 
1407  return script->measure_result;
1408 }
1409 
1410 // NOTE: This interface is DEPRECATED
1411 // Please use the "cv bias" interface instead:
1412 
1413 // Replace "colvarbias changeconfig" with:
1414 // cv bias <name> delete
1415 // cv config <new_config_string>
1416 
1417 // Replace "colvarbias energydiff" with:
1418 // cv bias config <config_string_with_tempBias>
1419 // set ediff [expr [cv bias tempBias energy] - [cv bias refBias energy]]
1420 // cv bias tempBias delete
1421 
1422 int ScriptTcl::Tcl_colvarbias(ClientData clientData,
1423  Tcl_Interp *interp, int argc, const char *argv[]) {
1424  ScriptTcl *script = (ScriptTcl *)clientData;
1425  script->initcheck();
1426  if (argc < 4 || argc % 2) {
1427  Tcl_SetResult(interp,(char*)"wrong # args",TCL_VOLATILE);
1428  return TCL_ERROR;
1429  }
1430  colvarmodule *colvars = Node::Object()->colvars;
1431  if ( ! colvars ) {
1432  Tcl_SetResult(interp,(char*)"colvars module not active",TCL_VOLATILE);
1433  return TCL_ERROR;
1434  }
1435  if ( ! strcmp(argv[1],"changeconfig") ) {
1436  for ( int i=2; i<argc; i+=2 ) {
1437  std::string name(argv[i]);
1438  std::string conf(argv[i+1]);
1439  colvars->change_configuration(name,conf);
1440  }
1441  return TCL_OK;
1442  } else if ( ! strcmp(argv[1],"energydiff") ) {
1443  if ( ! script->runWasCalled ) {
1444  Tcl_SetResult(interp,
1445  (char*)"energydiff requires a previous timestep",TCL_VOLATILE);
1446  return TCL_ERROR;
1447  }
1448  double ediff = 0.;
1449  for ( int i=2; i<argc; i+=2 ) {
1450  std::string name(argv[i]);
1451  std::string conf(argv[i+1]);
1452  ediff += colvars->energy_difference(name,conf);
1453  }
1454  Tcl_SetObjResult(interp, Tcl_NewDoubleObj(ediff));
1455  return TCL_OK;
1456  } else {
1457  Tcl_SetResult(interp,(char*)"unknown colvarbias operation",TCL_VOLATILE);
1458  return TCL_ERROR;
1459  }
1460 }
1461 
1462 // NOTE: This interface is DEPRECATED
1463 // Please use the "cv colvar" interface instead
1464 
1465 int ScriptTcl::Tcl_colvarvalue(ClientData clientData,
1466  Tcl_Interp *interp, int argc, const char *argv[]) {
1467  ScriptTcl *script = (ScriptTcl *)clientData;
1468  script->initcheck();
1469  if (argc != 2) {
1470  Tcl_SetResult(interp,(char*)"wrong # args",TCL_VOLATILE);
1471  return TCL_ERROR;
1472  }
1473  colvarmodule *colvars = Node::Object()->colvars;
1474  if ( ! colvars ) {
1475  Tcl_SetResult(interp,(char*)"colvars module not active",TCL_VOLATILE);
1476  return TCL_ERROR;
1477  }
1478  // Pass the colvarvalue to Tcl
1479  std::string name(argv[1]);
1480  std::string value = colvars->read_colvar(name);
1481  // Process from a colvar list to a Tcl compatible list
1482  size_t found;
1483  do {
1484  found = value.find("(");
1485  if (found != std::string::npos) {
1486  value.replace(found, 1, " ");
1487  } else {
1488  break;
1489  }
1490  } while (true);
1491  do {
1492  found = value.find(")");
1493  if (found != std::string::npos) {
1494  value.replace(found, 1, " ");
1495  } else {
1496  break;
1497  }
1498  } while (true);
1499  do {
1500  found = value.find(",");
1501  if (found != std::string::npos) {
1502  value.replace(found, 1, " ");
1503  } else {
1504  break;
1505  }
1506  } while (true);
1507  // Send the result to Tcl
1508  Tcl_DString recvstr;
1509  Tcl_DStringInit(&recvstr);
1510  Tcl_DStringAppend(&recvstr,value.c_str(), -1);
1511  Tcl_DStringResult(interp, &recvstr);
1512  Tcl_DStringFree(&recvstr);
1513  return TCL_OK;
1514 }
1515 
1516 int ScriptTcl::Tcl_colvarfreq(ClientData clientData,
1517  Tcl_Interp *interp, int argc, const char *argv[]) {
1518  ScriptTcl *script = (ScriptTcl *)clientData;
1519  script->initcheck();
1520  if (argc != 2) {
1521  Tcl_SetResult(interp,(char*)"wrong # args",TCL_VOLATILE);
1522  return TCL_ERROR;
1523  }
1524  colvarmodule *colvars = Node::Object()->colvars;
1525  if ( ! colvars ) {
1526  Tcl_SetResult(interp,(char*)"colvars module not active",TCL_VOLATILE);
1527  return TCL_ERROR;
1528  }
1529  int new_freq;
1530  if (Tcl_GetInt(interp,argv[1],&new_freq) != TCL_OK) {
1531  return TCL_ERROR;
1532  }
1533  colvars->cv_traj_freq = new_freq;
1534  return TCL_OK;
1535 }
1536 
1537 // Declaration of Colvars Tcl wrapper
1538 extern "C"
1539 int tcl_run_colvarscript_command(ClientData clientData,
1540  Tcl_Interp *interp_in,
1541  int objc, Tcl_Obj *const objv[]);
1542 
1543 int ScriptTcl::Tcl_colvars(ClientData clientData,
1544  Tcl_Interp *interp,
1545  int objc,
1546  Tcl_Obj *const objv[])
1547 {
1548  ScriptTcl *script = (ScriptTcl *) clientData;
1549  script->initcheck();
1550  return tcl_run_colvarscript_command(clientData, interp, objc, objv);
1551 }
1552 
1553 int ScriptTcl::Tcl_checkpoint(ClientData clientData,
1554  Tcl_Interp *interp, int argc, const char *argv[]) {
1555  ScriptTcl *script = (ScriptTcl *)clientData;
1556  script->initcheck();
1557  if (argc != 1) {
1558  Tcl_SetResult(interp,(char*)"wrong # args",TCL_VOLATILE);
1559  return TCL_ERROR;
1560  }
1561 
1562  script->runController(SCRIPT_CHECKPOINT);
1563 
1564  return TCL_OK;
1565 }
1566 
1567 int ScriptTcl::Tcl_revert(ClientData clientData,
1568  Tcl_Interp *interp, int argc, const char *argv[]) {
1569  ScriptTcl *script = (ScriptTcl *)clientData;
1570  script->initcheck();
1571  if (argc != 1) {
1572  Tcl_SetResult(interp,(char*)"wrong # args",TCL_VOLATILE);
1573  return TCL_ERROR;
1574  }
1575 
1576  script->runController(SCRIPT_REVERT);
1577 
1578  return TCL_OK;
1579 }
1580 
1581 static int replica_hash(const char *key) {
1582  unsigned int hash = 0;
1583 
1584  while (*key) {
1585  hash *= 73;
1586  hash += *key++;
1587  }
1588 
1589  return hash % CmiNumPartitions();
1590 }
1591 
1592 int ScriptTcl::Tcl_checkpointReplica(ClientData clientData,
1593  Tcl_Interp *interp, int argc, const char *argv[]) {
1594  ScriptTcl *script = (ScriptTcl *)clientData;
1595  script->initcheck();
1596  if (argc < 2 || argc > 3) {
1597  Tcl_SetResult(interp,
1598  (char*)"args: <key> ?<replica> or global?",TCL_VOLATILE);
1599  return TCL_ERROR;
1600  }
1601  script->setParameter("scriptStringArg1", argv[1]);
1602  int replica = CmiMyPartition();
1603  if ( argc == 3 ) {
1604  if ( ! strcmp(argv[2],"global") ) {
1605  replica = replica_hash(argv[1]);
1606  } else if ( sscanf(argv[2],"%d",&replica) != 1 ) {
1607  Tcl_SetResult(interp,
1608  (char*)"args: <key> ?<replica> or global?",TCL_VOLATILE);
1609  return TCL_ERROR;
1610  }
1611  }
1612  if ( replica != CmiMyPartition() ) {
1613  if ( ! Node::Object()->simParameters->replicaUniformPatchGrids ) {
1614  Tcl_SetResult(interp,
1615  (char*)"replicaUniformPatchGrids is required for "
1616  "checkpointing on other replicas",TCL_VOLATILE);
1617  return TCL_ERROR;
1618  }
1619  }
1620 
1621  CHECK_REPLICA(replica);
1622  char str[40];
1623  sprintf(str, "%d", replica);
1624  script->setParameter("scriptIntArg1", str);
1625 
1626  CkpvAccess(_qd)->create(PatchMap::Object()->numPatches());
1627  if ( replica != CmiMyPartition() ) CkpvAccess(_qd)->create(1);
1628 
1629  if ( ! strcmp(argv[0],"checkpointStore") ) script->runController(SCRIPT_CHECKPOINT_STORE);
1630  else if ( ! strcmp(argv[0],"checkpointLoad") ) script->runController(SCRIPT_CHECKPOINT_LOAD);
1631  else if ( ! strcmp(argv[0],"checkpointSwap") ) script->runController(SCRIPT_CHECKPOINT_SWAP);
1632  else if ( ! strcmp(argv[0],"checkpointFree") ) script->runController(SCRIPT_CHECKPOINT_FREE);
1633  else {
1634  Tcl_SetResult(interp,
1635  (char*)"checkpointStore/Load/Swap/Free called via unrecognized name",
1636  TCL_VOLATILE);
1637  return TCL_ERROR;
1638  }
1639 
1640  return TCL_OK;
1641 }
1642 
1643 int ScriptTcl::Tcl_replicaDcdFile(ClientData clientData,
1644  Tcl_Interp *interp, int argc, const char *argv[]) {
1645 #ifdef MEM_OPT_VERSION
1646  Tcl_SetResult(interp,
1647  (char*)"replicaDcdFile not supported in memory-optimized builds",
1648  TCL_VOLATILE);
1649  return TCL_ERROR;
1650 #endif
1651  ScriptTcl *script = (ScriptTcl *)clientData;
1652  script->initcheck();
1653  int index;
1654  int cmpoff;
1655  if (argc < 2 || argc > 3 || ((cmpoff = strcmp(argv[1],"off")) != 0 && sscanf(argv[1],"%d",&index) != 1) ) {
1656  Tcl_SetResult(interp,(char*)"args: <index>|off ?<filename>?",TCL_VOLATILE);
1657  return TCL_ERROR;
1658  }
1659  if ( argc == 2 ) {
1660  if ( cmpoff == 0 ) Node::Object()->output->replicaDcdOff();
1661  else Node::Object()->output->setReplicaDcdIndex(index);
1662  } else if ( argc == 3 ) {
1663  Node::Object()->output->replicaDcdInit(index,argv[2]);
1664  script->barrier();
1665  }
1666  return TCL_OK;
1667 }
1668 
1669 int ScriptTcl::Tcl_callback(ClientData clientData,
1670  Tcl_Interp *interp, int argc, const char *argv[]) {
1671  ScriptTcl *script = (ScriptTcl *)clientData;
1672  if (argc != 2) {
1673  Tcl_SetResult(interp,(char*)"wrong # args",TCL_VOLATILE);
1674  return TCL_ERROR;
1675  }
1676 
1677  delete [] script->callbackname;
1678  script->callbackname = new char[strlen(argv[1])+1];
1679  strcpy(script->callbackname,argv[1]);
1680 
1681  iout << "TCL: Reduction callback proc set to " <<
1682  script->callbackname << "\n" << endi;
1683 
1684  return TCL_OK;
1685 }
1686 
1687 void ScriptTcl::doCallback(const char *labels, const char *data) {
1688  if ( ! callbackname ) return;
1689  int len = strlen(callbackname) + strlen(labels) + strlen(data) + 7;
1690  char *cmd = new char[len];
1691  sprintf(cmd, "%s {%s} {%s}", callbackname, labels, data);
1692  int rval = Tcl_Eval(interp,cmd);
1693  delete [] cmd;
1694  if (rval != TCL_OK) {
1695  const char *errorInfo = Tcl_GetVar(interp,"errorInfo",0);
1696  NAMD_die(errorInfo ? errorInfo : "Unknown Tcl error");
1697  }
1698 }
1699 
1700 extern void read_binary_coors(char *fname, PDB *pdbobj);
1701 
1702 int ScriptTcl::Tcl_reinitatoms(ClientData clientData,
1703  Tcl_Interp *interp, int argc, const char *argv[]) {
1704  ScriptTcl *script = (ScriptTcl *)clientData;
1705  script->initcheck();
1706  if (argc > 2) {
1707  Tcl_SetResult(interp,(char*)"wrong # args",TCL_VOLATILE);
1708  return TCL_ERROR;
1709  }
1710 
1711  if (argc == 1 ) {
1712  iout << "TCL: Reinitializing atom data\n" << endi;
1713  SimParameters *simParams = Node::Object()->simParameters;
1714  Controller *c = script->state->controller;
1715  script->state->lattice = c->origLattice;
1719  SetLatticeMsg *msg = new SetLatticeMsg;
1720  msg->lattice = script->state->lattice;
1721  (CProxy_PatchMgr(CkpvAccess(BOCclass_group).patchMgr)).setLattice(msg);
1722  script->barrier();
1723  if ( ! simParams->binaryOutput ) { // output may have overwritten data in PDB
1724  StringList *coordinateFilename = script->state->configList->find("bincoordinates");
1725  if ( coordinateFilename ) {
1726  read_binary_coors(coordinateFilename->data, script->state->pdb);
1727  } else if (coordinateFilename = script->state->configList->find("coordinates")) {
1728  PDB coordpdb(coordinateFilename->data);
1729  if ( coordpdb.num_atoms() != script->state->pdb->num_atoms() ) {
1730  NAMD_die("inconsistent atom count on re-reading coordinates pdb file");
1731  }
1732  Vector *positions = new Position[coordpdb.num_atoms()];
1733  coordpdb.get_all_positions(positions);
1734  script->state->pdb->set_all_positions(positions);
1735  delete [] positions;
1736  } else {
1737  iout << iWARN << "reinitatoms may fail if pdb-format output has occurred\n" << endi;
1738  }
1739  }
1740  script->reinitAtoms();
1741  return TCL_OK;
1742  }
1743 
1744  iout << "TCL: Reinitializing atom data from files with basename " << argv[1] << "\n" << endi;
1745  SimParameters *simParams = Node::Object()->simParameters;
1746  simParams->readExtendedSystem((std::string(argv[1])+".xsc").c_str(), &(script->state->lattice));
1747  Controller *c = script->state->controller;
1749  Tensor::symmetric(simParams->strainRate,simParams->strainRate2);
1752  SetLatticeMsg *msg = new SetLatticeMsg;
1753  msg->lattice = script->state->lattice;
1754  (CProxy_PatchMgr(CkpvAccess(BOCclass_group).patchMgr)).setLattice(msg);
1755  script->barrier();
1756  script->reinitAtoms(argv[1]);
1757 
1758  return TCL_OK;
1759 }
1760 
1761 #define DEG2RAD 3.14159625359/180.0
1762 #define UNITCELLSLOP 0.0001
1763 
1764 static int get_lattice_from_ts(Lattice *lattice, const molfile_timestep_t *ts)
1765 {
1766  // Check if valid unit cell data is contained in the timestep. We don't
1767  // have any formalized way of doing this yet; for now, just check that
1768  // the length of the vector is greater than 1.
1769  if (ts->A <= 1 || ts->B <= 1 || ts->C <= 1) return 0;
1770 
1771  // convert from degrees to radians
1772  // Try to get exact results when the angles are exactly 90.
1773  double epsalpha = DEG2RAD*(ts->alpha-90.0);
1774  double epsbeta = DEG2RAD*(ts->beta-90.0);
1775  double epsgamma = DEG2RAD*(ts->gamma-90.0);
1776  double cosAB = -sin(epsgamma);
1777  double sinAB = cos(epsgamma);
1778  double cosAC = -sin(epsbeta);
1779  double cosBC = -sin(epsalpha);
1780 
1781  // A will lie along the positive x axis.
1782  // B will lie in the x-y plane
1783  // The origin will be (0,0,0).
1784  Vector A(0), B(0), vecC(0);
1785  A.x = ts->A;
1786  B.x = ts->B*cosAB;
1787  B.y = ts->B*sinAB;
1788  //if (fabs(B.x) < UNITCELLSLOP) B.x = 0;
1789  //if (fabs(B.y) < UNITCELLSLOP) B.y = 0;
1790  vecC.x = ts->C * cosAC;
1791  vecC.y = (ts->B*ts->C*cosBC - B.x*vecC.x)/B.y;
1792  vecC.z = sqrt(ts->C*ts->C - vecC.x*vecC.x - vecC.y*vecC.y);
1793  //if (fabs(vecC.x) < UNITCELLSLOP) vecC.x = 0;
1794  //if (fabs(vecC.y) < UNITCELLSLOP) vecC.y = 0;
1795  //if (fabs(vecC.z) < UNITCELLSLOP) vecC.z = 0;
1796  lattice->set(A, B, vecC, Vector(0));
1797  return 1;
1798 }
1799 
1800 int ScriptTcl::Tcl_coorfile(ClientData clientData,
1801  Tcl_Interp *interp, int argc, const char *argv[]) {
1802  ScriptTcl *script = (ScriptTcl *)clientData;
1803  script->initcheck();
1804  if (argc == 4 && !strcmp(argv[1], "open")) {
1805  if (strcmp(argv[2], "dcd")) {
1806  NAMD_die("Sorry, coorfile presently supports only DCD files");
1807  }
1808  filehandle = dcdplugin->open_file_read(argv[3], "dcd", &numatoms);
1809  if (!filehandle) {
1810  Tcl_AppendResult(interp, "coorfile: Error opening file ", argv[3], NULL);
1811  return TCL_ERROR;
1812  }
1813  if (numatoms != Node::Object()->pdb->num_atoms()) {
1814  Tcl_AppendResult(interp, "Coordinate file ", argv[3],
1815  "\ncontains the wrong number of atoms.", NULL);
1816  return TCL_ERROR;
1817  }
1818  coords = new float[3*numatoms];
1819  vcoords = new Vector[3*numatoms];
1820  iout << iINFO << "Coordinate file " << argv[3] << " opened for reading.\n"
1821  << endi;
1822  } else if (argc == 2 && !strcmp(argv[1], "read")) {
1823  if (filehandle == NULL) {
1824  Tcl_AppendResult(interp, "coorfile read: Error, no file open for reading",
1825  NULL);
1826  return TCL_ERROR;
1827  }
1828  molfile_timestep_t ts;
1829  ts.coords = coords;
1830  int rc = dcdplugin->read_next_timestep(filehandle, numatoms, &ts);
1831  if (rc) { // EOF
1832  Tcl_SetObjResult(interp, Tcl_NewIntObj(-1));
1833  return TCL_OK;
1834  }
1835  iout << iINFO << "Reading timestep from file.\n" << endi;
1836  Lattice lattice;
1837  if (get_lattice_from_ts(&lattice, &ts)) {
1838  iout << iINFO << "Updating unit cell from timestep.\n" << endi;
1839  if ( lattice.a_p() && ! script->state->lattice.a_p() ||
1840  lattice.b_p() && ! script->state->lattice.b_p() ||
1841  lattice.c_p() && ! script->state->lattice.c_p() ) {
1842  iout << iWARN << "Cell basis vectors should be specified before reading trajectory.\n" << endi;
1843  }
1844  // update Controller's lattice, but don't change the origin!
1845  Vector a(0.); if ( script->state->lattice.a_p() ) a = lattice.a();
1846  Vector b(0.); if ( script->state->lattice.b_p() ) b = lattice.b();
1847  Vector c(0.); if ( script->state->lattice.c_p() ) c = lattice.c();
1848  script->state->lattice.set(a,b,c);
1849  SetLatticeMsg *msg = new SetLatticeMsg;
1850  msg->lattice = script->state->lattice;
1851  (CProxy_PatchMgr(CkpvAccess(BOCclass_group).patchMgr)).setLattice(msg);
1852  script->barrier();
1853  }
1854  for (int i=0; i<numatoms; i++) {
1855  vcoords[i].x = coords[3*i+0];
1856  vcoords[i].y = coords[3*i+1];
1857  vcoords[i].z = coords[3*i+2];
1858  }
1859  Node::Object()->pdb->set_all_positions(vcoords);
1860  script->reinitAtoms();
1861  Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
1862  } else if (argc == 2 && !strcmp(argv[1], "close")) {
1863  if (!filehandle) {
1864  Tcl_AppendResult(interp, "coorfile close: No file opened for reading!",
1865  NULL);
1866  return TCL_OK;
1867  }
1868  iout << iINFO << "Closing coordinate file.\n" << endi;
1869  dcdplugin->close_file_read(filehandle);
1870  filehandle = NULL;
1871  delete [] coords;
1872  delete [] vcoords;
1873 
1874  } else if (argc ==2 && !strcmp(argv[1], "skip")) {
1875  if (filehandle == NULL) {
1876  Tcl_AppendResult(interp, "coorfile skip: Error, no file open for reading",
1877  NULL);
1878  return TCL_ERROR;
1879  }
1880  int rc = dcdplugin->read_next_timestep(filehandle, numatoms, NULL);
1881  if (rc) { // EOF
1882  Tcl_SetObjResult(interp, Tcl_NewIntObj(-1));
1883  return TCL_OK;
1884  }
1885  Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
1886 
1887  } else {
1888  NAMD_die("Unknown option passed to coorfile");
1889  }
1890  return TCL_OK;
1891 }
1892 
1893 int ScriptTcl::Tcl_dumpbench(ClientData clientData,
1894  Tcl_Interp *interp, int argc, const char *argv[]) {
1895  ScriptTcl *script = (ScriptTcl *)clientData;
1896  script->initcheck();
1897  if (argc != 2) {
1898  Tcl_AppendResult(interp, "usage: dumpbench <filename>", NULL);
1899  return TCL_ERROR;
1900  }
1901 
1902  if ( CkNumPes() != 1 ) {
1903  Tcl_AppendResult(interp, "multiple processors detected; dumpbench only works on serial runs", NULL);
1904  return TCL_ERROR;
1905  }
1906 
1907  FILE *file = fopen(argv[1],"w");
1908  if ( ! file ) {
1909  Tcl_AppendResult(interp, "dumpbench: error opening file ", argv[1], NULL);
1910  return TCL_ERROR;
1911  }
1912 
1913  if ( dumpbench(file) ) {
1914  Tcl_AppendResult(interp, "dumpbench: error dumping benchmark data", NULL);
1915  return TCL_ERROR;
1916  }
1917 
1918  fclose(file);
1919 
1920  Tcl_AppendResult(interp, "benchmark data written to file ", argv[1], NULL);
1921  return TCL_OK;
1922 }
1923 
1924 #include "ComputeConsForceMsgs.h"
1925 // consforceconfig <atomids> <forces>
1926 int ScriptTcl::Tcl_consForceConfig(ClientData clientData,
1927  Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
1928  ScriptTcl *script = (ScriptTcl *)clientData;
1929  script->initcheck();
1930  if ( ! Node::Object()->simParameters->consForceOn ) {
1931  Tcl_AppendResult(interp, "consForceConfig requires constantForce on", NULL);
1932  return TCL_ERROR;
1933  }
1934  if (objc != 3) {
1935  Tcl_WrongNumArgs(interp, 1, objv, (char *)"<atomids> <forces>");
1936  return TCL_ERROR;
1937  }
1938  int natoms, nforces;
1939  Tcl_Obj **atomobjlist, **forceobjlist;
1940  if (Tcl_ListObjGetElements(interp, objv[1], &natoms, &atomobjlist) != TCL_OK ||
1941  Tcl_ListObjGetElements(interp, objv[2], &nforces, &forceobjlist) != TCL_OK) {
1942  return TCL_ERROR;
1943  }
1944  if (natoms != nforces) {
1945  Tcl_AppendResult(interp, (char *)"consforceconfig: atom list and force list not the same size!", NULL);
1946  return TCL_ERROR;
1947  }
1949  for (int i=0; i<natoms; i++) {
1950  int atomid;
1951  int nelem;
1952  Tcl_Obj **elemlist;
1953  Vector force;
1954  if (Tcl_GetIntFromObj(interp, atomobjlist[i], &atomid) != TCL_OK)
1955  return TCL_ERROR;
1956  if (Tcl_ListObjGetElements(interp, forceobjlist[i], &nelem, &elemlist) != TCL_OK)
1957  return TCL_ERROR;
1958  if (nelem != 3) {
1959  Tcl_AppendResult(interp, (char *)"consforceconfig: forces must have three elements", NULL);
1960  return TCL_ERROR;
1961  }
1962  if (Tcl_GetDoubleFromObj(interp, elemlist[0], &force.x) != TCL_OK ||
1963  Tcl_GetDoubleFromObj(interp, elemlist[1], &force.y) != TCL_OK ||
1964  Tcl_GetDoubleFromObj(interp, elemlist[2], &force.z) != TCL_OK) {
1965  return TCL_ERROR;
1966  }
1967  msg->aid.add(atomid);
1968  msg->f.add(force);
1969  }
1970  (CProxy_ComputeMgr(CkpvAccess(BOCclass_group).computeMgr)).recvComputeConsForceMsg(msg);
1971  return TCL_OK;
1972 }
1973 
1974 int ScriptTcl::Tcl_reloadCharges(ClientData clientData,
1975  Tcl_Interp *interp, int argc, const char *argv[]) {
1976  ScriptTcl *script = (ScriptTcl *)clientData;
1977  script->initcheck();
1978  if (argc != 2) {
1979  Tcl_AppendResult(interp, "usage: reloadCharges <filename>", NULL);
1980  return TCL_ERROR;
1981  }
1982 
1983  Node::Object()->reloadCharges(argv[1]);
1984 
1985  script->runController(SCRIPT_RELOADCHARGES);
1986 
1987  return TCL_OK;
1988 }
1989 
1990 // BEGIN gf
1991 int ScriptTcl::Tcl_reloadGridforceGrid(ClientData clientData,
1992  Tcl_Interp *interp, int argc, const char *argv[]) {
1993  ScriptTcl *script = (ScriptTcl *)clientData;
1994  script->initcheck();
1995 
1996  const char *key = NULL;
1997  if (argc == 1) {
1998  // nothing ... key is NULL, then Node::reloadGridforceGrid uses the
1999  // default key, which is used internally when the gridforce*
2000  // keywords are used (as opposed to the mgridforce* keywords)
2001  } else if (argc == 2) {
2002  key = argv[1];
2003  } else {
2004  Tcl_AppendResult(interp, "usage: reloadGridforceGrid [<gridkey>]", NULL);
2005  return TCL_ERROR;
2006  }
2007 
2008  //(CProxy_Node(CkpvAccess(BOCclass_group).node)).reloadGridforceGrid(key);
2010  script->barrier();
2011 
2012  return TCL_OK;
2013 }
2014 
2015 int ScriptTcl::Tcl_updateGridScale(ClientData clientData,
2016  Tcl_Interp *interp, int argc, const char *argv[]) {
2017  ScriptTcl *script = (ScriptTcl *)clientData;
2018  script->initcheck();
2019 
2020  Vector scale(1.0f,1.0f,1.0f);
2021  const char *key = NULL;
2022  if (argc == 4) {
2023  // nothing ... key is NULL, then Node::updateGridScale uses the
2024  // default key, which is used internally when the gridforce*
2025  // keywords are used (as opposed to the mgridforce* keywords)
2026  scale.x = atof( argv[1] );
2027  scale.y = atof( argv[2] );
2028  scale.z = atof( argv[3] );
2029  } else if (argc == 5) {
2030  key = argv[1];
2031  scale.x = atof( argv[2] );
2032  scale.y = atof( argv[3] );
2033  scale.z = atof( argv[4] );
2034  } else {
2035  Tcl_AppendResult(interp, "usage: updateGridforceGrid [<gridkey>] scaleX scaleY scaleZ", NULL);
2036  return TCL_ERROR;
2037  }
2038 
2039  //(CProxy_Node(CkpvAccess(BOCclass_group).node)).reloadGridforceGrid(key);
2040  Node::Object()->updateGridScale(key,scale);
2041  script->barrier();
2042 
2043  return TCL_OK;
2044 }
2045 // END gf
2046 
2047 int ScriptTcl::Tcl_reloadStructure(ClientData clientData,
2048  Tcl_Interp *interp, int argc, const char *argv[]) {
2049  ScriptTcl *script = (ScriptTcl *)clientData;
2050  script->initcheck();
2051 
2052  if ( argc == 1 ) { // get param value
2053  char buf[MAX_SCRIPT_PARAM_SIZE];
2054  SimParameters *simParams = Node::Object()->simParameters;
2055  char *result = simParams->getfromparseopts("structure",buf);
2056  if ( result ) {
2057  Tcl_SetResult(interp, result, TCL_VOLATILE);
2058  return TCL_OK;
2059  } else {
2060  Tcl_SetResult(interp,(char*)"unknown structure",TCL_VOLATILE);
2061  return TCL_ERROR;
2062  }
2063  }
2064 
2065  int ok = 0;
2066  if (argc == 2) ok = 1;
2067  if (argc == 4 && ! strcmp(argv[2],"pdb")) ok = 1;
2068  if (! ok) {
2069  Tcl_AppendResult(interp, "usage: structure <filename> [pdb] <filename>", NULL);
2070  return TCL_ERROR;
2071  }
2072 
2073  iout << "TCL: Reloading molecular structure from file " << argv[1];
2074  if ( argc == 4 ) iout << " and pdb file " << argv[3];
2075  iout << "\n" << endi;
2076  script->config->find("structure")->set(argv[1]);
2077  if (argc == 4) script->config->find("coordinates")->set(argv[3]);
2078  Node::Object()->reloadStructure(argv[1], (argc == 4) ? argv[3] : 0);
2079 
2080  script->barrier();
2081 
2082  // return Tcl_reinitatoms(clientData, interp, argc-1, argv+1);
2083 
2084  return TCL_OK;
2085 }
2086 
2087 
2088 extern "C" void newhandle_msg(void *v, const char *msg) {
2089  CkPrintf("psfgen) %s\n",msg);
2090 }
2091 
2092 extern "C" void newhandle_msg_ex(void *v, const char *msg, int prepend, int newline) {
2093  CkPrintf("%s%s%s", (prepend ? "psfgen) " : ""), msg, (newline ? "\n" : ""));
2094 }
2095 
2096 extern "C" int psfgen_static_init(Tcl_Interp *);
2097 
2098 int eabf_static_init(Tcl_Interp *);
2099 
2100 
2101 #endif // NAMD_TCL
2102 
2103 
2105  DebugM(3,"Constructing ScriptTcl\n");
2106 #ifdef NAMD_TCL
2107  interp = 0;
2108  callbackname = 0;
2109 #endif
2110  state = new NamdState;
2111  barrierStep = 0;
2112 
2115 
2116  initWasCalled = 0;
2117  runWasCalled = 0;
2118 
2119 #ifdef NAMD_TCL
2120  config = new ConfigList;
2121 
2122  // Create interpreter
2123  interp = Tcl_CreateInterp();
2124  psfgen_static_init(interp);
2125  eabf_static_init(interp);
2126  tcl_vector_math_init(interp);
2127  Tcl_CreateCommand(interp, "python", Tcl_python,
2128  (ClientData) this, (Tcl_CmdDeleteProc *) NULL);
2129  Tcl_CreateCommand(interp, "startup", Tcl_startup,
2130  (ClientData) this, (Tcl_CmdDeleteProc *) NULL);
2131  Tcl_CreateCommand(interp, "exit", Tcl_exit,
2132  (ClientData) this, (Tcl_CmdDeleteProc *) NULL);
2133  Tcl_CreateCommand(interp, "abort", Tcl_abort,
2134  (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
2135  Tcl_CreateCommand(interp, "numPes", Tcl_numPes,
2136  (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
2137  Tcl_CreateCommand(interp, "numNodes", Tcl_numNodes,
2138  (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
2139  Tcl_CreateCommand(interp, "numPhysicalNodes", Tcl_numPhysicalNodes,
2140  (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
2141  Tcl_CreateCommand(interp, "numReplicas", Tcl_numReplicas,
2142  (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
2143  Tcl_CreateCommand(interp, "myReplica", Tcl_myReplica,
2144  (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
2145  Tcl_CreateCommand(interp, "replicaEval", Tcl_replicaEval,
2146  (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
2147  Tcl_CreateCommand(interp, "replicaYield", Tcl_replicaYield,
2148  (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
2149  Tcl_CreateCommand(interp, "replicaSendrecv", Tcl_replicaSendrecv,
2150  (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
2151  Tcl_CreateCommand(interp, "replicaSend", Tcl_replicaSend,
2152  (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
2153  Tcl_CreateCommand(interp, "replicaRecv", Tcl_replicaRecv,
2154  (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
2155  Tcl_CreateCommand(interp, "replicaBarrier", Tcl_replicaBarrier,
2156  (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
2157  Tcl_CreateCommand(interp, "replicaAtomSendrecv", Tcl_replicaAtomSendrecv,
2158  (ClientData) this, (Tcl_CmdDeleteProc *) NULL);
2159  Tcl_CreateCommand(interp, "replicaAtomSend", Tcl_replicaAtomSend,
2160  (ClientData) this, (Tcl_CmdDeleteProc *) NULL);
2161  Tcl_CreateCommand(interp, "replicaAtomRecv", Tcl_replicaAtomRecv,
2162  (ClientData) this, (Tcl_CmdDeleteProc *) NULL);
2163  Tcl_CreateCommand(interp, "stdout", Tcl_stdout,
2164  (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
2165  Tcl_CreateCommand(interp, "print", Tcl_print,
2166  (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
2167  Tcl_CreateCommand(interp, "unknown", Tcl_config,
2168  (ClientData) this, (Tcl_CmdDeleteProc *) NULL);
2169  Tcl_CreateCommand(interp, "param", Tcl_config,
2170  (ClientData) this, (Tcl_CmdDeleteProc *) NULL);
2171  Tcl_CreateCommand(interp, "isset", Tcl_isset_config,
2172  (ClientData) this, (Tcl_CmdDeleteProc *) NULL);
2173  Tcl_CreateCommand(interp, "istrue", Tcl_istrue_config,
2174  (ClientData) this, (Tcl_CmdDeleteProc *) NULL);
2175  Tcl_CreateCommand(interp, "run", Tcl_run,
2176  (ClientData) this, (Tcl_CmdDeleteProc *) NULL);
2177  Tcl_CreateCommand(interp, "minimize", Tcl_minimize,
2178  (ClientData) this, (Tcl_CmdDeleteProc *) NULL);
2179  Tcl_CreateCommand(interp, "move", Tcl_move,
2180  (ClientData) this, (Tcl_CmdDeleteProc *) NULL);
2181  Tcl_CreateCommand(interp, "moveallby", Tcl_moveallby,
2182  (ClientData) this, (Tcl_CmdDeleteProc *) NULL);
2183  Tcl_CreateCommand(interp, "output", Tcl_output,
2184  (ClientData) this, (Tcl_CmdDeleteProc *) NULL);
2185  Tcl_CreateCommand(interp, "measure", Tcl_measure,
2186  (ClientData) this, (Tcl_CmdDeleteProc *) NULL);
2187  Tcl_CreateCommand(interp, "colvarbias", Tcl_colvarbias,
2188  (ClientData) this, (Tcl_CmdDeleteProc *) NULL);
2189  Tcl_CreateCommand(interp, "colvarvalue", Tcl_colvarvalue,
2190  (ClientData) this, (Tcl_CmdDeleteProc *) NULL);
2191  Tcl_CreateObjCommand(interp, "cv", Tcl_colvars,
2192  (ClientData) this, (Tcl_CmdDeleteProc *) NULL);
2193  Tcl_CreateCommand(interp, "colvarfreq", Tcl_colvarfreq,
2194  (ClientData) this, (Tcl_CmdDeleteProc *) NULL);
2195  Tcl_CreateCommand(interp, "checkpoint", Tcl_checkpoint,
2196  (ClientData) this, (Tcl_CmdDeleteProc *) NULL);
2197  Tcl_CreateCommand(interp, "revert", Tcl_revert,
2198  (ClientData) this, (Tcl_CmdDeleteProc *) NULL);
2199  Tcl_CreateCommand(interp, "checkpointStore", Tcl_checkpointReplica,
2200  (ClientData) this, (Tcl_CmdDeleteProc *) NULL);
2201  Tcl_CreateCommand(interp, "checkpointLoad", Tcl_checkpointReplica,
2202  (ClientData) this, (Tcl_CmdDeleteProc *) NULL);
2203  Tcl_CreateCommand(interp, "checkpointSwap", Tcl_checkpointReplica,
2204  (ClientData) this, (Tcl_CmdDeleteProc *) NULL);
2205  Tcl_CreateCommand(interp, "checkpointFree", Tcl_checkpointReplica,
2206  (ClientData) this, (Tcl_CmdDeleteProc *) NULL);
2207  Tcl_CreateCommand(interp, "reinitvels", Tcl_reinitvels,
2208  (ClientData) this, (Tcl_CmdDeleteProc *) NULL);
2209  Tcl_CreateCommand(interp, "rescalevels", Tcl_rescalevels,
2210  (ClientData) this, (Tcl_CmdDeleteProc *) NULL);
2211  Tcl_CreateCommand(interp, "reinitatoms", Tcl_reinitatoms,
2212  (ClientData) this, (Tcl_CmdDeleteProc *) NULL);
2213  Tcl_CreateCommand(interp, "replicaDcdFile", Tcl_replicaDcdFile,
2214  (ClientData) this, (Tcl_CmdDeleteProc *) NULL);
2215  Tcl_CreateCommand(interp, "callback", Tcl_callback,
2216  (ClientData) this, (Tcl_CmdDeleteProc *) NULL);
2217  Tcl_CreateCommand(interp, "coorfile", Tcl_coorfile,
2218  (ClientData) this, (Tcl_CmdDeleteProc *) NULL);
2219  Tcl_CreateCommand(interp, "dumpbench", Tcl_dumpbench,
2220  (ClientData) this, (Tcl_CmdDeleteProc *) NULL);
2221  Tcl_CreateObjCommand(interp, "consForceConfig", Tcl_consForceConfig,
2222  (ClientData) this, (Tcl_CmdDeleteProc *) NULL);
2223  Tcl_CreateCommand(interp, "reloadCharges", Tcl_reloadCharges,
2224  (ClientData) this, (Tcl_CmdDeleteProc *) NULL);
2225  // BEGIN gf
2226  Tcl_CreateCommand(interp, "reloadGridforceGrid", Tcl_reloadGridforceGrid,
2227  (ClientData) this, (Tcl_CmdDeleteProc *) NULL);
2228  Tcl_CreateCommand(interp, "updateGridScale", Tcl_updateGridScale,
2229  (ClientData) this, (Tcl_CmdDeleteProc *) NULL);
2230  // END gf
2231 #endif
2232 
2233 }
2234 
2235 int ScriptTcl::eval(const char *script, const char **resultPtr) {
2236 
2237 #ifdef NAMD_TCL
2238  int code = Tcl_EvalEx(interp,script,-1,TCL_EVAL_GLOBAL);
2239  *resultPtr = Tcl_GetStringResult(interp);
2240  return code;
2241 #else
2242  NAMD_bug("ScriptTcl::eval called without Tcl.");
2243  return -1; // appease compiler
2244 #endif
2245 }
2246 
2247 void ScriptTcl::eval(char *script) {
2248 
2249 #ifdef NAMD_TCL
2250  int code = Tcl_Eval(interp,script);
2251  const char *result = Tcl_GetStringResult(interp);
2252  if (*result != 0) CkPrintf("TCL: %s\n",result);
2253  if (code != TCL_OK) {
2254  const char *errorInfo = Tcl_GetVar(interp,"errorInfo",0);
2255  NAMD_die(errorInfo ? errorInfo : "Unknown Tcl error");
2256  }
2257 #else
2258  NAMD_bug("ScriptTcl::eval called without Tcl.");
2259 #endif
2260 
2261 }
2262 
2263 
2264 #ifdef NAMD_TCL
2265 int ScriptTcl::tclsh(int argc, char **argv) {
2266  Tcl_Interp *interp = Tcl_CreateInterp();
2267  psfgen_static_init(interp);
2268  eabf_static_init(interp);
2269  tcl_vector_math_init(interp);
2270  Tcl_SetVar(interp, "argv0", argv[0], TCL_GLOBAL_ONLY);
2271  Tcl_SetVar2Ex(interp, "argc", NULL, Tcl_NewIntObj(argc-1), TCL_GLOBAL_ONLY);
2272  Tcl_Obj *argvPtr = Tcl_NewListObj(0, NULL);
2273  for ( int i=1; i<argc; ++i ) {
2274  Tcl_ListObjAppendElement(NULL, argvPtr, Tcl_NewStringObj(argv[i],-1));
2275  }
2276  Tcl_SetVar2Ex(interp, "argv", NULL, argvPtr, TCL_GLOBAL_ONLY);
2277  int code = Tcl_EvalFile(interp,argv[0]);
2278  if (code != TCL_OK) {
2279  const char *errorInfo = Tcl_GetVar(interp,"errorInfo",0);
2280  fprintf(stderr,"%s\n",(errorInfo ? errorInfo : "Unknown Tcl error"));
2281  return -1;
2282  }
2283  return 0;
2284 }
2285 
2286 
2287 void ScriptTcl::tclmain(int argc, char **argv) {
2288  Tcl_SetVar(interp, "argv0", argv[0], TCL_GLOBAL_ONLY);
2289  Tcl_SetVar2Ex(interp, "argc", NULL, Tcl_NewIntObj(argc-1), TCL_GLOBAL_ONLY);
2290  Tcl_Obj *argvPtr = Tcl_NewListObj(0, NULL);
2291  for ( int i=1; i<argc; ++i ) {
2292  Tcl_ListObjAppendElement(NULL, argvPtr, Tcl_NewStringObj(argv[i],-1));
2293  }
2294  Tcl_SetVar2Ex(interp, "argv", NULL, argvPtr, TCL_GLOBAL_ONLY);
2295  int code = Tcl_EvalFile(interp,argv[0]);
2296  if (code != TCL_OK) {
2297  const char *errorInfo = Tcl_GetVar(interp,"errorInfo",0);
2298  NAMD_die(errorInfo ? errorInfo : "Unknown Tcl error");
2299  }
2300 }
2301 #endif
2302 
2303 
2304 void ScriptTcl::load(char *scriptFile) {
2305 
2306 #ifdef NAMD_TCL
2307  int code = Tcl_EvalFile(interp,scriptFile);
2308  const char *result = Tcl_GetStringResult(interp);
2309  if (*result != 0) CkPrintf("TCL: %s\n",result);
2310  if (code != TCL_OK) {
2311  const char *errorInfo = Tcl_GetVar(interp,"errorInfo",0);
2312  NAMD_die(errorInfo ? errorInfo : "Unknown Tcl error");
2313  }
2314 #else
2315  NAMD_bug("ScriptTcl::load called without Tcl.");
2316 #endif
2317 
2318 }
2319 
2320 #ifdef NAMD_TCL
2322 #else
2323 void ScriptTcl::run(char *scriptFile) {
2324 
2325  if ( NULL == scriptFile || NULL == (config = new ConfigList(scriptFile)) ) {
2326  NAMD_die("Simulation config file is empty.");
2327  }
2328 #endif
2329 
2330  if (runWasCalled == 0) {
2331  initcheck();
2332  SimParameters *simParams = Node::Object()->simParameters;
2333  if ( simParams->minimizeCGOn ) runController(SCRIPT_MINIMIZE);
2334  else runController(SCRIPT_RUN);
2335  runWasCalled = 1;
2336  }
2337 
2338 #if CMK_HAS_PARTITION
2339  replica_barrier();
2340 #endif
2341  runController(SCRIPT_END);
2342 
2343 }
2344 
2346  DebugM(3,"Destructing ScriptTcl\n");
2347 #ifdef NAMD_TCL
2348  if ( interp ) Tcl_DeleteInterp(interp);
2349  delete [] callbackname;
2350 #endif
2351 
2353 }
2354 
static Node * Object()
Definition: Node.h:86
std::ostream & iINFO(std::ostream &s)
Definition: InfoStream.C:107
Definition: PDB.h:35
int istrueinparseopts(const char *name)
#define DEG2RAD
Definition: ScriptTcl.C:1761
static int replica_hash(const char *key)
Definition: ScriptTcl.C:1581
void setReplicaDcdIndex(int index)
Definition: Output.C:673
int molfile_dcdplugin_init(void)
void saveMolDataPointers(NamdState *)
Definition: Node.C:1372
void set(const char *newdata)
Definition: ConfigList.h:59
void load(char *scriptFile)
Definition: ScriptTcl.C:2304
static PatchMap * Object()
Definition: PatchMap.h:27
void add_element(const char *s1, int len1, const char *s2, int len2)
Definition: ConfigList.C:58
__global__ void const int const TileList *__restrict__ TileExcl *__restrict__ const int *__restrict__ const int const float2 *__restrict__ const int *__restrict__ const float3 const float3 const float3 const float4 *__restrict__ const float cudaTextureObject_t cudaTextureObject_t cudaTextureObject_t const int const float const PatchPairRecord *__restrict__ const int *__restrict__ const int2 *__restrict__ const unsigned int *__restrict__ unsigned int *__restrict__ int *__restrict__ int *__restrict__ TileListStat *__restrict__ const BoundingBox *__restrict__ float4 *__restrict__ float4 *__restrict__ float *__restrict__ float *__restrict__ float *__restrict__ float *__restrict__ float *__restrict__ float *__restrict__ float *__restrict__ float *__restrict__ const int numPatches
const BigReal A
static __thread ComputeMgr * computeMgr
static void exit(int status=0)
Definition: BackEnd.C:276
Definition: Vector.h:64
Output * output
Definition: Node.h:182
SimParameters * simParameters
Definition: Node.h:178
static int numatoms
Definition: ScriptTcl.C:64
#define DebugM(x, y)
Definition: Debug.h:59
int psfgen_static_init(Tcl_Interp *)
void replica_send(const char *sndbuf, int sendcount, int destPart, int destPE)
BigReal z
Definition: Vector.h:66
void replicaDcdOff()
Definition: Output.h:100
int atomid
Definition: PatchMgr.h:55
static void suspend(void)
Definition: BackEnd.C:311
char value[MAX_SCRIPT_PARAM_SIZE]
Definition: Node.h:75
static void messageStartUp()
Definition: Node.C:418
std::ostream & iWARN(std::ostream &s)
Definition: InfoStream.C:108
void set_all_positions(Vector *)
Definition: PDB.C:331
#define iout
Definition: InfoStream.h:87
int num_atoms(void)
Definition: PDB.C:323
const char * rstring(Range r)
Definition: ParseOptions.C:25
char outputFilename[NAMD_FILENAME_BUFFER_SIZE]
void replica_eval(const char *cmdbuf, int targPart, int targPE, DataMessage **precvMsg)
static int atoBool(const char *s)
Definition: ScriptTcl.C:967
Vector offset
Definition: PatchMgr.h:62
Tensor langevinPiston_strainRate
Definition: Controller.h:33
void run()
Definition: ScriptTcl.C:2321
void replica_recv(DataMessage **precvMsg, int srcPart, int srcPE)
void read_binary_coors(char *fname, PDB *pdbobj)
Definition: NamdOneTools.C:34
void reinitAtoms(const char *basename=0)
Definition: WorkDistrib.C:952
void replicaDcdInit(int index, const char *filename)
Definition: Output.C:678
void NAMD_bug(const char *err_msg)
Definition: common.C:123
static void * filehandle
Definition: ScriptTcl.C:65
void set(Vector A, Vector B, Vector C)
Definition: Lattice.h:31
zVector strainRate2
void updateGridScale(const char *key, Vector scale)
Definition: Node.C:1195
gridSize z
static molfile_plugin_t * dcdplugin
Definition: ScriptTcl.C:55
int eabf_static_init(Tcl_Interp *interp)
Definition: eabfTcl.C:179
BigReal rescaleVelocities_sumTemps
Definition: Controller.h:174
void reloadStructure(const char *, const char *)
Definition: Node.C:998
BigReal x
Definition: Vector.h:66
int berendsenPressure_count
Definition: Controller.h:35
int moveto
Definition: PatchMgr.h:56
void replica_barrier()
void readExtendedSystem(const char *filename, Lattice *latptr=0)
void NAMD_die(const char *err_msg)
Definition: common.C:83
PDB * pdb
Definition: Node.h:180
void tclmain(int, char **)
Definition: ScriptTcl.C:2287
zVector strainRate
void publish(int tag, const T &t)
Vector * coords
Definition: Node.h:185
int tcl_run_colvarscript_command(ClientData clientData, Tcl_Interp *interp_in, int objc, Tcl_Obj *const objv[])
void eval(char *script)
Definition: ScriptTcl.C:2247
int add(const Elem &elem)
Definition: ResizeArray.h:97
char * getfromparseopts(const char *name, char *outbuf)
#define simParams
Definition: Output.C:127
WorkDistrib * workDistrib
Definition: Node.h:166
char data[1]
Definition: DataExchanger.h:23
int tcl_vector_math_init(Tcl_Interp *interp)
Definition: TclCommands.C:299
void newhandle_msg(void *v, const char *msg)
Definition: ScriptTcl.C:2088
static void barrier(void)
Definition: BackEnd.C:321
char * data
Definition: ConfigList.h:48
int register_cb(void *v, vmdplugin_t *p)
Definition: PluginIOMgr.C:6
int rescaleVelocities_numTemps
Definition: Controller.h:175
BigReal y
Definition: Vector.h:66
#define MAX_SCRIPT_PARAM_SIZE
Definition: Node.h:71
Vector b() const
Definition: Lattice.h:253
const BigReal B
static void createCommands(Tcl_Interp *)
Definition: Measure.C:169
static Vector * vcoords
Definition: ScriptTcl.C:67
StringList * find(const char *name) const
Definition: ConfigList.C:341
void newhandle_msg_ex(void *v, const char *msg, int prepend, int newline)
Definition: ScriptTcl.C:2092
colvarmodule * colvars
Definition: Node.h:184
int dumpbench(FILE *file)
Definition: DumpBench.C:27
int molfile_dcdplugin_fini(void)
static int get_lattice_from_ts(Lattice *lattice, const molfile_timestep_t *ts)
Definition: ScriptTcl.C:1764
gridSize y
static Tensor symmetric(const Vector &v1, const Vector &v2)
Definition: Tensor.h:45
#define CHECK_REPLICA(REP)
Definition: ScriptTcl.C:562
infostream & endi(infostream &s)
Definition: InfoStream.C:38
int b_p() const
Definition: Lattice.h:274
void replica_sendRecv(const char *sndbuf, int sendcount, int destPart, int destPE, DataMessage **precvMsg, int srcPart, int srcPE)
static int tclsh(int, char **)
Definition: ScriptTcl.C:2265
Lattice origLattice
Definition: Controller.h:281
gridSize x
int molfile_dcdplugin_register(void *, vmdplugin_register_cb)
void measure(Vector *)
Definition: ScriptTcl.C:1387
int configListInit(ConfigList *)
Definition: NamdState.C:123
int a_p() const
Definition: Lattice.h:273
Tensor langevinPiston_origStrainRate
Definition: Controller.h:204
static void deleteCommands(Tcl_Interp *)
Definition: Measure.C:180
Lattice lattice
Definition: PatchMgr.h:67
static float * coords
Definition: ScriptTcl.C:66
Vector a() const
Definition: Lattice.h:252
int issetinparseopts(const char *name)
Tensor berendsenPressure_avg
Definition: Controller.h:34
Vector coord
Definition: PatchMgr.h:57
Vector c() const
Definition: Lattice.h:254
char param[MAX_SCRIPT_PARAM_SIZE]
Definition: Node.h:74
void reloadCharges(const char *filename)
Definition: Node.C:1144
int c_p() const
Definition: Lattice.h:275
void reloadGridforceGrid(const char *key)
Definition: Node.C:1167