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