Main Page | Namespace List | Class Hierarchy | Alphabetical List | Class List | File List | Class Members | File Members

ScriptTcl.C

Go to the documentation of this file.
00001 
00007 /*
00008    Modifies SimParameters settings during run.
00009 */
00010 
00011 #include "InfoStream.h"
00012 #include "BackEnd.h"
00013 #include "ScriptTcl.h"
00014 #include "Broadcasts.h"
00015 #include "ConfigList.h"
00016 #include "Node.h"
00017 #include "PDB.h"
00018 #include "WorkDistrib.h"
00019 #include "NamdState.h"
00020 #include "Controller.h"
00021 #include "SimParameters.h"
00022 #include "Thread.h"
00023 #include "ProcessorPrivate.h"
00024 #include "PatchMgr.h"
00025 #include "Measure.h"
00026 #include "DumpBench.h"
00027 #include <stdio.h>
00028 #include <ctype.h>  // for isspace
00029 #ifndef WIN32
00030 #include <strings.h>
00031 #endif
00032 
00033 #ifdef NAMD_TCL
00034 #define USE_COMPAT_CONST
00035 #include <tcl.h>
00036 #endif
00037 #include "TclCommands.h"
00038 
00039 //#define DEBUGM
00040 #define MIN_DEBUG_LEVEL 4
00041 #include "Debug.h"
00042 
00043 #include <molfile_plugin.h>
00044 #include <libmolfile_plugin.h>
00045 
00046 static molfile_plugin_t *dcdplugin;
00047 static int register_cb(void *v, vmdplugin_t *p) {
00048         dcdplugin = (molfile_plugin_t *)p;
00049         return 0;
00050 }
00051 
00052 //
00053 // XXX static and global variables are unsafe for shared memory builds.
00054 //
00055 static int numatoms;
00056 static void *filehandle;
00057 static float *coords;
00058 static Vector *vcoords;
00059 
00060 
00061 void ScriptTcl::suspend() {
00062   BackEnd::suspend();
00063 }
00064 
00065 void ScriptTcl::barrier() {
00066   BackEnd::barrier();
00067 }
00068 
00069 void ScriptTcl::initcheck() {
00070   if ( runWasCalled == 0 ) {
00071 #ifdef NAMD_TCL
00072     CkPrintf("TCL: Suspending until startup complete.\n");
00073     Tcl_CreateCommand(interp, "param", Tcl_param,
00074       (ClientData) this, (Tcl_CmdDeleteProc *) NULL);
00075     Tcl_CreateCommand(interp, "unknown", Tcl_param,
00076       (ClientData) this, (Tcl_CmdDeleteProc *) NULL);
00077 #endif
00078     runWasCalled = 1;
00079 
00080     state->configListInit(config);
00081     Node::Object()->saveMolDataPointers(state);
00082     Node::messageStartUp();
00083     suspend();
00084   }
00085 }
00086 
00087 void ScriptTcl::runController(int task) {
00088   scriptBarrier.publish(barrierStep++,task);
00089   suspend();
00090 }
00091 
00092 void ScriptTcl::setParameter(const char* param, const char* value) {
00093   ScriptParamMsg *msg = new ScriptParamMsg;
00094   strncpy(msg->param,param,MAX_SCRIPT_PARAM_SIZE);
00095   strncpy(msg->value,value,MAX_SCRIPT_PARAM_SIZE);
00096   (CProxy_Node(CkpvAccess(BOCclass_group).node)).scriptParam(msg);
00097   barrier();
00098 }
00099 
00100 void ScriptTcl::setParameter(const char* param, int value) {
00101   ScriptParamMsg *msg = new ScriptParamMsg;
00102   strncpy(msg->param,param,MAX_SCRIPT_PARAM_SIZE);
00103   sprintf(msg->value,"%d",value);
00104   (CProxy_Node(CkpvAccess(BOCclass_group).node)).scriptParam(msg);
00105   barrier();
00106 }
00107 
00108 void ScriptTcl::reinitAtoms(void) {
00109   Node::Object()->workDistrib->reinitAtoms();
00110   barrier();
00111 }
00112 
00113 #ifdef NAMD_TCL
00114 
00115 int ScriptTcl::Tcl_exit(ClientData clientData,
00116         Tcl_Interp *, int argc, char *argv[]) {
00117   ScriptTcl *script = (ScriptTcl *)clientData;
00118   script->runController(SCRIPT_END);
00119   BackEnd::exit();
00120   return TCL_OK;
00121 }
00122 
00123 int ScriptTcl::Tcl_abort(ClientData,
00124         Tcl_Interp *, int argc, char *argv[]) {
00125   Tcl_DString msg;
00126   Tcl_DStringInit(&msg);
00127   Tcl_DStringAppend(&msg,"TCL:",-1);
00128   for ( int i = 1; i < argc; ++i ) {
00129     Tcl_DStringAppend(&msg," ",-1);
00130     Tcl_DStringAppend(&msg,argv[i],-1);
00131   }
00132   NAMD_die(Tcl_DStringValue(&msg));
00133   Tcl_DStringFree(&msg);
00134   return TCL_OK;
00135 }
00136 
00137 int ScriptTcl::Tcl_print(ClientData,
00138         Tcl_Interp *, int argc, char *argv[]) {
00139   Tcl_DString msg;
00140   Tcl_DStringInit(&msg);
00141   for ( int i = 1; i < argc; ++i ) {
00142     Tcl_DStringAppend(&msg," ",-1);
00143     Tcl_DStringAppend(&msg,argv[i],-1);
00144   }
00145   CkPrintf("TCL:%s\n",Tcl_DStringValue(&msg));
00146   Tcl_DStringFree(&msg);
00147   return TCL_OK;
00148 }
00149 
00150 int ScriptTcl::Tcl_config(ClientData clientData,
00151         Tcl_Interp *interp, int argc, char *argv[]) {
00152 
00153 // Needs to handle the following cases as passed in by Tcl:
00154 //    name data #comment
00155 //    name=data #comment
00156 //    name= data #comment
00157 //    name =data #comment
00158 //    name = data #comment
00159 //    name data1 data2 data3 #comment
00160 //    name=data1 data2 data3 #comment
00161 //    name= data1 data2 data3 #comment
00162 //    name =data1 data2 data3 #comment
00163 //    name = data1 data2 data3 #comment
00164 //    name { data1 data2 data3 } #comment
00165 //    name { data1 data2 data3 } #comment
00166 //    name { data1 data2 # data3 } #comment
00167 //    name {data1 data2 # data3 } #comment
00168 // Do not try to handle "data#comment" in any form.
00169 // The '#' start of any comments will *always* be a new argv.
00170 // The name will *always* be contained in argv[1].
00171 
00172   // allocate storage for data string
00173   int arglen = 1;  int ai;
00174   for (ai=1; ai<argc; ++ai) { arglen += strlen(argv[ai]) + 1; }
00175   char *data = new char[arglen];  *data = 0;
00176 
00177   // find the end of the name
00178   char *name, *s;
00179   name = argv[1];
00180   for ( s = name; *s && *s != '='; ++s );
00181 
00182   // eliminate any comment
00183   for (ai=2; ai<argc; ++ai) { if (argv[ai][0] == '#') argc = ai; }
00184 
00185   // concatenate all the data items
00186   ai = 2;
00187   if ( *s ) { *s = 0; ++s; strcat(data,s); }  // name=data or name=
00188   else if ( ai < argc && argv[ai][0] == '=' ) {  // name =data or name =
00189     strcat(data,argv[ai]+1);
00190     ++ai;
00191   }
00192   for ( ; ai<argc; ++ai) {
00193     if ( data[0] ) { strcat(data," "); }
00194     strcat(data,argv[ai]);
00195   }
00196 
00197   if ( ! *name || ! *data ) {
00198     delete [] data;
00199     Tcl_SetResult(interp,"error parsing config file",TCL_VOLATILE);
00200     return TCL_ERROR;
00201   }
00202 
00203   ScriptTcl *script = (ScriptTcl *)clientData;
00204   script->config->add_element( name, strlen(name), data, strlen(data) );
00205 
00206   delete [] data;
00207   return TCL_OK;
00208 }
00209 
00210 int ScriptTcl::Tcl_param(ClientData clientData,
00211         Tcl_Interp *interp, int argc, char *argv[]) {
00212   if (argc != 3 && argc != 5) {
00213     Tcl_SetResult(interp,"wrong # args",TCL_VOLATILE);
00214     return TCL_ERROR;
00215   }
00216 
00217   char *param = argv[1];
00218   if ( strlen(param) + 1 > MAX_SCRIPT_PARAM_SIZE ) {
00219     Tcl_SetResult(interp,"parameter name too long",TCL_VOLATILE);
00220     return TCL_ERROR;
00221   }
00222 
00223   char value[MAX_SCRIPT_PARAM_SIZE];
00224   int arglen = strlen(argv[2]) + 1;
00225   if ( argc == 5 ) arglen += strlen(argv[3]) + strlen(argv[4]) + 2;
00226   if ( arglen > MAX_SCRIPT_PARAM_SIZE ) {
00227     Tcl_SetResult(interp,"parameter value too long",TCL_VOLATILE);
00228     return TCL_ERROR;
00229   }
00230   if ( argc == 3 ) sprintf(value,"%s",argv[2]);
00231   if ( argc == 5 ) sprintf(value,"%s %s %s",argv[2],argv[3],argv[4]);
00232 
00233   iout << "TCL: Setting parameter " << param << " to " << value << "\n" << endi;
00234 
00235   ScriptTcl *script = (ScriptTcl *)clientData;
00236   script->setParameter(param,value);
00237 
00238   return TCL_OK;
00239 }
00240 
00241 int ScriptTcl::Tcl_reinitvels(ClientData clientData,
00242         Tcl_Interp *interp, int argc, char *argv[]) {
00243   ScriptTcl *script = (ScriptTcl *)clientData;
00244   script->initcheck();
00245   if (argc != 2) {
00246     Tcl_SetResult(interp,"wrong # args",TCL_VOLATILE);
00247     return TCL_ERROR;
00248   }
00249   char *temp = argv[1];
00250 
00251   script->setParameter("initialTemp",temp);
00252 
00253   script->runController(SCRIPT_REINITVELS);
00254 
00255   return TCL_OK;
00256 }
00257 
00258 int ScriptTcl::Tcl_rescalevels(ClientData clientData,
00259         Tcl_Interp *interp, int argc, char *argv[]) {
00260   ScriptTcl *script = (ScriptTcl *)clientData;
00261   script->initcheck();
00262   if (argc != 2) {
00263     Tcl_SetResult(interp,"wrong # args",TCL_VOLATILE);
00264     return TCL_ERROR;
00265   }
00266   char *factor = argv[1];
00267 
00268   script->setParameter("scriptArg1",factor);
00269 
00270   script->runController(SCRIPT_RESCALEVELS);
00271 
00272   return TCL_OK;
00273 }
00274 
00275 int ScriptTcl::Tcl_run(ClientData clientData,
00276         Tcl_Interp *interp, int argc, char *argv[]) {
00277   ScriptTcl *script = (ScriptTcl *)clientData;
00278   script->initcheck();
00279   if (argc != 2) {
00280     Tcl_SetResult(interp,"wrong # args",TCL_VOLATILE);
00281     return TCL_ERROR;
00282   }
00283   int numsteps;
00284   if (Tcl_GetInt(interp,argv[1],&numsteps) != TCL_OK) {
00285     return TCL_ERROR;
00286   }
00287   if (numsteps < 0) {
00288     Tcl_SetResult(interp,"number of steps must be non-negative",TCL_VOLATILE);
00289     return TCL_ERROR;
00290   }
00291   SimParameters *simParams = Node::Object()->simParameters;
00292   if (numsteps % simParams->stepsPerCycle) {
00293     Tcl_SetResult(interp,"number of steps must be a multiple of stepsPerCycle",TCL_VOLATILE);
00294     return TCL_ERROR;
00295   }
00296   iout << "TCL: Running for " << numsteps << " steps\n" << endi;
00297 
00298   script->setParameter("numsteps",simParams->firstTimestep + numsteps);
00299 
00300   script->runController(SCRIPT_RUN);
00301 
00302   script->setParameter("firsttimestep",simParams->N);
00303 
00304   return TCL_OK;
00305 }
00306 
00307 int ScriptTcl::Tcl_minimize(ClientData clientData,
00308         Tcl_Interp *interp, int argc, char *argv[]) {
00309   ScriptTcl *script = (ScriptTcl *)clientData;
00310   script->initcheck();
00311   if (argc != 2) {
00312     Tcl_SetResult(interp,"wrong # args",TCL_VOLATILE);
00313     return TCL_ERROR;
00314   }
00315   int numsteps;
00316   if (Tcl_GetInt(interp,argv[1],&numsteps) != TCL_OK) {
00317     return TCL_ERROR;
00318   }
00319   if (numsteps < 0) {
00320     Tcl_SetResult(interp,"number of steps must be non-negative",TCL_VOLATILE);
00321     return TCL_ERROR;
00322   }
00323   SimParameters *simParams = Node::Object()->simParameters;
00324   if (numsteps % simParams->stepsPerCycle) {
00325     Tcl_SetResult(interp,"number of steps must be a multiple of stepsPerCycle",TCL_VOLATILE);
00326     return TCL_ERROR;
00327   }
00328   iout << "TCL: Minimizing for " << numsteps << " steps\n" << endi;
00329 
00330   script->setParameter("numsteps",simParams->firstTimestep + numsteps);
00331 
00332   script->runController(SCRIPT_MINIMIZE);
00333 
00334   script->setParameter("firsttimestep",simParams->N);
00335 
00336   return TCL_OK;
00337 }
00338 
00339 // move all atoms by a given vector
00340 int ScriptTcl::Tcl_moveallby(ClientData clientData,
00341         Tcl_Interp *interp, int argc, char *argv[]) {
00342   ScriptTcl *script = (ScriptTcl *)clientData;
00343   script->initcheck();
00344   if (argc != 2) {
00345     Tcl_SetResult(interp, "wrong # args", TCL_VOLATILE);
00346     return TCL_ERROR;
00347   }
00348   char **fstring;
00349   int fnum;
00350   double x, y, z;
00351   if (Tcl_SplitList(interp, argv[1], &fnum, &fstring) != TCL_OK)
00352     return TCL_ERROR;
00353   if ( (fnum != 3) ||
00354        (Tcl_GetDouble(interp, fstring[0],&x) != TCL_OK) ||
00355        (Tcl_GetDouble(interp, fstring[1],&y) != TCL_OK) ||
00356        (Tcl_GetDouble(interp, fstring[2],&z) != TCL_OK) ) {
00357     Tcl_SetResult(interp,"argument not a vector",TCL_VOLATILE);
00358     Tcl_Free((char*)fstring);
00359     return TCL_ERROR;
00360   }
00361   Tcl_Free((char*)fstring);
00362 
00363   MoveAllByMsg *msg = new MoveAllByMsg;
00364   msg->offset = Vector(x,y,z);
00365   (CProxy_PatchMgr(CkpvAccess(BOCclass_group).patchMgr)).moveAllBy(msg);
00366 
00367   script->barrier();
00368   return TCL_OK;
00369 }
00370 
00371 int ScriptTcl::Tcl_move(ClientData clientData,
00372         Tcl_Interp *interp, int argc, char *argv[]) {
00373   ScriptTcl *script = (ScriptTcl *)clientData;
00374   script->initcheck();
00375   if (argc != 4) {
00376     Tcl_SetResult(interp,"wrong # args",TCL_VOLATILE);
00377     return TCL_ERROR;
00378   }
00379   char **fstring;  int fnum;  int atomid;  int moveto;  double x, y, z;
00380   if (Tcl_GetInt(interp,argv[1],&atomid) != TCL_OK) return TCL_ERROR;
00381   if (argv[2][0]=='t' && argv[2][1]=='o' && argv[2][2]==0) moveto = 1;
00382   else if (argv[2][0]=='b' && argv[2][1]=='y' && argv[2][2]==0) moveto = 0;
00383   else {
00384     Tcl_SetResult(interp,"syntax is 'move <id> to|by {<x> <y> <z>}'",TCL_VOLATILE);
00385     return TCL_ERROR;
00386   }
00387   if (Tcl_SplitList(interp, argv[3], &fnum, &fstring) != TCL_OK) {
00388     return TCL_ERROR;
00389   }
00390   if ( (fnum != 3) ||
00391        (Tcl_GetDouble(interp, fstring[0],&x) != TCL_OK) ||
00392        (Tcl_GetDouble(interp, fstring[1],&y) != TCL_OK) ||
00393        (Tcl_GetDouble(interp, fstring[2],&z) != TCL_OK) ) {
00394     Tcl_SetResult(interp,"third argument not a vector",TCL_VOLATILE);
00395     Tcl_Free((char*)fstring);
00396     return TCL_ERROR;
00397   }
00398   Tcl_Free((char*)fstring);
00399 
00400   SimParameters *simParams = Node::Object()->simParameters;
00401 
00402   iout << "TCL: Moving atom " << atomid << " ";
00403   if ( moveto ) iout << "to"; else iout << "by";
00404   iout << " " << Vector(x,y,z) << ".\n" << endi;
00405 
00406   MoveAtomMsg *msg = new MoveAtomMsg;
00407   msg->atomid = atomid - 1;
00408   msg->moveto = moveto;
00409   msg->coord = Vector(x,y,z);
00410   (CProxy_PatchMgr(CkpvAccess(BOCclass_group).patchMgr)).moveAtom(msg);
00411 
00412   script->barrier();
00413 
00414   return TCL_OK;
00415 }
00416 
00417 int ScriptTcl::Tcl_output(ClientData clientData,
00418         Tcl_Interp *interp, int argc, char *argv[]) {
00419   ScriptTcl *script = (ScriptTcl *)clientData;
00420   script->initcheck();
00421   if (argc != 2) {
00422     Tcl_SetResult(interp,"wrong # args",TCL_VOLATILE);
00423     return TCL_ERROR;
00424   }
00425   if (strlen(argv[1]) > MAX_SCRIPT_PARAM_SIZE) {
00426     Tcl_SetResult(interp,"file name too long",TCL_VOLATILE);
00427     return TCL_ERROR;
00428   }
00429 
00430   SimParameters *simParams = Node::Object()->simParameters;
00431 
00432   char oldname[MAX_SCRIPT_PARAM_SIZE+1];
00433   strncpy(oldname,simParams->outputFilename,MAX_SCRIPT_PARAM_SIZE);
00434 
00435   script->setParameter("outputname",argv[1]);
00436 
00437   iout << "TCL: Writing to files with basename " <<
00438                 simParams->outputFilename << ".\n" << endi;
00439 
00440   script->runController(SCRIPT_OUTPUT);
00441 
00442   script->setParameter("outputname",oldname);
00443 
00444   return TCL_OK;
00445 }
00446 
00447 void ScriptTcl::measure(Vector *c) {
00448   Measure::createCommands(interp);
00449   Node::Object()->coords = c;
00450   measure_result = Tcl_Eval(interp,measure_command);
00451   Node::Object()->coords = 0;
00452   Measure::deleteCommands(interp);
00453 }
00454 
00455 int ScriptTcl::Tcl_measure(ClientData clientData,
00456         Tcl_Interp *interp, int argc, char *argv[]) {
00457   ScriptTcl *script = (ScriptTcl *)clientData;
00458   script->initcheck();
00459   if (argc != 2) {
00460     Tcl_SetResult(interp,"wrong # args",TCL_VOLATILE);
00461     return TCL_ERROR;
00462   }
00463   script->measure_command = argv[1];
00464 
00465   script->runController(SCRIPT_MEASURE);
00466 
00467   return script->measure_result;
00468 }
00469 
00470 int ScriptTcl::Tcl_checkpoint(ClientData clientData,
00471         Tcl_Interp *interp, int argc, char *argv[]) {
00472   ScriptTcl *script = (ScriptTcl *)clientData;
00473   script->initcheck();
00474   if (argc != 1) {
00475     Tcl_SetResult(interp,"wrong # args",TCL_VOLATILE);
00476     return TCL_ERROR;
00477   }
00478 
00479   script->runController(SCRIPT_CHECKPOINT);
00480 
00481   return TCL_OK;
00482 }
00483 
00484 int ScriptTcl::Tcl_revert(ClientData clientData,
00485         Tcl_Interp *interp, int argc, char *argv[]) {
00486   ScriptTcl *script = (ScriptTcl *)clientData;
00487   script->initcheck();
00488   if (argc != 1) {
00489     Tcl_SetResult(interp,"wrong # args",TCL_VOLATILE);
00490     return TCL_ERROR;
00491   }
00492 
00493   script->runController(SCRIPT_REVERT);
00494 
00495   return TCL_OK;
00496 }
00497 
00498 int ScriptTcl::Tcl_callback(ClientData clientData,
00499         Tcl_Interp *interp, int argc, char *argv[]) {
00500   ScriptTcl *script = (ScriptTcl *)clientData;
00501   if (argc != 2) {
00502     Tcl_SetResult(interp,"wrong # args",TCL_VOLATILE);
00503     return TCL_ERROR;
00504   }
00505 
00506   delete [] script->callbackname;
00507   script->callbackname = new char[strlen(argv[1])+1];
00508   strcpy(script->callbackname,argv[1]);
00509 
00510   iout << "TCL: Reduction callback proc set to " <<
00511                         script->callbackname << "\n" << endi;
00512 
00513   return TCL_OK;
00514 }
00515 
00516 void ScriptTcl::doCallback(const char *labels, const char *data) {
00517   if ( ! callbackname ) return;
00518   int len = strlen(callbackname) + strlen(labels) + strlen(data) + 7;
00519   char *cmd = new char[len];
00520   sprintf(cmd, "%s {%s} {%s}", callbackname, labels, data);
00521   int rval = Tcl_Eval(interp,cmd);
00522   delete [] cmd;
00523   if (rval != TCL_OK) {
00524     const char *errorInfo = Tcl_GetVar(interp,"errorInfo",0);
00525     NAMD_die(errorInfo);
00526   }
00527 }
00528 
00529 int ScriptTcl::Tcl_reinitatoms(ClientData clientData,
00530         Tcl_Interp *interp, int argc, char *argv[]) {
00531   ScriptTcl *script = (ScriptTcl *)clientData;
00532   script->initcheck();
00533   if (argc != 1) {
00534     Tcl_SetResult(interp,"wrong # args",TCL_VOLATILE);
00535     return TCL_ERROR;
00536   }
00537 
00538   iout << "TCL: Reinitializing atom data\n" << endi;
00539   script->reinitAtoms();
00540 
00541   return TCL_OK;
00542 }
00543 
00544 #define DEG2RAD 3.14159625359/180.0
00545 #define UNITCELLSLOP 0.0001
00546 
00547 static int get_lattice_from_ts(Lattice *lattice, const molfile_timestep_t *ts)
00548 {
00549   // Check if valid unit cell data is contained in the timestep.  We don't
00550   // have any formalized way of doing this yet; for now, just check that
00551   // the length of the vector is greater than 1.
00552   if (ts->A <= 1 || ts->B <= 1 || ts->C <= 1) return 0;
00553 
00554   // convert from degrees to radians
00555   // Try to get exact results when the angles are exactly 90.
00556   double epsalpha = DEG2RAD*(ts->alpha-90.0);
00557   double epsbeta  = DEG2RAD*(ts->beta-90.0);
00558   double epsgamma = DEG2RAD*(ts->gamma-90.0);
00559   double cosAB = -sin(epsgamma);
00560   double sinAB = cos(epsgamma);
00561   double cosAC = -sin(epsbeta);
00562   double cosBC = -sin(epsalpha);
00563 
00564   // A will lie along the positive x axis.
00565   // B will lie in the x-y plane
00566   // The origin will be (0,0,0).
00567   Vector A(0), B(0), vecC(0);
00568   A.x = ts->A;
00569   B.x = ts->B*cosAB;
00570   B.y = ts->B*sinAB;
00571   //if (fabs(B.x) < UNITCELLSLOP) B.x = 0;
00572   //if (fabs(B.y) < UNITCELLSLOP) B.y = 0;
00573   vecC.x = ts->C * cosAC;
00574   vecC.y = (ts->B*ts->C*cosBC - B.x*vecC.x)/B.y;
00575   vecC.z = sqrt(ts->C*ts->C - vecC.x*vecC.x - vecC.y*vecC.y);
00576   //if (fabs(vecC.x) < UNITCELLSLOP) vecC.x = 0;
00577   //if (fabs(vecC.y) < UNITCELLSLOP) vecC.y = 0;
00578   //if (fabs(vecC.z) < UNITCELLSLOP) vecC.z = 0;
00579   lattice->set(A, B, vecC, Vector(0));
00580   return 1;
00581 }
00582 
00583 int ScriptTcl::Tcl_coorfile(ClientData clientData,
00584         Tcl_Interp *interp, int argc, char *argv[]) {
00585   ScriptTcl *script = (ScriptTcl *)clientData;
00586   script->initcheck();
00587   if (argc == 4 && !strcmp(argv[1], "open")) {
00588     if (strcmp(argv[2], "dcd")) {
00589       NAMD_die("Sorry, coorfile presently supports only DCD files");
00590     }
00591     filehandle = dcdplugin->open_file_read(argv[3], "dcd", &numatoms);
00592     if (!filehandle) {
00593       Tcl_AppendResult(interp, "coorfile: Error opening file ", argv[3], NULL);
00594       return TCL_ERROR;
00595     }
00596     if (numatoms != Node::Object()->pdb->num_atoms()) {
00597       Tcl_AppendResult(interp, "Coordinate file ", argv[3], 
00598         "\ncontains the wrong number of atoms.", NULL);
00599       return TCL_ERROR;
00600     }
00601     coords = new float[3*numatoms];
00602     vcoords = new Vector[3*numatoms];
00603     iout << iINFO << "Coordinate file " << argv[3] << " opened for reading.\n"
00604          << endi;
00605   } else if (argc == 2 && !strcmp(argv[1], "read")) {
00606     if (filehandle == NULL) {
00607       Tcl_AppendResult(interp, "coorfile read: Error, no file open for reading",
00608         NULL);
00609       return TCL_ERROR;
00610     }
00611     molfile_timestep_t ts;
00612     ts.coords = coords;
00613     int rc = dcdplugin->read_next_timestep(filehandle, numatoms, &ts);
00614     if (rc) {  // EOF
00615       Tcl_SetObjResult(interp, Tcl_NewIntObj(-1));
00616       return TCL_OK;
00617     }
00618     iout << iINFO << "Reading timestep from file.\n" << endi;
00619     Lattice lattice;
00620     if (get_lattice_from_ts(&lattice, &ts)) {
00621       iout << iINFO << "Updating unit cell from timestep.\n" << endi;
00622       if ( lattice.a_p() && ! script->state->lattice.a_p() ||
00623            lattice.b_p() && ! script->state->lattice.b_p() ||
00624            lattice.c_p() && ! script->state->lattice.c_p() ) {
00625         iout << iWARN << "Cell basis vectors should be specified before reading trajectory.\n" << endi;
00626       }
00627       // update Controller's lattice, but don't change the origin!
00628       Vector a(0.);  if ( script->state->lattice.a_p() ) a = lattice.a();
00629       Vector b(0.);  if ( script->state->lattice.b_p() ) b = lattice.b();
00630       Vector c(0.);  if ( script->state->lattice.c_p() ) c = lattice.c();
00631       script->state->lattice.set(a,b,c);
00632       SetLatticeMsg *msg = new SetLatticeMsg;
00633       msg->lattice = script->state->lattice;
00634       (CProxy_PatchMgr(CkpvAccess(BOCclass_group).patchMgr)).setLattice(msg);
00635       script->barrier();
00636     }
00637     for (int i=0; i<numatoms; i++) {
00638       vcoords[i].x = coords[3*i+0];
00639       vcoords[i].y = coords[3*i+1];
00640       vcoords[i].z = coords[3*i+2];
00641     }
00642     Node::Object()->pdb->set_all_positions(vcoords);
00643     script->reinitAtoms();
00644     Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
00645   } else if (argc == 2 && !strcmp(argv[1], "close")) {
00646     if (!filehandle) {
00647       Tcl_AppendResult(interp, "coorfile close: No file opened for reading!", 
00648         NULL);
00649       return TCL_OK;
00650     }
00651     iout << iINFO << "Closing coordinate file.\n" << endi; 
00652     dcdplugin->close_file_read(filehandle);
00653     filehandle = NULL;
00654     delete [] coords;
00655     delete [] vcoords;
00656 
00657   } else if (argc ==2 && !strcmp(argv[1], "skip")) {
00658     if (filehandle == NULL) {
00659       Tcl_AppendResult(interp, "coorfile skip: Error, no file open for reading",
00660         NULL);
00661       return TCL_ERROR;
00662     }
00663     int rc = dcdplugin->read_next_timestep(filehandle, numatoms, NULL);
00664     if (rc) {  // EOF
00665       Tcl_SetObjResult(interp, Tcl_NewIntObj(-1));
00666       return TCL_OK;
00667     }
00668     Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
00669 
00670   } else {
00671     NAMD_die("Unknown option passed to coorfile");
00672   }
00673   return TCL_OK;
00674 }
00675 
00676 int ScriptTcl::Tcl_dumpbench(ClientData clientData,
00677         Tcl_Interp *interp, int argc, char *argv[]) {
00678   ScriptTcl *script = (ScriptTcl *)clientData;
00679   script->initcheck();
00680   if (argc != 2) {
00681     Tcl_AppendResult(interp, "usage: dumpbench <filename>", NULL);
00682     return TCL_ERROR;
00683   }
00684 
00685   if ( CkNumPes() != 1 ) {
00686     Tcl_AppendResult(interp, "multiple processors detected; dumpbench only works on serial runs", NULL);
00687     return TCL_ERROR;
00688   }
00689 
00690   FILE *file = fopen(argv[1],"w");
00691   if ( ! file ) {
00692     Tcl_AppendResult(interp, "dumpbench: error opening file ", argv[1], NULL);
00693     return TCL_ERROR;
00694   }
00695 
00696   if ( dumpbench(file) ) {
00697     Tcl_AppendResult(interp, "dumpbench: error dumping benchmark data", NULL);
00698     return TCL_ERROR;
00699   }
00700 
00701   fclose(file);
00702 
00703   Tcl_AppendResult(interp, "benchmark data written to file ", argv[1], NULL);
00704   return TCL_OK;
00705 }
00706 
00707 #include "ComputeConsForceMsgs.h"
00708 // consforceconfig <atomids> <forces>
00709 int ScriptTcl::Tcl_consForceConfig(ClientData clientData,
00710     Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
00711   ScriptTcl *script = (ScriptTcl *)clientData;
00712   script->initcheck();
00713   if (objc != 3) {
00714     Tcl_WrongNumArgs(interp, 1, objv, (char *)"<atomids> <forces>");
00715     return TCL_ERROR;
00716   }
00717   int natoms, nforces;
00718   Tcl_Obj **atomobjlist, **forceobjlist;
00719   if (Tcl_ListObjGetElements(interp, objv[1], &natoms, &atomobjlist) != TCL_OK ||
00720       Tcl_ListObjGetElements(interp, objv[2], &nforces, &forceobjlist) != TCL_OK) {
00721     return TCL_ERROR;
00722   }
00723   if (natoms != nforces) {
00724     Tcl_AppendResult(interp, (char *)"consforceconfig: atom list and force list not the same size!", NULL);
00725     return TCL_ERROR;
00726   }
00727   ComputeConsForceMsg *msg = new ComputeConsForceMsg;
00728   for (int i=0; i<natoms; i++) {
00729     int atomid;
00730     int nelem;
00731     Tcl_Obj **elemlist;
00732     Vector force;
00733     if (Tcl_GetIntFromObj(interp, atomobjlist[i], &atomid) != TCL_OK) 
00734       return TCL_ERROR;
00735     if (Tcl_ListObjGetElements(interp, forceobjlist[i], &nelem, &elemlist) != TCL_OK)
00736       return TCL_ERROR;
00737     if (nelem != 3) {
00738       Tcl_AppendResult(interp, (char *)"consforceconfig: forces must have three elements", NULL);
00739       return TCL_ERROR;
00740     }
00741     if (Tcl_GetDoubleFromObj(interp, elemlist[0], &force.x) != TCL_OK ||
00742         Tcl_GetDoubleFromObj(interp, elemlist[1], &force.y) != TCL_OK ||
00743         Tcl_GetDoubleFromObj(interp, elemlist[2], &force.z) != TCL_OK) {
00744       return TCL_ERROR;
00745     }
00746     msg->aid.add(atomid);
00747     msg->f.add(force);
00748   }
00749   (CProxy_ComputeMgr(CkpvAccess(BOCclass_group).computeMgr)).recvComputeConsForceMsg(msg);
00750   return TCL_OK;
00751 }
00752 
00753 int ScriptTcl::Tcl_reloadCharges(ClientData clientData,
00754         Tcl_Interp *interp, int argc, char *argv[]) {
00755   ScriptTcl *script = (ScriptTcl *)clientData;
00756   script->initcheck();
00757   if (argc != 2) {
00758     Tcl_AppendResult(interp, "usage: reloadCharges <filename>", NULL);
00759     return TCL_ERROR;
00760   }
00761 
00762   Node::Object()->reloadCharges(argv[1]);
00763 
00764   script->runController(SCRIPT_RELOADCHARGES);
00765 
00766   return TCL_OK;
00767 }
00768 
00769 #endif  // NAMD_TCL
00770 
00771 
00772 ScriptTcl::ScriptTcl() : scriptBarrier(scriptBarrierTag) {
00773   DebugM(3,"Constructing ScriptTcl\n");
00774 #ifdef NAMD_TCL
00775   interp = 0;
00776   callbackname = 0;
00777 #endif
00778   state = new NamdState;
00779   barrierStep = 0;
00780 
00781   molfile_dcdplugin_init();
00782   molfile_dcdplugin_register(NULL, register_cb);
00783 
00784   runWasCalled = 0;
00785 
00786 #ifdef NAMD_TCL
00787   config = new ConfigList;
00788 
00789   // Create interpreter
00790   interp = Tcl_CreateInterp();
00791   tcl_vector_math_init(interp);
00792   Tcl_CreateCommand(interp, "exit", Tcl_exit,
00793     (ClientData) this, (Tcl_CmdDeleteProc *) NULL);
00794   Tcl_CreateCommand(interp, "abort", Tcl_abort,
00795     (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
00796   Tcl_CreateCommand(interp, "print", Tcl_print,
00797     (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
00798   Tcl_CreateCommand(interp, "unknown", Tcl_config,
00799     (ClientData) this, (Tcl_CmdDeleteProc *) NULL);
00800   Tcl_CreateCommand(interp, "param", Tcl_config,
00801     (ClientData) this, (Tcl_CmdDeleteProc *) NULL);
00802   Tcl_CreateCommand(interp, "run", Tcl_run,
00803     (ClientData) this, (Tcl_CmdDeleteProc *) NULL);
00804   Tcl_CreateCommand(interp, "minimize", Tcl_minimize,
00805     (ClientData) this, (Tcl_CmdDeleteProc *) NULL);
00806   Tcl_CreateCommand(interp, "move", Tcl_move,
00807     (ClientData) this, (Tcl_CmdDeleteProc *) NULL);
00808   Tcl_CreateCommand(interp, "moveallby", Tcl_moveallby,
00809     (ClientData) this, (Tcl_CmdDeleteProc *) NULL);
00810   Tcl_CreateCommand(interp, "output", Tcl_output,
00811     (ClientData) this, (Tcl_CmdDeleteProc *) NULL);
00812   Tcl_CreateCommand(interp, "measure", Tcl_measure,
00813     (ClientData) this, (Tcl_CmdDeleteProc *) NULL);
00814   Tcl_CreateCommand(interp, "checkpoint", Tcl_checkpoint,
00815     (ClientData) this, (Tcl_CmdDeleteProc *) NULL);
00816   Tcl_CreateCommand(interp, "revert", Tcl_revert,
00817     (ClientData) this, (Tcl_CmdDeleteProc *) NULL);
00818   Tcl_CreateCommand(interp, "reinitvels", Tcl_reinitvels,
00819     (ClientData) this, (Tcl_CmdDeleteProc *) NULL);
00820   Tcl_CreateCommand(interp, "rescalevels", Tcl_rescalevels,
00821     (ClientData) this, (Tcl_CmdDeleteProc *) NULL);
00822   Tcl_CreateCommand(interp, "reinitatoms", Tcl_reinitatoms,
00823     (ClientData) this, (Tcl_CmdDeleteProc *) NULL);
00824   Tcl_CreateCommand(interp, "callback", Tcl_callback,
00825     (ClientData) this, (Tcl_CmdDeleteProc *) NULL);
00826   Tcl_CreateCommand(interp, "coorfile", Tcl_coorfile,
00827     (ClientData) this, (Tcl_CmdDeleteProc *) NULL);
00828   Tcl_CreateCommand(interp, "dumpbench", Tcl_dumpbench,
00829     (ClientData) this, (Tcl_CmdDeleteProc *) NULL);
00830   Tcl_CreateObjCommand(interp, "consForceConfig", Tcl_consForceConfig, 
00831     (ClientData) this, (Tcl_CmdDeleteProc *) NULL);
00832   Tcl_CreateCommand(interp, "reloadCharges", Tcl_reloadCharges,
00833     (ClientData) this, (Tcl_CmdDeleteProc *) NULL);
00834 #endif
00835 
00836 }
00837 
00838 void ScriptTcl::load(char *scriptFile) {
00839 
00840 #ifdef NAMD_TCL
00841   int code = Tcl_EvalFile(interp,scriptFile);
00842   const char *result = Tcl_GetStringResult(interp);
00843   if (*result != 0) CkPrintf("TCL: %s\n",result);
00844   if (code != TCL_OK) {
00845     const char *errorInfo = Tcl_GetVar(interp,"errorInfo",0);
00846     NAMD_die(errorInfo);
00847   }
00848 #else
00849   NAMD_bug("ScriptTcl::load called without Tcl.");
00850 #endif
00851 
00852 }
00853 
00854 void ScriptTcl::run(char *scriptFile) {
00855 
00856 #ifdef NAMD_TCL
00857   int code = Tcl_EvalFile(interp,scriptFile);
00858   const char *result = Tcl_GetStringResult(interp);
00859   if (*result != 0) CkPrintf("TCL: %s\n",result);
00860   if (code != TCL_OK) {
00861     const char *errorInfo = Tcl_GetVar(interp,"errorInfo",0);
00862     NAMD_die(errorInfo);
00863   }
00864 
00865 #else
00866   if ( NULL == scriptFile || NULL == (config = new ConfigList(scriptFile)) ) {
00867     NAMD_die("Simulation config file is empty.");
00868   }
00869 #endif
00870 
00871   if (runWasCalled == 0) {
00872     initcheck();
00873     SimParameters *simParams = Node::Object()->simParameters;
00874     if ( simParams->minimizeCGOn ) runController(SCRIPT_MINIMIZE);
00875     else runController(SCRIPT_RUN);
00876   }
00877 
00878   runController(SCRIPT_END);
00879 
00880 }
00881 
00882 ScriptTcl::~ScriptTcl() {
00883   DebugM(3,"Destructing ScriptTcl\n");
00884 #ifdef NAMD_TCL
00885   if ( interp ) Tcl_DeleteInterp(interp);
00886   delete [] callbackname;
00887 #endif
00888 
00889   molfile_dcdplugin_fini();
00890 }
00891 

Generated on Tue Nov 24 04:07:45 2009 for NAMD by  doxygen 1.3.9.1