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 adress_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_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_mmm1d(Tcl_Interp *interp, int argc, char **argv)
{
double switch_rad, maxPWerror;
int bessel_cutoff;
if (argc < 2) {
Tcl_AppendResult(interp, "wrong # arguments: inter coulomb mmm1d <switch radius> "
"{<bessel cutoff>} <maximal error for near formula> | tune <maximal pairwise error>", (char *) NULL);
return TCL_ERROR;
}
if (ARG0_IS_S("tune")) {
/* autodetermine bessel cutoff AND switching radius */
if (! ARG_IS_D(1, maxPWerror))
return TCL_ERROR;
bessel_cutoff = -1;
switch_rad = -1;
}
else {
if (argc == 2) {
/* autodetermine bessel cutoff */
if ((! ARG_IS_D(0, switch_rad)) ||
(! ARG_IS_D(1, maxPWerror)))
return TCL_ERROR;
bessel_cutoff = -1;
}
else if (argc == 3) {
/* fully manual */
if((! ARG_IS_D(0, switch_rad)) ||
(! ARG_IS_I(1, bessel_cutoff)) ||
(! ARG_IS_D(2, maxPWerror)))
return TCL_ERROR;
if (bessel_cutoff <=0) {
Tcl_AppendResult(interp, "bessel cutoff too small", (char *)NULL);
return TCL_ERROR;
}
}
else {
Tcl_AppendResult(interp, "wrong # arguments: inter coulomb mmm1d <switch radius> "
"{<bessel cutoff>} <maximal error for near formula> | tune <maximal pairwise error>", (char *) NULL);
return TCL_ERROR;
}
if (switch_rad <= 0 || switch_rad > box_l[2]) {
Tcl_AppendResult(interp, "switching radius is not between 0 and box_l[2]", (char *)NULL);
return TCL_ERROR;
}
}
MMM1D_set_params(switch_rad, bessel_cutoff, maxPWerror);
char *log = NULL;
int result = mmm1d_tune(&log) == ES_OK ? TCL_OK : TCL_ERROR;
Tcl_AppendResult(interp, log, NULL);
if (log)
free(log);
return gather_runtime_errors(interp, result);
}
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_parse_coulomb(Tcl_Interp * interp, int argc, char ** argv)
{
double d1;
Tcl_ResetResult(interp);
if(argc == 0) {
tclprint_to_result_CoulombIA(interp);
return TCL_OK;
}
if (! ARG0_IS_D(d1)) {
#ifdef P3M
Tcl_ResetResult(interp);
if (ARG0_IS_S("elc") && ((coulomb.method == COULOMB_P3M) || (coulomb.method == COULOMB_ELC_P3M)))
return tclcommand_inter_coulomb_parse_elc_params(interp, argc - 1, argv + 1);
if (ARG0_IS_S("elc") && coulomb.method == COULOMB_P3M_GPU) {
Tcl_AppendResult(interp, "elc can not be used in conjunction with the gpu p3m",
(char *) NULL);
return TCL_ERROR;
}
if (coulomb.method == COULOMB_P3M || coulomb.method == COULOMB_P3M_GPU)
return tclcommand_inter_coulomb_parse_p3m_opt_params(interp, argc, argv);
else {
Tcl_AppendResult(interp, "expect: inter coulomb <bjerrum>",
(char *) NULL);
return TCL_ERROR;
}
#else
return TCL_ERROR;
#endif
}
if (coulomb_set_bjerrum(d1) == TCL_ERROR) {
Tcl_AppendResult(interp, argv[0], "bjerrum length must be positive",
(char *) NULL);
return TCL_ERROR;
}
argc -= 1;
argv += 1;
if (d1 == 0.0 && argc == 0) {
mpi_bcast_coulomb_params();
return TCL_OK;
}
if(argc < 1) {
Tcl_AppendResult(interp, "wrong # args for inter coulomb.",
(char *) NULL);
mpi_bcast_coulomb_params();
return TCL_ERROR;
}
/* check method */
#define REGISTER_COULOMB(name, parser) \
if(ARG0_IS_S(name)) \
return parser(interp, argc-1, argv+1);
#ifdef P3M
REGISTER_COULOMB("p3m", tclcommand_inter_coulomb_parse_p3m);
#endif
REGISTER_COULOMB("dh", tclcommand_inter_coulomb_parse_dh);
if(ARG0_IS_S("rf")) return tclcommand_inter_coulomb_parse_rf(interp, argc-1, argv+1,COULOMB_RF);
if(ARG0_IS_S("inter_rf")) return tclcommand_inter_coulomb_parse_rf(interp, argc-1, argv+1,COULOMB_INTER_RF);
REGISTER_COULOMB("mmm1d", tclcommand_inter_coulomb_parse_mmm1d);
REGISTER_COULOMB("mmm2d", tclcommand_inter_coulomb_parse_mmm2d);
REGISTER_COULOMB("maggs", tclcommand_inter_coulomb_parse_maggs);
REGISTER_COULOMB("memd", tclcommand_inter_coulomb_parse_maggs);
#ifdef MMM1D_GPU
REGISTER_COULOMB("mmm1dgpu", tclcommand_inter_coulomb_parse_mmm1dgpu);
#endif
#ifdef EWALD_GPU
REGISTER_COULOMB("ewaldgpu", tclcommand_inter_coulomb_parse_ewaldgpu);
#endif
/* fallback */
coulomb.method = COULOMB_NONE;
coulomb.bjerrum = 0.0;
mpi_bcast_coulomb_params();
Tcl_AppendResult(interp, "do not know coulomb method \"",argv[0],
"\": coulomb switched off", (char *) NULL);
return TCL_ERROR;
}
/** 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) */
}
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_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;
}
/** Parser for the \ref tclcommand_lbnode command. */
int tclcommand_lbnode(ClientData data, Tcl_Interp *interp, int argc, char **argv) {
#if defined (LB) || defined (LB_GPU)
int coord[3];
int counter;
int integer_return = 0;
double double_return[19];
char double_buffer[TCL_DOUBLE_SPACE];
char integer_buffer[TCL_INTEGER_SPACE];
for (counter = 0; counter < 19; counter++)
double_return[counter]=0;
--argc; ++argv;
if (lattice_switch & LATTICE_LB_GPU) {
} else {
#ifdef LB
if (lbfluid[0][0]==0) {
Tcl_AppendResult(interp, "lbnode: lbfluid not correctly initialized", (char *)NULL);
return TCL_ERROR;
}
#endif
}
if (argc < 3) {
lbnode_tcl_print_usage(interp);
return TCL_ERROR;
}
if (!ARG_IS_I(0,coord[0]) || !ARG_IS_I(1,coord[1]) || !ARG_IS_I(2,coord[2])) {
Tcl_AppendResult(interp, "Coordinates are not integer.", (char *)NULL);
return TCL_ERROR;
}
if (lattice_switch & LATTICE_LB_GPU) {
#ifdef LB_GPU
if (coord[0]<0 || coord[0]>(box_l[0])/lbpar_gpu.agrid-1 || coord[1]<0 || coord[1]>(box_l[1])/lbpar_gpu.agrid-1 || coord[2]<0 || coord[2]>(box_l[2])/lbpar_gpu.agrid-1) {
Tcl_AppendResult(interp, "Coordinates do not correspond to a valid LB node index", (char *)NULL);
return TCL_ERROR;
}
#endif
}
else {
#ifdef LB
if (coord[0]<0 || coord[0]>(box_l[0])/lbpar.agrid-1 || coord[1]<0 || coord[1]>(box_l[1])/lbpar.agrid-1 || coord[2]<0 || coord[2]>(box_l[2])/lbpar.agrid-1) {
Tcl_AppendResult(interp, "Coordinates do not correspond to a valid LB node index", (char *)NULL);
return TCL_ERROR;
}
#endif
}
argc-=3; argv+=3;
if (ARG0_IS_S("print")) {
argc--; argv++;
while (argc > 0) {
if (ARG0_IS_S("rho") || ARG0_IS_S("density")) {
lb_lbnode_get_rho(coord, double_return);
for (counter = 0; counter < 1; counter++) {
Tcl_PrintDouble(interp, double_return[counter], double_buffer);
Tcl_AppendResult(interp, double_buffer, " ", (char *)NULL);
}
argc--; argv++;
}
else if (ARG0_IS_S("u") || ARG0_IS_S("v") || ARG0_IS_S("velocity")) {
lb_lbnode_get_u(coord, double_return);
for (counter = 0; counter < 3; counter++) {
Tcl_PrintDouble(interp, double_return[counter], double_buffer);
Tcl_AppendResult(interp, double_buffer, " ", (char *)NULL);
}
argc--; argv++;
}
else if (ARG0_IS_S("pi") || ARG0_IS_S("pressure")) {
lb_lbnode_get_pi(coord, double_return);
for (counter = 0; counter < 6; counter++) {
Tcl_PrintDouble(interp, double_return[counter], double_buffer);
Tcl_AppendResult(interp, double_buffer, " ", (char *)NULL);
}
argc--; argv++;
}
else if (ARG0_IS_S("pi_neq")) { /* this has to come after pi */
lb_lbnode_get_pi_neq(coord, double_return);
for (counter = 0; counter < 6; counter++) {
Tcl_PrintDouble(interp, double_return[counter], double_buffer);
Tcl_AppendResult(interp, double_buffer, " ", (char *)NULL);
}
argc--; argv++;
}
else if (ARG0_IS_S("boundary")) {
lb_lbnode_get_boundary(coord, &integer_return);
sprintf(integer_buffer, "%d", integer_return);
Tcl_AppendResult(interp, integer_buffer, " ", (char *)NULL);
argc--; argv++;
}
else if (ARG0_IS_S("populations") || ARG0_IS_S("pop")) {
lb_lbnode_get_pop(coord, double_return);
for (counter = 0; counter < 19; counter++) {
Tcl_PrintDouble(interp, double_return[counter], double_buffer);
Tcl_AppendResult(interp, double_buffer, " ", (char *)NULL);
}
argc--; argv++;
}
else {
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "unknown fluid data \"", argv[0], "\" requested", (char *)NULL);
return TCL_ERROR;
}
}
}
else if (ARG0_IS_S("set")) {
argc--; argv++;
if (ARG0_IS_S("rho") || ARG0_IS_S("density")) {
argc--; argv++;
for (counter = 0; counter < 1; counter++) {
if (!ARG0_IS_D(double_return[counter])) {
Tcl_AppendResult(interp, "recieved not a double but \"", argv[0], "\" requested", (char *)NULL);
return TCL_ERROR;
}
argc--; argv++;
}
if (lb_lbnode_set_rho(coord, double_return[0]) != 0) {
Tcl_AppendResult(interp, "General Error on lbnode set rho.", (char *)NULL);
return TCL_ERROR;
}
}
else if (ARG0_IS_S("u") || ARG0_IS_S("v") || ARG0_IS_S("velocity")) {
argc--; argv++;
for (counter = 0; counter < 3; counter++) {
if (!ARG0_IS_D(double_return[counter])) {
Tcl_AppendResult(interp, "received not a double but \"", argv[0], "\" requested", (char *)NULL);
return TCL_ERROR;
}
argc--; argv++;
}
if (lb_lbnode_set_u(coord, double_return) != 0) {
Tcl_AppendResult(interp, "General Error on lbnode set u.", (char *)NULL);
return TCL_ERROR;
}
}
else if (ARG0_IS_S("pop") || ARG0_IS_S("populations") ) {
argc--; argv++;
for (counter = 0; counter < 19; counter++) {
if (!ARG0_IS_D(double_return[counter])) {
Tcl_AppendResult(interp, "recieved not a double but \"", argv[0], "\" requested", (char *)NULL);
return TCL_ERROR;
}
argc--; argv++;
}
if (lb_lbnode_set_pop(coord, double_return) != 0) {
Tcl_AppendResult(interp, "General Error on lbnode set pop.", (char *)NULL);
return TCL_ERROR;
}
}
else {
Tcl_AppendResult(interp, "unknown feature \"", argv[0], "\" of lbnode x y z set", (char *)NULL);
return TCL_ERROR;
}
} else {
Tcl_AppendResult(interp, "unknown feature \"", argv[0], "\" of lbnode", (char *)NULL);
return TCL_ERROR;
}
return TCL_OK;
#else /* !defined LB */
Tcl_AppendResult(interp, "LB is not compiled in!", NULL);
return TCL_ERROR;
#endif
}
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_total_particles == 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.h)\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.c ");
#else
Tcl_AppendResult(interp, "DIPOLES not compiled (see config.h)\n", (char *)NULL);
#endif
}
else if (ARG0_IS_S("total")) {
for(j=0; j<9; j++) {
tvalue[j] = p_tensor.data.e[j];
for (i = 1; i < 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_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_on_collision(ClientData data, Tcl_Interp *interp, int argc, char **argv)
{
// If no argumens are given, print status
if (argc==1) {
char s[128 + 3*TCL_INTEGER_SPACE + TCL_DOUBLE_SPACE];
if (collision_params.mode == 0) {
sprintf(s, "off");
Tcl_AppendResult(interp, s, (char*) NULL);
return TCL_OK;
}
/* this one can be combined with the rest */
if (collision_params.mode & COLLISION_MODE_EXCEPTION) {
sprintf(s, " exception");
Tcl_AppendResult(interp, s + 1, (char*) NULL);
}
if (collision_params.mode & COLLISION_MODE_VS) {
sprintf(s, " bind_at_point_of_collision %f %d %d %d",
collision_params.distance, collision_params.bond_centers,
collision_params.bond_vs, collision_params.vs_particle_type);
Tcl_AppendResult(interp, s + 1, (char*) NULL);
return TCL_OK;
}
if (collision_params.mode & COLLISION_MODE_BIND_THREE_PARTICLES) {
sprintf(s, " bind_three_particles %f %d %d %d",
collision_params.distance, collision_params.bond_centers,
collision_params.bond_three_particles, collision_params.three_particle_angle_resolution);
Tcl_AppendResult(interp, s + 1, (char*) NULL);
}
else if (collision_params.mode & COLLISION_MODE_GLUE_TO_SURF) {
sprintf(s, " glue_to_surface %f %d %d %d %d %d %d %f",
collision_params.distance, collision_params.bond_centers,
collision_params.bond_vs, collision_params.vs_particle_type,
collision_params.part_type_to_be_glued,
collision_params.part_type_to_attach_vs_to,
collision_params.part_type_after_glueing,
collision_params.dist_glued_part_to_vs);
Tcl_AppendResult(interp, s + 1, (char*) NULL);
}
else if (collision_params.mode & COLLISION_MODE_BOND) {
sprintf(s, " bind_centers %f %d", collision_params.distance,
collision_params.bond_centers);
Tcl_AppendResult(interp, s + 1, (char*) NULL);
}
// first character is always the separating space
return TCL_OK;
}
argc--; argv++;
// Otherwise, we set parameters
if (ARG0_IS_S("off")) {
collision_detection_set_params(0,0,0,0,0,0,0,0,0,0,0);
return TCL_OK;
}
else {
/* parameters of collision_detection_set_params */
int mode = 0;
// Distances
double d,d2 = 0;
// Bond types
int bond_centers = 0;
int bond_vs = 0;
// Particle types for virtual sites based based methods
int t,tg,tv,ta = 0;
// /bond types for three particle binding
int bond_three_particles=0;
int angle_resolution=0;
if (ARG0_IS_S("exception")) {
mode = COLLISION_MODE_EXCEPTION;
argc--; argv++;
}
if (argc == 0) {
Tcl_AppendResult(interp, "throwing exception without creating any bond is not possible.", (char*) NULL);
return TCL_ERROR;
}
if (ARG0_IS_S("bind_centers")) {
mode |= COLLISION_MODE_BOND;
if (argc != 3) {
Tcl_AppendResult(interp, "Not enough parameters, need a distance and a bond type as args.", (char*) NULL);
return TCL_ERROR;
}
if (!ARG_IS_D(1,d)) {
Tcl_AppendResult(interp, "Need a distance as 1st arg.", (char*) NULL);
return TCL_ERROR;
}
if (!ARG_IS_I(2,bond_centers)) {
Tcl_AppendResult(interp, "Need a bond type as 2nd argument.", (char*) NULL);
return TCL_ERROR;
}
argc -= 3; argv += 3;
}
else if (ARG0_IS_S("bind_at_point_of_collision")) {
mode |= COLLISION_MODE_BOND | COLLISION_MODE_VS;
if (argc != 5) {
Tcl_AppendResult(interp, "Not enough parameters, need a distance, two bond types, and a particle type as args.", (char*) NULL);
return TCL_ERROR;
}
if (!ARG_IS_D(1,d)) {
Tcl_AppendResult(interp, "Need a distance as 1st arg.", (char*) NULL);
return TCL_ERROR;
}
if (!ARG_IS_I(2,bond_centers)) {
Tcl_AppendResult(interp, "Need a bond type as 2nd arg.", (char*) NULL);
return TCL_ERROR;
}
if (!ARG_IS_I(3,bond_vs)) {
Tcl_AppendResult(interp, "Need a bond type as 3rd arg.", (char*) NULL);
return TCL_ERROR;
}
if (!ARG_IS_I(4,t)) {
Tcl_AppendResult(interp, "Need a particle type as 4th arg.", (char*) NULL);
return TCL_ERROR;
}
argc -= 5; argv += 5;
}
else if (ARG0_IS_S("glue_to_surface")) {
mode |= COLLISION_MODE_BOND | COLLISION_MODE_GLUE_TO_SURF;
if (argc != 9) {
Tcl_AppendResult(interp, "Not enough parameters, need a distance, two bond types, four particle types and another distance as args.", (char*) NULL);
return TCL_ERROR;
}
if (!ARG_IS_D(1,d)) {
Tcl_AppendResult(interp, "Need a distance as 1st arg.", (char*) NULL);
return TCL_ERROR;
}
if (!ARG_IS_I(2,bond_centers)) {
Tcl_AppendResult(interp, "Need a bond type as 2nd arg.", (char*) NULL);
return TCL_ERROR;
}
if (!ARG_IS_I(3,bond_vs)) {
Tcl_AppendResult(interp, "Need a bond type as 3rd arg.", (char*) NULL);
return TCL_ERROR;
}
if (!ARG_IS_I(4,t)) {
Tcl_AppendResult(interp, "Need a particle type as 4th arg.", (char*) NULL);
return TCL_ERROR;
}
if (!ARG_IS_I(5,tg)) {
Tcl_AppendResult(interp, "Need a particle type as 5th arg.", (char*) NULL);
return TCL_ERROR;
}
if (!ARG_IS_I(6,tv)) {
Tcl_AppendResult(interp, "Need a particle type as 6th arg.", (char*) NULL);
return TCL_ERROR;
}
if (!ARG_IS_I(7,ta)) {
Tcl_AppendResult(interp, "Need a particle type as 7th arg.", (char*) NULL);
return TCL_ERROR;
}
if (!ARG_IS_D(8,d2)) {
Tcl_AppendResult(interp, "Need a distance as 8th arg.", (char*) NULL);
return TCL_ERROR;
}
argc -= 9; argv += 8;
}
else if (ARG0_IS_S("bind_three_particles")) {
mode |= COLLISION_MODE_BIND_THREE_PARTICLES | COLLISION_MODE_BOND;
if (argc != 5) {
Tcl_AppendResult(interp, "Not enough parameters, need a distance and two bond types.", (char*) NULL);
return TCL_ERROR;
}
if (!ARG_IS_D(1,d)) {
Tcl_AppendResult(interp, "Need a distance as 1st arg.", (char*) NULL);
return TCL_ERROR;
}
if (!ARG_IS_I(2,bond_centers)) {
Tcl_AppendResult(interp, "Need a bond type as 2nd arg.", (char*) NULL);
return TCL_ERROR;
}
if (!ARG_IS_I(3,bond_three_particles)) {
Tcl_AppendResult(interp, "Need a bond type as 3rd arg.", (char*) NULL);
return TCL_ERROR;
}
if (!ARG_IS_I(4,angle_resolution)) {
Tcl_AppendResult(interp, "Need an angle resolution as 4th arg.", (char*) NULL);
return TCL_ERROR;
}
argc -= 5; argv += 5;
}
else {
Tcl_AppendResult(interp, "\"", argv[0], "\" is not a valid collision detection mode.", (char*) NULL);
return TCL_ERROR;
}
int res = collision_detection_set_params(mode,d,bond_centers,bond_vs,t,d2,tg,tv,ta,bond_three_particles,angle_resolution);
switch (res) {
case 1:
Tcl_AppendResult(interp, "This mode requires the VIRTUAL_SITES_RELATIVE feature to be compiled in.", (char*) NULL);
return TCL_ERROR;
case 2:
Tcl_AppendResult(interp, "Collision detection only works on a single cpu.", (char*) NULL);
return TCL_ERROR;
case 3:
Tcl_AppendResult(interp, "Bond type does not exist.", (char*) NULL);
return TCL_ERROR;
case 4:
Tcl_AppendResult(interp, "Real particles' bond has to be a pair bond.", (char*) NULL);
return TCL_ERROR;
case 5:
Tcl_AppendResult(interp, "Virtual particles need a pair bond or triple bond.", (char*) NULL);
return TCL_ERROR;
case 6:
Tcl_AppendResult(interp, "Not enough angular bonds.", (char*) NULL);
return TCL_ERROR;
case 7:
Tcl_AppendResult(interp, "bond_three_particles needs triple bonds.", (char*) NULL);
return TCL_ERROR;
}
return TCL_OK;
}
}
int tclcommand_on_collision(ClientData data, Tcl_Interp *interp, int argc, char **argv)
{
// If no argumens are given, print status
if (argc==1) {
char s[128 + 3*TCL_INTEGER_SPACE + TCL_DOUBLE_SPACE];
if (collision_params.mode == 0) {
sprintf(s, "off");
Tcl_AppendResult(interp, s, (char*) NULL);
return TCL_OK;
}
/* this one can be combined with the rest */
if (collision_params.mode & COLLISION_MODE_EXCEPTION) {
sprintf(s, " exception");
}
if (collision_params.mode & COLLISION_MODE_VS) {
sprintf(s, " bind_at_point_of_collision %f %d %d %d",
collision_params.distance, collision_params.bond_centers,
collision_params.bond_vs, collision_params.vs_particle_type);
}
else if (collision_params.mode & COLLISION_MODE_BOND) {
sprintf(s, " bind_centers %f %d", collision_params.distance,
collision_params.bond_centers);
}
// first character is always the separating space
Tcl_AppendResult(interp, s + 1, (char*) NULL);
return TCL_OK;
}
argc--; argv++;
// Otherwise, we set parameters
if (ARG0_IS_S("off")) {
collision_detection_set_params(0,0,0,0,0);
return TCL_OK;
}
else {
/* parameters of collision_detection_set_params */
int mode = 0;
double d = 0;
int bond_centers = 0;
int bond_vs = 0;
int t = 0;
if (ARG0_IS_S("exception")) {
mode = COLLISION_MODE_EXCEPTION;
argc--; argv++;
}
if (argc == 0) {
Tcl_AppendResult(interp, "throwing exception without creating any bond is not possible.", (char*) NULL);
return TCL_ERROR;
}
if (ARG0_IS_S("bind_centers")) {
mode |= COLLISION_MODE_BOND;
if (argc != 3) {
Tcl_AppendResult(interp, "Not enough parameters, need a distance and a bond type as args.", (char*) NULL);
return TCL_ERROR;
}
if (!ARG_IS_D(1,d)) {
Tcl_AppendResult(interp, "Need a distance as 1st arg.", (char*) NULL);
return TCL_ERROR;
}
if (!ARG_IS_I(2,bond_centers)) {
Tcl_AppendResult(interp, "Need a bond type as 2nd argument.", (char*) NULL);
return TCL_ERROR;
}
argc -= 3; argv += 3;
}
else if (ARG0_IS_S("bind_at_point_of_collision")) {
mode |= COLLISION_MODE_BOND | COLLISION_MODE_VS;
if (argc != 5) {
Tcl_AppendResult(interp, "Not enough parameters, need a distance, two bond types, and a particle type as args.", (char*) NULL);
return TCL_ERROR;
}
if (!ARG_IS_D(1,d)) {
Tcl_AppendResult(interp, "Need a distance as 1st arg.", (char*) NULL);
return TCL_ERROR;
}
if (!ARG_IS_I(2,bond_centers)) {
Tcl_AppendResult(interp, "Need a bond type as 2nd arg.", (char*) NULL);
return TCL_ERROR;
}
if (!ARG_IS_I(3,bond_vs)) {
Tcl_AppendResult(interp, "Need a bond type as 3rd arg.", (char*) NULL);
return TCL_ERROR;
}
if (!ARG_IS_I(4,t)) {
Tcl_AppendResult(interp, "Need a particle type as 4th arg.", (char*) NULL);
return TCL_ERROR;
}
argc -= 5; argv += 5;
}
else {
Tcl_AppendResult(interp, "\"", argv[0], "\" is not a valid collision detection mode.", (char*) NULL);
return TCL_ERROR;
}
int res = collision_detection_set_params(mode,d,bond_centers,bond_vs,t);
switch (res) {
case 1:
Tcl_AppendResult(interp, "This mode requires the VIRTUAL_SITES_RELATIVE feature to be compiled in.", (char*) NULL);
return TCL_ERROR;
case 2:
Tcl_AppendResult(interp, "Collision detection only works on a single cpu.", (char*) NULL);
return TCL_ERROR;
case 3:
Tcl_AppendResult(interp, "Bond type does not exist.", (char*) NULL);
return TCL_ERROR;
case 4:
Tcl_AppendResult(interp, "Real particles' bond has to be a pair bond.", (char*) NULL);
return TCL_ERROR;
case 5:
Tcl_AppendResult(interp, "Virtual particles need a pair bond or triple bond.", (char*) NULL);
return TCL_ERROR;
}
return TCL_OK;
}
}
/** Parser for the \ref lbnode command.
*/
int tclcommand_lbnode_gpu(Tcl_Interp *interp, int argc, char **argv) {
#ifdef LB_GPU
int coord[3];
int counter;
char double_buffer[TCL_DOUBLE_SPACE];
LB_values_gpu *host_print_values;
host_print_values = malloc(sizeof(LB_values_gpu));
int single_nodeindex;
--argc; ++argv;
if (argc < 3) {
Tcl_AppendResult(interp, "too few arguments for lbnode", (char *)NULL);
return TCL_ERROR;
}
if (!ARG_IS_I(0,coord[0]) || !ARG_IS_I(1,coord[1]) || !ARG_IS_I(2,coord[2])) {
Tcl_AppendResult(interp, "wrong arguments for lbnode", (char *)NULL);
return TCL_ERROR;
}
argc-=3; argv+=3;
if (argc == 0 ) {
Tcl_AppendResult(interp, "lbnode syntax: lbnode X Y Z [ print ] [ rho | u ]", (char *)NULL);
return TCL_ERROR;
}
single_nodeindex = coord[0] + coord[1]*lbpar_gpu.dim_x + coord[2]*lbpar_gpu.dim_x*lbpar_gpu.dim_y;
if (ARG0_IS_S("print")) {
argc--; argv++;
if (argc == 0 ) {
Tcl_AppendResult(interp, "lbnode syntax: lbnode X Y Z [ print ] [ rho | u ]", (char *)NULL);
return TCL_ERROR;
}
while (argc > 0) {
if (ARG0_IS_S("rho") || ARG0_IS_S("density")) {
lb_print_node_GPU(single_nodeindex, host_print_values);
Tcl_PrintDouble(interp, (double)host_print_values[0].rho, double_buffer);
Tcl_AppendResult(interp, double_buffer, " ", (char *)NULL);
argc--; argv++;
}
else if (ARG0_IS_S("u") || ARG0_IS_S("v") || ARG0_IS_S("velocity")) {
lb_print_node_GPU(single_nodeindex, host_print_values);
for (counter = 0; counter < 3; counter++) {
Tcl_PrintDouble(interp, (double)host_print_values[0].v[counter], double_buffer);
Tcl_AppendResult(interp, double_buffer, " ", (char *)NULL);
}
argc--; argv++;
}
else if (ARG0_IS_S("ux") || ARG0_IS_S("vx")) {
lb_print_node_GPU(single_nodeindex, host_print_values);
Tcl_PrintDouble(interp, (double)host_print_values[0].v[0], double_buffer);
Tcl_AppendResult(interp, double_buffer, " ", (char *)NULL);
argc--; argv++;
}
else if (ARG0_IS_S("uy") || ARG0_IS_S("vy")) {
lb_print_node_GPU(single_nodeindex, host_print_values);
Tcl_PrintDouble(interp, (double)host_print_values[0].v[1], double_buffer);
Tcl_AppendResult(interp, double_buffer, " ", (char *)NULL);
argc--; argv++;
}
else if (ARG0_IS_S("uz") || ARG0_IS_S("vz")) {
lb_print_node_GPU(single_nodeindex, host_print_values);
Tcl_PrintDouble(interp, (double)host_print_values[0].v[2], double_buffer);
Tcl_AppendResult(interp, double_buffer, " ", (char *)NULL);
argc--; argv++;
}
else {
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "unknown fluid data \"", argv[0], "\" requested", (char *)NULL);
return TCL_ERROR;
}
}
}
else {
Tcl_AppendResult(interp, "unknown feature \"", argv[0], "\" of lbnode", (char *)NULL);
return TCL_ERROR;
}
return TCL_OK;
#else /* !defined LB_GPU */
Tcl_AppendResult(interp, "LB_GPU is not compiled in!", NULL);
return TCL_ERROR;
#endif /* LB_GPU */
}
int tclcommand_inter_coulomb_parse_p3m(Tcl_Interp * interp, int argc, char ** argv)
{
double r_cut, alpha, accuracy = -1.0;
int mesh[3], cao, i;
IntList il;
init_intlist(&il);
if (argc < 1) {
Tcl_AppendResult(interp, "expected: inter coulomb <bjerrum> p3m tune | [gpu] <r_cut> { <mesh> | \\{ <mesh_x> <mesh_y> <mesh_z> \\} } <cao> [<alpha> [<accuracy>]]",
(char *) NULL);
return TCL_ERROR;
}
if (ARG0_IS_S("gpu")) {
coulomb.method = COULOMB_P3M_GPU;
argc--;
argv++;
}
if (ARG0_IS_S("tune"))
return tclcommand_inter_coulomb_parse_p3m_tune(interp, argc-1, argv+1, 0);
if (ARG0_IS_S("tunev2"))
return tclcommand_inter_coulomb_parse_p3m_tune(interp, argc-1, argv+1, 1);
if(! ARG0_IS_D(r_cut))
return TCL_ERROR;
if(argc < 3 || argc > 5) {
Tcl_AppendResult(interp, "wrong # arguments: inter coulomb <bjerrum> p3m [gpu] <r_cut> { <mesh> | \\{ <mesh_x> <mesh_y> <mesh_z> \\} } <cao> [<alpha> [<accuracy>]]",
(char *) NULL);
return TCL_ERROR;
}
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 {
mesh[1] = mesh[2] = mesh[0];
}
if ( mesh[0]%2 != 0 || mesh[1]%2 != 0 || mesh[2]%2 != 0 ) {
Tcl_AppendResult(interp, "P3M requires an even number of mesh points in all directions", (char *) NULL);
return TCL_ERROR;
}
if(! ARG_IS_I(2, cao)) {
Tcl_AppendResult(interp, "integer expected", (char *) NULL);
return TCL_ERROR;
}
if(argc > 3) {
if(! ARG_IS_D(3, alpha))
return TCL_ERROR;
}
else {
Tcl_AppendResult(interp, "Automatic p3m tuning not implemented.",
(char *) NULL);
return TCL_ERROR;
}
if(argc > 4) {
if(! ARG_IS_D(4, accuracy)) {
Tcl_AppendResult(interp, "double expected", (char *) NULL);
return TCL_ERROR;
}
}
if ((i = p3m_set_params(r_cut, mesh, cao, alpha, accuracy)) < 0) {
switch (i) {
case -1:
Tcl_AppendResult(interp, "r_cut must be positive", (char *) NULL);
break;
case -2:
Tcl_AppendResult(interp, "mesh must be positive", (char *) NULL);
break;
case -3:
Tcl_AppendResult(interp, "cao must be between 1 and 7 and less than mesh",
(char *) NULL);
break;
case -4:
Tcl_AppendResult(interp, "alpha must be positive", (char *) NULL);
break;
case -5:
Tcl_AppendResult(interp, "accuracy must be positive", (char *) NULL);
break;
default:;
Tcl_AppendResult(interp, "unspecified error", (char *) NULL);
}
return TCL_ERROR;
}
return TCL_OK;
}
/** Parser for the \ref lbfluid command gpu.
*/
int tclcommand_lbfluid_gpu(Tcl_Interp *interp, int argc, char **argv) {
#ifdef LB_GPU
int err = TCL_OK;
int change = 0;
while (argc > 0) {
if (ARG0_IS_S("grid") || ARG0_IS_S("agrid"))
err = lbfluid_parse_agrid(interp, argc-1, argv+1, &change);
else if (ARG0_IS_S("tau"))
err = lbfluid_parse_tau(interp, argc-1, argv+1, &change);
else if (ARG0_IS_S("density") || ARG0_IS_S("dens"))
err = lbfluid_parse_density(interp, argc-1, argv+1, &change);
else if (ARG0_IS_S("viscosity") || ARG0_IS_S("visc"))
err = lbfluid_parse_viscosity(interp, argc-1, argv+1, &change);
else if (ARG0_IS_S("bulk_viscosity") || ARG0_IS_S("b_visc"))
err = lbfluid_parse_bulk_visc(interp, argc-1, argv+1, &change);
else if (ARG0_IS_S("friction") || ARG0_IS_S("coupling"))
err = lbfluid_parse_friction(interp, argc-1, argv+1, &change);
else if (ARG0_IS_S("ext_force"))
err = lbfluid_parse_ext_force(interp, argc-1, argv+1, &change);
else if (ARG0_IS_S("gamma_odd"))
err = lbfluid_parse_gamma_odd(interp, argc-1, argv+1, &change);
else if (ARG0_IS_S("gamma_even"))
err = lbfluid_parse_gamma_even(interp, argc-1, argv+1, &change);
else {
Tcl_AppendResult(interp, "unknown feature \"", argv[0],"\" of lbfluid", (char *)NULL);
err = TCL_ERROR ;
}
if (err == TCL_ERROR) return TCL_ERROR;
argc -= (change + 1);
argv += (change + 1);
}
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);
LB_TRACE (fprintf(stderr,"tclcommand_lbfluid_gpu parser ok \n"));
return err;
#else /* !defined LB_GPU */
Tcl_AppendResult(interp, "LB_GPU is not compiled in!", NULL);
return TCL_ERROR;
#endif
}
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_inter_parse_magnetic(Tcl_Interp * interp, int argc, char ** argv)
{
double d1;
Tcl_ResetResult(interp);
if(argc == 0) {
tclprint_to_result_DipolarIA(interp);
return TCL_OK;
}
if (! ARG0_IS_D(d1)) {
Tcl_ResetResult(interp);
if (ARG0_IS_S("mdlc") && ((coulomb.Dmethod == DIPOLAR_DS) || (coulomb.Dmethod == DIPOLAR_MDLC_DS)))
return tclcommand_inter_magnetic_parse_mdlc_params(interp, argc - 1, argv + 1);
#ifdef DP3M
if (ARG0_IS_S("mdlc") && ((coulomb.Dmethod == DIPOLAR_P3M) || (coulomb.Dmethod == DIPOLAR_MDLC_P3M)))
return tclcommand_inter_magnetic_parse_mdlc_params(interp, argc - 1, argv + 1);
if (coulomb.Dmethod == DIPOLAR_P3M)
return tclcommand_inter_magnetic_parse_dp3m_opt_params(interp, argc, argv);
else {
Tcl_AppendResult(interp, "expect: inter magnetic <Dbjerrum>",
(char *) NULL);
return TCL_ERROR;
}
#else
return TCL_ERROR;
#endif
}
if (dipolar_set_Dbjerrum(d1) == TCL_ERROR) {
Tcl_AppendResult(interp, argv[0], "Dbjerrum length must be positive",
(char *) NULL);
return TCL_ERROR;
}
argc -= 1;
argv += 1;
if (d1 == 0.0 && argc == 0) {
mpi_bcast_coulomb_params();
return TCL_OK;
}
if(argc < 1) {
Tcl_AppendResult(interp, "wrong # args for inter magnetic.",
(char *) NULL);
mpi_bcast_coulomb_params();
return TCL_ERROR;
}
/* check method */
#define REGISTER_DIPOLAR(name, parser) \
if(ARG0_IS_S(name)) \
return parser(interp, argc-1, argv+1);
#ifdef DP3M
REGISTER_DIPOLAR("p3m", tclcommand_inter_magnetic_parse_dp3m);
#endif
REGISTER_DIPOLAR("dawaanr", tclcommand_inter_magnetic_parse_dawaanr);
REGISTER_DIPOLAR("mdds", tclcommand_inter_magnetic_parse_mdds);
/* fallback */
coulomb.Dmethod = DIPOLAR_NONE;
coulomb.Dbjerrum = 0.0;
mpi_bcast_coulomb_params();
Tcl_AppendResult(interp, "do not know magnetic method \"",argv[0],
"\": magnetic switched off", (char *) NULL);
return TCL_ERROR;
}
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;
}
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 parse_trapmol(Tcl_Interp *interp, int argc, char **argv)
{
#ifdef MOLFORCES
#ifdef EXTERNAL_FORCES
int trap_flag = 0;
int noforce_flag =0;
int i;
#endif
#endif
int mol_num;
double spring_constant;
double drag_constant;
int isrelative;
DoubleList trap_center;
IntList trap_coords;
IntList noforce_coords;
char usage[] = "trapmol usage: <mol_id> { <xpos> <ypos> <zpos> } <isrelative> <spring_constant> <drag_constant> coords { <trapped_coord> <trapped_coord> <trapped_coord> } noforce_coords {<noforce_coord> <noforce_coord> <noforce_coord>}";
init_doublelist(&trap_center);
init_intlist(&trap_coords);
alloc_intlist(&trap_coords,3);
init_intlist(&noforce_coords);
alloc_intlist(&noforce_coords,3);
/* Unless coords are specified the default is just to trap it completely */
trap_coords.e[0] = 1;
trap_coords.e[1] = 1;
trap_coords.e[2] = 1;
Tcl_ResetResult(interp);
/* The first argument should be a molecule number */
if (!ARG0_IS_I(mol_num)) {
Tcl_AppendResult(interp, "first argument should be a molecule id", (char *)NULL);
Tcl_AppendResult(interp, usage, (char *)NULL);
return TCL_ERROR;
} else {
/* Sanity checks */
if (mol_num > n_molecules) {
Tcl_AppendResult(interp, "trapmol: cannot trap mol %d because it does not exist",mol_num , (char *)NULL);
return TCL_ERROR;
}
argc--;
argv++;
}
/* The next argument should be a double list specifying the trap center */
if (!ARG0_IS_DOUBLELIST(trap_center)) {
Tcl_AppendResult(interp, "second argument should be a double list", (char *)NULL);
Tcl_AppendResult(interp, usage , (char *)NULL);
return TCL_ERROR;
} else {
argc -= 1;
argv += 1;
}
/* The next argument should be an integer specifying whether the trap is relative (fraction of box_l) or absolute */
if (!ARG0_IS_I(isrelative)) {
Tcl_AppendResult(interp, "third argument should be an integer", (char *)NULL);
Tcl_AppendResult(interp, usage, (char *)NULL);
return TCL_ERROR;
} else {
argc -= 1;
argv += 1;
}
/* The next argument should be the spring constant for the trap */
if (!ARG0_IS_D(spring_constant)) {
Tcl_AppendResult(interp, "fourth argument should be a double", (char *)NULL);
Tcl_AppendResult(interp, usage, (char *)NULL);
return TCL_ERROR;
} else {
argc -= 1;
argv += 1;
}
/* The next argument should be the drag constant for the trap */
if (!ARG0_IS_D(drag_constant)) {
Tcl_AppendResult(interp, "fifth argument should be a double", (char *)NULL);
Tcl_AppendResult(interp, usage, (char *)NULL);
return TCL_ERROR;
} else {
argc -= 1;
argv += 1;
}
/* Process optional arguments */
while ( argc > 0 ) {
if ( ARG0_IS_S("coords") ) {
if ( !ARG_IS_INTLIST(1,trap_coords) ) {
Tcl_AppendResult(interp, "an intlist is required to specify coords", (char *)NULL);
Tcl_AppendResult(interp, usage, (char *)NULL);
return TCL_ERROR;
}
argc -= 2;
argv += 2;
} else if ( ARG0_IS_S("noforce_coords")) {
if ( !ARG_IS_INTLIST(1,noforce_coords) ) {
Tcl_AppendResult(interp, "an intlist is required to specify coords", (char *)NULL);
Tcl_AppendResult(interp, usage, (char *)NULL);
return TCL_ERROR;
}
argc -= 2;
argv += 2;
} else {
Tcl_AppendResult(interp, "an option is not recognised", (char *)NULL);
Tcl_AppendResult(interp, usage, (char *)NULL);
return TCL_ERROR;
}
}
#ifdef MOLFORCES
#ifdef EXTERNAL_FORCES
for (i = 0; i < 3; i++) {
if (trap_coords.e[i])
trap_flag |= COORD_FIXED(i);
if (noforce_coords.e[i])
noforce_flag |= COORD_FIXED(i);
}
if (set_molecule_trap(mol_num, trap_flag,&trap_center,spring_constant, drag_constant, noforce_flag, isrelative) == TCL_ERROR) {
Tcl_AppendResult(interp, "set topology first", (char *)NULL);
return TCL_ERROR;
}
#else
Tcl_AppendResult(interp, "Error: EXTERNAL_FORCES not defined ", (char *)NULL);
return TCL_ERROR;
#endif
#endif
realloc_doublelist(&trap_center,0);
realloc_intlist(&trap_coords,0);
realloc_intlist(&noforce_coords,0);
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_readpdb(ClientData data, Tcl_Interp *interp, int argc, char *argv[]) {
char *pdb_file = NULL;
char *itp_file = NULL;
int first_id = -1;
int first_type = 0;
int type = -1;
bool fit = false;
bool lj_internal = false;
double lj_rel_cutoff = 2.5;
bool lj_diagonal = false;
std::vector<PdbLJInteraction> ljinteractions;
argc--;
argv++;
while(argc > 0) {
if(ARG0_IS_S("pdb_file")) {
argc--;
argv++;
pdb_file = argv[0];
} else if (ARG0_IS_S("itp_file")) {
argc--;
argv++;
itp_file = argv[0];
} else if (ARG0_IS_S("type")) {
argc--;
argv++;
if(!ARG0_IS_I(type)) {
Tcl_AppendResult(interp, "type takes exactly one integer argument.\n", (char *)NULL);
return TCL_ERROR;
}
} else if (ARG0_IS_S("first_id")) {
argc--;
argv++;
if(!ARG0_IS_I(first_id)) {
Tcl_AppendResult(interp, "first_id takes exactly one integer argument.\n", (char *)NULL);
return TCL_ERROR;
}
} else if (ARG0_IS_S("first_type")) {
argc--;
argv++;
if(!ARG0_IS_I(first_type)) {
Tcl_AppendResult(interp, "first_type takes exactly one integer argument.\n", (char *)NULL);
return TCL_ERROR;
}
} else if (ARG0_IS_S("lj_rel_cutoff")) {
argc--;
argv++;
if(!ARG0_IS_D(lj_rel_cutoff)) {
return TCL_ERROR;
}
} else if (ARG0_IS_S("rescale_box")) {
fit = true;
} else if (ARG0_IS_S("lj_internal")) {
lj_internal = true;
lj_diagonal = false;
} else if (ARG0_IS_S("lj_diagonal")) {
lj_internal = true;
lj_diagonal = true;
} else if (ARG0_IS_S("lj_with")) {
argc--;
argv++;
if(argc < 3)
return TCL_ERROR;
struct PdbLJInteraction ljia;
if(!ARG0_IS_I(ljia.other_type)) {
return TCL_ERROR;
}
argc--;
argv++;
if(!ARG0_IS_D(ljia.epsilon)) {
return TCL_ERROR;
}
argc--;
argv++;
if(!ARG0_IS_D(ljia.sigma)) {
return TCL_ERROR;
}
ljinteractions.push_back(ljia);
}
else {
usage(interp);
return TCL_ERROR;
}
argc--;
argv++;
}
if((type < 0) || (first_id < 0) || (pdb_file == NULL)) {
usage(interp);
return TCL_ERROR;
}
const int n_part = pdb_add_particles_from_file(pdb_file, first_id, type, ljinteractions, lj_rel_cutoff, itp_file, first_type, fit, lj_internal, lj_diagonal);
if(!n_part) {
Tcl_AppendResult(interp, "Could not parse pdb file.", (char *)NULL);
return TCL_ERROR;
}
char buffer[32];
snprintf(buffer, sizeof(buffer), "%d", n_part);
Tcl_AppendResult(interp, buffer, (char *)NULL);
return TCL_OK;
}