/* ---------------------------------------------------------------------- */
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);
}
/* ---------------------------------------------------------------------- */
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();
}
}
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);
}
}
}
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;
}
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);
}
}
/* ---------------------------------------------------------------------- */
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;
}
}
}
/* ---------------------------------------------------------------------- */
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();
}
/* ---------------------------------------------------------------------- */
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");
}
}
/* ---------------------------------------------------------------------- */
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);
}
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;
}
/* ---------------------------------------------------------------------- */
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);
}
/* ---------------------------------------------------------------------- */
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);
}
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);
}
/* ---------------------------------------------------------------------- */
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);
}
/* ---------------------------------------------------------------------- */
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);
}
// 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);
}
/* ---------------------------------------------------------------------- */
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;
}
/* ---------------------------------------------------------------------- */
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);
}
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;
}
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;
}
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;
}
/* ---------------------------------------------------------------------- */
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);
}
/* ---------------------------------------------------------------------- */
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);
}
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;
}
/* ---------------------------------------------------------------------- */
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);
}