int tclcommand_analyze_set_parse_chain_topology(Tcl_Interp *interp, int argc, char **argv)
{
/* parses a chain topology (e.g. in 'analyze ( rg | <rg> ) [chain start n chains chain length]' , or
in 'analyze set chains <chain_start> <n_chains> <chain_length>') */
int m, i, pc;
if (argc < 3) {
Tcl_AppendResult(interp, "chain structure info consists of <start> <n> <length>", (char *)NULL);
return TCL_ERROR;
}
if (! (ARG0_IS_I(chain_start) && ARG1_IS_I(chain_n_chains) && ARG_IS_I(2, chain_length)))
return TCL_ERROR;
realloc_topology(chain_n_chains);
pc = 0;
for (m = 0; m < n_molecules; m++) {
topology[m].type = 0;
realloc_intlist(&topology[m].part, topology[m].part.n = chain_length);
for (i = 0; i < chain_length; i++)
topology[m].part.e[i] = pc++;
}
return TCL_OK;
}
int tclcommand_inter_magnetic_parse_mdds(Tcl_Interp * interp, int argc, char ** argv)
{
int n_cut=-1;
while(argc > 0) {
if (ARG0_IS_S("n_cut")) {
if (! (argc > 1 && ARG1_IS_I(n_cut) && n_cut >= 0)) {
Tcl_AppendResult(interp, "n_cut expects an nonnegative integer",
(char *) NULL);
return TCL_ERROR;
}
} else { /* unknown parameter*/
Tcl_AppendResult(interp, "unknown parameter/s for the magnetic dipolar direct sum, the only one accepted is: n_cut positive_integer", (char *) NULL);
return TCL_ERROR;
}
argc -= 2;
argv += 2;
}
if (mdds_set_params(n_cut) != ES_OK) {
Tcl_AppendResult(interp, "sorry: magnetic dipolar direct sum only works with 1 cpu", (char *) NULL);
return TCL_ERROR;
}
return TCL_OK;
}
int tclcommand_observable_com_force(Tcl_Interp* interp, int argc, char** argv, int* change, observable* obs) {
IntList* ids;
int temp, blocksize;
if (parse_id_list(interp, argc-1, argv+1, &temp, &ids) != TCL_OK )
return TCL_ERROR;
argc-=temp+1;
argv+=temp+1;
for ( int i = 0; i < argc; i++) {
printf("%s\n", argv[i]);
}
if (argc>0 && ARG0_IS_S("blocked")) {
if (argc >= 2 && ARG1_IS_I(blocksize) && (ids->n % blocksize ==0 )) {
obs->fun=&observable_blocked_com_force;
obs->args=ids;
obs->n=3*ids->n/blocksize;
*change=3+temp;
printf("found %d ids and a blocksize of %d, that makes %d dimensions\n", ids->n, blocksize, obs->n);
return TCL_OK;
} else {
Tcl_AppendResult(interp, "com_velocity blocked expected integer argument that fits the number of particles\n", (char *)NULL );
return TCL_ERROR;
}
} else /* if nonblocked com is to be taken */ {
obs->fun=&observable_com_force;
obs->args=ids;
obs->n=3;
*change=1+temp;
return TCL_OK;
}
}
int tclcommand_observable_tclcommand(Tcl_Interp* interp, int argc, char** argv, int* change, observable* obs) {
int n_A;
Observable_Tclcommand_Arg_Container* container;
if (argc!=3) {
Tcl_AppendResult(interp, "Usage: observable tclcommand <n_vec> <command>\n", (char *)NULL );
return TCL_ERROR;
}
if (!ARG1_IS_I(n_A)) {
Tcl_AppendResult(interp, "Error in observable tclcommand: n_vec is not int\n", (char *)NULL );
return TCL_ERROR;
}
container = (Observable_Tclcommand_Arg_Container*) malloc(sizeof(Observable_Tclcommand_Arg_Container));
container->command = (char*)malloc(strlen(argv[2])*sizeof(char*));
strcpy(container->command, argv[2]);
container->n_A = n_A;
container->interp = interp;
obs->calculate=&observable_calc_tclcommand;
obs->update=0;
obs->n=n_A;
obs->last_value=(double*)malloc(obs->n*sizeof(double));
obs->container=(void*) container;
return TCL_OK;
}
int tclcommand_analyze_parse_cwvac(Tcl_Interp *interp, int argc, char **argv)
{
/* 'analyze { cwvac } <maxtau> <interval> [<chain_start> <n_chains> <chain_length>]' */
/***********************************************************************************************************/
char buffer[4*TCL_DOUBLE_SPACE+7];
int i, maxtau, interval;
double *avac, *evac;
if (argc < 2) {
Tcl_AppendResult(interp, "Wrong # of args! Usage: analyze gkmobility <maxtau> <interval> [<chain_start> <n_chains> <chain_length>]",
(char *)NULL);
return (TCL_ERROR);
} else {
if (!ARG0_IS_I(maxtau))
return (TCL_ERROR);
if (!ARG1_IS_I(interval))
return (TCL_ERROR);
argc-=2; argv+=2;
}
if (tclcommand_analyze_set_parse_chain_topology_check(interp, argc, argv) == TCL_ERROR) return TCL_ERROR;
if ((chain_n_chains == 0) || (chain_length == 0)) {
Tcl_AppendResult(interp, "The chain topology has not been set",(char *)NULL); return TCL_ERROR;
}
if (maxtau <=0) {
Tcl_AppendResult(interp, "Nothing to be done - choose <maxtau> greater zero!",(char *)NULL); return TCL_ERROR;
}
if (interval <= 0) {
Tcl_AppendResult(interp, "<interval> has to be positive", (char *)NULL);
return TCL_ERROR;
}
updatePartCfg(WITHOUT_BONDS);
analyze_cwvac(maxtau, interval, &avac, &evac);
// create return string
sprintf(buffer, "{ ");
Tcl_AppendResult(interp, buffer, (char *)NULL);
for(i=0;i<=maxtau;i++) {
sprintf(buffer,"%e ",avac[i]);
Tcl_AppendResult(interp, buffer, (char *)NULL);
}
sprintf(buffer, "} { ");
Tcl_AppendResult(interp, buffer, (char *)NULL);
for(i=0;i<=maxtau;i++) {
sprintf(buffer,"%e ",evac[i]);
Tcl_AppendResult(interp, buffer, (char *)NULL);
}
sprintf(buffer, "}");
Tcl_AppendResult(interp, buffer, (char *)NULL);
free(avac); free(evac);
return (TCL_OK);
}
int tclcommand_analyze_parse_and_print_pressure_mol(Tcl_Interp *interp,int argc, char **argv)
{
char buffer[TCL_DOUBLE_SPACE];
int type1, type2;
double psum;
#ifdef ELECTROSTATICS
#ifndef INTER_RF
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "parse_and_print_pressure_mol is only possible with INTER_RF ", (char *)NULL);
return (TCL_ERROR);
#endif
#endif
updatePartCfg(WITHOUT_BONDS);
if (!sortPartCfg()) {
char *errtxt = runtime_error(128);
ERROR_SPRINTF(errtxt, "{059 parse_and_print_pressure_mol: could not sort particle config, particle ids not consecutive?} ");
return TCL_ERROR;
}
if (argc < 2) {
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "usage: analyze pressure_mol <type1> <type2>", (char *)NULL);
return (TCL_ERROR);
}
if (!ARG0_IS_I(type1)) {
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "usage: analyze pressure_mol <type1> <type2>", (char *)NULL);
return (TCL_ERROR);
}
if (!ARG1_IS_I(type2)) {
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "usage: analyze pressure_mol <type1> <type2>", (char *)NULL);
return (TCL_ERROR);
}
argc-=2;
argv+=2;
if (n_molecules==0) {
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "No molecules defined !", (char *)NULL);
return (TCL_ERROR);
}
psum=calc_pressure_mol(type1,type2);
//sprintf(buffer,"%i",type1);
//Tcl_AppendResult(interp,"{ analyze pressure_mol ",buffer," ",(char *)NULL);
//sprintf(buffer,"%i",type2);
//Tcl_AppendResult(interp,buffer," ",(char *)NULL);
sprintf(buffer,"%e",psum);
Tcl_AppendResult(interp, buffer,(char *)NULL);
return TCL_OK;
}
int tclcommand_time_integration(ClientData data, Tcl_Interp *interp, int argc, char *argv[]) {
char buffer[10+TCL_DOUBLE_SPACE];
double t;
int n = 1;
if(argc > 2) {
Tcl_AppendResult(interp, "time_integration expects zero or one argument.", (char *)NULL);
return TCL_ERROR;
}
if(argc == 2) {
if(!(ARG1_IS_I(n) && (n > 1))) {
return TCL_ERROR;
}
}
t = time_force_calc(n);
sprintf(buffer, "%lf", t);
Tcl_AppendResult(interp, buffer, (char *)NULL);
return TCL_OK;
}
int tclcommand_inter_coulomb_parse_ewaldgpu_tune(Tcl_Interp * interp, int argc, char ** argv, int adaptive)
{
double r_cut;
double alpha;
int num_kx;
int num_ky;
int num_kz;
int K_max = 30;
int time_calc_steps = 0;
double accuracy = 0.0001;
double precision = 0.000001;
while(argc > 0)
{
if(ARG0_IS_S("accuracy"))
{
if(! (argc > 1 && ARG1_IS_D(accuracy) && accuracy > 0))
{
Tcl_AppendResult(interp, "accuracy expects a positive double ",(char *) NULL);
return TCL_ERROR;
}
}
else if(ARG0_IS_S("precision"))
{
if(! (argc > 1 && ARG1_IS_D(precision) && precision > 0))
{
Tcl_AppendResult(interp, "precision expects a positive double ",(char *) NULL);
return TCL_ERROR;
}
}
else if(ARG0_IS_S("K_max"))
{
if(! (argc > 1 && ARG1_IS_I(K_max) && K_max > 0))
{
Tcl_AppendResult(interp, "K_max expects a positive integer ",(char *) NULL);
return TCL_ERROR;
}
}
else if(ARG0_IS_S("time_calc_steps"))
{
if(! (argc > 1 && ARG1_IS_I(time_calc_steps) && time_calc_steps > 0))
{
Tcl_AppendResult(interp, "time_calc_steps expects a positive integer ",(char *) NULL);
return TCL_ERROR;
}
}
/* unknown parameter. Probably one of the optionals */
else break;
argc -= 2;
argv += 2;
}
ewaldgpu_set_params_tune(accuracy, precision, K_max, time_calc_steps);
/* Create object */
EwaldgpuForce *A=new EwaldgpuForce(r_cut, num_kx, num_ky, num_kz, alpha);
FI.addMethod(A);
rebuild_verletlist = 1;
/* do the tuning */
char *log = NULL;
if (ewaldgpu_adaptive_tune(&log) == ES_ERROR)
{
Tcl_AppendResult(interp, log, "\nfailed to tune ewaldgpu parameters to required accuracy ", (char *) NULL);
if (log) free(log);
return TCL_ERROR;
}
/* Tell the user about the tuning outcome */
Tcl_AppendResult(interp, log, (char *) NULL);
if (log) free(log);
rebuild_verletlist = 1;
mpi_bcast_coulomb_params();
mpi_bcast_event(INVALIDATE_SYSTEM);
return TCL_OK;
}
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_thermostat_parse_dpd(Tcl_Interp *interp, int argc, char **argv)
{
extern double dpd_gamma,dpd_r_cut;
extern int dpd_wf;
#ifdef TRANS_DPD
extern double dpd_tgamma,dpd_tr_cut;
extern int dpd_twf;
#endif
double temp, gamma, r_cut;
int wf=0;
#ifdef TRANS_DPD
double tgamma=0.0,tr_cut;
int twf;
int set_tgamma=0;
#endif
#ifdef ROTATION
fprintf(stderr,"WARNING: Do not use DPD with ROTATION compiled in\n");
fprintf(stderr," You should first check if a combination of a DPD thermostat\n");
fprintf(stderr," for the translational degrees of freedom and a LANGEVIN thermostat\n");
fprintf(stderr," for the rotational ones yields correct physics!\n");
fprintf(stderr," After this you may remove these lines (thermostat.c::tclcommand_thermostat_parse_dpd)!\n");
#endif
/* check number of arguments */
if (argc < 5) {
Tcl_AppendResult(interp, "wrong # args: should be \n\"",
argv[0]," ",argv[1]," <temp> <gamma> <r_cut>", (char *)NULL);
#ifdef TRANS_DPD
Tcl_AppendResult(interp,"[<tgamma>] [<tR_cut>]", (char *)NULL);
#endif
Tcl_AppendResult(interp," [WF <wf>]", (char *)NULL);
#ifdef TRANS_DPD
Tcl_AppendResult(interp," [TWF <twf>]", (char *)NULL);
#endif
Tcl_AppendResult(interp,"\"", (char *)NULL);
return (TCL_ERROR);
}
/* check argument types */
if ( !ARG_IS_D(2, temp) || !ARG_IS_D(3, gamma) || !ARG_IS_D(4, r_cut)) {
Tcl_AppendResult(interp, argv[0]," ",argv[1]," needs at least three DOUBLES", (char *)NULL);
return (TCL_ERROR);
}
argc-=5;
argv+=5;
#ifdef TRANS_DPD
tgamma=0;
tr_cut=r_cut;
twf=wf;
if ( (argc>0) && (!ARG0_IS_S("WF")) ) {
if (!ARG0_IS_D(tgamma)) {
Tcl_AppendResult(interp," thermostat dpd: tgamma should be double",(char *)NULL);
return (TCL_ERROR);
}
else{
argc--;
argv++;
set_tgamma++;
}
}
#endif
//try for WF
if ( (argc>0) && (ARG0_IS_S("WF")) ){
if (!ARG1_IS_I(wf)){
Tcl_AppendResult(interp," thermostat dpd: wf should be int",(char *)NULL);
return (TCL_ERROR);
}
else{
argc-=2;argv+=2;
#ifdef TRANS_DPD
twf=wf;
#endif
}
}
#ifdef TRANS_DPD
if ( (set_tgamma==0) && (argc>0) && (!ARG0_IS_S("TWF")) ) {
if (!ARG0_IS_D(tgamma)) {
Tcl_AppendResult(interp," thermostat dpd: tgamma should be double",(char *)NULL);
return (TCL_ERROR);
}
else{
argc--;
argv++;
set_tgamma++;
}
}
if ( (argc>0) && (!ARG0_IS_S("TWF")) ) {
if (set_tgamma!=0) {
if (!ARG0_IS_D(tr_cut)) {
Tcl_AppendResult(interp," thermostat dpd: tr_cut should be double",(char *)NULL);
return (TCL_ERROR);
}
else{
argc--;
argv++;
}
}
else{
Tcl_AppendResult(interp," thermostat dpd: tgamma must be set before twf",(char *)NULL);
return (TCL_ERROR);
}
}
if ( (argc>0) && (ARG0_IS_S("TWF")) ) {
if (set_tgamma!=0) {
if (!ARG1_IS_I(wf)) {
Tcl_AppendResult(interp," thermostat dpd: twf should be int",(char *)NULL);
return (TCL_ERROR);
}
else{
argc-=2;argv+=2;
}
}
else{
Tcl_AppendResult(interp," thermostat dpd: tgamma must be set before twf",(char *)NULL);
return (TCL_ERROR);
}
}
#endif
if (argc > 0){
Tcl_AppendResult(interp," thermostat dpd: too many arguments - don't know how to parse them!!!",(char *)NULL);
return (TCL_ERROR);
}
/* broadcast parameters */
temperature = temp;
dpd_gamma = gamma;
dpd_r_cut = r_cut;
dpd_wf = wf;
#ifdef TRANS_DPD
dpd_tgamma = tgamma;
dpd_tr_cut= tr_cut;
dpd_twf=twf;
#endif
thermo_switch = ( thermo_switch | THERMO_DPD );
mpi_bcast_parameter(FIELD_THERMO_SWITCH);
mpi_bcast_parameter(FIELD_TEMPERATURE);
mpi_bcast_parameter(FIELD_DPD_GAMMA);
mpi_bcast_parameter(FIELD_DPD_RCUT);
mpi_bcast_parameter(FIELD_DPD_WF);
#ifdef TRANS_DPD
mpi_bcast_parameter(FIELD_DPD_TGAMMA);
mpi_bcast_parameter(FIELD_DPD_TRCUT);
mpi_bcast_parameter(FIELD_DPD_TWF);
#endif
return (TCL_OK);
}
int tclcommand_inter_coulomb_parse_ewaldgpu_tune(Tcl_Interp * interp, int argc, char ** argv, int adaptive)
{
double r_cut=-1;
double alpha=-1;
int num_kx=-1;
int num_ky=-1;
int num_kz=-1;
int K_max = 30;
int time_calc_steps = 100;
double accuracy = 0.0001;
double precision = 0.000001;
//PARSE EWALD COMMAND LINE
while(argc > 0)
{
if(ARG0_IS_S("accuracy"))
{
if(! (argc > 1 && ARG1_IS_D(accuracy) && accuracy > 0))
{
Tcl_AppendResult(interp, "\n<accuracy> expects a positive double ",(char *) NULL);
return TCL_ERROR;
}
}
else if(ARG0_IS_S("precision"))
{
if(! (argc > 1 && ARG1_IS_D(precision) && precision > 0))
{
Tcl_AppendResult(interp, "\n<precision> expects a positive double ",(char *) NULL);
return TCL_ERROR;
}
}
else if(ARG0_IS_S("K_max"))
{
if(! (argc > 1 && ARG1_IS_I(K_max) && K_max > 0))
{
Tcl_AppendResult(interp, "\n<K_max> expects a positive integer ",(char *) NULL);
return TCL_ERROR;
}
}
else if(ARG0_IS_S("time_calc_steps"))
{
if(! (argc > 1 && ARG1_IS_I(time_calc_steps) && time_calc_steps > 0))
{
Tcl_AppendResult(interp, "\n<time_calc_steps> expects a positive integer ",(char *) NULL);
return TCL_ERROR;
}
}
else break;
argc -= 2;
argv += 2;
}
//Turn on ewaldgpu
ewaldgpuForce->set_params_tune(accuracy, precision, K_max, time_calc_steps);
if (!ewaldgpuForce) // inter coulomb ewaldgpu was never called before
{
ewaldgpuForce = new EwaldgpuForce(espressoSystemInterface, r_cut, num_kx, num_ky, num_kz, alpha);
forceActors.add(ewaldgpuForce);
energyActors.add(ewaldgpuForce);
}
//Broadcast parameters
coulomb.method = COULOMB_EWALD_GPU;
ewaldgpu_params.isTunedFlag = false;
rebuild_verletlist = 1;
mpi_bcast_coulomb_params();
//Tuning
char *log = NULL;
if (ewaldgpuForce->adaptive_tune(&log,espressoSystemInterface) == ES_ERROR)
{
Tcl_AppendResult(interp, "\nAccuracy could not been reached. Choose higher K_max or lower accuracy", (char *) NULL);
return TCL_ERROR;
}
//Tell the user about the tuning outcome
Tcl_AppendResult(interp, log, (char *) NULL);
if (log) free(log);
return TCL_OK;
}
int tclcommand_analyze_parse_and_print_stress_tensor(Tcl_Interp *interp, int v_comp, int argc, char **argv)
{
/* 'analyze stress_tensor [{ bond <type_num> | nonbonded <type1> <type2> | coulomb | ideal | total }]' */
char buffer[TCL_DOUBLE_SPACE + TCL_INTEGER_SPACE + 2];
int i, j, k;
double p_vel[3], tvalue[9];
for(j=0; j<9; j++) tvalue[j] = 0.0;
if (n_part == 0) {
Tcl_AppendResult(interp, "(no particles)",
(char *)NULL);
return (TCL_OK);
}
/* if desired (v_comp==1) replace ideal component with instantaneous one */
if (total_pressure.init_status != 1+v_comp ) {
init_virials(&total_pressure);
init_p_tensor(&total_p_tensor);
init_virials_non_bonded(&total_pressure_non_bonded);
init_p_tensor_non_bonded(&total_p_tensor_non_bonded);
if(v_comp && (integ_switch == INTEG_METHOD_NPT_ISO) && !(nptiso.invalidate_p_vel)) {
if (total_pressure.init_status == 0)
master_pressure_calc(0);
p_tensor.data.e[0] = 0.0;
MPI_Reduce(nptiso.p_vel, p_vel, 3, MPI_DOUBLE, MPI_SUM, 0, MPI_COMM_WORLD);
for(i=0; i<3; i++)
if(nptiso.geometry & nptiso.nptgeom_dir[i])
p_tensor.data.e[0] += p_vel[i];
p_tensor.data.e[0] /= (nptiso.dimension*nptiso.volume);
total_pressure.init_status = 1+v_comp; }
else
master_pressure_calc(v_comp);
}
if (argc == 0)
tclcommand_analyze_print_stress_tensor_all(interp);
else {
if (ARG0_IS_S("ideal")) {
for(j=0; j<9; j++) tvalue[j] = total_p_tensor.data.e[j];
}
else if (ARG0_IS_S("bonded") ||
ARG0_IS_S("fene") ||
ARG0_IS_S("subt_lj_harm") ||
ARG0_IS_S("subt_lj_fene") ||
ARG0_IS_S("subt_lj") ||
ARG0_IS_S("harmonic") ||
ARG0_IS_S("endangledist")) {
if(argc<2 || ! ARG1_IS_I(i)) {
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "wrong # or type of arguments for: analyze pressure bonded <type_num>",
(char *)NULL);
return (TCL_ERROR);
}
if(i < 0 || i >= n_bonded_ia) {
Tcl_AppendResult(interp, "bond type does not exist", (char *)NULL);
return (TCL_ERROR);
}
for(k=0; k<9; k++) tvalue[k] = obsstat_bonded(&total_p_tensor, i)[k];
}
else if (ARG0_IS_S("nonbonded") ||
ARG0_IS_S("lj") ||
ARG0_IS_S("buckingham") ||
ARG0_IS_S("morse") ||
ARG0_IS_S("soft-sphere") ||
ARG0_IS_S("lj-cos") ||
ARG0_IS_S("lj-cos2") ||
ARG0_IS_S("tabulated") ||
ARG0_IS_S("gb")) {
if(argc<3 || ! ARG_IS_I(1, i) || ! ARG_IS_I(2, j)) {
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "wrong # or type of arguments for: analyze pressure nonbonded <type1> <type2>",
(char *)NULL);
return (TCL_ERROR);
}
if(i < 0 || i >= n_particle_types || j < 0 || j >= n_particle_types) {
Tcl_AppendResult(interp, "particle type does not exist", (char *)NULL);
return (TCL_ERROR);
}
for(k=0; k<9; k++) tvalue[k] = obsstat_nonbonded(&total_p_tensor, i, j)[k];
}
else if( ARG0_IS_S("tot_nb_intra")) {
for(k=0; k<9; k++) {
for (i = 0; i < n_particle_types; i++)
for (j = i; j < n_particle_types; j++) {
tvalue[k] += obsstat_nonbonded_intra(&total_p_tensor_non_bonded, i, j)[k];
}
}
}
else if( ARG0_IS_S("tot_nb_inter")) {
for(k=0; k<9; k++) {
for (i = 0; i < n_particle_types; i++)
for (j = i; j < n_particle_types; j++) {
tvalue[k] += obsstat_nonbonded_inter(&total_p_tensor_non_bonded, i, j)[k];
}
}
}
else if( ARG0_IS_S("nb_intra")) {
if(argc<3 || ! ARG_IS_I(1, i) || ! ARG_IS_I(2, j)) {
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "wrong # or type of arguments for: analyze stress tensor nonbonded <type1> <type2>",
(char *)NULL);
return (TCL_ERROR);
}
if(i < 0 || i >= n_particle_types || j < 0 || j >= n_particle_types) {
Tcl_AppendResult(interp, "particle type does not exist", (char *)NULL);
return (TCL_ERROR);
}
for(k=0; k<9; k++) tvalue[k] = obsstat_nonbonded_intra(&total_p_tensor_non_bonded, i, j)[k];
}
else if( ARG0_IS_S("nb_inter")) {
if(argc<3 || ! ARG_IS_I(1, i) || ! ARG_IS_I(2, j)) {
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "wrong # or type of arguments for: analyze stress tensor nonbonded <type1> <type2>",
(char *)NULL);
return (TCL_ERROR);
}
if(i < 0 || i >= n_particle_types || j < 0 || j >= n_particle_types) {
Tcl_AppendResult(interp, "particle type does not exist", (char *)NULL);
return (TCL_ERROR);
}
for(k=0; k<9; k++) tvalue[k] = obsstat_nonbonded_inter(&total_p_tensor_non_bonded, i, j)[k];
}
else if( ARG0_IS_S("coulomb")) {
#ifdef ELECTROSTATICS
for(j=0; j<9; j++) tvalue[j] = total_p_tensor.coulomb[j];
#else
Tcl_AppendResult(interp, "ELECTROSTATICS not compiled (see config.hpp)\n", (char *)NULL);
#endif
}
else if( ARG0_IS_S("dipolar")) {
#ifdef DIPOLES
/* for(j=0; j<9; j++) tvalue[j] = total_p_tensor.coulomb[j];*/
fprintf(stderr," stress tensor, magnetostatics, something should go here, file pressure.cpp ");
#else
Tcl_AppendResult(interp, "DIPOLES not compiled (see config.hpp)\n", (char *)NULL);
#endif
}
#ifdef VIRTUAL_SITES_RELATIVE
else if (ARG0_IS_S("VS_RELATIVE")) {
for(j=0; j<9; j++) tvalue[j] = total_p_tensor.vs_relative[j];
}
#endif
else if (ARG0_IS_S("total")) {
for(j=0; j<9; j++) {
tvalue[j] = total_p_tensor.data.e[j];
for (i = 1; i < total_p_tensor.data.n/9; i++) tvalue[j] += total_p_tensor.data.e[9*i + j];
}
}
else {
Tcl_AppendResult(interp, "unknown feature of: analyze pressure",
(char *)NULL);
return (TCL_ERROR);
}
Tcl_AppendResult(interp, *argv, (char *)NULL);
Tcl_AppendResult(interp, " ", (char *)NULL);
for(j=0; j<9; j++) {
Tcl_PrintDouble(interp, tvalue[j], buffer);
Tcl_AppendResult(interp, buffer, " ", (char *)NULL);
}
}
return (TCL_OK);
}
int tclcommand_analyze_parse_and_print_dipmom_mol(Tcl_Interp *interp,int argc, char **argv)
{
#ifndef ELECTROSTATICS
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "calc_dipole_mol is not possible without ELECTROSTATICS", (char *)NULL);
return (TCL_ERROR);
#else
int k,type;
char buffer[TCL_DOUBLE_SPACE];
double dipole[4];
updatePartCfg(WITHOUT_BONDS);
if (!sortPartCfg()) {
char *errtxt = runtime_error(128);
ERROR_SPRINTF(errtxt, "{059 parse_and_print_dipole: could not sort particle config, particle ids not consecutive?} ");
return TCL_ERROR;
}
if (n_molecules==0) {
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "No molecules defined !", (char *)NULL);
return (TCL_ERROR);
}
if (argc < 2) {
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "usage: analyze parse_and_print_dipole_mol <type>", (char *)NULL);
return (TCL_ERROR);
}
if (!ARG1_IS_I(type)) {
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "usage: analyze parse_and_print_dipole_mol <type>", (char *)NULL);
return (TCL_ERROR);
}
if (ARG0_IS_S("total")){
calc_total_dipolmoment_mol(type,dipole);
sprintf(buffer,"%i ",type);
Tcl_AppendResult(interp,"{ dipolemoment_mol total ",buffer,(char *)NULL);
for (k=0;k<3;k++)
{
sprintf(buffer,"%e ",dipole[k]);
Tcl_AppendResult(interp, buffer,(char *)NULL);
}
sprintf(buffer,"%e",dipole[3]);
Tcl_AppendResult(interp,buffer,"}",(char *)NULL);
}
else if (ARG0_IS_S("absolute")){
calc_absolute_dipolmoment_mol(type,dipole);
sprintf(buffer,"%i ",type);
Tcl_AppendResult(interp,"{ dipolemoment_mol absolute ",buffer,(char *)NULL);
sprintf(buffer,"%e ",dipole[0]);
Tcl_AppendResult(interp, buffer,(char *)NULL);
sprintf(buffer,"%e",dipole[1]);
Tcl_AppendResult(interp,buffer,"}",(char *)NULL);
}
else
{
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "Feature not implemented", (char *)NULL);
return (TCL_ERROR);
}
argc-=2; argv+=2;
return TCL_OK;
#endif
}
int tclcommand_parse_radial_profile(Tcl_Interp* interp, int argc, char** argv, int* change, int* dim_A, radial_profile_data** pdata_) {
int temp;
*change=0;
radial_profile_data* pdata=(radial_profile_data*)malloc(sizeof(radial_profile_data));
*pdata_ = pdata;
pdata->id_list=0;
if (box_l[0]<box_l[1])
pdata->maxr = box_l[0];
else
pdata->maxr = box_l[1];
pdata->minr=0;
pdata->maxphi=PI;
pdata->minphi=-PI;
pdata->minz=-box_l[2]/2.;
pdata->maxz=+box_l[2]/2.;
pdata->center[0]=box_l[0]/2.;pdata->center[1]=box_l[1]/2.;pdata->center[2]=box_l[2]/2.;
pdata->rbins=1;
pdata->zbins=1;
pdata->phibins=1;
pdata->axis[0]=0.;
pdata->axis[1]=0.;
pdata->axis[2]=1.;
if (argc < 1) {
Tcl_AppendResult(interp, "Usage radial_profile id $ids center $x $y $z maxr $r_max nbins $n\n" , (char *)NULL);
return TCL_ERROR;
}
while (argc>0) {
if (ARG0_IS_S("ids") || ARG0_IS_S("types") || ARG0_IS_S("all")) {
if (!parse_id_list(interp, argc, argv, &temp, &pdata->id_list )==TCL_OK) {
Tcl_AppendResult(interp, "Error reading profile: Error parsing particle id information\n" , (char *)NULL);
return TCL_ERROR;
} else {
*change+=temp;
argc-=temp;
argv+=temp;
}
} else if ( ARG0_IS_S("center")){
if (argc>3 && ARG1_IS_D(pdata->center[0]) && ARG_IS_D(2,pdata->center[1]) && ARG_IS_D(3,pdata->center[2])) {
argc-=4;
argv+=4;
*change+=4;
} else {
Tcl_AppendResult(interp, "Error in radial_profile: could not read center\n" , (char *)NULL);
return TCL_ERROR;
}
} else if ( ARG0_IS_S("axis")){
Tcl_AppendResult(interp, "Using arbitrary axes does not work yet!\n" , (char *)NULL);
return TCL_ERROR;
if (argc>3 && ARG1_IS_D(pdata->axis[0]) && ARG_IS_D(2,pdata->axis[1]) && ARG_IS_D(3,pdata->axis[2])) {
argc-=4;
argv+=4;
*change+=4;
} else {
Tcl_AppendResult(interp, "Error in radial_profile: could not read center\n" , (char *)NULL);
return TCL_ERROR;
}
} else if ( ARG0_IS_S("maxr") ) {
if (argc>1 && ARG1_IS_D(pdata->maxr)) {
argc-=2;
argv+=2;
*change+=2;
} else {
Tcl_AppendResult(interp, "Error in radial_profile: could not read maxr\n" , (char *)NULL);
return TCL_ERROR;
}
} else if ( ARG0_IS_S("minr") ) {
if (argc>1 && ARG1_IS_D(pdata->maxr)) {
argc-=2;
argv+=2;
*change+=2;
} else {
Tcl_AppendResult(interp, "Error in radial_profile: could not read maxr\n" , (char *)NULL);
return TCL_ERROR;
}
} else if ( ARG0_IS_S("minz")){
if (argc>1 && ARG1_IS_D(pdata->minz)) {
argc-=2;
argv+=2;
*change+=2;
} else {
Tcl_AppendResult(interp, "Error in profile: could not read minz\n" , (char *)NULL);
return TCL_ERROR;
}
} else if ( ARG0_IS_S("maxz") ) {
if (argc>1 && ARG1_IS_D(pdata->maxz)) {
argc-=2;
argv+=2;
*change+=2;
} else {
Tcl_AppendResult(interp, "Error in profile: could not read maxz\n" , (char *)NULL);
return TCL_ERROR;
}
} else if ( ARG0_IS_S("minphi")){
if (argc>1 && ARG1_IS_D(pdata->minphi)) {
argc-=2;
argv+=2;
*change+=2;
} else {
Tcl_AppendResult(interp, "Error in profile: could not read minz\n" , (char *)NULL);
return TCL_ERROR;
}
} else if ( ARG0_IS_S("maxphi") ) {
if (argc>1 && ARG1_IS_D(pdata->maxphi)) {
argc-=2;
argv+=2;
*change+=2;
} else {
Tcl_AppendResult(interp, "Error in profile: could not read maxz\n" , (char *)NULL);
return TCL_ERROR;
}
} else if (ARG0_IS_S("rbins")) {
if (argc>1 && ARG1_IS_I(pdata->rbins)) {
argc-=2;
argv+=2;
*change+=2;
} else {
Tcl_AppendResult(interp, "Error in radial_profile: could not read rbins\n" , (char *)NULL);
return TCL_ERROR;
}
} else if (ARG0_IS_S("zbins")) {
if (argc>1 && ARG1_IS_I(pdata->zbins)) {
argc-=2;
argv+=2;
*change+=2;
} else {
Tcl_AppendResult(interp, "Error in radial_profile: could not read rbins\n" , (char *)NULL);
return TCL_ERROR;
}
} else if (ARG0_IS_S("phibins")) {
if (argc>1 && ARG1_IS_I(pdata->phibins)) {
argc-=2;
argv+=2;
*change+=2;
} else {
Tcl_AppendResult(interp, "Error in radial_profile: could not read rbins\n" , (char *)NULL);
return TCL_ERROR;
}
} else {
Tcl_AppendResult(interp, "Error in radial_profile: understand argument ", argv[0], "\n" , (char *)NULL);
return TCL_ERROR;
}
}
temp=0;
// if (pdata->center[0]>1e90) {
// Tcl_AppendResult(interp, "Error in radial_profile: center not specified\n" , (char *)NULL);
// temp=1;
// }
// if (pdata->maxr>1e90) {
// Tcl_AppendResult(interp, "Error in radial_profile: maxr not specified\n" , (char *)NULL);
// temp=1;
// }
// if (pdata->rbins<1) {
// Tcl_AppendResult(interp, "Error in radial_profile: rbins not specified\n" , (char *)NULL);
// temp=1;
// }
if (temp)
return TCL_ERROR;
else
return TCL_OK;
}
int tclcommand_analyze_parse_and_print_pressure(Tcl_Interp *interp, int v_comp, int argc, char **argv)
{
/* 'analyze pressure [{ bond <type_num> | nonbonded <type1> <type2> | coulomb | ideal | total }]' */
char buffer[TCL_DOUBLE_SPACE + TCL_INTEGER_SPACE + 2];
int i, j;
double value, p_vel[3];
value = 0.0;
if (n_part == 0) {
Tcl_AppendResult(interp, "(no particles)",
(char *)NULL);
return (TCL_OK);
}
/* if desired (v_comp==1) replace ideal component with instantaneous one */
if (total_pressure.init_status != 1+v_comp ) {
init_virials(&total_pressure);
init_p_tensor(&total_p_tensor);
init_virials_non_bonded(&total_pressure_non_bonded);
init_p_tensor_non_bonded(&total_p_tensor_non_bonded);
if(v_comp && (integ_switch == INTEG_METHOD_NPT_ISO) && !(nptiso.invalidate_p_vel)) {
if (total_pressure.init_status == 0)
master_pressure_calc(0);
total_pressure.data.e[0] = 0.0;
MPI_Reduce(nptiso.p_vel, p_vel, 3, MPI_DOUBLE, MPI_SUM, 0, MPI_COMM_WORLD);
for(i=0; i<3; i++)
if(nptiso.geometry & nptiso.nptgeom_dir[i])
total_pressure.data.e[0] += p_vel[i];
total_pressure.data.e[0] /= (nptiso.dimension*nptiso.volume);
total_pressure.init_status = 1+v_comp; }
else
master_pressure_calc(v_comp);
}
if (argc == 0)
tclcommand_analyze_print_pressure_all(interp);
else {
if (ARG0_IS_S("ideal"))
value = total_pressure.data.e[0];
else if (ARG0_IS_S("bonded") ||
ARG0_IS_S("fene") ||
ARG0_IS_S("subt_lj_harm") ||
ARG0_IS_S("subt_lj_fene") ||
ARG0_IS_S("subt_lj") ||
ARG0_IS_S("harmonic") ||
ARG0_IS_S("endangledist")) {
if(argc<2 || ! ARG1_IS_I(i)) {
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "wrong # or type of arguments for: analyze pressure bonded <type_num>",
(char *)NULL);
return (TCL_ERROR);
}
if(i < 0 || i >= n_bonded_ia) {
Tcl_AppendResult(interp, "bond type does not exist", (char *)NULL);
return (TCL_ERROR);
}
value = *obsstat_bonded(&total_pressure, i);
}
else if (ARG0_IS_S("nonbonded") ||
ARG0_IS_S("lj") ||
ARG0_IS_S("buckingham") ||
ARG0_IS_S("morse") ||
ARG0_IS_S("soft-sphere") ||
ARG0_IS_S("lj-cos") ||
ARG0_IS_S("lj-cos2") ||
ARG0_IS_S("tabulated") ||
ARG0_IS_S("gb")) {
if(argc<3 || ! ARG_IS_I(1, i) || ! ARG_IS_I(2, j)) {
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "wrong # or type of arguments for: analyze pressure nonbonded <type1> <type2>",
(char *)NULL);
return (TCL_ERROR);
}
if(i < 0 || i >= n_particle_types || j < 0 || j >= n_particle_types) {
Tcl_AppendResult(interp, "particle type does not exist", (char *)NULL);
return (TCL_ERROR);
}
value = *obsstat_nonbonded(&total_pressure, i, j);
}
else if( ARG0_IS_S("tot_nb_intra") ||
ARG0_IS_S("tot_nonbonded_intra")) {
value = 0.0;
for (i = 0; i < n_particle_types; i++)
for (j = i; j < n_particle_types; j++)
value += *obsstat_nonbonded_intra(&total_pressure_non_bonded, i, j);
}
else if( ARG0_IS_S("tot_nb_inter") ||
ARG0_IS_S("tot_nonbonded_inter")) {
value = 0.0;
for (i = 0; i < n_particle_types; i++)
for (j = i; j < n_particle_types; j++)
value += *obsstat_nonbonded_inter(&total_pressure_non_bonded, i, j);
}
else if( ARG0_IS_S("nb_intra") ||
ARG0_IS_S("nonbonded_intra")) {
if(argc<3 || ! ARG_IS_I(1, i) || ! ARG_IS_I(2, j)) {
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "wrong # or type of arguments for: analyze pressure nb_intra <type1> <type2>",
(char *)NULL);
return (TCL_ERROR);
}
if(i < 0 || i >= n_particle_types || j < 0 || j >= n_particle_types) {
Tcl_AppendResult(interp, "particle type does not exist", (char *)NULL);
return (TCL_ERROR);
}
value = *obsstat_nonbonded_intra(&total_pressure_non_bonded, i, j);
}
else if( ARG0_IS_S("nb_inter") ||
ARG0_IS_S("nonbonded_inter")) {
if(argc<3 || ! ARG_IS_I(1, i) || ! ARG_IS_I(2, j)) {
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "wrong # or type of arguments for: analyze pressure nb_inter <type1> <type2>",
(char *)NULL);
return (TCL_ERROR);
}
if(i < 0 || i >= n_particle_types || j < 0 || j >= n_particle_types) {
Tcl_AppendResult(interp, "particle type does not exist", (char *)NULL);
return (TCL_ERROR);
}
value = *obsstat_nonbonded_inter(&total_pressure_non_bonded, i, j);
}
else if( ARG0_IS_S("coulomb")) {
#ifdef ELECTROSTATICS
value = 0;
for (i = 0; i < total_pressure.n_coulomb; i++)
value += total_pressure.coulomb[i];
#else
Tcl_AppendResult(interp, "ELECTROSTATICS not compiled (see config.hpp)\n", (char *)NULL);
#endif
}
else if( ARG0_IS_S("dipolar")) {
#ifdef DIPOLES
value = 0;
for (i = total_pressure.n_coulomb-1; i < total_pressure.n_coulomb; i++) /*when DLC will be installed this has to be changed */
value += total_pressure.coulomb[i];
#else
Tcl_AppendResult(interp, "DIPOLES not compiled (see config.hpp)\n", (char *)NULL);
#endif
}
#ifdef VIRTUAL_SITES_RELATIVE
else if (ARG0_IS_S("vs_relative")) {
value =total_pressure.vs_relative[0];
}
#endif
else if (ARG0_IS_S("total")) {
value = total_pressure.data.e[0];
for (i = 1; i < total_pressure.data.n; i++) {
value += total_pressure.data.e[i];
}
}
else {
Tcl_AppendResult(interp, "unknown feature of: analyze pressure",
(char *)NULL);
return (TCL_ERROR);
}
Tcl_PrintDouble(interp, value, buffer);
Tcl_AppendResult(interp, buffer, (char *)NULL);
}
return (TCL_OK);
}
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_parse_profile(Tcl_Interp* interp, int argc, char** argv, int* change, int* dim_A, profile_data** pdata_) {
int temp;
*change=0;
profile_data* pdata=(profile_data*)malloc(sizeof(profile_data));
*pdata_ = pdata;
pdata->id_list=0;
pdata->minx=0;
pdata->maxx=box_l[0];
pdata->xbins=1;
pdata->miny=0;
pdata->maxy=box_l[1];
pdata->ybins=1;
pdata->minz=0;
pdata->maxz=box_l[2];
pdata->zbins=1;
while (argc>0) {
if (ARG0_IS_S("ids") || ARG0_IS_S("types") || ARG0_IS_S("all")) {
if (!parse_id_list(interp, argc, argv, &temp, &pdata->id_list )==TCL_OK) {
Tcl_AppendResult(interp, "Error reading profile: Error parsing particle id information\n" , (char *)NULL);
return TCL_ERROR;
} else {
*change+=temp;
argc-=temp;
argv+=temp;
}
} else if ( ARG0_IS_S("minx")){
if (argc>1 && ARG1_IS_D(pdata->minx)) {
argc-=2;
argv+=2;
*change+=2;
} else {
Tcl_AppendResult(interp, "Error in profile: could not read minz\n" , (char *)NULL);
return TCL_ERROR;
}
} else if ( ARG0_IS_S("maxx") ) {
if (argc>1 && ARG1_IS_D(pdata->maxx)) {
argc-=2;
argv+=2;
*change+=2;
} else {
Tcl_AppendResult(interp, "Error in profile: could not read maxz\n" , (char *)NULL);
return TCL_ERROR;
}
} else if (ARG0_IS_S("xbins")) {
if (argc>1 && ARG1_IS_I(pdata->xbins)) {
argc-=2;
argv+=2;
*change+=2;
} else {
Tcl_AppendResult(interp, "Error in profile: could not read nbins\n" , (char *)NULL);
return TCL_ERROR;
}
} else if ( ARG0_IS_S("miny")){
if (argc>1 && ARG1_IS_D(pdata->miny)) {
argc-=2;
argv+=2;
*change+=2;
} else {
Tcl_AppendResult(interp, "Error in profile: could not read minz\n" , (char *)NULL);
return TCL_ERROR;
}
} else if ( ARG0_IS_S("maxy") ) {
if (argc>1 && ARG1_IS_D(pdata->maxy)) {
argc-=2;
argv+=2;
*change+=2;
} else {
Tcl_AppendResult(interp, "Error in profile: could not read maxz\n" , (char *)NULL);
return TCL_ERROR;
}
} else if (ARG0_IS_S("ybins")) {
if (argc>1 && ARG1_IS_I(pdata->ybins)) {
argc-=2;
argv+=2;
*change+=2;
} else {
Tcl_AppendResult(interp, "Error in profile: could not read nbins\n" , (char *)NULL);
return TCL_ERROR;
}
} else if ( ARG0_IS_S("minz")){
if (argc>1 && ARG1_IS_D(pdata->minz)) {
argc-=2;
argv+=2;
*change+=2;
} else {
Tcl_AppendResult(interp, "Error in profile: could not read minz\n" , (char *)NULL);
return TCL_ERROR;
}
} else if ( ARG0_IS_S("maxz") ) {
if (argc>1 && ARG1_IS_D(pdata->maxz)) {
argc-=2;
argv+=2;
*change+=2;
} else {
Tcl_AppendResult(interp, "Error in profile: could not read maxz\n" , (char *)NULL);
return TCL_ERROR;
}
} else if (ARG0_IS_S("zbins")) {
if (argc>1 && ARG1_IS_I(pdata->zbins)) {
argc-=2;
argv+=2;
*change+=2;
} else {
Tcl_AppendResult(interp, "Error in profile: could not read nbins\n" , (char *)NULL);
return TCL_ERROR;
}
} else {
Tcl_AppendResult(interp, "Error in radial_profile: understand argument ", argv[0], "\n" , (char *)NULL);
return TCL_ERROR;
}
}
temp=0;
if (pdata->xbins <= 0 || pdata->ybins <=0 || pdata->zbins <= 0) {
Tcl_AppendResult(interp, "Error in profile: the bin number in each direction must be >=1\n" , (char *)NULL);
temp=1;
}
if (temp)
return TCL_ERROR;
else
return TCL_OK;
}
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_analyze_parse_and_print_energy(Tcl_Interp *interp, int argc, char **argv)
{
/* 'analyze energy [{ fene <type_num> | harmonic <type_num> | subt_lj_harm <type_num> | subt_lj_fene <type_num> | subt_lj <type_num> | lj <type1> <type2> | ljcos <type1> <type2> | ljcos2 <type1> <type2> | gb <type1> <type2> | coulomb | kinetic | total }]' */
char buffer[TCL_DOUBLE_SPACE + TCL_INTEGER_SPACE + 2];
int i, j;
double value;
value = 0.0;
if (n_part == 0) {
Tcl_AppendResult(interp, "(no particles)",
(char *)NULL);
return (TCL_OK);
}
if (total_energy.init_status == 0) {
init_energies(&total_energy);
master_energy_calc();
}
if (argc == 0)
tclcommand_analyze_print_all(interp);
else {
if (ARG0_IS_S("kinetic"))
value = total_energy.data.e[0];
else if (ARG0_IS_S("bonded") ||
ARG0_IS_S("fene") ||
ARG0_IS_S("subt_lj_harm") ||
ARG0_IS_S("subt_lj_fene") ||
ARG0_IS_S("subt_lj") ||
ARG0_IS_S("harmonic") ||
ARG0_IS_S("umbrella") ||
ARG0_IS_S("endangledist")) {
if(argc<2 || ! ARG1_IS_I(i)) {
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "wrong # or type of arguments for: analyze energy bonded <type_num>",
(char *)NULL);
return (TCL_ERROR);
}
if(i < 0 || i >= n_bonded_ia) {
Tcl_AppendResult(interp, "bond type does not exist", (char *)NULL);
return (TCL_ERROR);
}
value = *obsstat_bonded(&total_energy, i);
}
else if (ARG0_IS_S("nonbonded") ||
ARG0_IS_S("lj") ||
ARG0_IS_S("buckingham") ||
ARG0_IS_S("lj-cos") ||
ARG0_IS_S("lj-cos2") ||
ARG0_IS_S("cos2") ||
ARG0_IS_S("gb") ||
ARG0_IS_S("tabulated")) {
if(argc<3 || ! ARG_IS_I(1, i) || ! ARG_IS_I(2, j)) {
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "wrong # or type of arguments for: analyze energy nonbonded <type1> <type2>",
(char *)NULL);
return (TCL_ERROR);
}
if(i < 0 || i >= n_particle_types || j < 0 || j >= n_particle_types) {
Tcl_AppendResult(interp, "particle type does not exist", (char *)NULL);
return (TCL_ERROR);
}
value = *obsstat_nonbonded(&total_energy, i, j);
}
else if( ARG0_IS_S("coulomb")) {
#ifdef ELECTROSTATICS
value = 0;
for (i = 0; i < total_energy.n_coulomb; i++)
value += total_energy.coulomb[i];
#else
Tcl_AppendResult(interp, "ELECTROSTATICS not compiled (see myconfig.hpp)\n", (char *)NULL);
#endif
}
else if( ARG0_IS_S("magnetic")) {
#ifdef DIPOLES
value = 0;
for (i = 0; i < total_energy.n_dipolar; i++)
value += total_energy.dipolar[i];
#else
Tcl_AppendResult(interp, "DIPOLES not compiled (see myconfig.hpp)\n", (char *)NULL);
#endif
}
else if (ARG0_IS_S("total")) {
value = total_energy.data.e[0];
for (i = 1; i < total_energy.data.n; i++)
value += total_energy.data.e[i];
for (i = 0; i < n_external_potentials; i++) {
value += external_potentials[i].energy;
}
}
else {
Tcl_AppendResult(interp, "unknown feature of: analyze energy",
(char *)NULL);
return (TCL_ERROR);
}
Tcl_PrintDouble(interp, value, buffer);
Tcl_AppendResult(interp, buffer, (char *)NULL);
}
return (TCL_OK);
}
int tclcommand_inter_coulomb_parse_p3m_tune(Tcl_Interp * interp, int argc, char ** argv, int adaptive)
{
int cao = -1, n_interpol = -1;
double r_cut = -1, accuracy = -1;
int mesh[3];
IntList il;
init_intlist(&il);
mesh[0] = -1;
mesh[1] = -1;
mesh[2] = -1;
while(argc > 0) {
if(ARG0_IS_S("r_cut")) {
if (! (argc > 1 && ARG1_IS_D(r_cut) && r_cut >= -1)) {
Tcl_AppendResult(interp, "r_cut expects a positive double",
(char *) NULL);
return TCL_ERROR;
}
} else if(ARG0_IS_S("mesh")) {
if(! ARG_IS_I(1, mesh[0])) {
Tcl_ResetResult(interp);
if( ! ARG_IS_INTLIST(1, il) || !(il.n == 3) ) {
Tcl_AppendResult(interp, "integer or integer list of length 3 expected", (char *) NULL);
return TCL_ERROR;
} else {
mesh[0] = il.e[0];
mesh[1] = il.e[1];
mesh[2] = il.e[2];
}
} else if(! (argc > 1 && mesh[0] >= -1)) {
Tcl_AppendResult(interp, "mesh expects an integer >= -1",
(char *) NULL);
return TCL_ERROR;
}
} else if(ARG0_IS_S("cao")) {
if(! (argc > 1 && ARG1_IS_I(cao) && cao >= -1 && cao <= 7)) {
Tcl_AppendResult(interp, "cao expects an integer between -1 and 7",
(char *) NULL);
return TCL_ERROR;
}
} else if(ARG0_IS_S("accuracy")) {
if(! (argc > 1 && ARG1_IS_D(accuracy) && accuracy > 0)) {
Tcl_AppendResult(interp, "accuracy expects a positive double",
(char *) NULL);
return TCL_ERROR;
}
} else if (ARG0_IS_S("n_interpol")) {
if (! (argc > 1 && ARG1_IS_I(n_interpol) && n_interpol >= 0)) {
Tcl_AppendResult(interp, "n_interpol expects an nonnegative integer", (char *) NULL);
return TCL_ERROR;
}
}
/* unknown parameter. Probably one of the optionals */
else break;
argc -= 2;
argv += 2;
}
if ( (mesh[0]%2 != 0 && mesh[0] != -1) || (mesh[1]%2 != 0 && mesh[1] != -1) || (mesh[2]%2 != 0 && mesh[2] != -1) ) {
printf ("y cond me %d %d %d\n", mesh[1], mesh[1]%2 != 0, mesh[1] != -1);
// if ( ( mesh[0]%2 != 0) && (mesh[0] != -1) ) {
Tcl_AppendResult(interp, "P3M requires an even number of mesh points in all directions", (char *) NULL);
return TCL_ERROR;
}
p3m_set_tune_params(r_cut, mesh, cao, -1.0, accuracy, n_interpol);
/* check for optional parameters */
if (argc > 0) {
if (tclcommand_inter_coulomb_parse_p3m_opt_params(interp, argc, argv) == TCL_ERROR)
return TCL_ERROR;
}
/* do the tuning */
char *log = NULL;
if (p3m_adaptive_tune(&log) == ES_ERROR) {
Tcl_AppendResult(interp, log, "\nfailed to tune P3M parameters to required accuracy", (char *) NULL);
if (log)
free(log);
return TCL_ERROR;
}
/* Tell the user about the tuning outcome */
Tcl_AppendResult(interp, log, (char *) NULL);
if (log)
free(log);
return TCL_OK;
}
/** Parses the ICCP3M command.
*/
int tclcommand_iccp3m(ClientData data, Tcl_Interp *interp, int argc, char **argv) {
char buffer[TCL_DOUBLE_SPACE];
if(iccp3m_initialized==0){
iccp3m_init();
iccp3m_initialized=1;
}
if(argc < 2 ) {
Tcl_AppendResult(interp, "Usage of ICCP3M: RTFM", (char *)NULL);
return (TCL_ERROR);
}
if (argc == 2 ){
if(ARG_IS_S(1,"iterate")) {
if (iccp3m_cfg.set_flag==0) {
Tcl_AppendResult(interp, "iccp3m parameters not set!", (char *)NULL);
return (TCL_ERROR);
} else {
Tcl_PrintDouble(interp,mpi_iccp3m_iteration(0),buffer);
Tcl_AppendResult(interp, buffer, (char *) NULL);
return TCL_OK;
}
} else if(ARG_IS_S(1,"no_iterations")) {
Tcl_PrintDouble(interp,iccp3m_cfg.citeration,buffer);
Tcl_AppendResult(interp, buffer, (char *) NULL);
return TCL_OK;
}
}
else {
if(ARG_IS_I(1, iccp3m_cfg.n_ic)) {
argc-=2;
argv+=2;
} else {
Tcl_AppendResult(interp, "ICCP3M: First argument has to be the number of induced charges", (char *)NULL);
return (TCL_ERROR);
}
while (argc > 0) {
if (ARG0_IS_S("convergence")) {
if (argc>1 && ARG1_IS_D(iccp3m_cfg.convergence)) {
argc-=2;
argv+=2;
} else {
Tcl_AppendResult(interp, "ICCP3M Usage: convergence <convergence>", (char *)NULL);
return (TCL_ERROR);
}
} else if (ARG0_IS_S("relaxation")) {
if (argc>1 && ARG1_IS_D(iccp3m_cfg.relax)) {
argc-=2;
argv+=2;
} else {
Tcl_AppendResult(interp, "ICCP3M Usage: convergence <convergence>", (char *)NULL);
return (TCL_ERROR);
}
} else if (ARG0_IS_S("eps_out")) {
if (argc>1 && ARG1_IS_D(iccp3m_cfg.eout)) {
argc-=2;
argv+=2;
} else {
Tcl_AppendResult(interp, "ICCP3M Usage: eps_out <eps_out>", (char *)NULL);
return (TCL_ERROR);
}
} else if (ARG0_IS_S("ext_field")) {
if (argc>1 && ARG1_IS_D(iccp3m_cfg.extx) && ARG_IS_D(2,iccp3m_cfg.exty) && ARG_IS_D(3,iccp3m_cfg.extz)) {
argc-=4;
argv+=4;
} else {
Tcl_AppendResult(interp, "ICCP3M Usage: eps_out <eps_out>", (char *)NULL);
return (TCL_ERROR);
}
} else if (ARG0_IS_S("max_iterations")) {
if (argc>1 && ARG1_IS_I(iccp3m_cfg.num_iteration)) {
argc-=2;
argv+=2;
} else {
Tcl_AppendResult(interp, "ICCP3M Usage: max_iterations <max_iterations>", (char *)NULL);
return (TCL_ERROR);
}
} else if (ARG0_IS_S("first_id")) {
if (argc>1 && ARG1_IS_I(iccp3m_cfg.first_id)) {
argc-=2;
argv+=2;
} else {
Tcl_AppendResult(interp, "ICCP3M Usage: first_id <first_id>", (char *)NULL);
return (TCL_ERROR);
}
} else if (ARG0_IS_S("normals")) {
if (argc>1) {
if (tclcommand_iccp3m_parse_normals(interp, iccp3m_cfg.n_ic, argv[1]) != TCL_OK) {
return TCL_ERROR;
}
argc-=2;
argv+=2;
} else {
Tcl_AppendResult(interp, "ICCP3M Usage: normals <List of normal vectors>", (char *)NULL);
return (TCL_ERROR);
}
} else if (ARG0_IS_S("areas")) {
if (argc>1) {
if (tclcommand_iccp3m_parse_double_list(interp, iccp3m_cfg.n_ic, argv[1], ICCP3M_AREA)!=TCL_OK) {
return TCL_ERROR;
}
argc-=2;
argv+=2;
} else {
Tcl_AppendResult(interp, "ICCP3M Usage: areas <list of areas>", (char *)NULL);
return (TCL_ERROR);
}
} else if (ARG0_IS_S("sigmas")) {
if (argc>1) {
if (tclcommand_iccp3m_parse_double_list(interp, iccp3m_cfg.n_ic, argv[1], ICCP3M_SIGMA)!=TCL_OK) {
return TCL_ERROR;
}
argc-=2;
argv+=2;
} else {
Tcl_AppendResult(interp, "ICCP3M Usage: sigmas <list of sigmas>", (char *)NULL);
return (TCL_ERROR);
}
} else if (ARG0_IS_S("epsilons")) {
if (argc>1) {
if (tclcommand_iccp3m_parse_double_list(interp, iccp3m_cfg.n_ic, argv[1], ICCP3M_EPSILON) != TCL_OK) {
return TCL_ERROR;
}
argc-=2;
argv+=2;
} else {
Tcl_AppendResult(interp, "ICCP3M Usage: epsilons <list of epsilons>", (char *)NULL);
return (TCL_ERROR);
}
} else {
Tcl_AppendResult(interp, "Unknown Argument to ICCP3M ", argv[0], (char *)NULL);
return (TCL_ERROR);
}
}
}
iccp3m_initialized=1;
iccp3m_cfg.set_flag = 1;
if (!iccp3m_cfg.areas || !iccp3m_cfg.ein || !iccp3m_cfg.nvectorx)
return TCL_ERROR;
if (!iccp3m_cfg.sigma) {
iccp3m_cfg.sigma = (double*) Utils::malloc(iccp3m_cfg.n_ic*sizeof(double));
memset(iccp3m_cfg.sigma, 0, iccp3m_cfg.n_ic*sizeof(double));
}
mpi_iccp3m_init(0);
return TCL_OK;
}
/** returns 1 if and only if the GPU with the given id is usable for
CUDA computations. Only devices with compute capability of 1.1 or
higher are ok, since atomic operations are required for
CUDA-LB. */
int tclcommand_cuda(ClientData data, Tcl_Interp *interp,
int argc, char **argv)
{
#ifndef CUDA
Tcl_AppendResult(interp, "Feature CUDA required!", (char *)NULL);
return TCL_ERROR;
#else
if (argc <= 1) {
Tcl_AppendResult(interp, "too few arguments to the cuda command", (char *)NULL);
return TCL_ERROR;
}
argc--; argv++;
if (ARG0_IS_S("list")) {
if (argc != 1) {
Tcl_AppendResult(interp, "cuda list takes no arguments", (char *)NULL);
return TCL_ERROR;
}
return list_gpus(interp);
}
else if (ARG0_IS_S("setdevice")) {
int dev;
if (argc <= 1 || !ARG1_IS_I(dev)) {
Tcl_AppendResult(interp, "expected: cuda setdevice <devnr>", (char *)NULL);
return TCL_ERROR;
}
if (cuda_check_gpu(dev) == ES_ERROR) {
Tcl_AppendResult(interp, "GPU not present or compute model not sufficient", (char *)NULL);
return TCL_ERROR;
}
if (cuda_set_device(dev) == ES_OK) {
return TCL_OK;
}
else {
Tcl_AppendResult(interp, cuda_error, (char *)NULL);
return TCL_ERROR;
}
}
else if (ARG0_IS_S("getdevice")) {
if (argc != 1) {
Tcl_AppendResult(interp, "cuda getdevice takes no arguments", (char *)NULL);
return TCL_ERROR;
}
int dev = cuda_get_device();
if (dev >= 0) {
char buffer[TCL_INTEGER_SPACE];
sprintf(buffer, "%d", dev);
Tcl_AppendResult(interp, buffer, (char *)NULL);
return TCL_OK;
}
else {
Tcl_AppendResult(interp, cuda_error, (char *)NULL);
return TCL_ERROR;
}
}
else {
Tcl_AppendResult(interp, "unknown subcommand \"", argv[0], "\"", (char *)NULL);
return TCL_ERROR;
}
#endif /* defined(CUDA) */
}
