Ejemplo n.º 1
0
/* ---------------------------------------------------------------------- */
LDBLE
qromb_midpnt (LDBLE x1, LDBLE x2)
/* ---------------------------------------------------------------------- */
{
  LDBLE ss, dss;
  LDBLE sv[MAX_QUAD + 2], h[MAX_QUAD + 2];
  int j;

  h[0] = 1.0;
  sv[0] = midpnt (x1, x2, 1);
  for (j = 1; j < MAX_QUAD; j++)
  {
    sv[j] = midpnt (x1, x2, j + 1);
    h[j] = h[j - 1] / 9.0;

    if (fabs (sv[j] - sv[j - 1]) <= G_TOL * fabs (sv[j]))
    {
      sv[j] *= surface_charge_ptr->grams * surface_charge_ptr->specific_area * alpha / F_C_MOL;	/* (ee0RT/2)**1/2, (L/mol)**1/2 C / m**2 */
      if ((x2 - 1) < 0.0)
	sv[j] *= -1.0;
      if (debug_diffuse_layer == TRUE)
      {
	output_msg (OUTPUT_MESSAGE, "Iterations in qromb_midpnt: %d\n", j);
      }
      return (sv[j]);
    }

    if (j >= K_POLY - 1)
    {
      polint (&h[j - K_POLY], &sv[j - K_POLY], K_POLY, 0.0, &ss, &dss);
      if (fabs (dss) <= G_TOL * fabs (ss) || fabs (dss) < G_TOL)
      {
	ss *= surface_charge_ptr->grams * surface_charge_ptr->specific_area * alpha / F_C_MOL;	/* (ee0RT/2)**1/2, (L/mol)**1/2 C / m**2 */
	if ((x2 - 1) < 0.0)
	  ss *= -1.0;
	if (debug_diffuse_layer == TRUE)
	{
	  output_msg (OUTPUT_MESSAGE, "Iterations in qromb_midpnt: %d\n", j);
	}
	return (ss);
      }
    }

  }
  sprintf (error_string,
	   "\nToo many iterations integrating diffuse layer.\n");
  error_msg (error_string, STOP);
  return (-999.9);
}
Ejemplo n.º 2
0
/* ---------------------------------------------------------------------- */
void PHRQ_io::
error_msg(const char *err_str, bool stop)
/* ---------------------------------------------------------------------- */
{

	io_error_count++;
	if (error_ostream != NULL && error_on)
	{
		//(*error_ostream) << err_str;
		screen_msg(err_str);
		error_flush();
	}
	if (stop)
	{
		if (error_ostream != NULL && error_on)
		{
			//(*error_ostream) << "Stopping.\n";
			screen_msg("Stopping.\n");
			error_ostream->flush();
		}
		output_msg("Stopping.\n");
		log_msg("Stopping.\n");

		throw PhreeqcStop();
	}
}
Ejemplo n.º 3
0
void QuadDecodeMsg::serial_callback(const quadrotor_msgs::Serial::ConstPtr &msg)
{
    if(msg->type == quadrotor_msgs::Serial::OUTPUT_DATA)
    {
        quadrotor_msgs::OutputData::Ptr output_msg(new quadrotor_msgs::OutputData);
        sensor_msgs::Imu::Ptr imu_msg(new sensor_msgs::Imu);

        if(quadrotor_msgs::decodeOutputData(msg->data, *output_msg))
        {
            output_msg->header.stamp = msg->header.stamp;
            output_msg->header.frame_id = "/quadrotor";
            output_data_pub_.publish(output_msg);

            imu_msg->header = output_msg->header;
            imu_msg->orientation = output_msg->orientation;
            imu_msg->angular_velocity = output_msg->angular_velocity;
            imu_msg->linear_acceleration = output_msg->linear_acceleration;
            imu_output_pub_.publish(imu_msg);
        }
    }
    else if(msg->type == quadrotor_msgs::Serial::STATUS_DATA)
    {
        quadrotor_msgs::StatusData::Ptr status_msg(new quadrotor_msgs::StatusData);
        if(quadrotor_msgs::decodeStatusData(msg->data, *status_msg))
        {
            status_msg->header.stamp = msg->header.stamp;
            status_msg->header.frame_id = "/quadrotor";
            status_pub_.publish(status_msg);
        }
    }
}
Ejemplo n.º 4
0
Archivo: remunge.c Proyecto: dun/munge
void
start_threads (conf_t conf)
{
/*  Start the number of threads specified by [conf] for processing credentials.
 */
    pthread_attr_t tattr;
    size_t         stacksize = 256 * 1024;
    int            i;

    if (!(conf->tids = malloc (sizeof (*conf->tids) * conf->num_threads))) {
        log_err (EMUNGE_NO_MEMORY, LOG_ERR, "Failed to allocate tid array");
    }
    if ((errno = pthread_attr_init (&tattr)) != 0) {
        log_errno (EMUNGE_SNAFU, LOG_ERR, "Failed to init thread attribute");
    }
#ifdef _POSIX_THREAD_ATTR_STACKSIZE
    if ((errno = pthread_attr_setstacksize (&tattr, stacksize)) != 0) {
        log_errno (EMUNGE_SNAFU, LOG_ERR, "Failed to set thread stacksize");
    }
#endif /* _POSIX_THREAD_ATTR_STACKSIZE */
    /*
     *  Lock mutex to prevent threads from starting until all are created.
     *    After the timer has been started, the mutex will be unlocked via
     *    pthread_cond_timedwait().
     */
    if ((errno = pthread_mutex_lock (&conf->mutex)) != 0) {
        log_errno (EMUNGE_SNAFU, LOG_ERR, "Failed to lock mutex");
    }
    /*  The purpose of the num_running count is for signaling the main thread
     *    when the last worker thread has exited in order to interrupt the
     *    pthread_cond_timedwait().  The reason num_running is set to
     *    num_threads here instead of incrementing it at the start of each
     *    thread is to prevent this condition from being signaled prematurely.
     *    This could happen if all credentials are processed by just a few
     *    threads before all threads have been scheduled to run; consequently,
     *    num_running would bounce to 0 before all threads have finished while
     *    the remaining threads would have no credentials left to process.
     */
    assert (conf->num_threads > 0);
    conf->num_running = conf->num_threads;

    output_msg ("Spawning %d thread%s for %s",
        conf->num_threads, ((conf->num_threads == 1) ? "" : "s"),
        (conf->do_decode ? "encoding/decoding" : "encoding"));

    for (i = 0; i < conf->num_threads; i++) {
        if ((errno = pthread_create
                    (&conf->tids[i], &tattr, (thread_f) remunge, conf)) != 0) {
            log_errno (EMUNGE_SNAFU, LOG_ERR,
                "Failed to create thread #%d", i+1);
        }
    }
    if ((errno = pthread_attr_destroy (&tattr)) != 0) {
        log_errno (EMUNGE_SNAFU, LOG_ERR,
            "Failed to destroy thread attribute");
    }
    return;
}
Ejemplo n.º 5
0
void skelton_msgbox(const char* m, ...) {
	if(_debug && skelton_debug) {
		char st[1024];
		va_list marker;
		va_start(marker, m);
		vsprintf(st, m, marker);
		va_end(marker);
		output_msg(st);
	}
}
Ejemplo n.º 6
0
/* ---------------------------------------------------------------------- */
void PHRQ_io::
echo_msg(const char * str)
/* ---------------------------------------------------------------------- */
{
	if (echo_on)
	{
		switch (this->echo_destination)
		{
		case ECHO_LOG:
			log_msg(str);
			break;
		case ECHO_OUTPUT:
			output_msg(str);
			break;
		}
	}
}
Ejemplo n.º 7
0
/* ---------------------------------------------------------------------- */
void PHRQ_io::
warning_msg(const char *err_str)
/* ---------------------------------------------------------------------- */
{
	if (error_file != NULL && error_on)
	{
		//(*error_file) << err_str << "\n";
		std::string err_stdstr(err_str);
		err_stdstr.append("\n");
		screen_msg(err_stdstr.c_str());
		error_flush();
	}
	std::ostringstream warn_str;
	warn_str << err_str << "\n";
	log_msg(warn_str.str().c_str());
	log_flush();
	output_msg(warn_str.str().c_str());
	output_flush();
}
Ejemplo n.º 8
0
/* ---------------------------------------------------------------------- */
void PHRQ_io::
error_msg(const char *err_str, bool stop)
/* ---------------------------------------------------------------------- */
{

	io_error_count++;
	if (error_file != NULL && error_on)
	{
		//(*error_file) << err_str;
		screen_msg(err_str);
		error_flush();
	}
	if (stop)
	{
		if (error_file != NULL && error_on)
		{
			//(*error_file) << "Stopping.\n";
			screen_msg("Stopping.\n");
			fflush(error_file);
		}
		output_msg("Stopping.\n");
		log_msg("Stopping.\n");
	}
}
Ejemplo n.º 9
0
/* ---------------------------------------------------------------------- */
int
calc_all_donnan_music (void)
/* ---------------------------------------------------------------------- */
{
  int i, j, k;
  int count_g, count_charge, converge;
  char name[MAX_LENGTH];
  LDBLE new_g, f_psi, surf_chrg_eq, psi_avg, f_sinh, A_surf, ratio_aq;
  LDBLE cz, cm, cp;

  if (use.surface_ptr == NULL)
    return (OK);
  f_sinh =
    sqrt (8000.0 * EPSILON * EPSILON_ZERO * (R_KJ_DEG_MOL * 1000.0) * tk_x *
	  mu_x);
  cz = cm = 1.0;
  cp = 1.0;
/*
 *   calculate g for each surface...
 */
  converge = TRUE;
  count_charge = 0;
  for (j = 0; j < count_unknowns; j++)
  {
    if (x[j]->type != SURFACE_CB)
      continue;
    surface_charge_ptr = x[j]->surface_charge;

    if (debug_diffuse_layer == TRUE)
      output_msg (OUTPUT_MESSAGE, "Calc_all_g, X[%d]\n", j);
/*
 *  sum eq of each charge number in solution...
 */
    count_g = x[j]->surface_charge->count_g;
    for (i = 0; i < count_g; i++)
    {
      charge_group[i].eq = 0.0;
    }
    for (i = 0; i < count_s_x; i++)
    {
      if (s_x[i]->type > HPLUS)
	continue;
      for (k = 0; k < count_g; k++)
      {
	if (equal (charge_group[k].z, s_x[i]->z, G_TOL) == TRUE)
	{
	  charge_group[k].eq += s_x[i]->z * s_x[i]->moles;
	  break;
	}
      }
    }
    /* find surface charge from potential... */
    A_surf =
      x[j]->surface_charge->specific_area * x[j]->surface_charge->grams;
    f_psi = x[j + 2]->master[0]->s->la * LOG_10;	/* -FPsi/RT */
    f_psi = f_psi / 2;
    surf_chrg_eq = A_surf * f_sinh * sinh (f_psi) / F_C_MOL;
    psi_avg = calc_psi_avg (surf_chrg_eq);

    /*output_msg(OUTPUT_MESSAGE, "psi's  %e %e %e\n", f_psi, psi_avg, surf_chrg_eq); */

    /* fill in g's */
    ratio_aq = surface_charge_ptr->mass_water / mass_water_aq_x;

    for (k = 0; k < count_g; k++)
    {
      x[j]->surface_charge->g[k].charge = charge_group[k].z;
      new_g = exp (charge_group[k].z * psi_avg) - 1;
      if (new_g < -ratio_aq)
	new_g = -ratio_aq + G_TOL * 1e-5;
      if (fabs (new_g) >= 1)
      {
	if (fabs ((new_g - x[j]->surface_charge->g[k].g) / new_g) >
	    convergence_tolerance)
	{
	  converge = FALSE;
	}
      }
      else
      {
	if (fabs (new_g - x[j]->surface_charge->g[k].g) >
	    convergence_tolerance)
	{
	  converge = FALSE;
	}
      }
      x[j]->surface_charge->g[k].g = new_g;
      /* save g for species */
      for (i = 0; i < count_s_x; i++)
      {
	if (equal (charge_group[k].z, s_x[i]->z, G_TOL) == TRUE)
	{
	  s_x[i]->diff_layer[count_charge].charge = x[j]->surface_charge;
	  s_x[i]->diff_layer[count_charge].count_g = k;
	}
      }
    }
    if (debug_diffuse_layer == TRUE)
    {
      strcpy (name, x[j + 2]->master[0]->elt->name);
      replace ("_psi", "", name);
/*			surf_chrg_eq = calc_surface_charge(name);
 */
      output_msg (OUTPUT_MESSAGE,
		  "\nDonnan all on %s (%d): charge, \tg, \tdg, Psi_surface = %8f V. \n",
		  name, count_charge,
		  x[j]->master[0]->s->la * LOG_10 * R_KJ_DEG_MOL * tk_x /
		  F_KJ_V_EQ);
      for (i = 0; i < count_g; i++)
      {
	output_msg (OUTPUT_MESSAGE, "\t%12f\t%12.4e\t%12.4e\n",
		    (double) x[j]->surface_charge->g[i].charge,
		    (double) x[j]->surface_charge->g[i].g,
		    (double) x[j]->surface_charge->g[i].dg);
      }
    }
    count_charge++;
  }
  return (converge);
}
Ejemplo n.º 10
0
Archivo: remunge.c Proyecto: dun/munge
void
stop_threads (conf_t conf)
{
/*  Stop the threads from processing further credentials.  Output the results.
 */
    int           i;
    unsigned long n;
    double        delta;
    double        rate;

    /*  The mutex must be unlocked here in order to let the threads clean up
     *    (via remunge_cleanup()) once they are canceled/finished.
     */
    if ((errno = pthread_mutex_unlock (&conf->mutex)) != 0) {
        log_errno (EMUNGE_SNAFU, LOG_ERR, "Failed to unlock mutex");
    }
    for (i = 0; i < conf->num_threads; i++) {
        errno = pthread_cancel (conf->tids[i]);
        if ((errno != 0) && (errno != ESRCH)) {
            log_errno (EMUNGE_SNAFU, LOG_ERR,
                "Failed to cancel thread #%d", i+1);
        }
    }
    for (i = 0; i < conf->num_threads; i++) {
        if ((errno = pthread_join (conf->tids[i], NULL)) != 0) {
            log_errno (EMUNGE_SNAFU, LOG_ERR,
                "Failed to join thread #%d", i+1);
        }
        conf->tids[i] = 0;
    }
    /*  Stop the main timer now that all credential processing has stopped.
     */
    GET_TIMEVAL (conf->t_main_stop);
    delta = DIFF_TIMEVAL (conf->t_main_stop, conf->t_main_start);
    /*
     *  Output processing stop message and results.
     */
    if (conf->shared.num_encode_errs && conf->shared.num_decode_errs) {
        output_msg ("Generated %lu encoding error%s and %lu decoding error%s",
            conf->shared.num_encode_errs,
            ((conf->shared.num_encode_errs == 1) ? "" : "s"),
            conf->shared.num_decode_errs,
            ((conf->shared.num_decode_errs == 1) ? "" : "s"));
    }
    else if (conf->shared.num_encode_errs) {
        output_msg ("Generated %lu encoding error%s",
            conf->shared.num_encode_errs,
            ((conf->shared.num_encode_errs == 1) ? "" : "s"));
    }
    else if (conf->shared.num_decode_errs) {
        output_msg ("Generated %lu decoding error%s",
            conf->shared.num_decode_errs,
            ((conf->shared.num_decode_errs == 1) ? "" : "s"));
    }
    /*  Subtract the errors from the number of credentials processed.
     */
    n = conf->shared.num_creds_done
        - conf->shared.num_encode_errs
        - conf->shared.num_decode_errs;
    rate = n / delta;
    output_msg ("Processed %lu credential%s in %0.3fs (%0.0f creds/sec)",
        n, ((n == 1) ? "" : "s"), delta, rate);
    if (g_got_quiet) {
        printf ("%0.0f\n", rate);
    }
    /*  Check for minimum duration time interval.
     */
    if (delta < MIN_DURATION) {
        printf ("\nWARNING: Results based on such a short time interval "
                "are of low accuracy\n\n");
    }
    return;
}
Ejemplo n.º 11
0
/* ---------------------------------------------------------------------- */
int
calc_all_donnan (void)
/* ---------------------------------------------------------------------- */
{
  int i, j, k;
  int count_g, count_charge, converge;
  char name[MAX_LENGTH];
  LDBLE new_g, f_psi, surf_chrg_eq, psi_avg, f_sinh, A_surf, ratio_aq;
  LDBLE new_g2, f_psi2, surf_chrg_eq2, psi_avg2, dif;
  LDBLE cz, cm, cp;

  if (use.surface_ptr == NULL)
    return (OK);
  if (use.surface_ptr->type == CD_MUSIC)
    return (calc_all_donnan_music ());
  f_sinh =
    sqrt (8000.0 * EPSILON * EPSILON_ZERO * (R_KJ_DEG_MOL * 1000.0) * tk_x *
	  mu_x);
  cz = cm = 1.0;
  cp = 1.0;
/*
 *   calculate g for each surface...
 */
  converge = TRUE;
  count_charge = 0;
  for (j = 0; j < count_unknowns; j++)
  {
    if (x[j]->type != SURFACE_CB)
      continue;
    surface_charge_ptr = x[j]->surface_charge;

    if (debug_diffuse_layer == TRUE)
      output_msg (OUTPUT_MESSAGE, "Calc_all_g, X[%d]\n", j);
/*
 *  sum eq of each charge number in solution...
 */
    count_g = x[j]->surface_charge->count_g;
    for (i = 0; i < count_g; i++)
    {
      charge_group[i].eq = 0.0;
    }
    for (i = 0; i < count_s_x; i++)
    {
      if (s_x[i]->type > HPLUS)
	continue;
      for (k = 0; k < count_g; k++)
      {
	if (equal (charge_group[k].z, s_x[i]->z, G_TOL) == TRUE)
	{
#ifdef SKIP
	  if (s_x[i]->z > 0)
	    cz = s_x[i]->z * pow (cp, s_x[i]->z);
	  else
	    cz = s_x[i]->z * pow (cm, -s_x[i]->z);
	  charge_group[k].eq += cz * s_x[i]->moles;
#endif
	  charge_group[k].eq += s_x[i]->z * s_x[i]->moles;
	  break;
	}
      }
    }
    /* find surface charge from potential... */
    A_surf =
      x[j]->surface_charge->specific_area * x[j]->surface_charge->grams;
    f_psi = x[j]->master[0]->s->la * LOG_10;
    surf_chrg_eq = A_surf * f_sinh * sinh (f_psi) / F_C_MOL;
    /* also for the derivative... */
    dif = 1e-5;
    f_psi2 = f_psi + dif;
    surf_chrg_eq2 = A_surf * f_sinh * sinh (f_psi2) / F_C_MOL;


    /* find psi_avg that matches surface charge... */
    psi_avg = calc_psi_avg (surf_chrg_eq);
    psi_avg2 = calc_psi_avg (surf_chrg_eq2);

    /*output_msg(OUTPUT_MESSAGE, "psi's  %e %e %e\n", f_psi, psi_avg, surf_chrg_eq); */

    /* fill in g's */
    ratio_aq = surface_charge_ptr->mass_water / mass_water_aq_x;

    for (k = 0; k < count_g; k++)
    {
      x[j]->surface_charge->g[k].charge = charge_group[k].z;
#ifdef SKIP
      if (charge_group[k].z > 0)
	cz = pow (cp, charge_group[k].z);
      else
	cz = pow (cm, -charge_group[k].z);
      new_g = cz * (exp (-charge_group[k].z * psi_avg)) - 1;
      if (new_g < -ratio_aq)
	new_g = -ratio_aq + G_TOL * 1e-5;
      new_g2 = cz * (exp (-charge_group[k].z * psi_avg2)) - 1;
      if (new_g2 < -ratio_aq)
	new_g2 = -ratio_aq + G_TOL * 1e-5;
#endif
      new_g = ratio_aq * (exp (-charge_group[k].z * psi_avg) - 1);
      if (use.surface_ptr->only_counter_ions &&
	  ((surf_chrg_eq < 0 && charge_group[k].z < 0)
	   || (surf_chrg_eq > 0 && charge_group[k].z > 0)))
	new_g = -ratio_aq;
      if (new_g <= -ratio_aq)
	new_g = -ratio_aq + G_TOL * 1e-3;
      new_g2 = ratio_aq * (exp (-charge_group[k].z * psi_avg2) - 1);
      if (use.surface_ptr->only_counter_ions &&
	  ((surf_chrg_eq < 0 && charge_group[k].z < 0)
	   || (surf_chrg_eq > 0 && charge_group[k].z > 0)))
	new_g2 = -ratio_aq;
      if (new_g2 <= -ratio_aq)
	new_g2 = -ratio_aq + G_TOL * 1e-3;
      if (fabs (new_g) >= 1)
      {
	if (fabs ((new_g - x[j]->surface_charge->g[k].g) / new_g) >
	    convergence_tolerance)
	{
	  converge = FALSE;
	}
      }
      else
      {
	if (fabs (new_g - x[j]->surface_charge->g[k].g) >
	    convergence_tolerance)
	{
	  converge = FALSE;
	}
      }
      x[j]->surface_charge->g[k].g = new_g;
      if (new_g != 0)
      {
	x[j]->surface_charge->g[k].dg = (new_g2 - new_g) / dif;
      }
      else
      {
	x[j]->surface_charge->g[k].dg = -charge_group[k].z;
      }
      /* save g for species */
      for (i = 0; i < count_s_x; i++)
      {
	if (equal (charge_group[k].z, s_x[i]->z, G_TOL) == TRUE)
	{
	  s_x[i]->diff_layer[count_charge].charge = x[j]->surface_charge;
	  s_x[i]->diff_layer[count_charge].count_g = k;
	}
      }
    }
    if (debug_diffuse_layer == TRUE)
    {
      strcpy (name, x[j]->master[0]->elt->name);
      replace ("_psi", "", name);
/*			surf_chrg_eq = calc_surface_charge(name);
 */
      output_msg (OUTPUT_MESSAGE,
		  "\nDonnan all on %s (%d): charge, \tg, \tdg, Psi_surface = %8f V. \n",
		  name, count_charge,
		  x[j]->master[0]->s->la * 2 * LOG_10 * R_KJ_DEG_MOL * tk_x /
		  F_KJ_V_EQ);
      for (i = 0; i < count_g; i++)
      {
	output_msg (OUTPUT_MESSAGE, "\t%12f\t%12.4e\t%12.4e\n",
		    (double) x[j]->surface_charge->g[i].charge,
		    (double) x[j]->surface_charge->g[i].g,
		    (double) x[j]->surface_charge->g[i].dg);
      }
    }
    count_charge++;
  }
  return (converge);
}
Ejemplo n.º 12
0
/* ---------------------------------------------------------------------- */
int
calc_init_donnan (void)
/* ---------------------------------------------------------------------- */
{
  int i, j, k;
  int count_g, count_charge;
  char name[MAX_LENGTH];
  LDBLE f_psi, surf_chrg_eq, psi_avg, f_sinh, A_surf, ratio_aq;

  if (use.surface_ptr == NULL)
    return (OK);
  if (use.surface_ptr->type == CD_MUSIC)
    return (calc_init_donnan_music ());
  f_sinh =
    sqrt (8000.0 * EPSILON * EPSILON_ZERO * (R_KJ_DEG_MOL * 1000.0) * tk_x *
	  mu_x);
  if (convergence_tolerance >= 1e-8)
  {
    G_TOL = 1e-9;
  }
  else
  {
    G_TOL = 1e-13;
  }
/*
 *  sum eq of each charge number in solution...
 */
  charge_group = (struct Charge_Group *) free_check_null (charge_group);
  charge_group =
    (struct Charge_Group *) PHRQ_malloc ((size_t)
					 sizeof (struct Charge_Group));
  if (charge_group == NULL)
    malloc_error ();
  charge_group[0].z = 0.0;
  charge_group[0].eq = 0.0;

  count_g = 1;
  for (i = 0; i < count_s_x; i++)
  {
    if (s_x[i]->type > HPLUS)
      continue;
    for (k = 0; k < count_g; k++)
    {
      if (equal (charge_group[k].z, s_x[i]->z, G_TOL) == TRUE)
      {
	charge_group[k].eq += s_x[i]->z * s_x[i]->moles;
	break;
      }
    }
    if (k >= count_g)
    {
      charge_group =
	(struct Charge_Group *) PHRQ_realloc (charge_group,
					      (size_t) (count_g +
							1) *
					      sizeof (struct Charge_Group));
      if (charge_group == NULL)
	malloc_error ();
      charge_group[count_g].z = s_x[i]->z;
      charge_group[count_g].eq = s_x[i]->z * s_x[i]->moles;

      count_g++;
    }
  }
/*
 *   calculate g for each surface...
 */
  count_charge = 0;
  for (j = 0; j < count_unknowns; j++)
  {
    if (x[j]->type != SURFACE_CB)
      continue;
    surface_charge_ptr = x[j]->surface_charge;

    x[j]->surface_charge->g =
      (struct surface_diff_layer *) PHRQ_malloc ((size_t) count_g *
						 sizeof (struct
							 surface_diff_layer));
    if (x[j]->surface_charge->g == NULL)
      malloc_error ();
    x[j]->surface_charge->count_g = count_g;

    /* find surface charge from potential... */
    A_surf =
      x[j]->surface_charge->specific_area * x[j]->surface_charge->grams;
    f_psi = x[j]->master[0]->s->la * LOG_10;
    surf_chrg_eq = A_surf * f_sinh * sinh (f_psi) / F_C_MOL;

    /* find psi_avg that matches surface charge... */
    psi_avg = calc_psi_avg (0);	/*(surf_chrg_eq); */

    /* fill in g's */
    ratio_aq = surface_charge_ptr->mass_water / mass_water_aq_x;

    for (k = 0; k < count_g; k++)
    {
      x[j]->surface_charge->g[k].charge = charge_group[k].z;
      x[j]->surface_charge->g[k].g =
	ratio_aq * (exp (-charge_group[k].z * psi_avg) - 1);
      if (use.surface_ptr->only_counter_ions
	  && ((surf_chrg_eq < 0 && charge_group[k].z < 0)
	      || (surf_chrg_eq > 0 && charge_group[k].z > 0)))
	x[j]->surface_charge->g[k].g = -ratio_aq;
      if (x[j]->surface_charge->g[k].g != 0)
      {
	x[j]->surface_charge->g[k].dg = -A_surf * f_sinh * cosh (f_psi) /
	  (charge_group[k].eq * F_C_MOL);
      }
      else
      {
	x[j]->surface_charge->g[k].dg = -charge_group[k].z;
      }
      /* save g for species */
      for (i = 0; i < count_s_x; i++)
      {
	if (equal (charge_group[k].z, s_x[i]->z, G_TOL) == TRUE)
	{
	  s_x[i]->diff_layer[count_charge].charge = x[j]->surface_charge;
	  s_x[i]->diff_layer[count_charge].count_g = k;
	  s_x[i]->diff_layer[count_charge].g_moles = 0.0;
	  s_x[i]->diff_layer[count_charge].dg_g_moles = 0.0;
	}
      }
    }
    if (debug_diffuse_layer == TRUE)
    {
      strcpy (name, x[j]->master[0]->elt->name);
      replace ("_psi", "", name);
/*			surf_chrg_eq = calc_surface_charge(name);
 */
      output_msg (OUTPUT_MESSAGE,
		  "\nDonnan init on %s : charge, \tg, \tdg, Psi_surface = %8f V. \n",
		  name,
		  x[j]->master[0]->s->la * 2 * LOG_10 * R_KJ_DEG_MOL * tk_x /
		  F_KJ_V_EQ);
      for (i = 0; i < count_g; i++)
      {
	output_msg (OUTPUT_MESSAGE, "\t%12f\t%12.4e\t%12.4e\n",
		    (double) x[j]->surface_charge->g[i].charge,
		    (double) x[j]->surface_charge->g[i].g,
		    (double) x[j]->surface_charge->g[i].dg);
      }
    }
    count_charge++;
  }
  return (OK);
}
Ejemplo n.º 13
0
Archivo: remunge.c Proyecto: dun/munge
void *
remunge (conf_t conf)
{
/*  Worker thread responsible for encoding/decoding/validating credentials.
 */
    tdata_t         tdata;
    int             cancel_state;
    unsigned long   n;
    unsigned long   got_encode_err;
    unsigned long   got_decode_err;
    struct timeval  t_start;
    struct timeval  t_stop;
    double          delta;
    munge_err_t     e;
    char           *cred;
    void           *data;
    int             dlen;
    uid_t           uid;
    gid_t           gid;

    tdata = create_tdata (conf);

    pthread_cleanup_push ((thread_cleanup_f) remunge_cleanup, tdata);

    if ((errno = pthread_mutex_lock (&conf->mutex)) != 0) {
        log_errno (EMUNGE_SNAFU, LOG_ERR, "Failed to lock mutex");
    }
    while (conf->num_creds - conf->shared.num_creds_done > 0) {

        pthread_testcancel ();

        if ((errno = pthread_setcancelstate
                    (PTHREAD_CANCEL_DISABLE, &cancel_state)) != 0) {
            log_errno (EMUNGE_SNAFU, LOG_ERR,
                "Failed to disable thread cancellation");
        }
        n = ++conf->shared.num_creds_done;

        if ((errno = pthread_mutex_unlock (&conf->mutex)) != 0) {
            log_errno (EMUNGE_SNAFU, LOG_ERR, "Failed to unlock mutex");
        }
        got_encode_err = 0;
        got_decode_err = 0;
        data = NULL;

        GET_TIMEVAL (t_start);
        e = munge_encode(&cred, tdata->ectx, conf->payload, conf->num_payload);
        GET_TIMEVAL (t_stop);

        delta = DIFF_TIMEVAL (t_stop, t_start);
        if (delta > conf->warn_time) {
            output_msg ("Credential #%lu encoding took %0.3f seconds",
                n, delta);
        }
        if (e != EMUNGE_SUCCESS) {
            output_msg ("Credential #%lu encoding failed: %s (err=%d)",
                n, munge_ctx_strerror (tdata->ectx), e);
            ++got_encode_err;
        }
        else if (conf->do_decode) {

            GET_TIMEVAL (t_start);
            e = munge_decode (cred, tdata->dctx, &data, &dlen, &uid, &gid);
            GET_TIMEVAL (t_stop);

            delta = DIFF_TIMEVAL (t_stop, t_start);
            if (delta > conf->warn_time) {
                output_msg ("Credential #%lu decoding took %0.3f seconds",
                    n, delta);
            }
            if (e != EMUNGE_SUCCESS) {
                output_msg ("Credential #%lu decoding failed: %s (err=%d)",
                    n, munge_ctx_strerror (tdata->dctx), e);
                ++got_decode_err;
            }

/*  FIXME:
 *    The following block does some validating of the decoded credential.
 *    It should have a cmdline option to enable this validation check.
 *    The decode ctx should also be checked against the encode ctx.
 *    This becomes slightly more difficult in that it must also take
 *    into account the default field settings.
 *
 *    This block should be moved into a separate function (or more).
 *    The [cred], [data], [dlen], [uid], and [gid] vars could be placed
 *    into the tdata struct to facilitate parameter passing.
 */
#if 0
            else if (conf->do_validate) {
                if (getuid () != uid) {
                output_msg (
                    "Credential #%lu UID %d does not match process UID %d",
                    n, uid, getuid ());
                }
                if (getgid () != gid) {
                    output_msg (
                        "Credential #%lu GID %d does not match process GID %d",
                        n, gid, getgid ());
                }
                if (conf->num_payload != dlen) {
                    output_msg (
                        "Credential #%lu payload length mismatch (%d/%d)",
                        n, conf->num_payload, dlen);
                }
                else if (data && memcmp (conf->payload, data, dlen) != 0) {
                    output_msg ("Credential #%lu payload mismatch", n);
                }
            }
#endif /* 0 */

            /*  The 'data' parm can still be set on certain munge errors.
             */
            if (data != NULL) {
                free (data);
            }
        }
        if (cred != NULL) {
            free (cred);
        }
        if ((errno = pthread_setcancelstate
                    (cancel_state, &cancel_state)) != 0) {
            log_errno (EMUNGE_SNAFU, LOG_ERR,
                "Failed to enable thread cancellation");
        }
        if ((errno = pthread_mutex_lock (&conf->mutex)) != 0) {
            log_errno (EMUNGE_SNAFU, LOG_ERR, "Failed to lock mutex");
        }
        conf->shared.num_encode_errs += got_encode_err;
        conf->shared.num_decode_errs += got_decode_err;
    }
    pthread_cleanup_pop (1);
    return (NULL);
}
Ejemplo n.º 14
0
/* ---------------------------------------------------------------------- */
int
calc_init_g (void)
/* ---------------------------------------------------------------------- */
{
  int i, j, k;
  int count_g, count_charge;

  if (use.surface_ptr == NULL)
    return (OK);

/*
 *   calculate g for each surface
 */
  count_charge = 0;
  for (j = 0; j < count_unknowns; j++)
  {
    if (x[j]->type != SURFACE_CB)
      continue;
    surface_charge_ptr = x[j]->surface_charge;
    count_g = 0;
    if (x[j]->surface_charge->g != NULL)
    {
      count_g = x[j]->surface_charge->count_g;
    }
    if (count_g == 0)
    {
      x[j]->surface_charge->g =
	(struct surface_diff_layer *) PHRQ_malloc ((size_t)
						   sizeof (struct
							   surface_diff_layer));
      if (x[j]->surface_charge->g == NULL)
	malloc_error ();
      x[j]->surface_charge->g[0].charge = 0.0;
      x[j]->surface_charge->g[0].g = 0.0;
      x[j]->surface_charge->g[0].dg = 0.0;
      xd = exp (-2 * x[j]->master[0]->s->la * LOG_10);
      /* alpha = 0.02935 @ 25;                (ee0RT/2)**1/2, (L/mol)**1/2 C / m**2 */
      /*  second 1000 is liters/m**3 */
      alpha =
	sqrt (EPSILON * EPSILON_ZERO * (R_KJ_DEG_MOL * 1000.0) * 1000.0 *
	      tk_x * 0.5);
    }
/*
 *   calculate g for given surface for each species
 */
    count_g = 1;
    for (i = 0; i < count_s_x; i++)
    {
      if (s_x[i]->type > HPLUS)
	continue;
      for (k = 0; k < count_g; k++)
      {
	if (equal (x[j]->surface_charge->g[k].charge, s_x[i]->z, G_TOL) ==
	    TRUE)
	{
	  s_x[i]->diff_layer[count_charge].charge = x[j]->surface_charge;
	  s_x[i]->diff_layer[count_charge].count_g = k;
	  s_x[i]->diff_layer[count_charge].g_moles = 0.0;
	  s_x[i]->diff_layer[count_charge].dg_g_moles = 0.0;
	  break;
	}
      }
      if (k >= count_g)
      {

	/* malloc space to save g for charge */
	x[j]->surface_charge->g =
	  (struct surface_diff_layer *) PHRQ_realloc (x[j]->surface_charge->g,
						      (size_t) (count_g +
								1) *
						      sizeof (struct
							      surface_diff_layer));
	if (x[j]->surface_charge->g == NULL)
	  malloc_error ();

	/* save g for charge */
	x[j]->surface_charge->g[count_g].charge = s_x[i]->z;
	if (x[j]->surface_charge->grams > 0.0)
	{
	  x[j]->surface_charge->g[count_g].g =
	    2 * alpha * sqrt (mu_x) * (pow (xd, s_x[i]->z / 2.0) -
				       1) * surface_charge_ptr->grams *
	    surface_charge_ptr->specific_area / F_C_MOL;
	  x[j]->surface_charge->g[count_g].dg = -s_x[i]->z;
	  if ((use.surface_ptr->only_counter_ions == TRUE) &&
	      x[j]->surface_charge->g[count_g].g < 0)
	  {
	    x[j]->surface_charge->g[count_g].g = 0;
	    x[j]->surface_charge->g[count_g].dg = 0;
	  }
	}
	else
	{
	  x[j]->surface_charge->g[count_g].g = 0.0;
	  x[j]->surface_charge->g[count_g].dg = -s_x[i]->z;
	}
	/* save g for species */
	s_x[i]->diff_layer[count_charge].charge = x[j]->surface_charge;
	s_x[i]->diff_layer[count_charge].count_g = count_g;
	s_x[i]->diff_layer[count_charge].g_moles = 0.0;
	s_x[i]->diff_layer[count_charge].dg_g_moles = 0.0;
	count_g++;
      }
    }
    if (debug_diffuse_layer == TRUE)
    {
      output_msg (OUTPUT_MESSAGE, "\nSurface component %d: charge,\tg,\tdg\n",
		  count_charge);
      for (i = 0; i < count_g; i++)
      {
	output_msg (OUTPUT_MESSAGE, "\t%12f\t%12.4e\t%12.4e\n",
		    (double) x[j]->surface_charge->g[i].charge,
		    (double) x[j]->surface_charge->g[i].g,
		    (double) x[j]->surface_charge->g[i].dg);
      }
    }
    count_charge++;
    x[j]->surface_charge->count_g = count_g;
  }
  return (OK);
}
Ejemplo n.º 15
0
/* ---------------------------------------------------------------------- */
int Phreeqc::
advection(void)
/* ---------------------------------------------------------------------- */
{
	int i;
	LDBLE kin_time;
/*
 *   Calculate advection
 */
	state = ADVECTION;
/*	mass_water_switch = TRUE; */
/*
 *   Check existence of all solutions
 */
	for (i = 0; i <= count_ad_cells; i++)
	{
		if (Utilities::Rxn_find(Rxn_solution_map, i) == NULL)
		//if (solution_bsearch(i, &n, TRUE) == NULL)
		{
			input_error++;
			error_string = sformatf(
					"Solution %d is needed for advection, but is not defined.",
					i);
			error_msg(error_string, CONTINUE);
		}
	}
/*
 *   Check kinetics logic
 */
	kin_time = advection_kin_time;
	if (kin_time <= 0.0)
	{
		for (i = 1; i <= count_ad_cells; i++)
		{
			if (Utilities::Rxn_find(Rxn_kinetics_map, i) != NULL)
			{
				input_error++;
				error_string = sformatf(
						"KINETIC reaction(s) defined, but time_step is not defined in ADVECTION keyword.");
				error_msg(error_string, CONTINUE);
				break;
			}
		}
	}
/*
 *   Quit on error
 */
	if (get_input_errors() > 0)
	{
		error_msg("Program terminating due to input errors.", STOP);
	}
/*
 *   Equilibrate solutions with phases, exchangers, surfaces
 */
	last_model.force_prep = TRUE;
	rate_sim_time_start = 0;
	for (advection_step = 1; advection_step <= count_ad_shifts;
		 advection_step++)
	{
		log_msg(sformatf(
				   "\nBeginning of advection time step %d, cumulative pore volumes %f.\n",
				   advection_step,
				   (double) (((LDBLE) advection_step) /
							 ((LDBLE) count_ad_cells))));
		if (pr.use == TRUE && pr.all == TRUE)
		{
			output_msg(sformatf(
					   "Beginning of advection time step %d, cumulative pore volumes %f.\n",
					   advection_step,
					   (double) (((LDBLE) advection_step) /
								 ((LDBLE) count_ad_cells))));
		}
/*
 *  Advect
 */
		for (i = count_ad_cells; i > 0; i--)
		{
			//solution_duplicate(i - 1, i);
			Utilities::Rxn_copy(Rxn_solution_map, i -1, i);
		}
/*
 *  Equilibrate and (or) mix
 */
		for (i = 1; i <= count_ad_cells; i++)
		{
			set_initial_moles(i);
			cell_no = i;
			set_advection(i, TRUE, TRUE, i);
			run_reactions(i, kin_time, TRUE, 1.0);
			if (advection_kin_time_defined == TRUE)
			{
				rate_sim_time = rate_sim_time_start + kin_time;
			}
			log_msg(sformatf( "\nCell %d.\n\n", i));
			if (pr.use == TRUE && pr.all == TRUE &&
				advection_step % print_ad_modulus == 0 &&
				advection_print[i - 1] == TRUE)
			{
				output_msg(sformatf( "\nCell %d.\n\n", i));
			}
			if (advection_step % punch_ad_modulus == 0 &&
				advection_punch[i - 1] == TRUE)
			{
				punch_all();
			}
			if (advection_step % print_ad_modulus == 0 &&
				advection_print[i - 1] == TRUE)
			{
				print_all();
			}
			if (i > 1)
				Utilities::Rxn_copy(Rxn_solution_map, -2, i - 1);
				//solution_duplicate(-2, i - 1);
			saver();
		}
		Utilities::Rxn_copy(Rxn_solution_map, -2, count_ad_cells);
		//solution_duplicate(-2, count_ad_cells);
		rate_sim_time_start += kin_time;
	}
	initial_total_time += rate_sim_time_start;
	/* free_model_allocs(); */
	mass_water_switch = FALSE;
	return (OK);
}
Ejemplo n.º 16
0
// SYMBOL INPUT
void oscroute_symbol(t_oscroute *x, t_symbol *msg, long argc, t_atom *argv)
{
	t_symbol	*output;
	char		input[MAX_MESS_SIZE];	// our input string
	long		inlet = proxy_getinlet((t_object *)x);

	// If the message comes in the second inlet, then set the string to match...
	if (inlet == 1) {
		x->arguments[0] = msg;
		x->arglen[0] = strlen(msg->s_name);
		return;
	}
	
	// Otherwise match the stored string(s) and output...
	strcpy(input, msg->s_name);

	/*	to -- the introduction of relative address feature
		in modular0.6 make this test useless
	 
	// Make sure we are dealing with valid OSC input by looking for a leading slash
	if (input[0] != '/') {
		outlet_anything(x->outlet_overflow, msg, argc , argv);
		return;
	}
	 */
	
	char *wc, *c;
	bool overFlow = true;
	for (int pos=0; pos < x->num_args; pos++) {
		// Look for exact matches first.
		if (strncmp(msg->s_name, x->arguments[pos]->s_name, x->arglen[pos])==0) {
			// If incoming message is longer than argument...
			if (strlen(msg->s_name) > x->arglen[pos]) {
				// ...it is only a match if it continues with a slash
				if (input[x->arglen[pos]] == '/') {
					output = gensym(msg->s_name + x->arglen[pos] +1);		// 0.6 changes : +1 to remove don't have a leading slash and output a relative adddress 
					outlet_anything(x->outlets[pos], output, argc , argv);
					overFlow = false;
					break;
				}
			}
			// If the incoming message is no longer we know that we have a match
			else {
			
				// We then have to check what message to return.
				// The message received has no arguments:
				if (argc == 0) {
					outlet_bang(x->outlets[pos]);
					overFlow = false;
					break;
				}
				// The message received has one argument only:
				else if (argc==1) {
					overFlow = false;
					// int argument
					if (argv->a_type==A_LONG) {
						outlet_int(x->outlets[pos],argv->a_w.w_long);
						break;
					}				
					// float argument
					else if (argv->a_type==A_FLOAT) {
						outlet_float(x->outlets[pos],argv->a_w.w_float);
						break;
					}
					// something else
					else if (argv->a_type==A_SYM) {
						outlet_anything(x->outlets[pos],argv->a_w.w_sym,0,0);
						break;
					}				
					else { // something completely different: copy to output as list
						outlet_anything(x->outlets[pos], _sym_list, 1, argv);
						break;
					}
				}		
				// There are two or more arguments: check if first is A_SYM	
				else {
					if (argv->a_type==A_SYM) {
						output = argv->a_w.w_sym;
						argc--;
						argv++;
					}
					else
						output = _sym_list;
					outlet_anything(x->outlets[pos], output, argc , argv);
					overFlow = false;
					break;
				}
			}
		}
	}
	// XXX Putting this here makes crashes go away.  It would be really good to know why.
	//cpost("temp hack to prevent optimizations that cause this object to crash in Deployment");
	// If no exact matches, look for wildcards.
	for (int index=0; index < x->num_args; index++) {	

		if (wc = strstr(x->arguments[index]->s_name, "*")) {
			// Does the argument have anything following the wildcard?
			if (*(wc+1) == '\0') {
				// Now compare the argument up to the asterisk to the message
				if (strncmp(msg->s_name, x->arguments[index]->s_name, x->arglen[index] - 1) == 0) {

					// Increment string past everything that matches including the asterisk
					char *temp = msg->s_name + (x->arglen[index] - 1);
					// Check for a slash, an asterisk causes us to strip off everything up to the next slash
					char *outMsg = strstr(temp, "/");
					if (outMsg)
						output_msg(x, outMsg, index, argc, argv);
					else {
						// no slash, output everything following the message
						output_msg(x, NULL, index, argc, argv);
					}
					return;
				} else {
					// We break here because if the strncmp() fails it means we have a wildcard following an 
					// OSC message i.e. /robot/* but the incoming message doesn't begin with /robot
					//break;
				}
			} else {
				// There is no NULL char after asterisk
				c = msg->s_name;
				while (wc && *(wc) == '*') {
					wc++;
					c++;
				}
					
				c += strlen(c) - strlen(wc);
				if (strncmp(c, wc, strlen(c)) == 0) {
					output_msg(x, c, index, argc, argv);
					return;
				}
			}
		} 
	}

	// the message was never reckognised
	if (overFlow)
		outlet_anything(x->outlet_overflow, msg, argc , argv);
}
Ejemplo n.º 17
0
/* ---------------------------------------------------------------------- */
PHRQ_io::LINE_TYPE PHRQ_io::
get_line(void)
/* ---------------------------------------------------------------------- */
{
/*
 *   Read a line from input file put in "line".
 *   Copy of input line is stored in "line_save".
 *   Characters after # are discarded in line but retained in "line_save"
 *
 *   Arguments:
 *      fp is file name
 *   Returns:
 *      EMPTY,
 *      EOF,
 *      KEYWORD,
 *      OK,
 *      OPTION
 */
	std::string stdtoken;
	bool continue_loop = true;;

	PHRQ_io::LINE_TYPE return_value;
	// loop for include files
	for (;;)
	{
		if (this->get_istream() == NULL)
		{
			break;
		}
		return_value = LT_EMPTY;
		while (return_value == LT_EMPTY)
		{
			/*
			*   Eliminate all characters after # sign as a comment
			*/
			/*
			*   Get line, check for eof
			*/
			continue_loop = false;

			if (get_logical_line() == LT_EOF)
			{
				//pop next file
				this->pop_istream();
				continue_loop = true;
				break;
			}
			/*
			*   Get long lines
			*/
			bool empty = true;
			m_line = m_line_save.substr(0, m_line_save.find_first_of('#'));
			for (unsigned int i = 0; i < m_line.size(); ++i)
			{
				if (!::isspace(m_line[i]))
				{
					empty = false;
					break;
				}
			}

			if (this->accumulate)
			{
				this->accumulated.append(m_line_save);
				this->accumulated.append("\n");
			}
			//
			// New line character encountered
			//
			return_value = (empty ? LT_EMPTY : LT_OK);

		}
		if (continue_loop) continue;
		//
		// Determine return_value
		//
		if (return_value == LT_OK)
		{
			if (check_key(m_line.begin(), m_line.end()))
			{
				return_value = LT_KEYWORD;
			}
			else
			{
				std::string::iterator beg = m_line.begin();
				std::string::iterator end = m_line.end();
				std::string token;
				CParser::copy_token(token, beg, end);

				if (token.size() > 1 && token[0] == '-' &&::isalpha(token[1]))
				{
					return_value = LT_OPTION;
				}
			}
		}

		// add new include file to stack
		std::string::iterator beg = m_line.begin();
		std::string::iterator end = m_line.end();
		CParser::copy_token(stdtoken, beg, end);
		std::transform(stdtoken.begin(), stdtoken.end(), stdtoken.begin(), ::tolower);
		if ((strstr(stdtoken.c_str(),"include$") == stdtoken.c_str()) ||
			(strstr(stdtoken.c_str(),"include_file") == stdtoken.c_str()))
		{
			std::string file_name;
			file_name.assign(beg, end);
			file_name = trim(file_name);

			if (file_name.size() > 0)
			{
				std::ifstream *next_stream = new std::ifstream(file_name.c_str(), std::ios_base::in);
				if (!next_stream->is_open())
				{
					std::ostringstream errstr;
					errstr << "\n***********  Could not open include file " << file_name
						   <<".\n             Please, write the full path to this file. ***********\n\n";
					delete next_stream;
#if defined(PHREEQCI_GUI)
					warning_msg(errstr.str().c_str());
					continue;
#else
					output_msg(errstr.str().c_str());
					error_msg(errstr.str().c_str(), OT_STOP);
#endif
				}
				else
				{
					this->push_istream(next_stream);
					std::ostringstream errstr;
					errstr << "\n\tReading data from " << file_name <<" ...\n";
					output_msg(errstr.str().c_str()); // **appt
				}
				continue;
			}
		}
		return return_value;
	}
	m_next_keyword = Keywords::KEY_END;
	return LT_EOF;
}
Ejemplo n.º 18
0
/* ---------------------------------------------------------------------- */
LDBLE
calc_psi_avg (LDBLE surf_chrg_eq)
/* ---------------------------------------------------------------------- */
{
/*
 * calculate the average (F * Psi / RT) that lets the DL charge counter the surface charge
 */
  int i, iter, count_g;
  LDBLE fd, fd1, p, temp, ratio_aq;
/*	LDBLE dif;
 */
  count_g = surface_charge_ptr->count_g;
  ratio_aq = surface_charge_ptr->mass_water / mass_water_aq_x;
  p = 0;
  if (surf_chrg_eq == 0)
    return (0.0);
  else if (surf_chrg_eq < 0)
    p = -0.5 * log (-surf_chrg_eq * ratio_aq / mu_x + 1);
  else if (surf_chrg_eq > 0)
    p = 0.5 * log (surf_chrg_eq * ratio_aq / mu_x + 1);
/*
 * Optimize p in SS{s_x[i]->moles * z_i * g(p)} = -surf_chrg_eq
 *  g(p) = exp(-p * z_i) * ratio_aq
 * Elsewhere in PHREEQC, g is the excess, after subtraction of conc's for p = 0:
 *                      g(p) = (exp(-p *z_i) - 1) * ratio_aq
 */
  iter = 0;
  do
  {
    fd = surf_chrg_eq;
    fd1 = 0.0;
    for (i = 1; i < count_g; i++)
    {
      if (use.surface_ptr->type == CD_MUSIC)
	temp = exp (-charge_group[i].z * p);
      else
	/*  multiply with ratio_aq for multiplier options cp and cm
	   in calc_all_donnan (not used now)...  */
	temp = exp (-charge_group[i].z * p) * ratio_aq;

      if (use.surface_ptr->only_counter_ions &&
	  ((surf_chrg_eq < 0 && charge_group[i].z < 0)
	   || (surf_chrg_eq > 0 && charge_group[i].z > 0)))
	temp = 0.0;
      fd += charge_group[i].eq * temp;
      fd1 -= charge_group[i].z * charge_group[i].eq * temp;
    }
    fd /= -fd1;
    p += (fd > 1) ? 1 : ((fd < -1) ? -1 : fd);
    if (fabs (p) < G_TOL)
      p = 0.0;
    iter++;
    if (iter > 50)
    {
      sprintf (error_string,
	       "\nToo many iterations for surface in subroutine calc_psi_avg.\n");
      error_msg (error_string, STOP);
    }
  }
  while (fabs (fd) > 1e-12 && p != 0.0);
  if (debug_diffuse_layer == TRUE)
    output_msg (OUTPUT_MESSAGE,
		"iter in calc_psi_avg = %d. g(+1) = %8f. surface charge = %8f.\n",
		iter, (double) (exp (-p) - 1), (double) surf_chrg_eq);

  return (p);
}
Ejemplo n.º 19
0
Archivo: remunge.c Proyecto: dun/munge
void
process_creds (conf_t conf)
{
/*  Process credentials according to the configuration [conf].
 *  Processing continues for the specified duration or until the
 *    credential count is reached, whichever comes first.
 */
    int             n_secs;
    unsigned long   n_creds;
    struct timespec to;

    /*  Start the main timer before the timeout is computed below.
     */
    GET_TIMEVAL (conf->t_main_start);
    /*
     *  The default is to process credentials for 1 second.
     */
    if (!conf->num_creds && !conf->num_seconds) {
        conf->num_seconds = 1;
    }
    /*  Save configuration values before they are further modified.
     */
    n_secs = conf->num_seconds;
    n_creds = conf->num_creds;
    /*
     *  If a duration is not specified (either explicitly or implicitly),
     *    set the timeout to the maximum value so pthread_cond_timedwait()
     *    can still be used.
     */
    if (conf->num_seconds) {
        to.tv_sec = conf->t_main_start.tv_sec + conf->num_seconds;
        if (to.tv_sec < conf->t_main_start.tv_sec) {
            to.tv_sec = (sizeof (to.tv_sec) == 4) ? INT_MAX : LONG_MAX;
        }
        to.tv_nsec = conf->t_main_start.tv_usec * 1e3;
    }
    else {
        to.tv_sec = (sizeof (to.tv_sec) == 4) ? INT_MAX : LONG_MAX;
        to.tv_nsec = 0;
    }
    /*  Recompute the number of seconds in case the specified duration
     *    exceeded the maximum timeout.
     */
    conf->num_seconds = to.tv_sec - conf->t_main_start.tv_sec;
    /*
     *  If a credential count was not specified, set the limit at the maximum.
     */
    if (!conf->num_creds) {
        conf->num_creds = ULONG_MAX;
    }
    /*  Output processing start message.
     */
    if (n_creds && !n_secs) {
        output_msg ("Processing %lu credential%s",
            conf->num_creds,   ((conf->num_creds   == 1) ? "" : "s"));
    }
    else if (n_secs && !n_creds) {
        output_msg ("Processing credentials for %d second%s",
            conf->num_seconds, ((conf->num_seconds == 1) ? "" : "s"));
    }
    else {
        output_msg ("Processing %lu credential%s for up to %d second%s",
            conf->num_creds,   ((conf->num_creds   == 1) ? "" : "s"),
            conf->num_seconds, ((conf->num_seconds == 1) ? "" : "s"));
    }
    /*  Start processing credentials.
     */
    while (conf->num_running > 0) {

        errno = pthread_cond_timedwait (&conf->cond_done, &conf->mutex, &to);

        if (!errno || (errno == ETIMEDOUT)) {
            break;
        }
        else if (errno == EINTR) {
            continue;
        }
        else {
            log_errno (EMUNGE_SNAFU, LOG_ERR, "Failed to wait on condition");
        }
    }
    return;
}
Ejemplo n.º 20
0
void io_dpc(unsigned long ref_data)
{
	struct io_mgr *pio_mgr = (struct io_mgr *)ref_data;
	struct chnl_mgr *chnl_mgr_obj;
	struct msg_mgr *msg_mgr_obj;
	struct deh_mgr *hdeh_mgr;
	u32 requested;
	u32 serviced;

	if (!pio_mgr)
		goto func_end;
	chnl_mgr_obj = pio_mgr->chnl_mgr;
	dev_get_msg_mgr(pio_mgr->dev_obj, &msg_mgr_obj);
	dev_get_deh_mgr(pio_mgr->dev_obj, &hdeh_mgr);
	if (!chnl_mgr_obj)
		goto func_end;

	requested = pio_mgr->dpc_req;
	serviced = pio_mgr->dpc_sched;

	if (serviced == requested)
		goto func_end;

	
	do {
		
		if ((pio_mgr->intr_val > DEH_BASE) &&
		    (pio_mgr->intr_val < DEH_LIMIT)) {
			
			if (hdeh_mgr) {
#ifdef CONFIG_TIDSPBRIDGE_BACKTRACE
				print_dsp_debug_trace(pio_mgr);
#endif
				bridge_deh_notify(hdeh_mgr, DSP_SYSERROR,
						  pio_mgr->intr_val);
			}
		}
		
		input_chnl(pio_mgr, NULL, IO_SERVICE);
		output_chnl(pio_mgr, NULL, IO_SERVICE);

#ifdef CHNL_MESSAGES
		if (msg_mgr_obj) {
			
			input_msg(pio_mgr, msg_mgr_obj);
			output_msg(pio_mgr, msg_mgr_obj);
		}

#endif
#ifdef CONFIG_TIDSPBRIDGE_BACKTRACE
		if (pio_mgr->intr_val & MBX_DBG_SYSPRINTF) {
			
			print_dsp_debug_trace(pio_mgr);
		}
#endif
		serviced++;
	} while (serviced != requested);
	pio_mgr->dpc_sched = requested;
func_end:
	return;
}
Ejemplo n.º 21
0
int s2e_web_configure(char buf[], int app_state, int connection_state)
{
    int err;
    int val;
    uart_config_data_t data;
    int telnet_port;
    chanend c_uart_config = (chanend) ((app_state_t *) app_state)->c_uart_config;
    chanend c_flash_data = (chanend) ((app_state_t *) app_state)->c_flash;
    char *err_msg;
    char *web_form_req;
    int flash_result;

    if (!web_server_is_post(connection_state))
        return 0;

    web_form_req = web_server_get_param("form_action", connection_state);

    if (strcmp(web_form_req, "Get") == 0)
    {
        return output_msg(buf, success_msg);
    }
    else if (strcmp(web_form_req, "Set") == 0)
    {
        val = get_int_param("id", connection_state, &err);
        if (err)
            return output_msg(buf, s2e_validation_bad_channel_id);

        data.channel_id = val;

        // Received Set request from web page
        val = get_int_param("pc", connection_state, &err);
        if (err)
            return output_msg(buf, s2e_validation_bad_parity_msg);
        data.parity = val;

        val = get_int_param("sb", connection_state, &err);
        if (err)
            return output_msg(buf, s2e_validation_bad_stop_bits_msg);
        data.stop_bits = val;

        val = get_int_param("br", connection_state, &err);
        if (err)
            return output_msg(buf, s2e_validation_bad_baudrate_msg);
        data.baud = val;

        val = get_int_param("cl", connection_state, &err);
        if (err)
            return output_msg(buf, s2e_validation_bad_char_len_msg);
        data.char_len = val;

        val = get_int_param("tp", connection_state, &err);
        if (err)
            return output_msg(buf, s2e_validation_bad_telnet_port_msg);

        telnet_port = val;

        data.polarity = 0;

        err_msg = s2e_validate_uart_config(&data);

        if (err_msg)
            return output_msg(buf, err_msg);

        err_msg = s2e_validate_telnet_port(data.channel_id, telnet_port);

        if (err_msg)
            return output_msg(buf, err_msg);

        // Do the setting

        uart_config_data_t *config = uart_get_config(data.channel_id);
        *config = data;
        uart_set_config(c_uart_config, &data);

        // We have to delay the changing of the telnet port until after the
        // page is rendered so we can use the tcp channel
        pending_telnet_port_change_id = data.channel_id;
        pending_telnet_port_change_port = telnet_port;

        return output_msg(buf, success_msg);

    } // Set
    else if (strcmp(web_form_req, "Save") == 0)
    {
        // Received Save request from web page
        send_cmd_to_flash_thread(c_flash_data, UART_CONFIG, FLASH_CMD_SAVE);

        for(int i = 0; i < NUM_UART_CHANNELS; i++)
        {
            uart_config_data_t *data1 = uart_get_config(i);
            send_data_to_flash_thread(c_flash_data, data1);
        }

        flash_result = get_flash_access_result(c_flash_data);

        if (flash_result == S2E_FLASH_OK)
        {
            return output_msg(buf, success_msg);
        }
        else
        {
            return output_msg(buf, error_msg);
        }

    } // Save
    else if (strcmp(web_form_req, "Restore") == 0)
    {
        uart_config_data_t data1;
        int telnet_port1;

        // Received Restore request from web page
        send_cmd_to_flash_thread(c_flash_data, UART_CONFIG, FLASH_CMD_RESTORE);

        flash_result = get_flash_access_result(c_flash_data);

        if (flash_result == S2E_FLASH_OK)
        {
            for (int i = 0; i < NUM_UART_CHANNELS; i++)
            {
                get_data_from_flash_thread(c_flash_data, &data1, &telnet_port1);

                uart_config_data_t *config = uart_get_config(data1.channel_id);
                *config = data1;
                uart_set_config(c_uart_config, &data1);

                // We have to delay the changing of the telnet port until after the
                // page is rendered so we can use the tcp channel
                pending_telnet_port_change_id = data1.channel_id;
                pending_telnet_port_change_port = telnet_port1;
            }
            return output_msg(buf, success_msg);
        }
        else
        {
            return output_msg(buf, error_msg);
        }

    } // Restore
    else
    {
        // invalid request
        return output_msg(buf, error_msg);
    }

    return 0;
}
Ejemplo n.º 22
0
/* ---------------------------------------------------------------------- */
int
calc_all_g (void)
/* ---------------------------------------------------------------------- */
{
  int i, j, k;
  int converge, converge1;
  int count_g, count_charge;
  LDBLE new_g, xd1;
  LDBLE epsilon;

  if (svnid == NULL)
    fprintf (stderr, " ");
  if (use.surface_ptr == NULL)
    return (OK);
/*
 *   calculate g for each surface
 */
#ifdef SKIP
  if (punch.high_precision == FALSE)
  {
    epsilon = 1e-8;
    G_TOL = 1e-9;
  }
  else
  {
    epsilon = 1.e-12;
    G_TOL = 1e-10;
  }
#endif
  epsilon = convergence_tolerance;
  if (convergence_tolerance >= 1e-8)
  {
    G_TOL = 1e-9;
  }
  else
  {
    G_TOL = 1e-10;
  }

  converge = TRUE;
  count_charge = 0;
  for (j = 0; j < count_unknowns; j++)
  {
    if (x[j]->type != SURFACE_CB)
      continue;
    if (debug_diffuse_layer == TRUE)
      output_msg (OUTPUT_MESSAGE, "Calc_all_g, X[%d]\n", j);
    surface_charge_ptr = x[j]->surface_charge;
    count_g = 1;
    x[j]->surface_charge->g[0].charge = 0.0;
    x[j]->surface_charge->g[0].g = 0.0;
    x[j]->surface_charge->g[0].dg = 0.0;
    xd = exp (-2 * x[j]->master[0]->s->la * LOG_10);
    /* alpha = 0.02935 @ 25;                (ee0RT/2)**1/2, (L/mol)**1/2 C / m**2 */
    /* 1000 J/kJ and 1000 L/m**3 */
    alpha =
      sqrt (EPSILON * EPSILON_ZERO * (R_KJ_DEG_MOL * 1000.0) * 1000.0 * tk_x *
	    0.5);
/*
 *   calculate g for given surface for each species
 */
    for (i = 0; i < count_s_x; i++)
    {
      if (s_x[i]->type > HPLUS)
	continue;
      for (k = 0; k < count_g; k++)
      {
	if (equal (x[j]->surface_charge->g[k].charge, s_x[i]->z, G_TOL) ==
	    TRUE)
	{
	  s_x[i]->diff_layer[count_charge].charge = x[j]->surface_charge;
	  s_x[i]->diff_layer[count_charge].count_g = k;
	  break;
	}
      }
      if (k < count_g)
	continue;

      if (x[j]->surface_charge->grams > 0.0)
      {
	z = s_x[i]->z;
	if ((use.surface_ptr->only_counter_ions == FALSE) ||
	    (((x[j]->master[0]->s->la > 0) && (z < 0))
	     || ((x[j]->master[0]->s->la < 0) && (z > 0))))
	{
	  if (xd > 0.1)
	  {
	    new_g = qromb_midpnt (1.0, xd);
	  }
	  else if (xd > 0.01)
	  {
	    new_g = qromb_midpnt (1.0, 0.1);
	    new_g += qromb_midpnt (0.1, xd);
	  }
	  else if (xd > 0.001)
	  {
	    new_g = qromb_midpnt (1.0, 0.1);
	    new_g += qromb_midpnt (0.1, 0.01);
	    new_g += qromb_midpnt (0.01, xd);
	  }
	  else if (xd > 0.0001)
	  {
	    new_g = qromb_midpnt (1.0, 0.1);
	    new_g += qromb_midpnt (0.1, 0.01);
	    new_g += qromb_midpnt (0.01, .001);
	    new_g += qromb_midpnt (0.001, xd);
	  }
	  else if (xd > 0.00001)
	  {
	    new_g = qromb_midpnt (1.0, 0.1);
	    new_g += qromb_midpnt (0.1, 0.01);
	    new_g += qromb_midpnt (0.01, .001);
	    new_g += qromb_midpnt (0.001, .0001);
	    new_g += qromb_midpnt (0.0001, xd);
	  }
	  else if (xd > 0.000001)
	  {
	    new_g = qromb_midpnt (1.0, 0.1);
	    new_g += qromb_midpnt (0.1, 0.01);
	    new_g += qromb_midpnt (0.01, .001);
	    new_g += qromb_midpnt (0.001, .0001);
	    new_g += qromb_midpnt (0.0001, .00001);
	    new_g += qromb_midpnt (0.00001, xd);
	  }
	  else if (xd > 0.0000001)
	  {
	    new_g = qromb_midpnt (1.0, 0.1);
	    new_g += qromb_midpnt (0.1, 0.01);
	    new_g += qromb_midpnt (0.01, .001);
	    new_g += qromb_midpnt (0.001, .0001);
	    new_g += qromb_midpnt (0.0001, .00001);
	    new_g += qromb_midpnt (0.00001, .000001);
	    new_g += qromb_midpnt (0.000001, xd);
	  }
	  else if (xd > 0.00000001)
	  {
	    new_g = qromb_midpnt (1.0, 0.1);
	    new_g += qromb_midpnt (0.1, 0.01);
	    new_g += qromb_midpnt (0.01, .001);
	    new_g += qromb_midpnt (0.001, .0001);
	    new_g += qromb_midpnt (0.0001, .00001);
	    new_g += qromb_midpnt (0.00001, .000001);
	    new_g += qromb_midpnt (0.000001, .0000001);
	    new_g += qromb_midpnt (0.0000001, xd);
	  }
	  else
	  {
	    new_g = qromb_midpnt (1.0, 0.1);
	    new_g += qromb_midpnt (0.1, 0.01);
	    new_g += qromb_midpnt (0.01, .001);
	    new_g += qromb_midpnt (0.001, .0001);
	    new_g += qromb_midpnt (0.0001, .00001);
	    new_g += qromb_midpnt (0.00001, .000001);
	    new_g += qromb_midpnt (0.000001, .0000001);
	    new_g += qromb_midpnt (0.0000001, .00000001);
	    new_g += qromb_midpnt (0.00000001, xd);
	  }
	}
	else
	{
	  new_g = 0;
	}
      }
      else
      {
	new_g = 0.0;
      }
      if ((use.surface_ptr->only_counter_ions == TRUE) && new_g < 0)
	new_g = 0;
      x[j]->surface_charge->g[count_g].charge = s_x[i]->z;
      converge1 = TRUE;
      if (fabs (new_g) >= 1.)
      {
	if (fabs ((new_g - x[j]->surface_charge->g[count_g].g) / new_g) >
	    epsilon)
	{
	  converge1 = FALSE;
	}
      }
      else
      {
	if (fabs (new_g - x[j]->surface_charge->g[count_g].g) > epsilon)
	{
	  converge1 = FALSE;
	}
      }
      if (converge1 == FALSE)
      {
	converge = FALSE;
	if (debug_diffuse_layer == TRUE)
	{
	  output_msg (OUTPUT_MESSAGE, "\t%12f\t%12.4e\t%12.4e\t%12.4e\n",
		      (double) x[j]->surface_charge->g[count_g].charge,
		      (double) x[j]->surface_charge->g[count_g].g,
		      (double) new_g,
		      (double) (new_g - x[j]->surface_charge->g[count_g].g));
	}
      }
      x[j]->surface_charge->g[count_g].g = new_g;
      if (new_g == 0)
      {
	x[j]->surface_charge->g[count_g].dg = 0;
      }
      else
      {
	if (x[j]->surface_charge->grams > 0.0)
	{
	  x[j]->surface_charge->g[count_g].dg =
	    surface_charge_ptr->grams * surface_charge_ptr->specific_area *
	    alpha * g_function (xd) / F_C_MOL;
	  x[j]->surface_charge->g[count_g].dg *=
	    -2. / (exp (x[j]->master[0]->s->la * LOG_10) *
		   exp (x[j]->master[0]->s->la * LOG_10));
	  if ((xd - 1) < 0.0)
	  {
	    x[j]->surface_charge->g[count_g].dg *= -1.0;
	  }
	  if (fabs (x[j]->surface_charge->g[count_g].dg) < 1e-8)
	  {
	    xd1 = exp (-2 * 1e-3 * LOG_10);


	    new_g = qromb_midpnt (1.0, xd1);
	    x[j]->surface_charge->g[count_g].dg = new_g / .001;
	  }
	}
	else
	{
	  x[j]->surface_charge->g[count_g].dg = 0.0;
	}
      }
      s_x[i]->diff_layer[count_charge].charge = x[j]->surface_charge;
      s_x[i]->diff_layer[count_charge].count_g = count_g;
      count_g++;

    }
    if (debug_diffuse_layer == TRUE)
    {
      output_msg (OUTPUT_MESSAGE,
		  "\nSurface component %d: charge,\tg,\tdg/dlny,\txd\n",
		  count_charge);
      for (i = 0; i < count_g; i++)
      {
	output_msg (OUTPUT_MESSAGE, "\t%12f\t%12.4e\t%12.4e\t%12.4e\n",
		    (double) x[j]->surface_charge->g[i].charge,
		    (double) x[j]->surface_charge->g[i].g,
		    (double) x[j]->surface_charge->g[i].dg, (double) xd);
      }
    }
    count_charge++;
  }
  return (converge);
}
Ejemplo n.º 23
0
/* ---------------------------------------------------------------------- */
LDBLE
g_function (LDBLE x_value)
/* ---------------------------------------------------------------------- */
{
  LDBLE sum, return_value, sum1;
  int i, j;
  LDBLE ln_x_value;

  if (equal (x_value, 1.0, G_TOL * 100) == TRUE)
    return (0.0);
  sum = 0.0;
  ln_x_value = log (x_value);
  for (j = 0; j < use.surface_ptr->charge[0].count_g; j++)
  {
    use.surface_ptr->charge[0].g[j].psi_to_z =
      exp (ln_x_value * use.surface_ptr->charge[0].g[j].charge) - 1.0;
  }
  for (i = 0; i < count_s_x; i++)
  {
    if (s_x[i]->type < H2O && s_x[i]->z != 0.0)
    {
      for (j = 0; j < use.surface_ptr->charge[0].count_g; j++)
      {
	if (use.surface_ptr->charge[0].g[j].charge == s_x[i]->z)
	{
	  sum += s_x[i]->moles * use.surface_ptr->charge[0].g[j].psi_to_z;
	  break;
	}
      }
    }
  }
  if (sum < 0.0)
  {
    sum = 0.0;
    sum1 = 0.0;
    output_msg (OUTPUT_MESSAGE, "Species\tmoles\tX**z-1\tsum\tsum charge\n");
    for (i = 0; i < count_s_x; i++)
    {
      if (s_x[i]->type < H2O && s_x[i]->z != 0.0)
      {
	sum += s_x[i]->moles * (pow (x_value, s_x[i]->z) - 1.0);
	sum1 += s_x[i]->moles * s_x[i]->z;
	output_msg (OUTPUT_MESSAGE, "%s\t%e\t%e\t%e\t%e\n", s_x[i]->name,
		    (double) s_x[i]->moles,
		    (double) (pow (x_value, (double) s_x[i]->z) - 1.0),
		    (double) sum, (double) sum1);
      }
    }
    sprintf (error_string, "Negative sum in g_function, %e\t%e.",
	     (double) sum, (double) x_value);
    error_msg (error_string, CONTINUE);
    sprintf (error_string,
	     "Solutions must be charge balanced, charge imbalance is %e\n",
	     (double) sum1);
    error_msg (error_string, STOP);
  }

  return_value =
    (exp (ln_x_value * z) -
     1) / sqrt ((x_value * x_value * mass_water_aq_x * sum));
  return (return_value);
}
Ejemplo n.º 24
0
int
cl1mp (int k, int l, int m, int n,
       int nklmd, int n2d,
       LDBLE * q_arg,
       int *kode_arg, LDBLE toler_arg,
       int *iter, LDBLE * x_arg, LDBLE * res_arg, LDBLE * error_arg,
       LDBLE * cu_arg, int *iu, int *s, int check, LDBLE censor_arg)
{
  /* System generated locals */
  union double_or_int
  {
    int ival;
    mpf_t dval;
  } *q2;

  /* Local variables */
  static int nklm;
  static int iout, i, j;
  static int maxit, n1, n2;
  static int ia, ii, kk, in, nk, js;
  static int iphase, kforce;
  static int klm, jmn, nkl, jpn;
  static int klm1;
  static int *kode;
  int q_dim, cu_dim;
  int iswitch;
  mpf_t *q;
  mpf_t *x;
  mpf_t *res;
  mpf_t error;
  mpf_t *cu;
  mpf_t dummy, dummy1, sum, z, zu, zv, xmax, minus_one, toler, check_toler;
  /*mpf_t *scratch; */
  mpf_t pivot, xmin, cuv, tpivot, sn;
  mpf_t zero;
  int censor;
  mpf_t censor_tol;
/* THIS SUBROUTINE USES A MODIFICATION OF THE SIMPLEX */
/* METHOD OF LINEAR PROGRAMMING TO CALCULATE AN L1 SOLUTION */
/* TO A K BY N SYSTEM OF LINEAR EQUATIONS */
/*             AX=B */
/* SUBJECT TO L LINEAR EQUALITY CONSTRAINTS */
/*             CX=D */
/* AND M LINEAR INEQUALITY CONSTRAINTS */
/*             EX.LE.F. */
/* DESCRIPTION OF PARAMETERS */
/* K      NUMBER OF ROWS OF THE MATRIX A (K.GE.1). */
/* L      NUMBER OF ROWS OF THE MATRIX C (L.GE.0). */
/* M      NUMBER OF ROWS OF THE MATRIX E (M.GE.0). */
/* N      NUMBER OF COLUMNS OF THE MATRICES A,C,E (N.GE.1). */
/* KLMD   SET TO AT LEAST K+L+M FOR ADJUSTABLE DIMENSIONS. */
/* KLM2D  SET TO AT LEAST K+L+M+2 FOR ADJUSTABLE DIMENSIONS. */
/* NKLMD  SET TO AT LEAST N+K+L+M FOR ADJUSTABLE DIMENSIONS. */
/* N2D    SET TO AT LEAST N+2 FOR ADJUSTABLE DIMENSIONS */
/* Q      TWO DIMENSIONAL REAL ARRAY WITH KLM2D ROWS AND */
/*        AT LEAST N2D COLUMNS. */
/*        ON ENTRY THE MATRICES A,C AND E, AND THE VECTORS */
/*        B,D AND F MUST BE STORED IN THE FIRST K+L+M ROWS */
/*        AND N+1 COLUMNS OF Q AS FOLLOWS */
/*             A B */
/*         Q = C D */
/*             E F */
/*        THESE VALUES ARE DESTROYED BY THE SUBROUTINE. */
/* KODE   A CODE USED ON ENTRY TO, AND EXIT */
/*        FROM, THE SUBROUTINE. */
/*        ON ENTRY, THIS SHOULD NORMALLY BE SET TO 0. */
/*        HOWEVER, IF CERTAIN NONNEGATIVITY CONSTRAINTS */
/*        ARE TO BE INCLUDED IMPLICITLY, RATHER THAN */
/*        EXPLICITLY IN THE CONSTRAINTS EX.LE.F, THEN KODE */
/*        SHOULD BE SET TO 1, AND THE NONNEGATIVITY */
/*        CONSTRAINTS INCLUDED IN THE ARRAYS X AND */
/*        RES (SEE BELOW). */
/*        ON EXIT, KODE HAS ONE OF THE */
/*        FOLLOWING VALUES */
/*             0- OPTIMAL SOLUTION FOUND, */
/*             1- NO FEASIBLE SOLUTION TO THE */
/*                CONSTRAINTS, */
/*             2- CALCULATIONS TERMINATED */
/*                PREMATURELY DUE TO ROUNDING ERRORS, */
/*             3- MAXIMUM NUMBER OF ITERATIONS REACHED. */
/* TOLER  A SMALL POSITIVE TOLERANCE. EMPIRICAL */
/*        EVIDENCE SUGGESTS TOLER = 10**(-D*2/3), */
/*        WHERE D REPRESENTS THE NUMBER OF DECIMAL */
/*        DIGITS OF ACCURACY AVAILABLE. ESSENTIALLY, */
/*        THE SUBROUTINE CANNOT DISTINGUISH BETWEEN ZERO */
/*        AND ANY QUANTITY WHOSE MAGNITUDE DOES NOT EXCEED */
/*        TOLER. IN PARTICULAR, IT WILL NOT PIVOT ON ANY */
/*        NUMBER WHOSE MAGNITUDE DOES NOT EXCEED TOLER. */
/* ITER   ON ENTRY ITER MUST CONTAIN AN UPPER BOUND ON */
/*        THE MAXIMUM NUMBER OF ITERATIONS ALLOWED. */
/*        A SUGGESTED VALUE IS 10*(K+L+M). ON EXIT ITER */
/*        GIVES THE NUMBER OF SIMPLEX ITERATIONS. */
/* X      ONE DIMENSIONAL REAL ARRAY OF SIZE AT LEAST N2D. */
/*        ON EXIT THIS ARRAY CONTAINS A */
/*        SOLUTION TO THE L1 PROBLEM. IF KODE=1 */
/*        ON ENTRY, THIS ARRAY IS ALSO USED TO INCLUDE */
/*        SIMPLE NONNEGATIVITY CONSTRAINTS ON THE */
/*        VARIABLES. THE VALUES -1, 0, OR 1 */
/*        FOR X(J) INDICATE THAT THE J-TH VARIABLE */
/*        IS RESTRICTED TO BE .LE.0, UNRESTRICTED, */
/*        OR .GE.0 RESPECTIVELY. */
/* RES    ONE DIMENSIONAL REAL ARRAY OF SIZE AT LEAST KLMD. */
/*        ON EXIT THIS CONTAINS THE RESIDUALS B-AX */
/*        IN THE FIRST K COMPONENTS, D-CX IN THE */
/*        NEXT L COMPONENTS (THESE WILL BE =0),AND */
/*        F-EX IN THE NEXT M COMPONENTS. IF KODE=1 ON */
/*        ENTRY, THIS ARRAY IS ALSO USED TO INCLUDE SIMPLE */
/*        NONNEGATIVITY CONSTRAINTS ON THE RESIDUALS */
/*        B-AX. THE VALUES -1, 0, OR 1 FOR RES(I) */
/*        INDICATE THAT THE I-TH RESIDUAL (1.LE.I.LE.K) IS */
/*        RESTRICTED TO BE .LE.0, UNRESTRICTED, OR .GE.0 */
/*        RESPECTIVELY. */
/* ERROR  ON EXIT, THIS GIVES THE MINIMUM SUM OF */
/*        ABSOLUTE VALUES OF THE RESIDUALS. */
/* CU     A TWO DIMENSIONAL REAL ARRAY WITH TWO ROWS AND */
/*        AT LEAST NKLMD COLUMNS USED FOR WORKSPACE. */
/* IU     A TWO DIMENSIONAL INTEGER ARRAY WITH TWO ROWS AND */
/*        AT LEAST NKLMD COLUMNS USED FOR WORKSPACE. */
/* S      INTEGER ARRAY OF SIZE AT LEAST KLMD, USED FOR */
/*        WORKSPACE. */
/*      DOUBLE PRECISION DBLE */
/*      REAL */

/* INITIALIZATION. */
  if (svnid == NULL)
    fprintf (stderr, " ");
  /*
   *  mp variables
   */
  censor = 1;
  if (censor_arg == 0.0)
    censor = 0;
  mpf_set_default_prec (96);
  mpf_init (zero);
  mpf_init (dummy);
  mpf_init (dummy1);
  mpf_init_set_d (censor_tol, censor_arg);
  q =
    (mpf_t *)
    PHRQ_malloc ((size_t)
		 (max_row_count * max_column_count * sizeof (mpf_t)));
  if (q == NULL)
    malloc_error ();
  for (i = 0; i < max_row_count * max_column_count; i++)
  {
    mpf_init_set_d (q[i], q_arg[i]);
    if (censor == 1)
    {
      if (mpf_cmp (q[i], zero) != 0)
      {
	mpf_abs (dummy1, q[i]);
	if (mpf_cmp (dummy1, censor_tol) <= 0)
	{
	  mpf_set_si (q[i], 0);
	}
      }
    }
  }
  x = (mpf_t *) PHRQ_malloc ((size_t) (n2d * sizeof (mpf_t)));
  if (x == NULL)
    malloc_error ();
  for (i = 0; i < n2d; i++)
  {
    mpf_init_set_d (x[i], x_arg[i]);
  }
  res = (mpf_t *) PHRQ_malloc ((size_t) ((k + l + m) * sizeof (mpf_t)));
  if (res == NULL)
    malloc_error ();
  for (i = 0; i < k + l + m; i++)
  {
    mpf_init_set_d (res[i], res_arg[i]);
  }
  cu = (mpf_t *) PHRQ_malloc ((size_t) (2 * nklmd * sizeof (mpf_t)));
  if (cu == NULL)
    malloc_error ();
  for (i = 0; i < 2 * nklmd; i++)
  {
    mpf_init_set_d (cu[i], cu_arg[i]);
  }
  kode = (int *) PHRQ_malloc (sizeof (int));
  if (kode == NULL)
    malloc_error ();
  *kode = *kode_arg;
  mpf_init (sum);
  mpf_init (error);
  mpf_init (z);
  mpf_init (zu);
  mpf_init (zv);
  mpf_init (xmax);
  mpf_init_set_si (minus_one, -1);
  mpf_init_set_d (toler, toler_arg);
  mpf_init_set_d (check_toler, toler_arg);
  mpf_init (pivot);
  mpf_init (xmin);
  mpf_init (cuv);
  mpf_init (tpivot);
  mpf_init (sn);
/* Parameter adjustments */
  q_dim = n2d;
  q2 = (union double_or_int *) q;
  cu_dim = nklmd;

/* Function Body */
  maxit = *iter;
  n1 = n + 1;
  n2 = n + 2;
  nk = n + k;
  nkl = nk + l;
  klm = k + l + m;
  klm1 = klm + 1;
  nklm = n + klm;
  kforce = 1;
  *iter = 0;
  js = 0;
  ia = -1;
/* Make scratch space */
/*
	scratch = (LDBLE *) PHRQ_malloc( (size_t) nklmd * sizeof(LDBLE));
	if (scratch == NULL) malloc_error();
	for (i=0; i < nklmd; i++) {
		scratch[i] = 0.0;
	}
*/
/*
	scratch = (mpf_t *) PHRQ_malloc( (size_t) nklmd * sizeof(mpf_t));
	if (scratch == NULL) malloc_error();
	for (i=0; i < nklmd; i++) {
		mpf_init(scratch[i]);
	}
*/
/* SET UP LABELS IN Q. */
  for (j = 0; j < n; ++j)
  {
    q2[klm1 * q_dim + j].ival = j + 1;
  }
/* L10: */
  for (i = 0; i < klm; ++i)
  {
    q2[i * q_dim + n1].ival = n + i + 1;
    if (mpf_cmp_d (q2[i * q_dim + n].dval, 0.0) < 0)
    {
      for (j = 0; j < n1; ++j)
      {
	/* q2[ i * q_dim + j ].dval = -q2[ i * q_dim + j ].dval; */
	mpf_neg (q2[i * q_dim + j].dval, q2[i * q_dim + j].dval);
      }
      q2[i * q_dim + n1].ival = -q2[i * q_dim + n1].ival;
/* L20: */
    }
  }
/* L30: */
/* SET UP PHASE 1 COSTS. */
  iphase = 2;
#ifdef DEBUG_CL1
  output_msg (OUTPUT_MESSAGE, "Set up phase 1 costs\n");
#endif
/* Zero first row of cu and iu */
  /*memcpy( (void *) &(cu[0]), (void *) &(scratch[0]), (size_t) nklm * sizeof(mpf_t) ); */
  for (j = 0; j < nklm; ++j)
  {
    mpf_set_si (cu[j], 0);
    iu[j] = 0;
  }
/* L40: */
#ifdef DEBUG_CL1
  output_msg (OUTPUT_MESSAGE, "L40\n");
#endif
  if (l != 0)
  {
    for (j = nk; j < nkl; ++j)
    {
      mpf_set_si (cu[j], 1);
      /*cu[ j ] = 1.; */
      iu[j] = 1;
    }
/* L50: */
    iphase = 1;
  }

/* Copy first row of cu and iu to second row */
  /*memcpy( (void *) &(cu[cu_dim]), (void *) &(cu[0]), (size_t) nklm * sizeof(mpf_t) ); */
  for (i = 0; i < nklm; i++)
  {
    mpf_set (cu[cu_dim + i], cu[i]);
  }
  memcpy ((void *) &(iu[cu_dim]), (void *) &(iu[0]),
	  (size_t) nklm * sizeof (int));
/* L60: */
#ifdef DEBUG_CL1
  output_msg (OUTPUT_MESSAGE, "L60\n");
#endif
  if (m != 0)
  {
    for (j = nkl; j < nklm; ++j)
    {
      /* cu[ cu_dim + j ] = 1.; */
      mpf_set_si (cu[cu_dim + j], 1);
      iu[cu_dim + j] = 1;
      jmn = j - n;
      if (q2[jmn * q_dim + n1].ival < 0)
      {
	iphase = 1;
      }
    }
/* L70: */
  }
/* L80: */
#ifdef DEBUG_CL1
  output_msg (OUTPUT_MESSAGE, "L80\n");
#endif
  if (*kode != 0)
  {
    for (j = 0; j < n; ++j)
    {
      /* if ( x[j] < 0.) { */
      if (mpf_cmp_si (x[j], 0) < 0)
      {
/* L90: */
	/* cu[ j ] = 1.; */
	mpf_set_si (cu[j], 1);
	iu[j] = 1;
	/* } else if (x[j] > 0.) { */
      }
      else if (mpf_cmp_si (x[j], 0) > 0)
      {
	/* cu[ cu_dim + j ] = 1.; */
	mpf_set_si (cu[cu_dim + j], 1);
	iu[cu_dim + j] = 1;
      }
    }
/* L110: */
#ifdef DEBUG_CL1
    output_msg (OUTPUT_MESSAGE, "L110\n");
#endif
    for (j = 0; j < k; ++j)
    {
      jpn = j + n;
      /* if (res[j] < 0.) { */
      if (mpf_cmp_si (res[j], 0) < 0)
      {
/* L120: */
	/* cu[ jpn ] = 1.; */
	mpf_set_si (cu[jpn], 1);
	iu[jpn] = 1;
	if (q2[j * q_dim + n1].ival > 0)
	{
	  iphase = 1;
	}
	/* } else if (res[j] > 0.) { */
      }
      else if (mpf_cmp_si (res[j], 0) > 0)
      {
/* L130: */
	/* cu[ cu_dim + jpn ] = 1.; */
	mpf_set_si (cu[cu_dim + jpn], 1);
	iu[cu_dim + jpn] = 1;
	if (q2[j * q_dim + n1].ival < 0)
	{
	  iphase = 1;
	}
      }
    }
/* L140: */
  }
/* L150: */
#ifdef DEBUG_CL1
  output_msg (OUTPUT_MESSAGE, "L150\n");
#endif
  if (iphase == 2)
  {
    goto L500;
  }
/* COMPUTE THE MARGINAL COSTS. */
L160:
#ifdef DEBUG_CL1
  output_msg (OUTPUT_MESSAGE, "L160\n");
#endif
  for (j = js; j < n1; ++j)
  {
    mpf_set_si (sum, 0);
    for (i = 0; i < klm; ++i)
    {
      ii = q2[i * q_dim + n1].ival;
      if (ii < 0)
      {
	/* z = cu[ cu_dim - ii - 1 ]; */
	mpf_set (z, cu[cu_dim - ii - 1]);
      }
      else
      {
	/*z = cu[ ii - 1 ]; */
	mpf_set (z, cu[ii - 1]);
      }
      /*sum += q2[ i * q_dim + j ].dval * z; */
      mpf_mul (dummy, q2[i * q_dim + j].dval, z);
      mpf_add (sum, sum, dummy);
    }
    /*q2[ klm * q_dim + j ].dval = sum; */
    mpf_set (q2[klm * q_dim + j].dval, sum);
  }
  for (j = js; j < n; ++j)
  {
    ii = q2[klm1 * q_dim + j].ival;
    if (ii < 0)
    {
      /*z = cu[ cu_dim - ii - 1 ]; */
      mpf_set (z, cu[cu_dim - ii - 1]);
    }
    else
    {
      /*z = cu[ ii - 1 ]; */
      mpf_set (z, cu[ii - 1]);
    }
    /*q2[ klm * q_dim + j ].dval -= z; */
    mpf_sub (q2[klm * q_dim + j].dval, q2[klm * q_dim + j].dval, z);
  }
/* DETERMINE THE VECTOR TO ENTER THE BASIS. */
L240:
#ifdef DEBUG_CL1
  output_msg (OUTPUT_MESSAGE, "L240, xmax %e\n", mpf_get_d (xmax));
#endif
  /*xmax = 0.; */
  mpf_set_si (xmax, 0);
  if (js >= n)
  {
    goto L490;			/* test for optimality */
  }
  for (j = js; j < n; ++j)
  {
    /*zu = q2[ klm * q_dim + j ].dval; */
    mpf_set (zu, q2[klm * q_dim + j].dval);
    ii = q2[klm1 * q_dim + j].ival;
    if (ii > 0)
    {
      /*zv = -zu - cu[ ii - 1 ] - cu[ cu_dim + ii - 1 ]; */
      mpf_mul (dummy, cu[cu_dim + ii - 1], minus_one);
      mpf_sub (dummy, dummy, cu[ii - 1]);
      mpf_sub (zv, dummy, zu);
    }
    else
    {
      ii = -ii;
      /* zv = zu; */
      mpf_set (zv, zu);
      /* zu = -zu - cu[ ii - 1 ] - cu[ cu_dim + ii - 1 ]; */
      mpf_mul (dummy, cu[cu_dim + ii - 1], minus_one);
      mpf_sub (dummy, dummy, cu[ii - 1]);
      mpf_sub (zu, dummy, zu);
    }
/* L260 */
    if (kforce == 1 && ii > n)
    {
      continue;
    }
    /*if (iu[ ii - 1 ] != 1 && zu > xmax){ */
    if ((iu[ii - 1] != 1) && (mpf_cmp (zu, xmax) > 0))
    {
      /*xmax = zu; */
      mpf_set (xmax, zu);
      in = j;
    }
/* L270 */
    /*if (iu[ cu_dim + ii - 1 ] != 1 && zv > xmax ) { */
    if ((iu[cu_dim + ii - 1] != 1) && (mpf_cmp (zv, xmax) > 0))
    {
      /*xmax = zv; */
      mpf_set (xmax, zv);
      in = j;
    }
  }
/* L280 */
#ifdef DEBUG_CL1
  output_msg (OUTPUT_MESSAGE, "L280 xmax %e, toler %e\n", mpf_get_d (xmax),
	      mpf_get_d (toler));
#endif
  /*if (xmax <= toler) { */
  if (mpf_cmp (xmax, toler) <= 0)
  {
#ifdef DEBUG_CL1
    output_msg (OUTPUT_MESSAGE, "xmax before optimality test %e\n",
		mpf_get_d (xmax));
#endif
    goto L490;			/* test for optimality */
  }
  /*if (q2[ klm * q_dim + in ].dval != xmax) { */
  if (mpf_cmp (q2[klm * q_dim + in].dval, xmax) != 0)
  {
    for (i = 0; i < klm1; ++i)
    {
      /*q2[ i * q_dim + in ].dval = -q2[ i * q_dim + in ].dval; */
      mpf_neg (q2[i * q_dim + in].dval, q2[i * q_dim + in].dval);
    }
    q2[klm1 * q_dim + in].ival = -q2[klm1 * q_dim + in].ival;
/* L290: */
    /*q2[ klm * q_dim + in ].dval = xmax; */
    mpf_set (q2[klm * q_dim + in].dval, xmax);
  }
/* DETERMINE THE VECTOR TO LEAVE THE BASIS. */
  if (iphase != 1 && ia != -1)
  {
    /*xmax = 0.; */
    mpf_set_si (xmax, 0);
/* find maximum absolute value in column "in" */
    for (i = 0; i <= ia; ++i)
    {
      /*z = fabs(q2[ i * q_dim + in ].dval); */
      mpf_abs (z, q2[i * q_dim + in].dval);
      /*if (z > xmax) { */
      if (mpf_cmp (z, xmax) > 0)
      {
	/*xmax = z; */
	mpf_set (xmax, z);
	iout = i;
      }
    }
/* L310: */
#ifdef DEBUG_CL1
    output_msg (OUTPUT_MESSAGE, "L310, xmax %e\n", mpf_get_d (xmax));
#endif
/* switch row ia with row iout, use memcpy */
    /*if (xmax > toler) { */
    if (mpf_cmp (xmax, toler) > 0)
    {
      /*
         memcpy( (void *) &(scratch[0]), (void *) &(q2[ ia * q_dim]),
         (size_t) n2 * sizeof(mpf_t) );
         memcpy( (void *) &(q2[ ia * q_dim ]), (void *) &(q2[ iout * q_dim]),
         (size_t) n2 * sizeof(mpf_t) );
         memcpy( (void *) &(q2[ iout * q_dim ]), (void *) &(scratch[ 0 ]),
         (size_t) n2 * sizeof(mpf_t) );
       */
      for (i = 0; i < n1; i++)
      {
	mpf_set (dummy, q2[ia * q_dim + i].dval);
	mpf_set (q2[ia * q_dim + i].dval, q2[iout * q_dim + i].dval);
	mpf_set (q2[iout * q_dim + i].dval, dummy);
      }
      j = q2[ia * q_dim + n1].ival;
      q2[ia * q_dim + n1].ival = q2[iout * q_dim + n1].ival;
      q2[iout * q_dim + n1].ival = j;

/* L320: */
/* set pivot to row ia, column in */
      iout = ia;
      --ia;
      /*pivot = q2[ iout * q_dim + in ].dval; */
      mpf_set (pivot, q2[iout * q_dim + in].dval);
      goto L420;		/* Gauss Jordan */
    }
  }
/* L330: */
#ifdef DEBUG_CL1
  output_msg (OUTPUT_MESSAGE, "L330, xmax %e\n", mpf_get_d (xmax));
#endif
  kk = -1;
/* divide column n1 by positive value in column "in" greater than toler */
  for (i = 0; i < klm; ++i)
  {
    /*z = q2[ i * q_dim + in ].dval; */
    mpf_set (z, q2[i * q_dim + in].dval);
    /*if (z > toler) { */
    if (mpf_cmp (z, toler) > 0)
    {
      ++kk;
      /*res[kk] = q2[ i * q_dim + n ].dval / z; */
      mpf_div (res[kk], q2[i * q_dim + n].dval, z);
      s[kk] = i;
    }
  }
/* L340: */
  if (kk < 0)
  {
    output_msg (OUTPUT_MESSAGE, "kode = 2 in loop 340.\n");
  }
L350:
#ifdef DEBUG_CL1
  output_msg (OUTPUT_MESSAGE, "L350, xmax %e\n", mpf_get_d (xmax));
#endif
  if (kk < 0)
  {
/* no positive value found in L340 or bypass intermediate verticies */
    *kode = 2;
    goto L590;
  }
/* L360: */
#ifdef DEBUG_CL1
  output_msg (OUTPUT_MESSAGE, "L360, xmax %e\n", mpf_get_d (xmax));
#endif
/* find minimum residual */
  /*xmin = res[ 0 ]; */
  mpf_set (xmin, res[0]);
  iout = s[0];
  j = 0;
  if (kk != 0)
  {
    for (i = 1; i <= kk; ++i)
    {
      /*if (res[i] < xmin) { */
      if (mpf_cmp (res[i], xmin) < 0)
      {
	j = i;
	/*xmin = res[i]; */
	mpf_set (xmin, res[i]);
	iout = s[i];
      }
    }
/* L370: */
/* put kk in position j */
    /*res[j] = res[kk]; */
    mpf_set (res[j], res[kk]);
    s[j] = s[kk];
  }
/* L380: */
#ifdef DEBUG_CL1
  output_msg (OUTPUT_MESSAGE, "L380 iout %d, xmin %e, xmax %e\n", iout,
	      mpf_get_d (xmin), mpf_get_d (xmax));
#endif
  --kk;
  /*pivot = q2[ iout * q_dim + in ].dval; */
  mpf_set (pivot, q2[iout * q_dim + in].dval);
  ii = q2[iout * q_dim + n1].ival;
  if (iphase != 1)
  {
    if (ii < 0)
    {
/* L390: */
      if (iu[-ii - 1] == 1)
      {
	goto L420;
      }
    }
    else
    {
      if (iu[cu_dim + ii - 1] == 1)
      {
	goto L420;
      }
    }
  }
/* L400: */
#ifdef DEBUG_CL1
  output_msg (OUTPUT_MESSAGE, "L400\n");
#endif
  ii = abs (ii);
  /*cuv = cu[ ii - 1 ] + cu[ cu_dim + ii - 1]; */
  mpf_add (cuv, cu[ii - 1], cu[cu_dim + ii - 1]);
  /*if (q2[ klm * q_dim + in ].dval - pivot * cuv > toler) { */
  mpf_mul (dummy, pivot, cuv);
  mpf_sub (dummy, q2[klm * q_dim + in].dval, dummy);
  if (mpf_cmp (dummy, toler) > 0)
  {
/* BYPASS INTERMEDIATE VERTICES. */
    for (j = js; j < n1; ++j)
    {
      /*z = q2[ iout * q_dim + j ].dval; */
      mpf_set (z, q2[iout * q_dim + j].dval);
      /*q2[ klm * q_dim + j ].dval -= z * cuv; */
      mpf_mul (dummy1, z, cuv);
      mpf_sub (q2[klm * q_dim + j].dval, q2[klm * q_dim + j].dval, dummy1);

      if (censor == 1)
      {
	if (mpf_cmp (q2[klm * q_dim + j].dval, zero) != 0)
	{
	  mpf_abs (dummy1, q2[klm * q_dim + j].dval);
	  if (mpf_cmp (dummy1, censor_tol) <= 0)
	  {
	    mpf_set_si (q2[klm * q_dim + j].dval, 0);
	  }
	}
      }

      /*q2[ iout * q_dim + j ].dval = -z; */
      mpf_neg (q2[iout * q_dim + j].dval, z);
    }
/* L410: */
    q2[iout * q_dim + n1].ival = -q2[iout * q_dim + n1].ival;
    goto L350;
  }
/* GAUSS-JORDAN ELIMINATION. */
L420:
#ifdef DEBUG_CL1
  output_msg (OUTPUT_MESSAGE, "Gauss Jordon %d\n", *iter);
#endif
  if (*iter >= maxit)
  {
    *kode = 3;
    goto L590;
  }
/* L430: */
#ifdef DEBUG_CL1
  output_msg (OUTPUT_MESSAGE, "L430\n");
#endif
  ++(*iter);
  for (j = js; j < n1; ++j)
  {
    if (j != in)
    {
      /*q2[ iout * q_dim + j ].dval /= pivot; */
      mpf_div (q2[iout * q_dim + j].dval, q2[iout * q_dim + j].dval, pivot);
    }
  }
/* L440: */
  for (j = js; j < n1; ++j)
  {
    if (j != in)
    {
      /*z = -q2[ iout * q_dim + j ].dval; */
      mpf_neg (z, q2[iout * q_dim + j].dval);
      for (i = 0; i < klm1; ++i)
      {
	if (i != iout)
	{
	  /*q2[ i * q_dim + j ].dval += z * q2[ i * q_dim + in ].dval; */
	  mpf_mul (dummy, z, q2[i * q_dim + in].dval);
	  mpf_add (q2[i * q_dim + j].dval, q2[i * q_dim + j].dval, dummy);

	  if (censor == 1)
	  {
	    if (mpf_cmp (q2[i * q_dim + j].dval, zero) != 0)
	    {
	      mpf_abs (dummy1, q2[i * q_dim + j].dval);
	      if (mpf_cmp (dummy1, censor_tol) <= 0)
	      {
		mpf_set_si (q2[i * q_dim + j].dval, 0);
	      }
	    }
	  }
	}
      }
/* L450: */
    }
  }
/* L460: */
#ifdef DEBUG_CL1
  output_msg (OUTPUT_MESSAGE, "L460\n");
#endif
  /*tpivot = -pivot; */
  mpf_neg (tpivot, pivot);
  for (i = 0; i < klm1; ++i)
  {
    if (i != iout)
    {
      /*q2[ i * q_dim + in ].dval /= tpivot; */
      mpf_div (q2[i * q_dim + in].dval, q2[i * q_dim + in].dval, tpivot);
    }
  }
/* L470: */
  /*q2[ iout * q_dim + in ].dval = 1. / pivot; */
  mpf_set_si (dummy, 1);
  mpf_div (q2[iout * q_dim + in].dval, dummy, pivot);
  ii = q2[iout * q_dim + n1].ival;
  q2[iout * q_dim + n1].ival = q2[klm1 * q_dim + in].ival;
  q2[klm1 * q_dim + in].ival = ii;
  ii = abs (ii);
  if (iu[ii - 1] == 0 || iu[cu_dim + ii - 1] == 0)
  {
    goto L240;
  }
/* switch column */
  for (i = 0; i < klm1; ++i)
  {
    /*z = q2[ i * q_dim + in ].dval; */
    mpf_set (z, q2[i * q_dim + in].dval);
    /*q2[ i * q_dim + in ].dval = q2[ i * q_dim + js ].dval; */
    mpf_set (q2[i * q_dim + in].dval, q2[i * q_dim + js].dval);
    /*q2[ i * q_dim + js ].dval = z; */
    mpf_set (q2[i * q_dim + js].dval, z);
  }
  i = q2[klm1 * q_dim + in].ival;
  q2[klm1 * q_dim + in].ival = q2[klm1 * q_dim + js].ival;
  q2[klm1 * q_dim + js].ival = i;
/* L480: */
  ++js;
  goto L240;
/* TEST FOR OPTIMALITY. */
L490:
#ifdef DEBUG_CL1
  output_msg (OUTPUT_MESSAGE, "L490\n");
#endif
  if (kforce == 0)
  {
    if (iphase == 1)
    {
      /*if (q2[ klm * q_dim + n ].dval <= toler) { */
      if (mpf_cmp (q2[klm * q_dim + n].dval, toler) <= 0)
      {
	goto L500;
      }
#ifdef DEBUG_CL1
      output_msg (OUTPUT_MESSAGE, "q2[klm1-1, n1-1] > *toler. %e\n",
		  mpf_get_d (q2[(klm1 - 1) * q_dim + n1 - 1].dval));
#endif
      *kode = 1;
      goto L590;
    }
    *kode = 0;
    goto L590;
  }
  /*if (iphase != 1 || q2[ klm * q_dim + n ].dval > toler) { */
  if ((iphase != 1) || (mpf_cmp (q2[klm * q_dim + n].dval, toler) > 0))
  {
    kforce = 0;
    goto L240;
  }
/* SET UP PHASE 2 COSTS. */
L500:
#ifdef DEBUG_CL1
  output_msg (OUTPUT_MESSAGE, "Set up phase 2 costs %d\n", *iter);
#endif
  iphase = 2;
  for (j = 0; j < nklm; ++j)
  {
    /*cu[ j ] = 0.; */
    mpf_set_si (cu[j], 0);
  }
/* L510: */
  for (j = n; j < nk; ++j)
  {
    /*cu[ j ] = 1.; */
    mpf_set_si (cu[j], 1);
  }
  /*
     memcpy( (void *) &(cu[cu_dim]), (void *) &(cu[0]), (size_t) nklm * sizeof(LDBLE) );
   */
  for (i = 0; i < nklm; i++)
  {
    mpf_set (cu[cu_dim + i], cu[i]);
  }

/* L520: */
  for (i = 0; i < klm; ++i)
  {
    ii = q2[i * q_dim + n1].ival;
    if (ii <= 0)
    {
      if (iu[cu_dim - ii - 1] == 0)
      {
	continue;
      }
      /*cu[ cu_dim - ii - 1 ] = 0.; */
      mpf_set_si (cu[cu_dim - ii - 1], 0);
    }
    else
    {
/* L530: */
      if (iu[ii - 1] == 0)
      {
	continue;
      }
      /*cu[ ii - 1 ] = 0.; */
      mpf_set_si (cu[ii - 1], 0);
    }
/* L540: */
    ++ia;
/* switch row */
    /*
       memcpy( (void *) &(scratch[0]), (void *) &(q2[ ia * q_dim]),
       (size_t) n2 * sizeof(LDBLE) );
       memcpy( (void *) &(q2[ ia * q_dim ]), (void *) &(q2[ i * q_dim]),
       (size_t) n2 * sizeof(LDBLE) );
       memcpy( (void *) &(q2[ i * q_dim ]), (void *) &(scratch[ 0 ]),
       (size_t) n2 * sizeof(LDBLE) );
     */
    for (iswitch = 0; iswitch < n1; iswitch++)
    {
      mpf_set (dummy, q2[ia * q_dim + iswitch].dval);
      mpf_set (q2[ia * q_dim + iswitch].dval, q2[i * q_dim + iswitch].dval);
      mpf_set (q2[i * q_dim + iswitch].dval, dummy);
    }
    iswitch = q2[ia * q_dim + n1].ival;
    q2[ia * q_dim + n1].ival = q2[i * q_dim + n1].ival;
    q2[i * q_dim + n1].ival = iswitch;
/* L550: */
  }
/* L560: */
  goto L160;


/* PREPARE OUTPUT. */
L590:
#ifdef DEBUG_CL1
  output_msg (OUTPUT_MESSAGE, "L590\n");
#endif
  /*sum = 0.; */
  mpf_set_si (sum, 0);
  for (j = 0; j < n; ++j)
  {
    /*x[j] = 0.; */
    mpf_set_si (x[j], 0);
  }
/* L600: */
  for (i = 0; i < klm; ++i)
  {
    /*res[i] = 0.; */
    mpf_set_si (res[i], 0);
  }
/* L610: */
  for (i = 0; i < klm; ++i)
  {
    ii = q2[i * q_dim + n1].ival;
    /*sn = 1.; */
    mpf_set_si (sn, 1);
    if (ii < 0)
    {
      ii = -ii;
      /*sn = -1.; */
      mpf_set_si (sn, -1);
    }
    if (ii <= n)
    {
/* L620: */
      /*x[ii - 1] = sn * q2[ i * q_dim + n ].dval; */
      mpf_mul (x[ii - 1], sn, q2[i * q_dim + n].dval);
    }
    else
    {
/* L630: */
      /*res[ii - n - 1] = sn * q2[ i * q_dim + n ].dval; */
      mpf_mul (res[ii - n - 1], sn, q2[i * q_dim + n].dval);
      if (ii >= n1 && ii <= nk)
      {
/*     *    DBLE(Q(I,N1)) */
	/*sum += q2[ i * q_dim + n ].dval; */
	mpf_add (sum, sum, q2[i * q_dim + n].dval);
      }
    }
  }
/* L640: */
#ifdef DEBUG_CL1
  output_msg (OUTPUT_MESSAGE, "L640\n");
#endif
  /*
   *  Check calculation
   */
  mpf_set_si (dummy, 100);
  mpf_mul (check_toler, toler, dummy);
  if (check && *kode == 0)
  {
    /*
     *  Check optimization constraints
     */
    if (*kode_arg == 1)
    {
      for (i = 0; i < k; i++)
      {
	if (res_arg[i] < 0.0)
	{
	  mpf_sub (dummy, res[i], check_toler);
	  mpf_set_si (dummy1, 0);
	  if (mpf_cmp (dummy, dummy1) > 0)
	  {
#ifdef CHECK_ERRORS
	    output_msg (OUTPUT_MESSAGE,
			"\tCL1MP: optimization constraint not satisfied row %d, res %e, constraint %f.\n",
			i, mpf_get_d (res[i]), res_arg[i]);
#endif
	    *kode = 1;
	  }
	}
	else if (res_arg[i] > 0.0)
	{
	  mpf_add (dummy, res[i], check_toler);
	  mpf_set_si (dummy1, 0);
	  if (mpf_cmp (dummy, dummy1) < 0)
	  {
#ifdef CHECK_ERRORS
	    output_msg (OUTPUT_MESSAGE,
			"\tCL1MP: optimization constraint not satisfied row %d, res %e, constraint %f.\n",
			i, mpf_get_d (res[i]), res_arg[i]);
#endif
	    *kode = 1;
	  }
	}
      }
    }
    /*
     *  Check equalities
     */
    for (i = k; i < k + l; i++)
    {
      mpf_abs (dummy, res[i]);
      if (mpf_cmp (dummy, check_toler) > 0)
      {
#ifdef CHECK_ERRORS
	output_msg (OUTPUT_MESSAGE,
		    "\tCL1MP: equality constraint not satisfied row %d, res %e, tolerance %e.\n",
		    i, mpf_get_d (res[i]), mpf_get_d (check_toler));
#endif

	*kode = 1;
      }
    }
    /*
     *  Check inequalities
     */
    for (i = k + l; i < k + l + m; i++)
    {
      mpf_neg (dummy, check_toler);
      if (mpf_cmp (res[i], dummy) < 0)
      {
#ifdef CHECK_ERRORS
	output_msg (OUTPUT_MESSAGE,
		    "\tCL1MP: inequality constraint not satisfied row %d, res %e, tolerance %e.\n",
		    i, mpf_get_d (res[i]), mpf_get_d (check_toler));
#endif
	*kode = 1;
      }
    }
    /*
     *   Check dissolution/precipitation constraints
     */
    if (*kode_arg == 1)
    {
      for (i = 0; i < n; i++)
      {
	if (x_arg[i] < 0.0)
	{
	  mpf_sub (dummy, x[i], check_toler);
	  mpf_set_si (dummy1, 0);
	  if (mpf_cmp (dummy, dummy1) > 0)
	  {
#ifdef CHECK_ERRORS
	    output_msg (OUTPUT_MESSAGE,
			"\tCL1MP: dis/pre constraint not satisfied column %d, x %e, constraint %f.\n",
			i, mpf_get_d (x[i]), x_arg[i]);
#endif
	    *kode = 1;
	  }
	}
	else if (x_arg[i] > 0.0)
	{
	  mpf_add (dummy, x[i], check_toler);
	  mpf_set_si (dummy1, 0);
	  if (mpf_cmp (dummy, dummy1) < 0)
	  {
#ifdef CHECK_ERRORS
	    output_msg (OUTPUT_MESSAGE,
			"\tCL1MP: dis/pre constraint not satisfied column %d, x %e, constraint %f.\n",
			i, mpf_get_d (x[i]), x_arg[i]);
#endif
	    *kode = 1;
	  }
	}
      }
    }
    if (*kode == 1)
    {
      output_msg (OUTPUT_MESSAGE,
		  "\n\tCL1MP: Roundoff errors in optimization.\n\t       Deleting model.\n");
    }
  }
  /*
   * set return variables
   */
	/**error = sum;*/
  mpf_set (error, sum);
  *error_arg = mpf_get_d (error);
  *kode_arg = *kode;
  for (i = 0; i < n2d; i++)
  {
    x_arg[i] = mpf_get_d (x[i]);
  }
  for (i = 0; i < k + l + m; i++)
  {
    res_arg[i] = mpf_get_d (res[i]);
  }

  /*scratch = free_check_null (scratch); */

  for (i = 0; i < max_row_count * max_column_count; i++)
  {
    mpf_clear (q[i]);
  }
  q = (mpf_t *) free_check_null (q);
  for (i = 0; i < n2d; i++)
  {
    mpf_clear (x[i]);
  }
  x = (mpf_t *) free_check_null (x);
  for (i = 0; i < k + l + m; i++)
  {
    mpf_clear (res[i]);
  }
  res = (mpf_t *) free_check_null (res);
  for (i = 0; i < 2 * nklmd; i++)
  {
    mpf_clear (cu[i]);
  }
  cu = (mpf_t *) free_check_null (cu);
  mpf_clear (dummy);
  mpf_clear (dummy1);
  mpf_clear (sum);
  mpf_clear (error);
  mpf_clear (z);
  mpf_clear (zu);
  mpf_clear (zv);
  mpf_clear (xmax);
  mpf_clear (minus_one);
  mpf_clear (toler);
  mpf_clear (check_toler);
  mpf_clear (pivot);
  mpf_clear (xmin);
  mpf_clear (cuv);
  mpf_clear (tpivot);
  mpf_clear (sn);
  mpf_clear (censor_tol);
  kode = (int *) free_check_null (kode);
  return 0;
}
Ejemplo n.º 25
0
/* ---------------------------------------------------------------------- */
int Phreeqc::
build_fixed_volume_gas(void)
/* ---------------------------------------------------------------------- */
{
/*
 *   Put coefficients into lists to sum iaps to test for equilibrium
 *   Put coefficients into lists to build jacobian for 
 *      sum of partial pressures equation and
 *      mass balance equations for elements contained in gases
 */
	int row, col;
	struct master *master_ptr;
	struct rxn_token *rxn_ptr;
	struct unknown *unknown_ptr;
	LDBLE coef, coef_elt;

	if (gas_unknown == NULL)
		return (OK);
	cxxGasPhase *gas_phase_ptr = use.Get_gas_phase_ptr();
	for (size_t i = 0; i < gas_phase_ptr->Get_gas_comps().size(); i++)
	{
		const cxxGasComp *comp_ptr = &(gas_phase_ptr->Get_gas_comps()[i]);
		int j;
		struct phase *phase_ptr = phase_bsearch(comp_ptr->Get_phase_name().c_str(), &j, FALSE);
/*
 *   Determine elements in gas component
 */
		count_elts = 0;
		paren_count = 0;
		if (phase_ptr->rxn_x == NULL)
			continue;
		add_elt_list(phase_ptr->next_elt, 1.0);
#define COMBINE
#ifdef COMBINE
		change_hydrogen_in_elt_list(0);
#endif
/*
 *   Build mass balance sums for each element in gas
 */
		if (debug_prep == TRUE)
		{
			output_msg(sformatf( "\n\tMass balance summations %s.\n\n",
					   phase_ptr->name));
		}

		/* All elements in gas */
		for (j = 0; j < count_elts; j++)
		{
			unknown_ptr = NULL;
			if (strcmp(elt_list[j].elt->name, "H") == 0)
			{
				unknown_ptr = mass_hydrogen_unknown;
			}
			else if (strcmp(elt_list[j].elt->name, "O") == 0)
			{
				unknown_ptr = mass_oxygen_unknown;
			}
			else
			{
				if (elt_list[j].elt->primary->in == TRUE)
				{
					unknown_ptr = elt_list[j].elt->primary->unknown;
				}
				else if (elt_list[j].elt->primary->s->secondary != NULL)
				{
					unknown_ptr =
						elt_list[j].elt->primary->s->secondary->unknown;
				}
			}
			if (unknown_ptr != NULL)
			{
				coef = elt_list[j].coef;
				store_mb(&(gas_unknowns[i]->moles), &(unknown_ptr->f), coef);
				if (debug_prep == TRUE)
				{
					output_msg(sformatf( "\t\t%-24s%10.3f\n",
							   unknown_ptr->description, (double) coef));
				}
			}
		}
		if (gas_phase_ptr->Get_type() == cxxGasPhase::GP_PRESSURE)
		{
			/* Total pressure of gases */
			store_mb(&(phase_ptr->p_soln_x), &(gas_unknown->f),
					 1.0);
		}
/*
 *   Build jacobian sums for mass balance equations
 */
		if (debug_prep == TRUE)
		{
			output_msg(sformatf( "\n\tJacobian summations %s.\n\n",
					   phase_ptr->name));
		}
		for (j = 0; j < count_elts; j++)
		{
			unknown_ptr = NULL;
			if (strcmp(elt_list[j].elt->name, "H") == 0)
			{
				unknown_ptr = mass_hydrogen_unknown;
			}
			else if (strcmp(elt_list[j].elt->name, "O") == 0)
			{
				unknown_ptr = mass_oxygen_unknown;
			}
			else
			{
				if (elt_list[j].elt->primary->in == TRUE)
				{
					unknown_ptr = elt_list[j].elt->primary->unknown;
				}
				else if (elt_list[j].elt->primary->s->secondary != NULL)
				{
					unknown_ptr =
						elt_list[j].elt->primary->s->secondary->unknown;
				}
			}
			if (unknown_ptr == NULL)
			{
				continue;
			}
			if (debug_prep == TRUE)
			{
				output_msg(sformatf( "\n\t%s.\n",
						   unknown_ptr->description));
			}
			row = unknown_ptr->number * (count_unknowns + 1);
			coef_elt = elt_list[j].coef;
			for (rxn_ptr = phase_ptr->rxn_x->token + 1;
				 rxn_ptr->s != NULL; rxn_ptr++)
			{

				if (rxn_ptr->s->secondary != NULL
					&& rxn_ptr->s->secondary->in == TRUE)
				{
					master_ptr = rxn_ptr->s->secondary;
				}
				else if (rxn_ptr->s->primary != NULL && rxn_ptr->s->primary->in == TRUE)
				{
					master_ptr = rxn_ptr->s->primary;
				}
				else
				{
					master_ptr = master_bsearch_primary(rxn_ptr->s->name);
					master_ptr->s->la = -999.0;
				}
				if (debug_prep == TRUE)
				{
					output_msg(sformatf( "\t\t%s\n",
							   master_ptr->s->name));
				}
				if (master_ptr->unknown == NULL)
				{
					continue;
				}
				if (master_ptr->in == FALSE)
				{
					error_string = sformatf(
							"Element, %s, in phase, %s, is not in model.",
							master_ptr->elt->name, phase_ptr->name);
					error_msg(error_string, CONTINUE);
					input_error++;
				}
				col = master_ptr->unknown->number;
				coef = coef_elt * rxn_ptr->coef;
				store_jacob(&(gas_unknowns[i]->moles),
							&(array[row + col]), coef);
				if (debug_prep == TRUE)
				{
					output_msg(sformatf( "\t\t%-24s%10.3f\t%d\t%d\n",
							   master_ptr->s->name, (double) coef,
							   row / (count_unknowns + 1), col));
				}
			}
			if (gas_phase_ptr->Get_type() == cxxGasPhase::GP_PRESSURE)
			{
				/* derivative wrt total moles of gas */
				store_jacob(&(phase_ptr->fraction_x),
							&(array[row + gas_unknown->number]), coef_elt);
				if (debug_prep == TRUE)
				{
					output_msg(sformatf( "\t\t%-24s%10.3f\t%d\t%d\n",
							   "gas moles", (double) elt_list[j].coef,
							   row / (count_unknowns + 1),
							   gas_unknown->number));
				}
			}
		}
/*
 *   Build jacobian sums for sum of partial pressures equation
 */
		if (gas_phase_ptr->Get_type() != cxxGasPhase::GP_PRESSURE)
			continue;
		if (debug_prep == TRUE)
		{
			output_msg(sformatf( "\n\tPartial pressure eqn %s.\n\n",
					   phase_ptr->name));
		}
		unknown_ptr = gas_unknown;
		row = unknown_ptr->number * (count_unknowns + 1);
		for (rxn_ptr = phase_ptr->rxn_x->token + 1; rxn_ptr->s != NULL; rxn_ptr++)
		{
			if (rxn_ptr->s != s_eminus && rxn_ptr->s->in == FALSE)
			{
				error_string = sformatf(
					"Element in species, %s, in phase, %s, is not in model.",
					rxn_ptr->s->name, phase_ptr->name);
				warning_msg(error_string);
			}
			else
			{
				if (rxn_ptr->s->secondary != NULL
					&& rxn_ptr->s->secondary->in == TRUE)
				{
					master_ptr = rxn_ptr->s->secondary;
				}
				else if (rxn_ptr->s->primary != NULL && rxn_ptr->s->primary->in == TRUE)
				{
					master_ptr = rxn_ptr->s->primary;
				}
				else
				{
					master_ptr = master_bsearch_primary(rxn_ptr->s->name);
					if (master_ptr && master_ptr->s)
					{
						master_ptr->s->la = -999.0;
					}
				}

				if (master_ptr == NULL)
				{
					error_string = sformatf(
						"Master species for %s, in phase, %s, is not in model.",
						rxn_ptr->s->name, phase_ptr->name);
					error_msg(error_string, CONTINUE);
					input_error++;
				}
				else
				{
					if (debug_prep == TRUE)
					{
						output_msg(sformatf( "\t\t%s\n", master_ptr->s->name));
					}
					if (master_ptr->unknown == NULL)
					{
						assert(false);
						continue;
					}
					if (master_ptr->in == FALSE)
					{
						error_string = sformatf(
							"Element, %s, in phase, %s, is not in model.",
							master_ptr->elt->name, phase_ptr->name);
						warning_msg(error_string);
					}
					col = master_ptr->unknown->number;
					coef = rxn_ptr->coef;
					store_jacob(&(phase_ptr->p_soln_x), &(array[row + col]), coef);
					if (debug_prep == TRUE)
					{
						output_msg(sformatf( "\t\t%-24s%10.3f\t%d\t%d\n",
							master_ptr->s->name, (double) coef,
							row / (count_unknowns + 1), col));
					}
				}
			}
		}
	}
	return (OK);
}