int tclcommand_external_potential_tabulated(Tcl_Interp* interp, int argc, char **argv, ExternalPotential* e)
{
char* filename =0;
DoubleList scalelist;
init_doublelist(&scalelist);
while (argc>0) {
if (ARG0_IS_S("file") ) {
if (argc>1) {
filename = argv[1];
argc-=2;
argv+=2;
} else {
Tcl_AppendResult(interp, "Usage: external_potential file <filename>\n" , (char *)NULL);
return TCL_ERROR;
}
} else if (ARG0_IS_S("scale")) {
if (argc>1 && ARG_IS_DOUBLELIST(1, scalelist)) {
argc-=2;
argv+=2;
} else {
Tcl_AppendResult(interp, "Usage: external_potential tabulated scale <float>\n" , (char *)NULL);
return TCL_ERROR;
}
} else {
Tcl_AppendResult(interp, "Unknown argument to external_potential: " , argv[0], "\n", (char *)NULL);
return TCL_ERROR;
}
}
if (filename == 0) {
Tcl_AppendResult(interp, "No filename given to external_potential tabulated\n" , (char *)NULL);
return TCL_ERROR;
}
if (external_potential_tabulated_init(n_external_potentials-1, filename, scalelist.n, scalelist.e)==ES_ERROR) {
Tcl_AppendResult(interp, "Error creating external potential\n" , (char *)NULL);
return TCL_ERROR;
}
return gather_runtime_errors(interp, TCL_OK);
}
int tclcommand_analyze_wallstuff(Tcl_Interp *interp, int argc, char **argv)
{
/* 'analyze wallmsd -xy|-z <min> <max>' */
/******************************************************************************/
char buffer[TCL_INTEGER_SPACE + TCL_DOUBLE_SPACE + 2];
DoubleList g;
int job, bin;
double rmin, rmax,rclocal;
int rbins, boxes;
enum { BINS, MX, MYZ, RDFYZ,BONDYZ,SCALE,SCALE2, PRINT };
if (argc < 2) {
Tcl_AppendResult(interp, "expected: analyze wallstuff -bins <binboundaries> | -myz <bin> |-mx <bin> | -rdfyz <bin> <rmin> <rmax> <rdfbins> | -bondyz | -scale | -scale2 | -print",
(char *)NULL);
return TCL_ERROR;
}
// 1. what do we do?
if (ARG0_IS_S("-bins")) {
job = BINS;
}
else if (ARG0_IS_S("-mx") && argc == 2) {
job = MX;
}
else if (ARG0_IS_S("-myz") && argc == 2) {
job = MYZ;
}
else if (ARG0_IS_S("-rdfyz") && argc == 5) {
job = RDFYZ;
}
else if (ARG0_IS_S("-bondyz") && argc == 5) {
job = BONDYZ;
}
else if (ARG0_IS_S("-scale") && argc == 4) {
job = SCALE;
}
else if (ARG0_IS_S("-scale2") && argc == 4) {
job = SCALE2;
}
else if (ARG0_IS_S("-print") && argc == 2) {
job = PRINT;
}
else {
Tcl_AppendResult(interp, ": analyze wallstuff -bins|-myz|-mx|-rdfyz|-bondyz|-scale|-scale2...", (char *)NULL);
return TCL_ERROR;
}
// 2. parameters
// 2. a) 1. parameter, bin or boundaries
switch (job) {
case BINS:
realloc_doublelist(&wallstuff_boundaries, wallstuff_boundaries.n = 0);
if (!ARG_IS_DOUBLELIST(1, wallstuff_boundaries)) {
return TCL_ERROR;
}
if (wallstuff_boundaries.n < 2) {
return (TCL_ERROR);
}
break;
case MX:
case MYZ:
case RDFYZ:
case BONDYZ:
case SCALE:
case SCALE2:
case PRINT:
if (!ARG_IS_I(1, bin)) {
return (TCL_ERROR);
}
if (bin < 0 || bin >= wallstuff_boundaries.n-1) {
return (TCL_ERROR);
}
break;
}
// 2. other parameters, only for rdf
switch (job) {
case RDFYZ:
if (!ARG_IS_D(2, rmin)) {
return (TCL_ERROR);
}
if (!ARG_IS_D(3, rmax)) {
return (TCL_ERROR);
}
if (!ARG_IS_I(4, rbins)) {
return (TCL_ERROR);
}
break;
case BONDYZ:
if (!ARG_IS_D(2, rclocal)) {
return (TCL_ERROR);
}
if (!ARG_IS_D(3, rmax)) {
return (TCL_ERROR);
}
if (!ARG_IS_I(4, rbins)) {
return (TCL_ERROR);
}
break;
case SCALE:
if (!ARG_IS_I(2, boxes)) {
return (TCL_ERROR);
}
case SCALE2:
if (!ARG_IS_I(2, boxes)) {
return (TCL_ERROR);
}
if (!ARG_IS_D(3, rclocal)) {
return (TCL_ERROR);
}
break;
}
// result double list
init_doublelist(&g);
// check that data is there
switch (job) {
case BINS:
case RDFYZ:
// these cases use partCfg
updatePartCfg(WITHOUT_BONDS);
break;
case BONDYZ:
// these cases use partCfg
updatePartCfg(WITHOUT_BONDS);
break;
case SCALE:
// these cases use partCfg
updatePartCfg(WITHOUT_BONDS);
break;
case SCALE2:
// these cases use partCfg
updatePartCfg(WITHOUT_BONDS);
break;
case MX:
case MYZ:
// these cases use the positions array
if (n_configs == 0) {
Tcl_AppendResult(interp, "no configurations found! Use 'analyze append' to save some!",
(char *)NULL);
return TCL_ERROR;
}
break;
}
// finally, do what is necessary
switch (job) {
case BINS:
wall_sort_particles();
break;
case MX:
realloc_doublelist(&g, g.n = n_configs);
calc_wallmsdx(g.e, bin);
break;
case MYZ:
realloc_doublelist(&g, g.n = n_configs);
calc_wallmsdyz(g.e, bin);
break;
case RDFYZ:
realloc_doublelist(&g, g.n = rbins);
calc_wallrdfyz(g.e, bin, rmin, rmax, rbins);
break;
case BONDYZ:
realloc_doublelist(&g, g.n = rbins+2);
calc_wallbondyz(g.e, bin, rclocal, rmax, rbins);
break;
case SCALE:
realloc_doublelist(&g, g.n = 3*pow(4,boxes));
calc_scaling (g.e,bin, boxes, rclocal);
break;
case SCALE2:
realloc_doublelist(&g, g.n = 14*pow(4,boxes));
calc_scaling2 (g.e,bin, boxes, rclocal);
break;
case PRINT:
// just write out what wall_sort_particles has put into
// this bin
for (int i = 1; i < wallstuff_part_in_bin[bin].n; i++) {
sprintf(buffer," %d",wallstuff_part_in_bin[bin].e[i]);
Tcl_AppendResult(interp, buffer, (char *)NULL);
}
break;
}
// print out double results, if any
if (g.n) {
sprintf(buffer,"%f",g.e[0]);
Tcl_AppendResult(interp, buffer, (char *)NULL);
for (int i = 1; i < g.n; i++) {
sprintf(buffer," %f",g.e[i]);
Tcl_AppendResult(interp, buffer, (char *)NULL);
}
realloc_doublelist(&g, g.n = 0);
}
return (TCL_OK);
}
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;
}
