C++ Tcl_PrintDouble函数代码示例

int tclprint_to_result_SmStIA(Tcl_Interp *interp, int i, int j)
{
  char buffer[TCL_DOUBLE_SPACE+TCL_INTEGER_SPACE];
  IA_parameters *data = get_ia_param(i, j);

  Tcl_AppendResult(interp, "smooth-step ", (char *) NULL);
  Tcl_PrintDouble(interp, data->SmSt_d, buffer);
  Tcl_AppendResult(interp, buffer, " ", (char *) NULL);
  sprintf(buffer, "%d", data->SmSt_n);
  Tcl_AppendResult(interp, buffer, " ", (char *) NULL);
  Tcl_PrintDouble(interp, data->SmSt_eps, buffer);
  Tcl_AppendResult(interp, buffer, " ", (char *) NULL);
  Tcl_PrintDouble(interp, data->SmSt_k0, buffer);
  Tcl_AppendResult(interp, buffer, " ", (char *) NULL);
  Tcl_PrintDouble(interp, data->SmSt_sig, buffer);
  Tcl_AppendResult(interp, buffer, " ", (char *) NULL);
  Tcl_PrintDouble(interp, data->SmSt_cut, buffer);
  Tcl_AppendResult(interp, buffer, " ", (char *) NULL);  
  
  return TCL_OK;
}

static int tclcommand_analyze_fluid_mass_gpu(Tcl_Interp* interp, int argc, char *argv[]){
  char buffer[TCL_DOUBLE_SPACE];
  double host_mass[1];
  
  lb_calc_fluid_mass_GPU(host_mass);

  Tcl_PrintDouble(interp, host_mass[0], buffer);
  Tcl_AppendResult(interp, buffer, " ", (char *)NULL);

  return TCL_OK;

}

/* Calculate the CMS velocity of the system */
int tclcommand_system_CMS_velocity(ClientData data, Tcl_Interp * interp, int argc, char ** argv){
  char buffer[256];

  if (argc != 1  ) { 
    return tcl_command_system_CMS_velocity_print_usage(interp);
  } else {
    if (ARG_IS_S_EXACT(0,"system_CMS_velocity")) {
        mpi_system_CMS_velocity();

        Tcl_PrintDouble(interp, gal.cms_vel[0]/time_step, buffer);
        Tcl_AppendResult(interp, buffer, " ", (char *)NULL);
        Tcl_PrintDouble(interp, gal.cms_vel[1]/time_step, buffer);
        Tcl_AppendResult(interp, buffer, " ", (char *)NULL);
        Tcl_PrintDouble(interp, gal.cms_vel[2]/time_step, buffer);
        Tcl_AppendResult(interp, buffer, (char *)NULL);

        return TCL_OK;
    } else {
      return tcl_command_system_CMS_velocity_print_usage(interp);
    }
  }
}

/* convert to a string from a double */
Tcl_DString*
TSP_Util_lang_convert_string_double(Tcl_Interp* interp, Tcl_DString* targetVarName, double sourceVarName) {
    char str[500];
    if (targetVarName != NULL) {
        Tcl_DStringSetLength(targetVarName, 0);
    } else {
        targetVarName = (Tcl_DString*) ckalloc(sizeof(Tcl_DString));;
        Tcl_DStringInit(targetVarName);
    }
    Tcl_PrintDouble(interp, sourceVarName, str);
    Tcl_DStringAppend(targetVarName, str, -1);
    return targetVarName;
}

int tclcommand_metadynamics_print_stat(Tcl_Interp *interp, int argc, char **argv)
{
  int j;
  char buffer[TCL_DOUBLE_SPACE];

  /* In case nothing has been initialized yet */
  if (meta_acc_fprofile == NULL) return (TCL_OK);

  argc -= 1; argv += 1;
  
  if ( ARG1_IS_S("current_coord") ) {
    /* Current value of the reaction coordinate */
    Tcl_PrintDouble(interp, meta_val_xi, buffer);
    Tcl_AppendResult(interp,"",buffer, (char *)NULL);
  } else if ( ARG1_IS_S("coord_values") ) {
    /* Possible values of the reaction coordinate */
    for (j = 0; j < meta_xi_num_bins; ++j) {
      Tcl_PrintDouble(interp, meta_xi_min+j*meta_xi_step, buffer);
      Tcl_AppendResult(interp,buffer," ", (char *)NULL);
    }
  } else if ( ARG1_IS_S("profile") ) {
    /* Values of the free energy profile */
    for (j = 0; j < meta_xi_num_bins; ++j) {
      Tcl_PrintDouble(interp, meta_acc_fprofile[j], buffer);
      Tcl_AppendResult(interp,buffer," ", (char *)NULL);
    }
  } else if ( ARG1_IS_S("force") ) {
    /* Values of the biased force */
    for (j = 0; j < meta_xi_num_bins; ++j) {
      Tcl_PrintDouble(interp, -1.*meta_acc_force[j], buffer);
      Tcl_AppendResult(interp,buffer," ", (char *)NULL);
    }
  } else {
    Tcl_AppendResult(interp, "Unknown option for 'metadynamics print_stat'", (char *)NULL);
    return (TCL_ERROR);
  }
  return (TCL_OK);
}

int correlation_print_variance1(double_correlation* self, Tcl_Interp* interp) {
  char buffer[TCL_DOUBLE_SPACE];
  if (self->n_data < 1) {
    Tcl_AppendResult(interp, buffer, "Error in print variance: No input data available", (char *)NULL);
    return TCL_ERROR;
  }
  for (unsigned i=0; i< self->dim_A; i++) {
    Tcl_PrintDouble(interp, 
        self->A_accumulated_variance[i]/self->n_data
        - (self->A_accumulated_average[i]/self->n_data)*(self->A_accumulated_average[i]/self->n_data), buffer);
    Tcl_AppendResult(interp, buffer, " ", (char *)NULL);
  }
  return TCL_OK;
}

int tclprint_to_result_inter_dpdIA(Tcl_Interp *interp, int i, int j)
{
  char buffer[TCL_DOUBLE_SPACE];
  IA_parameters *data = get_ia_param(i, j);

  Tcl_PrintDouble(interp, data->dpd_gamma, buffer);
  Tcl_AppendResult(interp, "inter_dpd ", buffer, " ", (char *) NULL);
  Tcl_PrintDouble(interp, data->dpd_r_cut, buffer);
  Tcl_AppendResult(interp, buffer, " ", (char *) NULL);
  sprintf(buffer,"%i", data->dpd_wf);
  Tcl_AppendResult(interp, buffer, " ", (char *) NULL);
/*  Tcl_PrintDouble(interp, data->dpd_pref2, buffer);
  Tcl_AppendResult(interp, buffer, " ", (char *) NULL);  */
  Tcl_PrintDouble(interp, data->dpd_tgamma, buffer);
  Tcl_AppendResult(interp, buffer, " ", (char *) NULL);
  Tcl_PrintDouble(interp, data->dpd_tr_cut, buffer);
  Tcl_AppendResult(interp, buffer, " ", (char *) NULL);
  sprintf(buffer,"%i", data->dpd_twf);
  Tcl_AppendResult(interp, buffer, " ", (char *) NULL);  
//   Tcl_PrintDouble(interp, data->dpd_pref4, buffer);
//   Tcl_AppendResult(interp, buffer, " ", (char *) NULL);  

  return TCL_OK;
}

char *
TkPixelPrintProc(
    ClientData clientData,	/* not used */
    Tk_Window tkwin,		/* not used */
    char *widgRec,		/* Widget structure record */
    int offset,			/* Offset of tile in record */
    Tcl_FreeProc **freeProcPtr)	/* not used */
{
    double *doublePtr = (double *) (widgRec + offset);
    char *p = (char *) ckalloc(24);

    Tcl_PrintDouble(NULL, *doublePtr, p);
    *freeProcPtr = TCL_DYNAMIC;
    return p;
}

int tclcommand_observable_print(Tcl_Interp* interp, int argc, char** argv, int* change, observable* obs) {
  char buffer[TCL_DOUBLE_SPACE];
  if ( observable_calculate(obs) ) {
    Tcl_AppendResult(interp, "\nFailed to compute observable tclcommand\n", (char *)NULL );
    return TCL_ERROR;
  }
  if (argc==0) {
    for (int i = 0; i<obs->n; i++) {
      Tcl_PrintDouble(interp, obs->last_value[i], buffer);
      Tcl_AppendResult(interp, buffer, " ", (char *)NULL );
    }
  } else if (argc>0 && ARG0_IS_S("formatted")) {
    tclcommand_observable_print_formatted(interp, argc-1, argv+1, change, obs, obs->last_value);
  } else {
    Tcl_AppendResult(interp, "Unknown argument to observable print: ", argv[0], "\n", (char *)NULL );
    return TCL_ERROR;
  }
  return TCL_OK;
}

int tclprint_to_result_CoulombIA(Tcl_Interp *interp) 
{
#ifdef ELECTROSTATICS
  char buffer[TCL_DOUBLE_SPACE + 2*TCL_INTEGER_SPACE];
  if (coulomb.method == COULOMB_NONE) {
    Tcl_AppendResult(interp, "coulomb 0.0", (char *) NULL);
    return (TCL_OK);
  }
  Tcl_PrintDouble(interp, coulomb.bjerrum, buffer);
  Tcl_AppendResult(interp, "{coulomb ", buffer, " ", (char *) NULL);
  switch (coulomb.method) {
#ifdef P3M
  case COULOMB_ELC_P3M:
    tclprint_to_result_p3m(interp);
    tclprint_to_result_ELC(interp);
    break;
  case COULOMB_P3M_GPU:
  case COULOMB_P3M: tclprint_to_result_p3m(interp); break;
#endif
  case COULOMB_DH: tclprint_to_result_dh(interp); break;
  case COULOMB_RF: tclprint_to_result_rf(interp,"rf"); break;
  case COULOMB_INTER_RF: tclprint_to_result_rf(interp,"inter_rf"); break;
  case COULOMB_MMM1D: tclprint_to_result_MMM1D(interp); break;
#ifdef MMM1D_GPU
  case COULOMB_MMM1D_GPU: tclprint_to_result_MMM1DGPU(interp); break;
#endif
  case COULOMB_MMM2D: tclprint_to_result_MMM2D(interp); break;
  case COULOMB_MAGGS: tclprint_to_result_Maggs(interp); break;
#ifdef EWALD_GPU
  case COULOMB_EWALD_GPU: tclprint_to_result_ewaldgpu(interp); break;
#endif
#ifdef SCAFACOS
    case COULOMB_SCAFACOS: tclprint_to_result_scafacos(interp); break;
#endif
  default: break;
  }
  Tcl_AppendResult(interp, "}",(char *) NULL);

#else
  Tcl_AppendResult(interp, "ELECTROSTATICS not compiled (see config.hpp)",(char *) NULL);
#endif
  return (TCL_OK);
}

static void
UpdateStringOfMM(
    register Tcl_Obj *objPtr)   /* pixel obj with string rep to update. */
{
    MMRep *mmPtr;
    char buffer[TCL_DOUBLE_SPACE];
    register int len;

    mmPtr = (MMRep *) objPtr->internalRep.twoPtrValue.ptr1;
    /* assert( mmPtr->units == -1 && objPtr->bytes == NULL ); */
    if ((mmPtr->units != -1) || (objPtr->bytes != NULL)) {
	Tcl_Panic("UpdateStringOfMM: false precondition");
    }

    Tcl_PrintDouble(NULL, mmPtr->value, buffer);
    len = (int)strlen(buffer);

    objPtr->bytes = (char *) ckalloc((unsigned) len + 1);
    strcpy(objPtr->bytes, buffer);
    objPtr->length = len;
}

int tclcommand_adress_parse_print(Tcl_Interp *interp,int argc, char **argv){
   int topo=(int)adress_vars[0],dim;
   char buffer[3*TCL_DOUBLE_SPACE];
   argv+=2;argc-=2;
   Tcl_ResetResult(interp);
   if (topo == 0) {
      Tcl_AppendResult(interp,"adress topo 0", (char *)NULL);
      return TCL_OK;
   }
   else if (topo == 1) {
      Tcl_PrintDouble(interp, adress_vars[1], buffer);
      Tcl_AppendResult(interp,"adress topo 1 width ",buffer, (char *)NULL);
      return TCL_OK;
   }
   //topo 2 and 3
   sprintf(buffer,"%i",topo);
   Tcl_AppendResult(interp,"adress topo ",buffer," width ",(char *)NULL);
   Tcl_PrintDouble(interp, adress_vars[1], buffer);
   Tcl_AppendResult(interp,buffer, " ", (char *)NULL);
   Tcl_PrintDouble(interp, adress_vars[2], buffer);
   Tcl_AppendResult(interp,buffer, " center ", (char *)NULL);
   
   if (topo==2) {
      dim=(int)adress_vars[3];
      if (dim==0) sprintf(buffer,"x");
      else if (dim==1) sprintf(buffer,"y");
      else sprintf(buffer,"z");
      Tcl_AppendResult(interp,buffer," ", (char *)NULL);
      Tcl_PrintDouble(interp, adress_vars[4], buffer);
   }
   else{ // topo == 3
      Tcl_PrintDouble(interp, adress_vars[3], buffer);
      Tcl_AppendResult(interp,buffer," ", (char *)NULL);
      Tcl_PrintDouble(interp, adress_vars[4], buffer);
      Tcl_AppendResult(interp,buffer," ", (char *)NULL);
      Tcl_PrintDouble(interp, adress_vars[5], buffer);
   }
   Tcl_AppendResult(interp,buffer, " wf ", (char *)NULL);
   sprintf(buffer,"%i",(int)adress_vars[6]);
   Tcl_AppendResult(interp,buffer, (char *)NULL);

   return TCL_OK;
}

int tclcommand_observable_print(Tcl_Interp* interp, int argc, char** argv, int* change, observable* obs) {
  char buffer[TCL_DOUBLE_SPACE];
  double* values=(double*)malloc(obs->n*sizeof(double));
  if ( (*obs->fun)(obs->args, values, obs->n) ) {
    Tcl_AppendResult(interp, "\nFailed to compute observable tclcommand\n", (char *)NULL );
    return TCL_ERROR;
  }
  if (argc==0) {
    for (int i = 0; i<obs->n; i++) {
      Tcl_PrintDouble(interp, values[i], buffer);
      Tcl_AppendResult(interp, buffer, " ", (char *)NULL );
    }
  } else if (argc>0 && ARG0_IS_S("formatted")) {
    tclcommand_observable_print_formatted(interp, argc-1, argv+1, change, obs, values);
  } else {
    Tcl_AppendResult(interp, "Unknown argument to observable print: ", argv[0], "\n", (char *)NULL );
    return TCL_ERROR;
  }
  free(values);
  return TCL_OK;
}

/** Write a vector of doubles as string
 */
int uwerr_write_tcl_vector(Tcl_Interp * interp,
			   double * in, int in_len, char * out)
{
  char str[TCL_DOUBLE_SPACE];
  int i, cur_len = 0;

  if (!out)
    return -1;

  out[0] = 0;

  for (i = 0; i < in_len; ++i) {
    Tcl_PrintDouble(interp, in[i], str);
    strcat(out+cur_len, str);
    cur_len += strlen(str);
    out[cur_len] = ' '; // overwrite the trailing NULL
    out[cur_len+1] = 0;
    cur_len += 1;
  }

  return 0;
}

/* Calculate the CMS of the system */
int tclcommand_system_CMS(ClientData data, Tcl_Interp * interp, int argc, char ** argv){
  char buffer[256];
  double cmspos[3];
  int box[3];

  if (argc != 1 && argc != 2  ) { 
    return tcl_command_system_CMS_print_usage(interp);
  } else {
    if (ARG_IS_S_EXACT(0,"system_CMS")) {
      if ( argc == 2 ) {
        if (ARG_IS_S_EXACT(1,"folded")) {
          mpi_system_CMS();

          memmove(cmspos, gal.cms, 3*sizeof(double));
          box[0] = 0; box[1] = 0; box[2] = 0;
          fold_position(cmspos, box);
          
          Tcl_PrintDouble(interp, cmspos[0], buffer);
          Tcl_AppendResult(interp, buffer, " ", (char *)NULL);
          Tcl_PrintDouble(interp, cmspos[1], buffer);
          Tcl_AppendResult(interp, buffer, " ", (char *)NULL);
          Tcl_PrintDouble(interp, cmspos[2], buffer);
          Tcl_AppendResult(interp, buffer, (char *)NULL);

          return TCL_OK;
        } else {
          return tcl_command_system_CMS_print_usage(interp);
        }
      } else {
        mpi_system_CMS();

        Tcl_PrintDouble(interp, gal.cms[0], buffer);
        Tcl_AppendResult(interp, buffer, " ", (char *)NULL);
        Tcl_PrintDouble(interp, gal.cms[1], buffer);
        Tcl_AppendResult(interp, buffer, " ", (char *)NULL);
        Tcl_PrintDouble(interp, gal.cms[2], buffer);
        Tcl_AppendResult(interp, buffer, (char *)NULL);


        return TCL_OK;     
      }
    } else {
      return tcl_command_system_CMS_print_usage(interp);
    }
  }
}