int tclcommand_nemd(ClientData data, Tcl_Interp *interp, int argc,
char **argv) {
#ifdef NEMD
int status = TCL_OK;
INTEG_TRACE(fprintf(stderr, "%d: nemd:\n", this_node));
Tcl_ResetResult(interp);
/* print nemd status */
if (argc == 1) {
status = tclcommand_nemd_print_status(interp);
} else if (ARG1_IS_S("off")) {
nemd_method = NEMD_METHOD_OFF;
status = nemd_free();
} else if (ARG1_IS_S("exchange")) {
status = tclcommand_nemd_parse_exchange(interp, argc, argv);
} else if (ARG1_IS_S("shearrate")) {
status = tclcommand_nemd_parse_shearrate(interp, argc, argv);
} else if (ARG1_IS_S("profile")) {
status = tclcommand_nemd_parse_and_print_profile(interp);
} else if (ARG1_IS_S("viscosity")) {
status = tclcommand_nemd_parse_and_print_viscosity(interp);
} else {
Tcl_AppendResult(interp, "Unkwnown keyword: \n", (char *)NULL);
return tclcommand_nemd_print_usage(interp);
}
return gather_runtime_errors(interp, status);
#endif
INTEG_TRACE(
fprintf(stderr, "%d: call to nemd but not compiled in!\n", this_node));
return tclcommand_nemd_print_usage(interp);
}
int tclcommand_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 gather_runtime_errors(interp, TCL_OK);
}
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_ghmc(ClientData data, Tcl_Interp *interp, int argc, char **argv)
{
#ifdef GHMC
int status = TCL_OK;
THERMO_TRACE(fprintf(stderr,"%d: ghmc:\n",this_node));
Tcl_ResetResult(interp);
/* print ghmc status */
if(argc == 1) {
status = tclcommand_ghmc_print_status(interp) ;
}
else if (ARG1_IS_S("statistics")) {
status = tclcommand_ghmc_print_statistics(interp);
}
else {
Tcl_AppendResult(interp, "Unknown keyword: \n", (char *)NULL);
status = tclcommand_ghmc_print_usage(interp);
}
return status;
#else
INTEG_TRACE(fprintf(stderr,"%d: call to ghmc but not compiled in!\n",this_node));
return tclcommand_ghmc_print_usage(interp);
#endif
}
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 gather_runtime_errors(interp, err);
}
int tclcommand_metadynamics_print_stat(Tcl_Interp *interp, int argc, char **argv)
{
int j;
char buffer[TCL_DOUBLE_SPACE];
/* In case nothing has been initialized yet */
if (meta_acc_fprofile == NULL) return (TCL_OK);
argc -= 1; argv += 1;
if ( ARG1_IS_S("current_coord") ) {
/* Current value of the reaction coordinate */
Tcl_PrintDouble(interp, meta_val_xi, buffer);
Tcl_AppendResult(interp,"",buffer, (char *)NULL);
} else if ( ARG1_IS_S("coord_values") ) {
/* Possible values of the reaction coordinate */
for (j = 0; j < meta_xi_num_bins; ++j) {
Tcl_PrintDouble(interp, meta_xi_min+j*meta_xi_step, buffer);
Tcl_AppendResult(interp,buffer," ", (char *)NULL);
}
} else if ( ARG1_IS_S("profile") ) {
/* Values of the free energy profile */
for (j = 0; j < meta_xi_num_bins; ++j) {
Tcl_PrintDouble(interp, meta_acc_fprofile[j], buffer);
Tcl_AppendResult(interp,buffer," ", (char *)NULL);
}
} else if ( ARG1_IS_S("force") ) {
/* Values of the biased force */
for (j = 0; j < meta_xi_num_bins; ++j) {
Tcl_PrintDouble(interp, -1.*meta_acc_force[j], buffer);
Tcl_AppendResult(interp,buffer," ", (char *)NULL);
}
} else {
Tcl_AppendResult(interp, "Unknown option for 'metadynamics print_stat'", (char *)NULL);
return (TCL_ERROR);
}
return (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_external_potential(ClientData _data, Tcl_Interp *interp,
int argc, char **argv) {
ExternalPotential* e;
int error = generate_external_potential(&e);
if (error == ES_ERROR)
return TCL_ERROR;
if (argc<2) {
Tcl_AppendResult(interp, "Usage: external_potential <tabulate|rod|...>\n" , (char *)NULL);
return TCL_ERROR;
}
if (ARG1_IS_S("tabulated")) {
return tclcommand_external_potential_tabulated(interp, argc-2, argv+2, e);
}
Tcl_AppendResult(interp, "Usage: external_potential <tabulate|rod|...>\n" , (char *)NULL);
return TCL_ERROR;
}
int tclcommand_lbfluid(ClientData data, Tcl_Interp *interp, int argc, char **argv) {
#if defined (LB) || defined (LB_GPU)
argc--; argv++;
/**if we have LB the LB cpu is set by default */
#ifdef LB
if(!(lattice_switch & LATTICE_LB_GPU)) lattice_switch = lattice_switch | LATTICE_LB;
#else
lattice_switch = lattice_switch | LATTICE_LB_GPU;
#endif
int err = TCL_OK;
double floatarg;
#ifdef EXTERNAL_FORCES
double vectarg[3];
#endif
if (argc < 1) {
lbfluid_tcl_print_usage(interp);
return TCL_ERROR;
}
else if (ARG0_IS_S("off")) {
lbfluid_tcl_print_usage(interp);
return TCL_ERROR;
}
else if (ARG0_IS_S("init")) {
lbfluid_tcl_print_usage(interp);
return TCL_ERROR;
}
else
while (argc > 0) {
if (ARG0_IS_S("gpu") || ARG0_IS_S("GPU")) {
#ifdef LB_GPU
lattice_switch = (lattice_switch &~ LATTICE_LB) | LATTICE_LB_GPU;
argc--; argv++;
#else
Tcl_AppendResult(interp, "LB_GPU is not compiled in!", NULL);
return TCL_ERROR;
#endif
}
else if (ARG0_IS_S("cpu") || ARG0_IS_S("CPU")) {
#ifdef LB
lattice_switch = (lattice_switch & ~LATTICE_LB_GPU) | LATTICE_LB;
argc--; argv++;
#else
Tcl_AppendResult(interp, "LB is not compiled in!", NULL);
return TCL_ERROR;
#endif
}
else if (ARG0_IS_S("density") || ARG0_IS_S("dens")) {
if ( argc < 2 || !ARG1_IS_D(floatarg) ) {
Tcl_AppendResult(interp, "dens requires 1 argument", (char *)NULL);
return TCL_ERROR;
} else if (floatarg <= 0) {
Tcl_AppendResult(interp, "dens must be positive", (char *)NULL);
return TCL_ERROR;
} else {
if ( lb_lbfluid_set_density(floatarg) == 0 ) {
argc-=2; argv+=2;
} else {
Tcl_AppendResult(interp, "Unknown Error setting dens", (char *)NULL);
return TCL_ERROR;
}
}
}
else if (ARG0_IS_S("grid") || ARG0_IS_S("agrid")) {
if ( argc < 2 || !ARG1_IS_D(floatarg) ) {
Tcl_AppendResult(interp, "agrid requires 1 argument", (char *)NULL);
return TCL_ERROR;
} else if (floatarg <= 0) {
Tcl_AppendResult(interp, "agrid must be positive", (char *)NULL);
return TCL_ERROR;
} else if (0) {
// agrid is not compatible with box_l;
// Not necessary because this is caught on the mpi level!
} else {
if ( lb_lbfluid_set_agrid(floatarg) == 0 ) {
argc-=2; argv+=2;
} else {
Tcl_AppendResult(interp, "Unknown Error setting agrid", (char *)NULL);
return TCL_ERROR;
}
}
}
else if (ARG0_IS_S("tau")) {
if ( argc < 2 || !ARG1_IS_D(floatarg) ) {
Tcl_AppendResult(interp, "tau requires 1 argument", (char *)NULL);
return TCL_ERROR;
} else if (floatarg <= 0) {
Tcl_AppendResult(interp, "tau must be positive", (char *)NULL);
return TCL_ERROR;
} else if (floatarg < time_step ) {
Tcl_AppendResult(interp, "tau must larger than the MD time step", (char *)NULL);
return TCL_ERROR;
} else {
if ( lb_lbfluid_set_tau(floatarg) == 0 ) {
argc-=2; argv+=2;
} else {
Tcl_AppendResult(interp, "Unknown Error setting tau", (char *)NULL);
return TCL_ERROR;
}
}
}
else if (ARG0_IS_S("viscosity") || ARG0_IS_S("visc")) {
if ( argc < 2 || !ARG1_IS_D(floatarg) ) {
Tcl_AppendResult(interp, "visc requires 1 argument", (char *)NULL);
return TCL_ERROR;
} else if (floatarg <= 0) {
Tcl_AppendResult(interp, "visc must be positive", (char *)NULL);
return TCL_ERROR;
} else {
if ( lb_lbfluid_set_visc(floatarg) == 0 ) {
argc-=2; argv+=2;
} else {
Tcl_AppendResult(interp, "Unknown Error setting viscosity", (char *)NULL);
return TCL_ERROR;
}
}
}
else if (ARG0_IS_S("bulk_viscosity")) {
if ( argc < 2 || !ARG1_IS_D(floatarg) ) {
Tcl_AppendResult(interp, "bulk_visc requires 1 argument", (char *)NULL);
return TCL_ERROR;
} else if (floatarg <= 0) {
Tcl_AppendResult(interp, "bulk_visc must be positive", (char *)NULL);
return TCL_ERROR;
} else {
if ( lb_lbfluid_set_bulk_visc(floatarg) == 0 ) {
argc-=2; argv+=2;
} else {
Tcl_AppendResult(interp, "Unknown Error setting bulk_viscosity", (char *)NULL);
return TCL_ERROR;
}
}
}
else if (ARG0_IS_S("friction") || ARG0_IS_S("coupling")) {
if ( argc < 2 || !ARG1_IS_D(floatarg) ) {
Tcl_AppendResult(interp, "friction requires 1 argument", (char *)NULL);
return TCL_ERROR;
} else if (floatarg <= 0) {
Tcl_AppendResult(interp, "friction must be positive", (char *)NULL);
return TCL_ERROR;
} else {
if ( lb_lbfluid_set_friction(floatarg) == 0 ) {
argc-=2; argv+=2;
} else {
Tcl_AppendResult(interp, "Unknown Error setting friction", (char *)NULL);
return TCL_ERROR;
}
}
}
else if (ARG0_IS_S("ext_force")) {
#ifdef EXTERNAL_FORCES
if ( argc < 4 || !ARG_IS_D(1, vectarg[0]) || !ARG_IS_D(2, vectarg[1]) || !ARG_IS_D(3, vectarg[2]) ) {
Tcl_AppendResult(interp, "friction requires 1 argument", (char *)NULL);
return TCL_ERROR;
} else if (lb_lbfluid_set_ext_force(vectarg[0], vectarg[1], vectarg[2]) == 0) {
argc-=4; argv+=4;
} else {
Tcl_AppendResult(interp, "Unknown Error setting ext_force", (char *)NULL);
return TCL_ERROR;
}
#else
Tcl_AppendResult(interp, "External Forces not compiled in!", (char *)NULL);
return TCL_ERROR;
#endif
}
else if (ARG0_IS_S("gamma_odd")) {
if ( argc < 2 || !ARG1_IS_D(floatarg) ) {
Tcl_AppendResult(interp, "gamma_odd requires 1 argument", (char *)NULL);
return TCL_ERROR;
} else if (fabs(floatarg) >= 1) {
Tcl_AppendResult(interp, "gamma_odd must < 1", (char *)NULL);
return TCL_ERROR;
} else {
if ( lb_lbfluid_set_gamma_odd(floatarg) == 0 ) {
argc-=2; argv+=2;
} else {
Tcl_AppendResult(interp, "Unknown Error setting gamma_odd", (char *)NULL);
return TCL_ERROR;
}
}
}
else if (ARG0_IS_S("gamma_even")) {
if ( argc < 2 || !ARG1_IS_D(floatarg) ) {
Tcl_AppendResult(interp, "gamma_even requires 1 argument", (char *)NULL);
return TCL_ERROR;
} else if (fabs(floatarg) >= 1) {
Tcl_AppendResult(interp, "gamma_even must < 1", (char *)NULL);
return TCL_ERROR;
} else {
if ( lb_lbfluid_set_gamma_even(floatarg) == 0 ) {
argc-=2; argv+=2;
} else {
Tcl_AppendResult(interp, "Unknown Error setting gamma_even", (char *)NULL);
return TCL_ERROR;
}
}
}
else if (ARG0_IS_S("print")) {
if ( argc < 3 || (ARG1_IS_S("vtk") && argc < 4) ) {
Tcl_AppendResult(interp, "lbfluid print requires at least 2 arguments. Usage: lbfluid print [vtk] velocity|boundary filename", (char *)NULL);
return TCL_ERROR;
}
else {
argc--; argv++;
if (ARG0_IS_S("vtk")) {
if (ARG1_IS_S("boundary")) {
if ( lb_lbfluid_print_vtk_boundary(argv[2]) != 0 ) {
Tcl_AppendResult(interp, "Unknown Error at lbfluid print vtk boundary", (char *)NULL);
return TCL_ERROR;
}
}
else if (ARG1_IS_S("velocity")) {
if ( lb_lbfluid_print_vtk_velocity(argv[2]) != 0 ) {
Tcl_AppendResult(interp, "Unknown Error at lbfluid print vtk velocity", (char *)NULL);
return TCL_ERROR;
}
}
else {
return TCL_ERROR;
}
argc-=3; argv+=3;
}
else {
if (ARG0_IS_S("boundary")) {
if ( lb_lbfluid_print_boundary(argv[1]) != 0 ) {
Tcl_AppendResult(interp, "Unknown Error at lbfluid print boundary", (char *)NULL);
return TCL_ERROR;
}
}
else if (ARG0_IS_S("velocity")) {
if ( lb_lbfluid_print_velocity(argv[1]) != 0 ) {
Tcl_AppendResult(interp, "Unknown Error at lbfluid print velocity", (char *)NULL);
return TCL_ERROR;
}
}
else {
return TCL_ERROR;
}
argc-=2; argv+=2;
}
}
}
else if (ARG0_IS_S("save_ascii_checkpoint")) {
if (argc < 2) {
Tcl_AppendResult(interp, "usage: lbfluid save_ascii_checkpoint <filename>", (char *)NULL);
return TCL_ERROR;
} else {
return lb_lbfluid_save_checkpoint(argv[1], 0);
}
}
else if (ARG0_IS_S("save_binary_checkpoint")) {
if (argc < 2) {
Tcl_AppendResult(interp, "usage: lbfluid save_binary_checkpoint <filename>", (char *)NULL);
return TCL_ERROR;
} else {
return lb_lbfluid_save_checkpoint(argv[1], 1);
}
}
else if (ARG0_IS_S("load_ascii_checkpoint")) {
if (argc < 2) {
Tcl_AppendResult(interp, "usage: lbfluid load_ascii_checkpoint <filename>", (char *)NULL);
return TCL_ERROR;
} else {
return lb_lbfluid_load_checkpoint(argv[1], 0);
}
}
else if (ARG0_IS_S("load_binary_checkpoint")) {
if (argc < 2) {
Tcl_AppendResult(interp, "usage: lbfluid load_binary_checkpoint <filename>", (char *)NULL);
return TCL_ERROR;
} else {
return lb_lbfluid_load_checkpoint(argv[1], 1);
}
}
#ifdef LB
else if (ARG0_IS_S("print_interpolated_velocity")) { //this has to come after print
return tclcommand_lbfluid_print_interpolated_velocity(interp, argc-1, argv+1);
}
#endif
else {
Tcl_AppendResult(interp, "unknown feature \"", argv[0],"\" of lbfluid", (char *)NULL);
return TCL_ERROR ;
}
if ((err = gather_runtime_errors(interp, err)) != TCL_OK)
return TCL_ERROR;
}
mpi_bcast_parameter(FIELD_LATTICE_SWITCH);
/* thermo_switch is retained for backwards compatibility */
thermo_switch = (thermo_switch | THERMO_LB);
mpi_bcast_parameter(FIELD_THERMO_SWITCH);
return TCL_OK;
#else /* !defined LB */
Tcl_AppendResult(interp, "LB is not compiled in!", NULL);
return TCL_ERROR;
#endif
}
int tclcommand_adress_parse_set(Tcl_Interp *interp,int argc, char **argv){
int topo=-1,i,wf=0,set_center=0;
double width[2],center[3];
char buffer[3*TCL_DOUBLE_SPACE];
argv+=2;argc-=2;
for(i=0;i<3;i++) center[i]=box_l[i]/2;
if (argc < 2) {
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "Wrong # of args! adress set needs at least 2 arguments\n", (char *)NULL);
Tcl_AppendResult(interp, "Usage: adress set topo [0|1|2|3] width X.X Y.Y (center X.X Y.Y Z.Z) (wf [0|1])\n", (char *)NULL);
Tcl_AppendResult(interp, "topo: 0 - switched off (no more values needed)\n", (char *)NULL);
Tcl_AppendResult(interp, " 1 - constant (weight will be first value of width)\n", (char *)NULL);
Tcl_AppendResult(interp, " 2 - divided in one direction (default x, or give a negative center coordinate\n", (char *)NULL);
Tcl_AppendResult(interp, " 3 - spherical topology\n", (char *)NULL);
Tcl_AppendResult(interp, "width: X.X - half of size of ex zone(r0/2 in the papers)\n", (char *)NULL);
Tcl_AppendResult(interp, " Y.Y - size of hybrid zone (d in the papers)\n", (char *)NULL);
Tcl_AppendResult(interp, " Note: Only one value need for topo 1 \n", (char *)NULL);
Tcl_AppendResult(interp, "center: center of the ex zone (default middle of the box) \n", (char *)NULL);
Tcl_AppendResult(interp, " Note: x|y|x X.X for topo 2 \n", (char *)NULL);
Tcl_AppendResult(interp, " Note: X.X Y.Y Z.Z for topo 3 \n", (char *)NULL);
Tcl_AppendResult(interp, "wf: 0 - cos weighting function (default)\n", (char *)NULL);
Tcl_AppendResult(interp, " 1 - polynom weighting function\n", (char *)NULL);
Tcl_AppendResult(interp, "ALWAYS set box_l first !!!", (char *)NULL);
return (TCL_ERROR);
}
//parse topo
if ( (argc<2) || (!ARG0_IS_S("topo")) || (!ARG1_IS_I(topo)) || (topo < 0) || (topo > 3) ) {
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "expected \'topo 0|1|2|3\'\n", (char *)NULL);
return (TCL_ERROR);
}
argv+=2;argc-=2;
//stop if topo is 0
if (topo==0) {
adress_vars[0]=0.0;
mpi_bcast_parameter(FIELD_ADRESS);
return TCL_OK;
}
//parse width
if ( (argc>1) && (ARG0_IS_S("width")) ) {
if (topo==1) {
if ( (!ARG1_IS_D(width[0])) || (width[0]<0) ){
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "expected \'width X.X (X.X non-negative)\'", (char *)NULL);
return (TCL_ERROR);
}
if ((width[0]> 1.0) || (width[0]< 0.0)) {
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "for constant topo, first width must be between 0 and 1", (char *)NULL);
return (TCL_ERROR);
}
//stop if topo is 1
adress_vars[0]=1;
adress_vars[1]=width[0];
mpi_bcast_parameter(FIELD_ADRESS);
return TCL_OK;
}
else {//topo 2 and 3 are left over
if ( (argc<3) || (!ARG1_IS_D(width[0])) || (width[0]<0) ||(!ARG_IS_D(2,width[1])) || (width[1]<0) ){
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "expected \'width X.X Y.Y (both non-negative)\'", (char *)NULL);
return (TCL_ERROR);
}
argv+=3;argc-=3;
}
}
else{
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "expected \'width\'", (char *)NULL);
return (TCL_ERROR);
}
while (argc!=0){
if (ARG0_IS_S("wf")){
if ( (argc<2) || (!ARG1_IS_I(wf)) || (wf < 0) || (wf > 1) ){
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "expected \'wf 0|1\'", (char *)NULL);
return (TCL_ERROR);
}
else{
argv+=2;argc-=2;
}
}
else if (ARG0_IS_S("center")){
if (topo == 2) {
if ( (argc<3) || ( (!ARG1_IS_S("x"))&&(!ARG1_IS_S("y"))&&(!ARG1_IS_S("z")) ) || (!ARG_IS_D(2,center[1])) ){
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "expected \'center x|y|z X.X\'", (char *)NULL);
return (TCL_ERROR);
}
if (ARG1_IS_S("x")) center[0]=0;
else if (ARG1_IS_S("y")) center[0]=1;
else center[0]=2;
if ( (center[1]<0) || (center[1]>box_l[(int)center[0]]) ) {
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "The center component is outside the box", (char *)NULL);
return (TCL_ERROR);
}
set_center=1;
argv+=3;argc-=3;
}
else { //topo 3
if ( (argc<4) || (!ARG_IS_D(1,center[0])) || (!ARG_IS_D(2,center[1])) || (!ARG_IS_D(3,center[2])) ){
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "expected \'center X.X Y.Y Z.Z\'", (char *)NULL);
return (TCL_ERROR);
}
argv+=4;argc-=4;
//check components of center
for (i=0;i<3;i++){
if ( (center[i]<0)||(center[i]>box_l[i]) ){
Tcl_ResetResult(interp);
sprintf(buffer,"%i",i);
Tcl_AppendResult(interp, "The ",buffer," th component of center is outside the box\n", (char *)NULL);
return (TCL_ERROR);
}
}
}
}
else{
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "The unknown operation \"", argv[0],"\".", (char *)NULL);
return (TCL_ERROR);
}
}
//set standard center value for topo 2
if ((topo==2) && (set_center==0) ) center[0]=0;
//width check
if (topo==2){
if (width[0]+width[1]>box_l[(int)center[0]]/2){
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "The width of ex+hy must smaller than box_l/2\n", (char *)NULL);
return (TCL_ERROR);
}
}
else if (topo==3){
for (i=0;i<3;i++){
if (width[0]+width[1]>box_l[i]/2){
Tcl_ResetResult(interp);
sprintf(buffer,"%i",i);
Tcl_AppendResult(interp, "The width of ex+hy must smaller than box_l/2 in dim " ,buffer,"\n", (char *)NULL);
return (TCL_ERROR);
}
}
}
adress_vars[0]=topo;
adress_vars[1]=width[0];
adress_vars[2]=width[1];
adress_vars[3]=center[0];
adress_vars[4]=center[1];
adress_vars[5]=center[2];
adress_vars[6]=wf;
mpi_bcast_parameter(FIELD_ADRESS);
return TCL_OK;
}
int tclcommand_integrate(ClientData data, Tcl_Interp *interp, int argc,
char **argv) {
int n_steps, reuse_forces = 0;
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);
// actual integration
if ((argc == 3) && ARG_IS_S(2, "reuse_forces")) {
reuse_forces = 1;
} else if ((argc == 3) && ARG_IS_S(2, "recalc_forces")) {
reuse_forces = -1;
} else if (argc != 2)
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);
;
}
/* if skin wasn't set, do an educated guess now */
if (!skin_set) {
if (max_cut == 0.0) {
Tcl_AppendResult(interp, "cannot automatically determine skin, please "
"set it manually via \"setmd skin\"\n",
(char *)NULL);
return TCL_ERROR;
}
skin = 0.4 * max_cut;
mpi_bcast_parameter(FIELD_SKIN);
}
/* perform integration */
if (!correlations_autoupdate && !observables_autoupdate) {
if (mpi_integrate(n_steps, reuse_forces))
return gather_runtime_errors(interp, TCL_OK);
} else {
for (int i = 0; i < n_steps; i++) {
if (mpi_integrate(1, reuse_forces))
return gather_runtime_errors(interp, TCL_OK);
reuse_forces = 1;
autoupdate_observables();
autoupdate_correlations();
}
if (n_steps == 0) {
if (mpi_integrate(0, reuse_forces))
return gather_runtime_errors(interp, TCL_OK);
}
}
return TCL_OK;
}
int tclcommand_imd(ClientData data, Tcl_Interp *interp,
int argc, char **argv)
{
if (argc < 2) {
Tcl_AppendResult(interp, "wrong # args: should be \"",
argv[0], " connect|disconnect|listen|positions|energies ?values?\"",
(char *) NULL);
return (TCL_ERROR);
}
if (ARG1_IS_S("connect")) {
/* connect to vmd */
int port = 12346;
if (argc > 3) {
Tcl_AppendResult(interp, "wrong # args: should be \"",
argv[0], " connect ?port?\"",
(char *) NULL);
return (TCL_ERROR);
}
if (argc == 3)
if (!ARG_IS_I(2, port))
return (TCL_ERROR);
if (sock)
vmdsock_destroy(sock);
if (initsock)
vmdsock_destroy(initsock);
sock = 0;
initsock = 0;
vmdsock_init();
initsock = vmdsock_create();
if (vmdsock_bind(initsock, port) != 0) {
Tcl_AppendResult(interp, "IMD bind failed. Port already in use ?",
(char *) NULL);
vmdsock_destroy(initsock);
initsock = 0;
return (TCL_ERROR);
}
if (vmdsock_listen(initsock)) {
Tcl_AppendResult(interp, "IMD listen failed. Port already in use ?",
(char *) NULL);
vmdsock_destroy(initsock);
initsock = 0;
return (TCL_ERROR);
}
return (TCL_OK);
}
if (ARG1_IS_S("disconnect")) {
if (argc > 2) {
Tcl_AppendResult(interp, "wrong # args: should be \"",
argv[0], " disconnect\"",
(char *) NULL);
return (TCL_ERROR);
}
if (sock)
vmdsock_destroy(sock);
if (initsock)
vmdsock_destroy(initsock);
sock = 0;
initsock = 0;
Tcl_AppendResult(interp, "no connection",
(char *) NULL);
return (TCL_OK);
}
if (ARG1_IS_S("listen")) {
/* wait until vmd connects */
int cnt = 3600;
if (argc != 3) {
Tcl_AppendResult(interp, "wrong # args: should be \"",
argv[0], " listen <secs>\"",
(char *) NULL);
return (TCL_ERROR);
}
if (!ARG_IS_I(2, cnt))
return (TCL_ERROR);
while (initsock && !sock && cnt--) {
if (tclcommand_imd_print_check_connect(interp) == TCL_ERROR)
return (TCL_ERROR);
sleep(1);
}
if (!sock)
Tcl_AppendResult(interp, "no connection",
(char *) NULL);
else {
if (tclcommand_imd_print_drain_socket(interp) == TCL_ERROR)
return (TCL_ERROR);
Tcl_AppendResult(interp, "connected",
(char *) NULL);
}
return (TCL_OK);
}
if (ARG1_IS_S("positions"))
return tclcommand_imd_parse_pos(interp, argc, argv);
if (ARG1_IS_S("energies")) {
Tcl_AppendResult(interp, "Sorry. imd energies not yet implemented",
(char *) NULL);
return (TCL_ERROR);
}
Tcl_AppendResult(interp, "imd: unkown job.",
(char *) NULL);
return (TCL_ERROR);
}
int tclcommand_inter_coulomb_parse_p3m_opt_params(Tcl_Interp * interp, int argc, char ** argv)
{
int i; double d1, d2, d3;
Tcl_ResetResult(interp);
while (argc > 0) {
/* p3m parameter: inter */
if (ARG0_IS_S("n_interpol")) {
if(argc < 2) {
Tcl_AppendResult(interp, argv[0], " needs 1 parameter",
(char *) NULL);
return TCL_ERROR;
}
if (! ARG1_IS_I(i)) {
Tcl_AppendResult(interp, argv[0], " needs 1 INTEGER parameter",
(char *) NULL);
return TCL_ERROR;
}
if (p3m_set_ninterpol(i) == TCL_ERROR) {
Tcl_AppendResult(interp, argv[0], " argument must be positive",
(char *) NULL);
return TCL_ERROR;
}
argc -= 2;
argv += 2;
}
/* p3m parameter: mesh_off */
else if (ARG0_IS_S("mesh_off")) {
if(argc < 4) {
Tcl_AppendResult(interp, argv[0], " needs 3 parameters",
(char *) NULL);
return TCL_ERROR;
}
if ((! ARG_IS_D(1, d1)) ||
(! ARG_IS_D(2, d2)) ||
(! ARG_IS_D(3, d3)))
{
Tcl_AppendResult(interp, argv[0], " needs 3 DOUBLE parameters",
(char *) NULL);
return TCL_ERROR;
}
if (p3m_set_mesh_offset(d1, d2 ,d3) == TCL_ERROR)
{
Tcl_AppendResult(interp, argv[0], " parameters have to be between 0.0 an 1.0",
(char *) NULL);
return TCL_ERROR;
}
argc -= 4;
argv += 4;
}
/* p3m parameter: epsilon */
else if(ARG0_IS_S( "epsilon")) {
if(argc < 2) {
Tcl_AppendResult(interp, argv[0], " needs 1 parameter",
(char *) NULL);
return TCL_ERROR;
}
if (ARG1_IS_S("metallic")) {
d1 = P3M_EPSILON_METALLIC;
}
else if (! ARG1_IS_D(d1)) {
Tcl_AppendResult(interp, argv[0], " needs 1 DOUBLE parameter or \"metallic\"",
(char *) NULL);
return TCL_ERROR;
}
if (p3m_set_eps(d1) == TCL_ERROR) {
Tcl_AppendResult(interp, argv[0], " There is no error msg yet!",
(char *) NULL);
return TCL_ERROR;
}
argc -= 2;
argv += 2;
}
else {
Tcl_AppendResult(interp, "Unknown coulomb p3m parameter: \"",argv[0],"\"",(char *) NULL);
return TCL_ERROR;
}
}
return TCL_OK;
}
int tclcommand_thermostat(ClientData data, Tcl_Interp *interp, int argc, char **argv)
{
int err = TCL_OK;
THERMO_TRACE(fprintf(stderr,"%d: thermostat:\n",this_node));
/* print thermostat status */
if(argc == 1) return tclcommand_thermostat_print_all(interp);
if ( ARG1_IS_S("set") ) {
argc--;
argv++;
if (argc == 1) {
Tcl_AppendResult(interp, "wrong # args: \n", (char *)NULL);
return tclcommand_thermostat_print_usage(interp, argc, argv);
}
}
if ( ARG1_IS_S("off") )
err = tclcommand_thermostat_parse_off(interp, argc, argv);
else if ( ARG1_IS_S("langevin"))
err = tclcommand_thermostat_parse_langevin(interp, argc, argv);
#ifdef DPD
else if ( ARG1_IS_S("dpd") )
err = tclcommand_thermostat_parse_dpd(interp, argc, argv);
#endif
#ifdef INTER_DPD
else if ( ARG1_IS_S("inter_dpd") )
err = tclcommand_thermostat_parse_inter_dpd(interp, argc, argv);
#endif
#ifdef NPT
else if ( ARG1_IS_S("npt_isotropic") )
err = tclcommand_thermostat_parse_npt_isotropic(interp, argc, argv);
#endif
#if defined(LB) || defined(LB_GPU)
else if ( ARG1_IS_S("lb"))
err = tclcommand_thermostat_parse_lb(interp, argc-1, argv+1);
#endif
#ifdef GHMC
else if ( ARG1_IS_S("ghmc") )
err = tclcommand_thermostat_parse_ghmc(interp, argc, argv);
#endif
else if ( ARG1_IS_S("cpu"))
err = tclcommand_thermostat_parse_cpu(interp, argc, argv);
#if defined(SD) || defined(BD)
#ifdef SD
else if ( ARG1_IS_S("sd") )
err = tclcommand_thermostat_parse_sd(interp, argc, argv);
#endif // SD
else if ( ARG1_IS_S("bd") )
err = tclcommand_thermostat_parse_bd(interp, argc, argv);
#endif //SD || BD
else {
Tcl_AppendResult(interp, "Unknown thermostat ", argv[1], "\n", (char *)NULL);
return tclcommand_thermostat_print_usage(interp, argc, argv);
}
return gather_runtime_errors(interp, err);
}
int tclcommand_observable(ClientData data, Tcl_Interp *interp, int argc, char **argv){
// file_data_source* fds;
char buffer[TCL_INTEGER_SPACE];
int n;
int id;
int temp;
//int no;
if (argc<2) {
Tcl_AppendResult(interp, "Usage!!!\n", (char *)NULL);
return TCL_ERROR;
}
if (argc > 1 && ARG_IS_S(1, "n_observables")) {
sprintf(buffer, "%d", n_observables);
Tcl_AppendResult(interp, buffer, (char *)NULL );
return TCL_OK;
}
// if (argc > 1 && ARG1_IS_I(no)) {
// }
if (argc > 2 && ARG1_IS_S("new") ) {
// find the next free observable id
for (id=0;id<n_observables;id++)
if ( observables+id == 0 ) break;
if (id==n_observables)
observables=(observable**) realloc(observables, (n_observables+1)*sizeof(observable*));
REGISTER_OBSERVABLE(particle_velocities, tclcommand_observable_particle_velocities,id);
REGISTER_OBSERVABLE(particle_angular_momentum, tclcommand_observable_particle_angular_momentum,id);
REGISTER_OBSERVABLE(particle_forces, tclcommand_observable_particle_forces,id);
REGISTER_OBSERVABLE(com_velocity, tclcommand_observable_com_velocity,id);
REGISTER_OBSERVABLE(com_position, tclcommand_observable_com_position,id);
REGISTER_OBSERVABLE(com_force, tclcommand_observable_com_force,id);
REGISTER_OBSERVABLE(particle_positions, tclcommand_observable_particle_positions,id);
REGISTER_OBSERVABLE(stress_tensor, tclcommand_observable_stress_tensor,id);
REGISTER_OBSERVABLE(stress_tensor_acf_obs, tclcommand_observable_stress_tensor_acf_obs,id);
REGISTER_OBSERVABLE(particle_currents, tclcommand_observable_particle_currents,id);
REGISTER_OBSERVABLE(currents, tclcommand_observable_currents,id);
REGISTER_OBSERVABLE(dipole_moment, tclcommand_observable_dipole_moment,id);
// REGISTER_OBSERVABLE(structure_factor, tclcommand_observable_structure_factor,id);
REGISTER_OBSERVABLE(interacts_with, tclcommand_observable_interacts_with,id);
// REGISTER_OBSERVABLE(obs_nothing, tclcommand_observable_obs_nothing,id);
// REGISTER_OBSERVABLE(flux_profile, tclcommand_observable_flux_profile,id);
REGISTER_OBSERVABLE(density_profile, tclcommand_observable_density_profile,id);
REGISTER_OBSERVABLE(lb_velocity_profile, tclcommand_observable_lb_velocity_profile,id);
REGISTER_OBSERVABLE(radial_density_profile, tclcommand_observable_radial_density_profile,id);
REGISTER_OBSERVABLE(radial_flux_density_profile, tclcommand_observable_radial_flux_density_profile,id);
REGISTER_OBSERVABLE(flux_density_profile, tclcommand_observable_flux_density_profile,id);
REGISTER_OBSERVABLE(lb_radial_velocity_profile, tclcommand_observable_lb_radial_velocity_profile,id);
REGISTER_OBSERVABLE(tclcommand, tclcommand_observable_tclcommand,id);
Tcl_AppendResult(interp, "Unknown observable ", argv[2] ,"\n", (char *)NULL);
return TCL_ERROR;
}
if (ARG1_IS_I(n)) {
if (n>=n_observables || observables+n == NULL ) {
sprintf(buffer,"%d \n",n);
Tcl_AppendResult(interp, "Observable with id ", buffer, (char *)NULL);
Tcl_AppendResult(interp, "is not defined\n", (char *)NULL);
return TCL_ERROR;
}
if (argc > 2 && ARG_IS_S(2,"print")) {
return tclcommand_observable_print(interp, argc-3, argv+3, &temp, observables[n]);
}
}
Tcl_AppendResult(interp, "Unknown observable ", argv[1] ,"\n", (char *)NULL);
return TCL_ERROR;
}
int tclcommand_bin(ClientData cdata, Tcl_Interp *interp,
int argc, char **argv)
{
DoubleList coords, data, count, sum, bins;
int i, num_bins, give_bincounts = 0;
double min_bin, max_bin, contr;
int w, s, e, c;
char buffer[2 + TCL_DOUBLE_SPACE];
init_doublelist(&coords);
init_doublelist(&data);
init_doublelist(&sum);
init_doublelist(&bins);
/* type of the binning */
if (argc > 1 && ARG1_IS_S("-stats")) {
give_bincounts = 1;
argc -= 1; argv += 1;
}
/* type of the binning */
if (argc > 2 && ARG1_IS_S("-bins")) {
if (!ARG_IS_DOUBLELIST(2, bins))
return TCL_ERROR;
argc -= 2; argv += 2;
}
else if (argc > 4 &&
(ARG1_IS_S("-linbins") || ARG1_IS_S("-logbins"))) {
if (!ARG_IS_D(2, min_bin) ||
!ARG_IS_D(3, max_bin) ||
!ARG_IS_I(4, num_bins))
return TCL_ERROR;
/* swap if necessary */
if (min_bin > max_bin) { double tmp = min_bin; min_bin = max_bin; max_bin = tmp; }
if (ARG1_IS_S("-linbins")) setup_linear_bins(&bins, min_bin, max_bin, num_bins);
else if (ARG1_IS_S("-logbins")) setup_log_bins(&bins, min_bin, max_bin, num_bins);
argc -= 4; argv += 4;
}
if (bins.n < 2) {
Tcl_AppendResult(interp, "please specify at least two bin boundaries", (char *) NULL);
return TCL_ERROR;
}
/* determine job to do */
if (argc == 2 && ARG1_IS_S("-binctrwdth")) {
/* just return the centers */
Tcl_PrintDouble(interp, .5*(bins.e[0] + bins.e[1]), buffer);
Tcl_AppendResult(interp, "{", buffer, (char *) NULL);
Tcl_PrintDouble(interp, bins.e[1] - bins.e[0], buffer);
Tcl_AppendResult(interp, " ", buffer, "}", (char *) NULL);
for (i = 1; i < bins.n - 1; i++) {
Tcl_PrintDouble(interp, .5*(bins.e[i] + bins.e[i+1]), buffer);
Tcl_AppendResult(interp, " {", buffer, (char *) NULL);
Tcl_PrintDouble(interp, bins.e[i+1] - bins.e[i], buffer);
Tcl_AppendResult(interp, " ", buffer, "}", (char *) NULL);
}
return TCL_OK;
}
else if (argc == 2) {
/* do the binning with bisection search algorithm */
/* check for the type of data */
if (!ARG1_IS_DOUBLELIST(coords)) {
int i, tmp_argc, parse_error = 0;
const char **tmp_argv;
Tcl_ResetResult(interp);
Tcl_SplitList(interp, argv[1], &tmp_argc, &tmp_argv);
realloc_doublelist(&coords, coords.n = tmp_argc);
realloc_doublelist(&data, data.n = tmp_argc);
for(i = 0 ; i < tmp_argc; i++) {
int tmp_argc2;
const char **tmp_argv2;
Tcl_SplitList(interp, tmp_argv[i], &tmp_argc2, &tmp_argv2);
if (tmp_argc2 != 2) {
Tcl_AppendResult(interp, "data set has to be either a list of doubles or of lists of 2 doubles", (char *) NULL);
parse_error = 1; break;
}
if (Tcl_GetDouble(interp, tmp_argv2[0], &(coords.e[i])) == TCL_ERROR) { parse_error = 1; break; }
if (Tcl_GetDouble(interp, tmp_argv2[1], &(data.e[i])) == TCL_ERROR) { parse_error = 1; break; }
Tcl_Free((char *)tmp_argv2);
}
Tcl_Free((char *)tmp_argv);
if (parse_error) return TCL_ERROR;
}
/* the binning itself */
alloc_doublelist(&count, count.n = bins.n - 1);
for (i = 0; i < count.n; i++) count.e[i] = 0;
if (data.n) {
alloc_doublelist(&sum, sum.n = bins.n - 1);
for (i = 0; i < sum.n; i++) sum.e[i] = 0;
}
for (i = 0; i < coords.n; i++) {
double cd = coords.e[i];
if (cd < bins.e[0] || cd > bins.e[bins.n-1])
continue;
s = 0; e = bins.n - 1;
while ((w = e - s) > 1) {
c = (e + s)/2;
if (cd >= bins.e[c]) s = c; else e = c;
}
count.e[s]++;
if (data.n)
sum.e[s] += data.e[i];
}
/* normalization */
contr = 1./coords.n;
for (i = 0; i < count.n; i++) {
if (data.n) {
if (count.e[i]) {
double tmp = sum.e[i]/count.e[i];
Tcl_PrintDouble(interp, tmp, buffer);
}
else
strcpy(buffer, "n/a");
}
else {
Tcl_PrintDouble(interp, count.e[i] * contr, buffer);
}
if (i == 0)
Tcl_AppendResult(interp, buffer, (char *) NULL);
else
Tcl_AppendResult(interp, " ", buffer, (char *) NULL);
if (give_bincounts) {
sprintf(buffer, "%d", (int)count.e[i]);
Tcl_AppendResult(interp, " ", buffer, (char *) NULL);
}
}
return TCL_OK;
}
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "usage: bin -bins <binboundarylist> | "
"(-linbins|-logbins <start> <end> <num>) <data>|-binctrwdth\n", (char *) NULL);
Tcl_AppendResult(interp, " <data> is a list of doubles to bin or lists {coord data},"
" where data is to be averaged in each bin", (char *) NULL);
return TCL_ERROR;
}
int tclcommand_reaction(ClientData data, Tcl_Interp * interp, int argc, char ** argv){
#ifdef REACTIONS
if (argc == 1 ) return tcl_command_reaction_print_usage(interp);
if (argc == 2 ) {
if (ARG1_IS_S("off")) {
reaction.rate=0.0;
mpi_bcast_event(REACTION);
return TCL_OK;
}
if (ARG1_IS_S("print")) {
return tcl_command_reaction_print(interp);
}
}
if( argc!=11 && argc!=13)
return tcl_command_reaction_print_usage(interp);
if(reaction.rate != 0.0) {
Tcl_AppendResult(interp, "Currently a simulation can only contain a single reaction!", (char *) NULL);
return (TCL_ERROR);
}
if(time_step < 0.0) {
Tcl_AppendResult(interp, "Time step needs to be set before setting up a reaction!", (char *) NULL);
return (TCL_ERROR);
}
argc--;
argv++;
while (argc>0){
if (ARG_IS_S(0,"product_type")) {
if (!ARG_IS_I(1,reaction.product_type))
return tcl_command_reaction_print_usage(interp);
argc-=2;
argv+=2;
} else
if (ARG_IS_S(0,"reactant_type")) {
if (!ARG_IS_I(1,reaction.reactant_type))
return tcl_command_reaction_print_usage(interp);
argc-=2;
argv+=2;
} else
if (ARG_IS_S(0,"catalyzer_type")) {
if (!ARG_IS_I(1,reaction.catalyzer_type))
return tcl_command_reaction_print_usage(interp);
argc-=2;
argv+=2;
} else
if (ARG_IS_S_EXACT(0,"range")) {
if (!ARG_IS_D(1,reaction.range))
return tcl_command_reaction_print_usage(interp);
argc-=2;
argv+=2;
} else
if (ARG_IS_S_EXACT(0,"rate")) {
if (!ARG_IS_D(1,reaction.rate))
return tcl_command_reaction_print_usage(interp);
argc-=2;
argv+=2;
} else
if (ARG_IS_S_EXACT(0,"back_rate")) {
if (!ARG_IS_D(1,reaction.back_rate))
return tcl_command_reaction_print_usage(interp);
argc-=2;
argv+=2;
} else {
return tcl_command_reaction_print_usage(interp);
}
}
mpi_bcast_event(REACTION);
return TCL_OK;
#else /* ifdef REACTIONS */
Tcl_AppendResult(interp, "REACTIONS not compiled in!" ,(char *) NULL);
return (TCL_ERROR);
#endif /* ifdef REACTIONS */
}
int tclcommand_reaction(ClientData data, Tcl_Interp * interp, int argc, char ** argv){
#ifdef CATALYTIC_REACTIONS
/* Determine the currently set types, to block the user from
trying to set up multiple reactions */
int react_type, prdct_type, catal_type;
react_type = reaction.reactant_type;
prdct_type = reaction.product_type;
catal_type = reaction.catalyzer_type;
if (argc == 1 ) return tcl_command_reaction_print_usage(interp);
if (argc == 2 ) {
if (ARG1_IS_S("off")) {
/* We only need to set ct_rate to zero and we
do not enter the reaction integration loop */
reaction.ct_rate=0.0;
mpi_setup_reaction();
return TCL_OK;
}
if (ARG1_IS_S("print")) {
return tcl_command_reaction_print(interp);
}
}
if( argc!=11 && argc!=13 && argc!=15 && argc!=17 && argc!=3) {
return tcl_command_reaction_print_usage(interp);
}
if(time_step < 0.0) {
Tcl_AppendResult(interp, "Time step needs to be set before setting up a reaction!", (char *) NULL);
return (TCL_ERROR);
}
argc--;
argv++;
while (argc>0){
if (ARG_IS_S(0,"product_type")) {
if (!ARG_IS_I(1,reaction.product_type))
return tcl_command_reaction_print_usage(interp);
argc-=2;
argv+=2;
}
else if (ARG_IS_S(0,"reactant_type")) {
if (!ARG_IS_I(1,reaction.reactant_type))
return tcl_command_reaction_print_usage(interp);
argc-=2;
argv+=2;
}
else if (ARG_IS_S(0,"catalyzer_type")) {
if (!ARG_IS_I(1,reaction.catalyzer_type))
return tcl_command_reaction_print_usage(interp);
argc-=2;
argv+=2;
}
else if (ARG_IS_S_EXACT(0,"range")) {
if (!ARG_IS_D(1,reaction.range))
return tcl_command_reaction_print_usage(interp);
argc-=2;
argv+=2;
}
else if (ARG_IS_S_EXACT(0,"ct_rate")) {
if (!ARG_IS_D(1,reaction.ct_rate))
return tcl_command_reaction_print_usage(interp);
argc-=2;
argv+=2;
}
else if (ARG_IS_S_EXACT(0,"eq_rate")) {
if (!ARG_IS_D(1,reaction.eq_rate))
return tcl_command_reaction_print_usage(interp);
argc-=2;
argv+=2;
}
else if (ARG_IS_S_EXACT(0,"react_once")) {
if (!ARG_IS_S(1,"on")&&!ARG_IS_S(1,"off")) {
return tcl_command_reaction_print_usage(interp);}
if (ARG_IS_S(1,"on")) reaction.sing_mult = 1;
if (ARG_IS_S(1,"off")) reaction.sing_mult = 0;
argc-=2;
argv+=2;
}
else if (ARG_IS_S_EXACT(0,"swap")) {
#ifndef ROTATION
char buffer[80];
sprintf(buffer, "WARNING: Parameter \"swap\" has no effect when ROTATION is not compiled in.");
Tcl_AppendResult(interp, buffer, (char *)NULL);
#endif
if (ARG_IS_S(1,"on"))
reaction.swap = 1;
else if (ARG_IS_S(1,"off"))
reaction.swap = 0;
else
return tcl_command_reaction_print_usage(interp);
argc-=2;
argv+=2;
} else {
return tcl_command_reaction_print_usage(interp);
}
}
if( reaction.ct_rate < 0.0 ) {
Tcl_AppendResult(interp, "Negative catalytic reaction rate constant is not allowed!", (char *) NULL);
return (TCL_ERROR);
}
if( reaction.eq_rate < 0.0 && fabs(reaction.eq_rate + 1.0) > 0.001 ) {
Tcl_AppendResult(interp, "Negative equilibrium reaction rate contstant is not allowed!", (char *) NULL);
return (TCL_ERROR);
}
if( (reaction.product_type == reaction.reactant_type) || (reaction.product_type == reaction.catalyzer_type) || (reaction.catalyzer_type == reaction.reactant_type) ) {
Tcl_AppendResult(interp, "One particle type cannot be a part more than one reaction species!", (char *) NULL);
return (TCL_ERROR);
}
if ( ((react_type != reaction.reactant_type) || (prdct_type != reaction.product_type) || (catal_type != reaction.catalyzer_type)) && (react_type != prdct_type) ) {
Tcl_AppendResult(interp, "A simulation can only contain a single reaction!", (char *) NULL);
return (TCL_ERROR);
}
mpi_setup_reaction();
return TCL_OK;
#else
Tcl_AppendResult(interp, "CATALYTIC_REACTIONS not compiled in!" ,(char *) NULL);
return (TCL_ERROR);
#endif
}