int tclcommand_integrate(ClientData data, Tcl_Interp *interp, int argc, char **argv)
{
int n_steps;
INTEG_TRACE(fprintf(stderr,"%d: integrate:\n",this_node));
if (argc < 1) {
Tcl_AppendResult(interp, "wrong # args: \n\"", (char *) NULL);
return tclcommand_integrate_print_usage(interp); }
else if (argc < 2) { return tclcommand_integrate_print_status(interp); }
if (ARG1_IS_S("set")) {
if (argc < 3) return tclcommand_integrate_print_status(interp);
if (ARG_IS_S(2,"nvt")) return tclcommand_integrate_set_nvt(interp, argc, argv);
#ifdef NPT
else if (ARG_IS_S(2,"npt_isotropic")) return tclcommand_integrate_set_npt_isotropic(interp, argc, argv);
#endif
else {
Tcl_AppendResult(interp, "unknown integrator method:\n", (char *)NULL);
return tclcommand_integrate_print_usage(interp);
}
} else if ( !ARG_IS_I(1,n_steps) ) return tclcommand_integrate_print_usage(interp);
/* go on with integrate <n_steps> */
if(n_steps < 0) {
Tcl_AppendResult(interp, "illegal number of steps (must be >0) \n", (char *) NULL);
return tclcommand_integrate_print_usage(interp);;
}
/* perform integration */
if (mpi_integrate(n_steps))
return mpi_gather_runtime_errors(interp, TCL_OK);
return TCL_OK;
}
int tclcommand_metadynamics(ClientData data, Tcl_Interp *interp, int argc, char **argv)
{
int err = TCL_OK;
/* print metadynamics status */
if(argc == 1) return tclcommand_metadynamics_print_status(interp);
if ( ARG1_IS_S("set") ) {
argc--;
argv++;
if (argc == 1) {
Tcl_AppendResult(interp, "wrong # args: \n", (char *)NULL);
return tclcommand_metadynamics_print_usage(interp, argc, argv);
}
}
if ( ARG1_IS_S("off") )
err = tclcommand_metadynamics_parse_off(interp, argc, argv);
else if ( ARG1_IS_S("distance"))
err = tclcommand_metadynamics_parse_distance(interp, argc, argv);
else if ( ARG1_IS_S("relative_z"))
err = tclcommand_metadynamics_parse_relative_z(interp, argc, argv);
else if ( ARG1_IS_S("print_stat"))
err = tclcommand_metadynamics_print_stat(interp, argc, argv);
else if ( ARG1_IS_S("load_stat"))
err = tclcommand_metadynamics_parse_load_stat(interp, argc, argv);
else {
Tcl_AppendResult(interp, "Unknown metadynamics command ", argv[1], "\n", (char *)NULL);
return tclcommand_metadynamics_print_usage(interp, argc, argv);
}
return mpi_gather_runtime_errors(interp, err);
}
int cellsystem(ClientData data, Tcl_Interp *interp,
int argc, char **argv)
{
int err = 0;
if (argc <= 1) {
Tcl_AppendResult(interp, "usage: cellsystem <system> <params>", (char *)NULL);
return TCL_ERROR;
}
if (ARG1_IS_S("domain_decomposition")) {
if (argc > 2) {
if (ARG_IS_S(2,"-verlet_list"))
dd.use_vList = 1;
else if(ARG_IS_S(2,"-no_verlet_list"))
dd.use_vList = 0;
else{
Tcl_AppendResult(interp, "wrong flag to",argv[0],
" : should be \" -verlet_list or -no_verlet_list \"",
(char *) NULL);
return (TCL_ERROR);
}
}
/** by default use verlet list */
else dd.use_vList = 1;
mpi_bcast_cell_structure(CELL_STRUCTURE_DOMDEC);
}
else if (ARG1_IS_S("nsquare"))
mpi_bcast_cell_structure(CELL_STRUCTURE_NSQUARE);
else if (ARG1_IS_S("layered")) {
if (argc > 2) {
if (!ARG_IS_I(2, n_layers))
return TCL_ERROR;
if (n_layers <= 0) {
Tcl_AppendResult(interp, "layer height should be positive", (char *)NULL);
return TCL_ERROR;
}
determine_n_layers = 0;
}
/* check node grid. All we can do is 1x1xn. */
if (node_grid[0] != 1 || node_grid[1] != 1) {
node_grid[0] = node_grid[1] = 1;
node_grid[2] = n_nodes;
err = mpi_bcast_parameter(FIELD_NODEGRID);
}
else
err = 0;
if (!err)
mpi_bcast_cell_structure(CELL_STRUCTURE_LAYERED);
}
else {
Tcl_AppendResult(interp, "unkown cell structure type \"", argv[1],"\"", (char *)NULL);
return TCL_ERROR;
}
return mpi_gather_runtime_errors(interp, TCL_OK);
}
int tclcommand_adress(ClientData data, Tcl_Interp *interp, int argc, char **argv){
int err = TCL_OK;
#ifndef ADRESS
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "Adress is not compiled in (change config.h).", (char *)NULL);
err = (TCL_ERROR);
#else
if (argc < 2) {
Tcl_AppendResult(interp, "Wrong # of args! Usage: adress (set|print)", (char *)NULL);
err = (TCL_ERROR);
}
else{
if (ARG1_IS_S("print")) err=tclcommand_adress_parse_print(interp,argc,argv);
else if (ARG1_IS_S("set")) err=tclcommand_adress_parse_set(interp,argc,argv);
else {
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "The operation \"", argv[1],"\" you requested is not implemented.", (char *)NULL);
err = (TCL_ERROR);
}
}
#endif
return mpi_gather_runtime_errors(interp, err);
}
int tclcommand_lbboundary_cpu(Tcl_Interp *interp, int argc, char **argv)
{
#ifdef LB_BOUNDARIES
int status, c_num;
double force[3];
char buffer[3*TCL_DOUBLE_SPACE+3];
if (argc < 2) return tclcommand_lbboundary_print_all(interp);
if(!strncmp(argv[1], "wall", strlen(argv[1]))) {
status = tclcommand_lbboundary_wall(generate_lbboundary(),interp, argc - 2, argv + 2);
mpi_bcast_lbboundary(-1);
}
else if(!strncmp(argv[1], "sphere", strlen(argv[1]))) {
status = tclcommand_lbboundary_sphere(generate_lbboundary(),interp, argc - 2, argv + 2);
mpi_bcast_lbboundary(-1);
}
else if(!strncmp(argv[1], "cylinder", strlen(argv[1]))) {
status = tclcommand_lbboundary_cylinder(generate_lbboundary(),interp, argc - 2, argv + 2);
mpi_bcast_lbboundary(-1);
}
else if(!strncmp(argv[1], "pore", strlen(argv[1]))) {
status = tclcommand_lbboundary_pore(generate_lbboundary(),interp, argc - 2, argv + 2);
mpi_bcast_lbboundary(-1);
}
else if(!strncmp(argv[1], "force", strlen(argv[1]))) {
if (argc != 3 || Tcl_GetInt(interp, argv[2], &(c_num)) == TCL_ERROR) {
Tcl_AppendResult(interp, "Usage: lbboundary force $n",(char *) NULL);
return (TCL_ERROR);
}
if(c_num < 0 || c_num >= n_lb_boundaries) {
Tcl_AppendResult(interp, "Error in lbboundary force: The selected boundary does not exist",(char *) NULL);
return (TCL_ERROR);
} else {
status = lbboundary_get_force(c_num, force);
for (int i = 0; i < 3; i++) {
Tcl_PrintDouble(interp, force[i], buffer);
Tcl_AppendResult(interp, buffer, " ", (char *)NULL);
}
return TCL_OK;
}
}
else if(!strncmp(argv[1], "delete", strlen(argv[1]))) {
if(argc < 3) {
/* delete all */
mpi_bcast_lbboundary(-2);
status = TCL_OK;
}
else {
if(Tcl_GetInt(interp, argv[2], &(c_num)) == TCL_ERROR) return (TCL_ERROR);
if(c_num < 0 || c_num >= n_lb_boundaries) {
Tcl_AppendResult(interp, "Can not delete non existing lbboundary",(char *) NULL);
return (TCL_ERROR);
}
mpi_bcast_lbboundary(c_num);
status = TCL_OK;
}
}
else if (argc == 2 && Tcl_GetInt(interp, argv[1], &c_num) == TCL_OK) {
tclcommand_printLbBoundaryToResult(interp, c_num);
status = TCL_OK;
}
else {
Tcl_AppendResult(interp, "possible lb_boundaries: wall sphere cylinder lbboundary pore delete {c} to delete lbboundary or lb_boundaries",(char *) NULL);
return (TCL_ERROR);
}
// lb_init_boundaries();
return mpi_gather_runtime_errors(interp, status);
#else /* !defined(LB_BOUNDARIES) */
Tcl_AppendResult(interp, "LB_BOUNDARIES not compiled in!" ,(char *) NULL);
return (TCL_ERROR);
#endif /* LB_BOUNDARIES */
}
int tclcommand_setmd(ClientData data, Tcl_Interp *interp,
int argc, char **argv)
{
char databuf[MAX_DIMENSION*(sizeof(int) + sizeof(double))];
char buffer[TCL_DOUBLE_SPACE + 5];
int i, j;
int all = (argc == 1), writing = (argc >= 3);
/* loop over all global variables. Has two purposes:
either we write al variables or search for the one
to write */
for (i = 0; fields[i].data != NULL; i++) {
if (all || !strncmp(argv[1], fields[i].name, strlen(argv[1]))) {
if (!all) {
if ((int)strlen(argv[1]) < fields[i].min_length) {
Tcl_AppendResult(interp, "Argument \"",argv[1],"\" not long ", (char *) NULL);
Tcl_AppendResult(interp, "enough to identify a setmd variable!", (char *) NULL);
return (TCL_ERROR);
}
if (writing) {
/* set */
/* parse in data */
if (argc != 2 + fields[i].dimension) {
sprintf(buffer, "%d", fields[i].dimension);
Tcl_AppendResult(interp, "\"", argv[1],
"\" has dimension ",
buffer, (char *) NULL);
sprintf(buffer, " not %d", argc - 2);
Tcl_AppendResult(interp, buffer, (char *) NULL);
return (TCL_ERROR);
}
/* get new value */
for (j = 0; j < fields[i].dimension; j++) {
switch (fields[i].type) {
case TYPE_INT:
if (Tcl_GetInt(interp, argv[2 + j], (int *)databuf + j) == TCL_ERROR)
return (TCL_ERROR);
break;
case TYPE_BOOL: {
int dta;
if (Tcl_GetInt(interp, argv[2 + j], &dta))
return (TCL_ERROR);
if (dta)
*(int *)databuf |= (1L << j);
else
*(int *)databuf &= ~(1L << j);
break;
}
case TYPE_DOUBLE:
if (Tcl_GetDouble(interp, argv[2 + j], (double *)databuf + j))
return (TCL_ERROR);
break;
default: ;
}
}
if (fields[i].changeproc(interp, databuf) != TCL_OK)
return mpi_gather_runtime_errors(interp, TCL_ERROR);
/* fall through to write out the set value immediately again */
}
}
/* get */
if (all) {
if (i != 0)
Tcl_AppendResult(interp, " ", (char *)NULL);
Tcl_AppendResult(interp, "{", fields[i].name, " ", (char *)NULL);
}
for (j = 0; j < fields[i].dimension; j++) {
switch (fields[i].type) {
case TYPE_INT:
sprintf(buffer, "%d", ((int *)fields[i].data)[j]);
break;
case TYPE_BOOL: {
if ((*(int *)fields[i].data) & (1L << j))
strcpy(buffer, "1");
else
strcpy(buffer, "0");
break;
}
case TYPE_DOUBLE:
Tcl_PrintDouble(interp, ((double *)fields[i].data)[j], buffer);
break;
default: ;
}
Tcl_AppendResult(interp, buffer, (char *) NULL);
if (j < fields[i].dimension - 1)
Tcl_AppendResult(interp, " ", (char *) NULL);
}
if (all)
Tcl_AppendResult(interp, "}", (char *)NULL);
/* wrote out one value, so skip rest */
if (!all) {
if (writing)
return mpi_gather_runtime_errors(interp, TCL_OK);
else
return (TCL_OK);
}
}
}
if (all)
return TCL_OK;
Tcl_AppendResult(interp, "unknown md variable \"",
argv[1], "\"", (char *) NULL);
return (TCL_ERROR);
}
