double dfridr(double (*func)(double), double x, double h, double *err)
{
int i,j;
double errt,fac,hh,ans;
static double **a=0;
if(h==0.0) error("h must be nonzero in dfridr");
if(!a) a=new_mat(NTAB,NTAB);
hh=h;
a[0][0]=((*func)(x+hh)-(*func)(x-hh))/(2.0*hh);
*err=BIG;
for(i=1;i<NTAB;i++) {
hh /= CON;
a[0][i]=((*func)(x+hh)-(*func)(x-hh))/(2.0*hh);
fac=CON2;
for(j=1;j<=i;j++) {
a[j][i]=(a[j-1][i]*fac-a[j-1][i-1])/(fac-1.0);
fac=CON2*fac;
errt=DMAX(fabs(a[j][i]-a[j-1][i]),fabs(a[j][i]-a[j-1][i-1]));
if(errt<=*err) {
*err=errt; ans=a[j][i];
}
}
if(fabs(a[i][i]-a[i-1][i-1]) >= SAFE*(*err)) break;
}
return ans;
}
void Sphere::MakeBound( Bound &out_bound ) const
{
float tuMin = mThetamaxRad * mURange[0];
float tuMax = mThetamaxRad * mURange[1];
float alphaMin = DASin( mZMin / mRadius );
float alphaMax = DASin( mZMax / mRadius );
float aVMin = DMix( alphaMin, alphaMax, mVRange[0] );
float aVMax = DMix( alphaMin, alphaMax, mVRange[1] );
float rVMin = DCos( aVMin ) * mRadius;
float rVMax = DCos( aVMax ) * mRadius;
float rMin = DMIN( rVMin, rVMax );
float rMax;
if ( aVMin < 0 && aVMax > 0 )
rMax = mRadius;
else
rMax = DMAX( rVMin, rVMax );
out_bound.Reset();
bounds2DSweepL( out_bound, rMin, rMax, tuMin, tuMax );
out_bound.mBox[0].z() = DSin( aVMin ) * mRadius;
out_bound.mBox[1].z() = DSin( aVMax ) * mRadius;
}
double sphere_ang_diff(double ra1, double dec1, double ra2, double dec2)
/* Returns the angular difference in radians between two sets */
/* of RA and DEC (in radians). */
{
int i;
double d, vec1[3], vec2[3], s2, c2, cosb;
/* Convert coordinates from spherical to Cartesian */
cosb = cos(dec1);
vec1[0] = cos(ra1) * cosb;
vec1[1] = sin(ra1) * cosb;
vec1[2] = sin(dec1);
cosb = cos(dec2);
vec2[0] = cos(ra2) * cosb;
vec2[1] = sin(ra2) * cosb;
vec2[2] = sin(dec2);
/* Modulus squared of half the difference vector */
s2 = 0.0;
for (i = 0; i < 3; i++) {
d = vec1[i] - vec2[i];
s2 += d * d;
}
s2 /= 4.0;
/* Angle between the vectors */
c2 = 1.0 - s2;
return 2.0 * atan2(sqrt(s2), sqrt(DMAX(0.0, c2)));
}
double DMAX_VECTOR(double v[], unsigned long l)
/* Find largest value in v */
{
unsigned long i;
double m=v[0];
for (i=1;i<l;i++) m=DMAX(m,v[i]);
return(m);
}
void do_the_kick(int i, int tstart, int tend, int tcurrent)
{
int j;
double dv[3];
double dt_entr, dt_gravkick, dt_hydrokick;
if(All.ComovingIntegrationOn)
{
dt_entr = (tend - tstart) * All.Timebase_interval;
dt_gravkick = get_gravkick_factor(tstart, tend);
dt_hydrokick = get_hydrokick_factor(tstart, tend);
}
else
{
dt_entr = dt_gravkick = dt_hydrokick = (tend - tstart) * All.Timebase_interval;
}
/* do the kick */
for(j = 0; j < 3; j++)
{
dv[j] = P[i].g.GravAccel[j] * dt_gravkick;
#ifdef RELAXOBJECT
dv[j] -= P[i].Vel[j] * All.RelaxFac * dt_gravkick;
#endif
P[i].Vel[j] += dv[j];
P[i].dp[j] += P[i].Mass * dv[j];
}
#ifdef DISTORTIONTENSORPS
do_distortion_tensor_kick(i, dt_gravkick);
#endif
if(P[i].Type == 0) /* kick for SPH quantities */
{
for(j = 0; j < 3; j++)
{
dv[j] = SphP[i].a.HydroAccel[j] * dt_hydrokick;
P[i].Vel[j] += dv[j];
P[i].dp[j] += P[i].Mass * dv[j];
}
double dEntr = SphP[i].e.DtEntropy * dt_entr;
#if defined(EOS_DEGENERATE)
dEntr *= All.UnitTime_in_s;
#endif
SphP[i].Entropy = DMAX(SphP[i].Entropy + dEntr, 0.5 * SphP[i].Entropy);
check_particle_for_temperature_minimum(i);
do_sph_kick_for_extra_physics(i, tstart, tend, dt_entr);
}
}
double DMAX_MATRIX(double **m, unsigned long naxes[])
/* Find largest value in m */
{
unsigned long ii,jj;
double max=*(*(m+0)+0);
for (jj=0;jj<naxes[1];jj++)
for (ii=0;ii<naxes[0];ii++)
max=DMAX(max, *(*(m+jj)+ii));
return(max);
}
uint8_t rawDataPut8(RawData *raw_data, const offset_t offset, const uint8_t data)
{
if(offset + 1 <= raw_data->max_size)
{
raw_data->buffer[offset] = data;
raw_data->cur_size = DMAX(raw_data->cur_size, offset + 1);
RAWDATA_SET_DIRTY(raw_data);
return RAW_FILE_SUCC;
}
return RAW_FILE_FAIL;
}
uint8_t rawDataPut16(RawData *raw_data, const offset_t offset, const uint16_t data)
{
if(offset + sizeof(uint16_t) <= raw_data->max_size)
{
uint16_t num;
num = gdb_hton_uint16(data);
memcpy(raw_data->buffer + offset, &num, sizeof(uint16_t));
raw_data->cur_size = DMAX(raw_data->cur_size, offset + sizeof(uint16_t));
RAWDATA_SET_DIRTY(raw_data);
return RAW_FILE_SUCC;
}
return RAW_FILE_FAIL;
}
/*put uint8_t array without storing its length*/
uint8_t rawDataPut8s(RawData *raw_data, const offset_t offset, const uint8_t *data, const uint32_t len)
{
if(offset + len <= raw_data->max_size)
{
memcpy(raw_data->buffer + offset, data, len);
raw_data->cur_size = DMAX(raw_data->cur_size, offset + len);
RAWDATA_SET_DIRTY(raw_data);
return RAW_FILE_SUCC;
}
dbg_log(SEC_0132_RAW, 0)(LOGSTDOUT, "error:rawDataPut8s: offset %d + len %d > max_size %d\n",
offset, len, raw_data->max_size);
return RAW_FILE_FAIL;
}
/* this function determines the electron fraction, and hence the mean
* molecular weight. With it arrives at a self-consistent temperature.
* Element abundances and the rates for the emission are also computed
*/
double convert_u_to_temp(double u, double rho, double *ne_guess)
{
double temp, temp_old, temp_new, max = 0, ne_old;
double mu, dmax1, dmax2;
int iter = 0;
double u_input, rho_input, ne_input;
u_input = u;
rho_input = rho;
ne_input = *ne_guess;
mu = (1 + 4 * yhelium) / (1 + yhelium + *ne_guess);
temp = GAMMA_MINUS1 / BOLTZMANN * u * PROTONMASS * mu;
do
{
ne_old = *ne_guess;
find_abundances_and_rates(log10(temp), rho, ne_guess);
temp_old = temp;
mu = (1 + 4 * yhelium) / (1 + yhelium + *ne_guess);
temp_new = GAMMA_MINUS1 / BOLTZMANN * u * PROTONMASS * mu;
max =
DMAX(max,
temp_new / (1 + yhelium + *ne_guess) * fabs((*ne_guess - ne_old) / (temp_new - temp_old + 1.0)));
temp = temp_old + (temp_new - temp_old) / (1 + max);
iter++;
if(iter > (MAXITER - 10))
printf("-> temp= %g ne=%g\n", temp, *ne_guess);
}
while(fabs(temp - temp_old) > 1.0e-3 * temp && iter < MAXITER);
if(iter >= MAXITER)
{
printf("failed to converge in convert_u_to_temp()\n");
printf("u_input= %g\nrho_input=%g\n ne_input=%g\n", u_input, rho_input, ne_input);
printf("DoCool_u_old_input=%g\nDoCool_rho_input= %g\nDoCool_dt_input= %g\nDoCool_ne_guess_input= %g\n",
DoCool_u_old_input, DoCool_rho_input, DoCool_dt_input, DoCool_ne_guess_input);
endrun(12);
}
return temp;
}
void Hyperboloid::MakeBound( Bound &out_bound ) const
{
float tuMin = mThetamaxRad * mURange[0];
float tuMax = mThetamaxRad * mURange[1];
Float2_ uvMin( 0.f, mVRange[0] );
Float2_ uvMax( 0.f, mVRange[1] );
Float3_ pMin; EvalP( uvMin, pMin );
Float3_ pMax; EvalP( uvMax, pMax );
out_bound.Reset();
bounds2DSweepP( out_bound, pMin.x()[0], pMin.y()[0], tuMin, tuMax );
bounds2DSweepP( out_bound, pMax.x()[0], pMax.y()[0], tuMin, tuMax );
out_bound.mBox[0].z() = DMIN( pMin.z()[0], pMax.z()[0] );
out_bound.mBox[1].z() = DMAX( pMin.z()[0], pMax.z()[0] );
}
/* This function updates the weights for SN before exploding. This is
* necessary due to the fact that gas particles neighbours of a given star
* could have been transformed into stars and they need to be taken off the
* neighbour list for the exploding star.
*/
void cs_update_weights(void)
{
MyFloat *Left, *Right;
int i, j, ndone, ndone_flag, npleft, dummy, iter = 0;
int ngrp, sendTask, recvTask, place, nexport, nimport;
long long ntot;
double dmax1, dmax2;
double desnumngb;
if(ThisTask == 0)
{
printf("... start update weights phase = %d ...\n", Flag_phase);
fflush(stdout);
}
Left = (MyFloat *) mymalloc(NumPart * sizeof(MyFloat));
Right = (MyFloat *) mymalloc(NumPart * sizeof(MyFloat));
for(i = FirstActiveParticle; i >= 0; i = NextActiveParticle[i])
{
if(P[i].Type == 6 || P[i].Type == 7)
{
Left[i] = Right[i] = 0;
}
}
/* allocate buffers to arrange communication */
Ngblist = (int *) mymalloc(NumPart * sizeof(int));
R2ngblist = (double *) mymalloc(NumPart * sizeof(double));
All.BunchSize =
(int) ((All.BufferSize * 1024 * 1024) / (sizeof(struct data_index) + sizeof(struct data_nodelist) +
sizeof(struct updateweight_in) +
sizeof(struct updateweight_out) +
sizemax(sizeof(struct updateweight_in),
sizeof(struct updateweight_out))));
DataIndexTable = (struct data_index *) mymalloc(All.BunchSize * sizeof(struct data_index));
DataNodeList = (struct data_nodelist *) mymalloc(All.BunchSize * sizeof(struct data_nodelist));
desnumngb = All.DesNumNgb;
/* we will repeat the whole thing for those particles where we didn't find enough neighbours */
do
{
i = FirstActiveParticle; /* begin with this index */
do
{
for(j = 0; j < NTask; j++)
{
Send_count[j] = 0;
Exportflag[j] = -1;
}
/* do local particles and prepare export list */
for(nexport = 0; i >= 0; i = NextActiveParticle[i])
{
if((P[i].Type == 6 || P[i].Type == 7) && P[i].TimeBin >= 0)
{
if(cs_update_weight_evaluate(i, 0, &nexport, Send_count) < 0)
break;
}
}
#ifdef MYSORT
mysort_dataindex(DataIndexTable, nexport, sizeof(struct data_index), data_index_compare);
#else
qsort(DataIndexTable, nexport, sizeof(struct data_index), data_index_compare);
#endif
MPI_Allgather(Send_count, NTask, MPI_INT, Sendcount_matrix, NTask, MPI_INT, MPI_COMM_WORLD);
for(j = 0, nimport = 0, Recv_offset[0] = 0, Send_offset[0] = 0; j < NTask; j++)
{
Recv_count[j] = Sendcount_matrix[j * NTask + ThisTask];
nimport += Recv_count[j];
if(j > 0)
{
Send_offset[j] = Send_offset[j - 1] + Send_count[j - 1];
Recv_offset[j] = Recv_offset[j - 1] + Recv_count[j - 1];
}
}
UpdateweightGet = (struct updateweight_in *) mymalloc(nimport * sizeof(struct updateweight_in));
UpdateweightIn = (struct updateweight_in *) mymalloc(nexport * sizeof(struct updateweight_in));
/* prepare particle data for export */
for(j = 0; j < nexport; j++)
{
place = DataIndexTable[j].Index;
UpdateweightIn[j].Pos[0] = P[place].Pos[0];
UpdateweightIn[j].Pos[1] = P[place].Pos[1];
UpdateweightIn[j].Pos[2] = P[place].Pos[2];
UpdateweightIn[j].Hsml = PPP[place].Hsml;
memcpy(UpdateweightIn[j].NodeList,
DataNodeList[DataIndexTable[j].IndexGet].NodeList, NODELISTLENGTH * sizeof(int));
}
/* exchange particle data */
for(ngrp = 1; ngrp < (1 << PTask); ngrp++)
{
sendTask = ThisTask;
recvTask = ThisTask ^ ngrp;
if(recvTask < NTask)
{
if(Send_count[recvTask] > 0 || Recv_count[recvTask] > 0)
{
/* get the particles */
MPI_Sendrecv(&UpdateweightIn[Send_offset[recvTask]],
Send_count[recvTask] * sizeof(struct updateweight_in), MPI_BYTE,
recvTask, TAG_DENS_A,
&UpdateweightGet[Recv_offset[recvTask]],
Recv_count[recvTask] * sizeof(struct updateweight_in), MPI_BYTE,
recvTask, TAG_DENS_A, MPI_COMM_WORLD, MPI_STATUS_IGNORE);
}
}
}
myfree(UpdateweightIn);
UpdateweightResult =
(struct updateweight_out *) mymalloc(nimport * sizeof(struct updateweight_out));
UpdateweightOut = (struct updateweight_out *) mymalloc(nexport * sizeof(struct updateweight_out));
/* now do the particles that were sent to us */
for(j = 0; j < nimport; j++)
cs_update_weight_evaluate(j, 1, &dummy, &dummy);
if(i < 0)
ndone_flag = 1;
else
ndone_flag = 0;
MPI_Allreduce(&ndone_flag, &ndone, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD);
/* get the result */
for(ngrp = 1; ngrp < (1 << PTask); ngrp++)
{
sendTask = ThisTask;
recvTask = ThisTask ^ ngrp;
if(recvTask < NTask)
{
if(Send_count[recvTask] > 0 || Recv_count[recvTask] > 0)
{
/* send the results */
MPI_Sendrecv(&UpdateweightResult[Recv_offset[recvTask]],
Recv_count[recvTask] * sizeof(struct updateweight_out),
MPI_BYTE, recvTask, TAG_DENS_B,
&UpdateweightOut[Send_offset[recvTask]],
Send_count[recvTask] * sizeof(struct updateweight_out),
MPI_BYTE, recvTask, TAG_DENS_B, MPI_COMM_WORLD, MPI_STATUS_IGNORE);
}
}
}
/* add the result to the local particles */
for(j = 0; j < nexport; j++)
{
place = DataIndexTable[j].Index;
PPP[place].n.dNumNgb += UpdateweightOut[j].Ngb;
}
myfree(UpdateweightOut);
myfree(UpdateweightResult);
myfree(UpdateweightGet);
}
while(ndone < NTask);
/* do final operations on results */
for(i = FirstActiveParticle, npleft = 0; i >= 0; i = NextActiveParticle[i])
{
if(P[i].Type == 6 || P[i].Type == 7)
{
#ifdef FLTROUNDOFFREDUCTION
PPP[i].n.NumNgb = FLT(PPP[i].n.dNumNgb);
#endif
/* now check whether we had enough neighbours */
if(PPP[i].n.NumNgb < (desnumngb - All.MaxNumNgbDeviation) ||
(PPP[i].n.NumNgb > (desnumngb + All.MaxNumNgbDeviation)
&& PPP[i].Hsml > (1.01 * All.MinGasHsml)))
{
/* need to redo this particle */
npleft++;
if(Left[i] > 0 && Right[i] > 0)
if((Right[i] - Left[i]) < 1.0e-3 * Left[i])
{
/* this one should be ok */
npleft--;
P[i].TimeBin = -P[i].TimeBin - 1; /* Mark as inactive */
continue;
}
if(PPP[i].n.NumNgb < (desnumngb - All.MaxNumNgbDeviation))
Left[i] = DMAX(PPP[i].Hsml, Left[i]);
else
{
if(Right[i] != 0)
{
if(PPP[i].Hsml < Right[i])
Right[i] = PPP[i].Hsml;
}
else
Right[i] = PPP[i].Hsml;
}
if(iter >= MAXITER - 10)
{
printf
("i=%d task=%d ID=%d Hsml=%g Left=%g Right=%g Ngbs=%g Right-Left=%g\n pos=(%g|%g|%g)\n",
i, ThisTask, (int) P[i].ID, PPP[i].Hsml, Left[i], Right[i],
(float) PPP[i].n.NumNgb, Right[i] - Left[i], P[i].Pos[0], P[i].Pos[1], P[i].Pos[2]);
fflush(stdout);
}
if(Right[i] > 0 && Left[i] > 0)
PPP[i].Hsml = pow(0.5 * (pow(Left[i], 3) + pow(Right[i], 3)), 1.0 / 3);
else
{
if(Right[i] == 0 && Left[i] == 0)
endrun(8188); /* can't occur */
if(Right[i] == 0 && Left[i] > 0)
{
PPP[i].Hsml *= 1.26;
}
if(Right[i] > 0 && Left[i] == 0)
{
PPP[i].Hsml /= 1.26;
}
}
if(PPP[i].Hsml < All.MinGasHsml)
PPP[i].Hsml = All.MinGasHsml;
}
else
P[i].TimeBin = -P[i].TimeBin - 1; /* Mark as inactive */
/* CECILIA */
if(iter == MAXITER)
{
int old_type;
old_type = P[i].Type;
P[i].Type = 4; /* no SN mark any more */
PPP[i].n.NumNgb = 0;
printf("part=%d of type=%d was assigned NumNgb=%g and type=%d\n", i, old_type,
PPP[i].n.NumNgb, P[i].Type);
}
}
}
sumup_large_ints(1, &npleft, &ntot);
if(ntot > 0)
{
iter++;
if(iter > 0 && ThisTask == 0)
{
printf("ngb iteration %d: need to repeat for %d%09d particles.\n", iter,
(int) (ntot / 1000000000), (int) (ntot % 1000000000));
fflush(stdout);
}
if(iter > MAXITER)
{
#ifndef CS_FEEDBACK
printf("failed to converge in neighbour iteration in update_weights \n");
fflush(stdout);
endrun(1155);
#else
/* CECILIA */
if(Flag_phase == 2) /* HOT */
{
printf("Not enough hot neighbours for energy/metal distribution part=%d Type=%d\n", i,
P[i].Type);
fflush(stdout);
break;
/* endrun(1156); */
}
else
{
printf("Not enough cold neighbours for energy/metal distribution part=%d Type=%d\n", i,
P[i].Type);
fflush(stdout);
break;
}
#endif
}
}
}
while(ntot > 0);
myfree(DataNodeList);
myfree(DataIndexTable);
myfree(R2ngblist);
myfree(Ngblist);
myfree(Right);
myfree(Left);
/* mark as active again */
for(i = FirstActiveParticle; i >= 0; i = NextActiveParticle[i])
if(P[i].TimeBin < 0)
P[i].TimeBin = -P[i].TimeBin - 1;
/* collect some timing information */
if(ThisTask == 0)
{
printf("... update weights phase = %d done...\n", Flag_phase);
fflush(stdout);
}
}
void MATRIX_map_rect(MATRIX *matrix, int *x, int *y, int *w, int *h)
{
int rx, ry, rw, rh;
if (matrix->m12 == 0.0F && matrix->m21 == 0.0F)
{
rx = DROUND(matrix->m11 * *x + matrix->dx);
ry = DROUND(matrix->m22 * *y + matrix->dy);
rw = DROUND(matrix->m11 * *w);
rh = DROUND(matrix->m22 * *h);
if (rw < 0)
{
rw = -rw;
rx -= rw - 1;
}
if (rh < 0)
{
rh = -rh;
ry -= rh-1;
}
}
else
{
int left = *x;
int top = *y;
int right = *x + *w;
int bottom = *y + *h;
double x0, y0;
double x, y;
MAPDOUBLE(matrix, left, top, x0, y0 );
double xmin = x0;
double ymin = y0;
double xmax = x0;
double ymax = y0;
MAPDOUBLE(matrix, right, top, x, y );
xmin = DMIN( xmin, x );
ymin = DMIN( ymin, y );
xmax = DMAX( xmax, x );
ymax = DMAX( ymax, y );
MAPDOUBLE(matrix, right, bottom, x, y );
xmin = DMIN( xmin, x );
ymin = DMIN( ymin, y );
xmax = DMAX( xmax, x );
ymax = DMAX( ymax, y );
MAPDOUBLE(matrix, left, bottom, x, y );
xmin = DMIN( xmin, x );
ymin = DMIN( ymin, y );
xmax = DMAX( xmax, x );
ymax = DMAX( ymax, y );
double ww = xmax - xmin;
double hh = ymax - ymin;
xmin -= ( xmin - x0 ) / ww;
ymin -= ( ymin - y0 ) / hh;
xmax -= ( xmax - x0 ) / ww;
ymax -= ( ymax - y0 ) / hh;
rx = DROUND(xmin);
ry = DROUND(ymin);
rw = DROUND(xmax) - DROUND(xmin) + 1;
rh = DROUND(ymax) - DROUND(ymin) + 1;
}
*x = rx;
*y = ry;
*w = rw;
*h = rh;
}
/* let u refer to the more recent time and d to the older time */
int
changet_RY1 (int ci, int timeperiod) // after Rannala and Yang (2003) - rubberband method
{
double metropolishastingsterm, newt, oldt;
double pdgnew[MAXLOCI + MAXLINKED], pdgnewsum, pdgoldsum, probgnewsum,
temppdg;
double t_u_hterm, t_d_hterm, tpw;
int li, i, j, ecd, ecu, emd, emu, ai, ui;
double U;
struct genealogy *G;
struct edge *gtree;
double t_d, t_u, t_u_prior, t_d_prior;
double holdt[MAXPERIODS];
if (assignmentoptions[POPULATIONASSIGNMENTCHECKPOINT] == 1)
{
assertgenealogy (ci);
}
t_u = (timeperiod == 0) ? 0 : C[ci]->tvals[timeperiod - 1];
t_d =
(timeperiod ==
(lastperiodnumber - 1)) ? TIMEMAX : C[ci]->tvals[timeperiod + 1];
t_d_prior = DMIN (T[timeperiod].pr.max, t_d);
t_u_prior = DMAX (T[timeperiod].pr.min, t_u);
oldt = C[ci]->tvals[timeperiod];
newt = getnewt (timeperiod, t_u_prior, t_d_prior, oldt, 1);
t_u_hterm = (newt - t_u) / (oldt - t_u);
if (timeperiod == lastperiodnumber - 1)
{
t_d_hterm = 1;
}
else
{
t_d_hterm = (t_d - newt) / (t_d - oldt);
}
copy_treeinfo (&holdallgweight_t_RY, &C[ci]->allgweight); // try turning this off and forcing all recalculations
copy_probcalc (&holdallpcalc_t_RY, &C[ci]->allpcalc);
for (i = 0; i < lastperiodnumber; i++)
holdt[i] = C[ci]->tvals[i];
pdgoldsum = C[ci]->allpcalc.pdg;
setzero_genealogy_weights (&C[ci]->allgweight);
ecd = ecu = emd = emu = 0;
pdgnewsum = 0;
probgnewsum = 0;
storegenealogystats_all_loci (ci, 0);
C[ci]->tvals[timeperiod] = newt;
for (i = 0; i < nurates; i++)
pdgnew[i] = 0;
for (li = 0; li < nloci; li++)
{
G = &(C[ci]->G[li]);
gtree = G->gtree;
copy_treeinfo (&holdgweight_t_RY[li], &G->gweight);
for (i = 0; i < L[li].numlines; i++)
{
if (gtree[i].down != -1)
{
if (gtree[i].time <= oldt && gtree[i].time > t_u)
{
//assert (skipflag[li][i] == 0);turn off 9/19/10
gtree[i].time =
beforesplit (timeperiod, oldt, newt, /* t_d, */ t_u, gtree[i].time);
assert (gtree[i].time != newt);
ecu++;
}
else
{
if (gtree[i].time > oldt && gtree[i].time < t_d)
{
// assert (skipflag[li][i] == 0); turn off 9/19/10
gtree[i].time =
aftersplit (timeperiod, oldt, newt, t_d, /* t_u, */ gtree[i].time);
assert (gtree[i].time != newt);
ecd++;
}
//else do not change the time
}
j = 0;
while (gtree[i].mig[j].mt > -0.5)
{
assert (gtree[i].mig[j].mt < C[0]->tvals[lastperiodnumber]);
if (gtree[i].mig[j].mt <= oldt && gtree[i].mig[j].mt > t_u)
{
gtree[i].mig[j].mt =
beforesplit (timeperiod, oldt, newt, /* t_d, */ t_u,
gtree[i].mig[j].mt);
emu++;
}
else
{
assert (oldt < C[0]->tvals[lastperiodnumber]);
if (gtree[i].mig[j].mt > oldt && gtree[i].mig[j].mt < t_d)
{
gtree[i].mig[j].mt =
aftersplit (timeperiod, oldt, newt, t_d, /* t_u, */
gtree[i].mig[j].mt);
emd++;
}
// else no need to change the time
}
j++;
}
}
}
if (G->roottime <= oldt && G->roottime > t_u
/* && skipflag[li][G->root] == 0 turn off 9/19/10*/)
G->roottime =
beforesplit (timeperiod, oldt, newt, /* t_d, */ t_u, G->roottime);
else if (G->roottime > oldt && G->roottime < t_d
/* && skipflag[li][G->root] == 0 turn off 9/19/10*/)
G->roottime =
aftersplit (timeperiod, oldt, newt, t_d, /* t_u, */ G->roottime);
setzero_genealogy_weights (&G->gweight);
treeweight (ci, li);
sum_treeinfo (&C[ci]->allgweight, &G->gweight);
ai = 0;
ui = L[li].uii[ai];
switch (L[li].model)
{
assert (pdgnew[ui] == 0);
case HKY:
if (assignmentoptions[JCMODEL] == 1)
{
temppdg = pdgnew[ui] =
likelihoodJC (ci, li, G->uvals[0]);
}
else
{
temppdg = pdgnew[ui] =
likelihoodHKY (ci, li, G->uvals[0], G->kappaval, -1, -1, -1, -1);
}
break;
case INFINITESITES:
temppdg = pdgnew[ui] = likelihoodIS (ci, li, G->uvals[0]);
break;
case STEPWISE:
temppdg = 0;
for (; ai < L[li].nlinked; ai++)
{
ui = L[li].uii[ai];
assert (pdgnew[ui] == 0);
pdgnew[ui] = likelihoodSW (ci, li, ai, G->uvals[ai], 1.0);
temppdg += pdgnew[ui];
}
break;
case JOINT_IS_SW:
temppdg = pdgnew[ui] = likelihoodIS (ci, li, G->uvals[0]);
for (ai = 1; ai < L[li].nlinked; ai++)
{
ui = L[li].uii[ai];
assert (pdgnew[ui] == 0);
pdgnew[ui] = likelihoodSW (ci, li, ai, G->uvals[ai], 1.0);
temppdg += pdgnew[ui];
}
break;
}
pdgnewsum += temppdg;
}
assert (!ODD (ecd));
assert (!ODD (ecu));
ecd /= 2;
ecu /= 2;
integrate_tree_prob (ci, &C[ci]->allgweight, &holdallgweight_t_RY,
&C[ci]->allpcalc, &holdallpcalc_t_RY, &holdt[0]); // try enforcing full cacullation
tpw = gbeta * (pdgnewsum - pdgoldsum);
/* 5/19/2011 JH adding thermodynamic integration */
if (calcoptions[CALCMARGINALLIKELIHOOD])
{
metropolishastingsterm = beta[ci] * tpw + (C[ci]->allpcalc.probg - holdallpcalc_t_RY.probg) + (ecd + emd) * log (t_d_hterm) + (ecu + emu) * log (t_u_hterm);
}
else
{
tpw += C[ci]->allpcalc.probg - holdallpcalc_t_RY.probg;
metropolishastingsterm = beta[ci] * tpw + (ecd + emd) * log (t_d_hterm) + (ecu + emu) * log (t_u_hterm);
}
//assert(metropolishastingsterm >= -1e200 && metropolishastingsterm < 1e200);
U = log (uniform ());
if (U < DMIN(1.0, metropolishastingsterm)) //9/13/2010
//if (metropolishastingsterm >= 0.0 || metropolishastingsterm > U)
{
for (li = 0; li < nloci; li++)
{
C[ci]->G[li].pdg = 0;
for (ai = 0; ai < L[li].nlinked; ai++)
{
C[ci]->G[li].pdg_a[ai] = pdgnew[L[li].uii[ai]];
C[ci]->G[li].pdg += C[ci]->G[li].pdg_a[ai];
}
if (L[li].model == HKY)
{
storescalefactors (ci, li);
copyfraclike (ci, li);
}
}
C[ci]->allpcalc.pdg = pdgnewsum;
C[ci]->poptree[C[ci]->droppops[timeperiod + 1][0]].time =
C[ci]->poptree[C[ci]->droppops[timeperiod + 1][1]].time = newt;
if (assignmentoptions[POPULATIONASSIGNMENTCHECKPOINT] == 1)
{
assertgenealogy (ci);
}
return 1;
}
else
{
copy_treeinfo (&C[ci]->allgweight, &holdallgweight_t_RY);
copy_probcalc (&C[ci]->allpcalc, &holdallpcalc_t_RY);
assert (pdgoldsum == C[ci]->allpcalc.pdg);
C[ci]->tvals[timeperiod] = oldt;
for (li = 0; li < nloci; li++)
{
G = &(C[ci]->G[li]);
gtree = G->gtree;
storegenealogystats_all_loci (ci, 1);
copy_treeinfo (&G->gweight, &holdgweight_t_RY[li]);
for (i = 0; i < L[li].numlines; i++)
{
if (gtree[i].down != -1)
{
if (gtree[i].time <= newt && gtree[i].time > t_u)
{
// assert (skipflag[li][i] == 0); turned off 9/19/10
gtree[i].time =
beforesplit (timeperiod, newt, oldt, /* t_d, */ t_u, gtree[i].time);
//cecu++;
}
else
{
if (gtree[i].time > newt && gtree[i].time < t_d)
{
//assert (skipflag[li][i] == 0); turned off 9/19/10
gtree[i].time =
aftersplit (timeperiod, newt, oldt, t_d, /* t_u, */ gtree[i].time);
//cecl++;
}
}
j = 0;
while (gtree[i].mig[j].mt > -0.5)
{
if (gtree[i].mig[j].mt <= newt && gtree[i].mig[j].mt > t_u)
{
gtree[i].mig[j].mt =
beforesplit (timeperiod, newt, oldt, /* t_d, */
t_u, gtree[i].mig[j].mt);
//cemu++;
}
else if (gtree[i].mig[j].mt > newt && gtree[i].mig[j].mt < t_d)
{
gtree[i].mig[j].mt =
aftersplit (timeperiod, newt, oldt, t_d, /* t_u, */
gtree[i].mig[j].mt);
//ceml++;
}
j++;
}
}
}
// assert(fabs(C[ci]->G[li].gtree[ C[ci]->G[li].gtree[C[ci]->G[li].root].up[0]].time - C[ci]->G[li].roottime) < 1e-8);
}
/* assert(ecu==cecu/2);
assert(ecd==cecl/2);
assert(emu==cemu);
assert(emd==ceml); */
for (li = 0; li < nloci; li++)
{
if (L[li].model == HKY)
restorescalefactors (ci, li);
/* have to reset the dlikeA values in the genealogies for stepwise model */
if (L[li].model == STEPWISE)
for (ai = 0; ai < L[li].nlinked; ai++)
likelihoodSW (ci, li, ai, C[ci]->G[li].uvals[ai], 1.0);
if (L[li].model == JOINT_IS_SW)
for (ai = 1; ai < L[li].nlinked; ai++)
likelihoodSW (ci, li, ai, C[ci]->G[li].uvals[ai], 1.0);
// assert(fabs(C[ci]->G[li].gtree[ C[ci]->G[li].gtree[C[ci]->G[li].root].up[0]].time - C[ci]->G[li].roottime) < 1e-8);
}
if (assignmentoptions[POPULATIONASSIGNMENTCHECKPOINT] == 1)
{
assertgenealogy (ci);
}
return 0;
}
} /* changet_RY1 */
void dsvdcmp(double **a, int m, int n, double w[], double **v)
{
double dpythag(double a, double b);
int flag,i,its,j,jj,k,l,nm;
double anorm,c,f,g,h,s,scale,x,y,z,*rv1;
static int maxits=100;
rv1=dvector(1,n);
g=scale=anorm=0.0;
for (i=1;i<=n;i++) {
l=i+1;
rv1[i]=scale*g;
g=s=scale=0.0;
if (i <= m) {
for (k=i;k<=m;k++) scale += fabs(a[k][i]);
if (scale) {
for (k=i;k<=m;k++) {
a[k][i] /= scale;
s += a[k][i]*a[k][i];
}
f=a[i][i];
g = -SIGN(sqrt(s),f);
h=f*g-s;
a[i][i]=f-g;
for (j=l;j<=n;j++) {
for (s=0.0,k=i;k<=m;k++) s += a[k][i]*a[k][j];
f=s/h;
for (k=i;k<=m;k++) a[k][j] += f*a[k][i];
}
for (k=i;k<=m;k++) a[k][i] *= scale;
}
}
w[i]=scale *g;
g=s=scale=0.0;
if (i <= m && i != n) {
for (k=l;k<=n;k++) scale += fabs(a[i][k]);
if (scale) {
for (k=l;k<=n;k++) {
a[i][k] /= scale;
s += a[i][k]*a[i][k];
}
f=a[i][l];
g = -SIGN(sqrt(s),f);
h=f*g-s;
a[i][l]=f-g;
for (k=l;k<=n;k++) rv1[k]=a[i][k]/h;
for (j=l;j<=m;j++) {
for (s=0.0,k=l;k<=n;k++) s += a[j][k]*a[i][k];
for (k=l;k<=n;k++) a[j][k] += s*rv1[k];
}
for (k=l;k<=n;k++) a[i][k] *= scale;
}
}
anorm=DMAX(anorm,(fabs(w[i])+fabs(rv1[i])));
}
for (i=n;i>=1;i--) {
if (i < n) {
if (g) {
for (j=l;j<=n;j++) v[j][i]=(a[i][j]/a[i][l])/g;
for (j=l;j<=n;j++) {
for (s=0.0,k=l;k<=n;k++) s += a[i][k]*v[k][j];
for (k=l;k<=n;k++) v[k][j] += s*v[k][i];
}
}
for (j=l;j<=n;j++) v[i][j]=v[j][i]=0.0;
}
v[i][i]=1.0;
g=rv1[i];
l=i;
}
for (i=IMIN(m,n);i>=1;i--) {
l=i+1;
g=w[i];
for (j=l;j<=n;j++) a[i][j]=0.0;
if (g) {
g=1.0/g;
for (j=l;j<=n;j++) {
for (s=0.0,k=l;k<=m;k++) s += a[k][i]*a[k][j];
f=(s/a[i][i])*g;
for (k=i;k<=m;k++) a[k][j] += f*a[k][i];
}
for (j=i;j<=m;j++) a[j][i] *= g;
} else for (j=i;j<=m;j++) a[j][i]=0.0;
++a[i][i];
}
for (k=n;k>=1;k--) {
for (its=1;its<=maxits;its++) {
flag=1;
for (l=k;l>=1;l--) {
nm=l-1;
if ((double)(fabs(rv1[l])+anorm) == anorm) {
flag=0;
break;
}
if ((double)(fabs(w[nm])+anorm) == anorm) break;
}
if (flag) {
c=0.0;
s=1.0;
for (i=l;i<=k;i++) {
f=s*rv1[i];
rv1[i]=c*rv1[i];
if ((double)(fabs(f)+anorm) == anorm) break;
g=w[i];
h=dpythag(f,g);
w[i]=h;
h=1.0/h;
c=g*h;
s = -f*h;
for (j=1;j<=m;j++) {
y=a[j][nm];
z=a[j][i];
a[j][nm]=y*c+z*s;
a[j][i]=z*c-y*s;
}
}
}
z=w[k];
if (l == k) {
if (z < 0.0) {
w[k] = -z;
for (j=1;j<=n;j++) v[j][k] = -v[j][k];
}
break;
}
if (its == maxits) nrerror("no convergence in many dsvdcmp iterations");
x=w[l];
nm=k-1;
y=w[nm];
g=rv1[nm];
h=rv1[k];
f=((y-z)*(y+z)+(g-h)*(g+h))/(2.0*h*y);
g=dpythag(f,1.0);
f=((x-z)*(x+z)+h*((y/(f+SIGN(g,f)))-h))/x;
c=s=1.0;
for (j=l;j<=nm;j++) {
i=j+1;
g=rv1[i];
y=w[i];
h=s*g;
g=c*g;
z=dpythag(f,h);
rv1[j]=z;
c=f/z;
s=h/z;
f=x*c+g*s;
g = g*c-x*s;
h=y*s;
y *= c;
for (jj=1;jj<=n;jj++) {
x=v[jj][j];
z=v[jj][i];
v[jj][j]=x*c+z*s;
v[jj][i]=z*c-x*s;
}
z=dpythag(f,h);
w[j]=z;
if (z) {
z=1.0/z;
c=f*z;
s=h*z;
}
f=c*g+s*y;
x=c*y-s*g;
for (jj=1;jj<=m;jj++) {
y=a[jj][j];
z=a[jj][i];
a[jj][j]=y*c+z*s;
a[jj][i]=z*c-y*s;
}
}
rv1[l]=0.0;
rv1[k]=f;
w[k]=x;
}
}
free_dvector(rv1,1,n);
}
RootNodeT *
buildTree(int N, MatrixT Dorig, char **taxon)
{
/*
\section{Initialize}
Initialize main variables
*/
int i;
RootNodeT *root;
int Nleft, Nnext; /* number of Nodes left to be joined
and the next index to be used */
MatrixT b=matrix(N); /* the $b_{i;j}$ matrix (eq 0.7) */
/* $q(i)$ array: value which minimizes $R(i,q(i),j)\,\forall j\ne i,q(i)$ */
int *q;
int *q2; /* Second best value */
VectorT R=vector(N); /* $R(i,q(i))$ (eq 0.10) */
VectorT LLR=vector(N); /* $R(i,q(i),q2(i))$ */
VectorT Zscore=vector(N); /* $z(i,q(i))$ */
/*
This auxilary matrices are globally defined in \|weighbor.h| we do
this to make it simplier so we do not always have to pass these
around. Note that the need to be visible here as we will be
calling \|calcR| later in this function and \|calcR| needs these
values
*/
s = matrix(N); /* $s_{ij}$ eq 0.9 */
deltaB = matrix(N); /* $\Delta b_{ij}$ eq 0.8 */
delta2B = matrix(N); /* $\Delta^2 b_{ij}$ */
if(recalcB)
oldDeltaB = matrix(N);
/*
This will hold this orignal $N$ distances plus any distances from
the $N-3$ internal nodes. Note we do not care about the root node
so $N-3$ and not $N-2$
*/
mD=matrix(2*N-3);
/*
This is the renormalization vector $c_i$ (eq 0.39) and matrix
$c_{i;j}$ (eq 0.43 ver0.2.5); again it must
be large enough to hold both the original and the new joined taxa
N.B. \|vector| sets all elements to zero.
*/
vC=vector(2*N-3);
/*
This matrices hold the previous iterations values of $s_{ij}$,
$\Delta b_{ij}$, etc. They are used to speed up the next
iterations calcultions of these quantities.
*/
mS = matrix(2*N-3);
mDelB = matrix(2*N-3);
mDel2B = matrix(2*N-3);
/*
Init \|mS| to -1 to keep track of which entries have not yet been
computed. */
for(i=0;i<2*N-3;++i) {
int j;
for(j=0;j<2*N-3;++j)
mS[i][j] = -1.0;
}
/*
Make a copy of the original distance matrix; embed it in the
larger matrix which will hold the new distance from the added
internal nodes of the tree.
*/
setMM(N, Dorig, mD);
/*
Allocate and initialize the \|q|, \|q2| and \|nodes| array. $2N-3$
nodes to hold both the original and the added nodes.
*/
q = (int *)malloc(N*sizeof(int));
if(!q) printError("build::buildTree:out of memory-q\n");
q2 = (int *)malloc(N*sizeof(int));
if(!q2) printError("build::buildTree:out of memory-q2\n");
nodes = (NodeT **)malloc( (2*N-3)*sizeof(NodeT *));
if(!nodes) printError("build::buildTree:out of memory-nodes");
for(i=0;i<N;++i) {
nodes[i] = createNode();
nodes[i]->name = taxon[i];
nodes[i]->ind = i;
}
Nleft = N;
Nnext = N;
/*
\section{Loop until 3 taxa left}
While we have more than 3 nodes left do the neighbor joining algorithm.
Each pass of the algorithm will join 2 nodes replacing them with one.
*/
while(Nleft>3) {
int j, k, ip, ip2;
double minR=0.0, min2R=0.0;
NodeT *newNode, *tmpNode;
double sigma_inf_i, sigma_inf_ip, sigma_inf_rat;
double sig_r, sig_l;
int jj, jjmin;
double LLRp=0, tR, tmp;
/* \subsection{Calculate Residual} */
calc_q(Nleft, q, R, b, q2, LLR, Zscore);
if(printLevel>2)
for(k=0;k<Nleft;++k)
fprintf(outfile, "q[%d]=%d R(%d,%d)=%g\n",
k, q[k], k, q[k], R[k]);
/*
Find $i$ than minimizes $R(i,q(i))$. With the constraint that
$q(q(i))=i$ first if no pair found then find the best $i$
without this constraint.
Note: the \|checkQQI| flag determines if we will use the
$q(q(i))=i$ constraint.
Note: j will hold the next best pair
*/
i = -1;
j = -1;
if(checkQQI) {
for(k=0;k<Nleft;++k)
if(q[q[k]]==k) {
if(R[k]<minR || i==-1) {
if(printLevel>3)
fprintf(outfile,
"ij=%d,%d k=%d q[k]=%d minR = %.16g R[k] = %.16g\n",
i,j,k, q[k], minR, R[k]);
j = i;
min2R = minR;
i = k;
minR = R[k];
}
else if(R[k]>minR && (R[k]<min2R || j==-1) ) {
j = k;
min2R = R[k];
}
}
}
if(i==-1) { /* No pair had $q(q(i))=i$ */
if(R[0]<R[1]) {
i = 0;
minR = R[0];
j = 1;
min2R = R[1];
} else {
i = 1;
minR = R[1];
j = 0;
min2R = R[0];
}
for(k=1;k<Nleft;++k)
if(R[k]<minR) {
j = i;
min2R = minR;
i = k;
minR = R[k];
}
else if(R[k] < min2R && R[k] > minR) {
j = k;
min2R = R[k];
}
if(checkQQI && printLevel>1)
fprintf(outfile, "No pair with q[q[i]]==i ");
else
if(q[q[i]]!=i && printLevel>1)
fprintf(outfile,
"The pair does not satisfy q[q[i]]==i (checking is off)"
);
}
ip = q[i];
ip2 = j;
/*
If the extended tournament option is set (-e) then run two
more tournaments for (i,q[i]) to see who really wins.
*/
if(extendedTourn) {
double minR1=0, minR2=0, tmpR, oldR=R[i];
int jmin=-1, jpmin=-1;
/*
First fine the j the minimizes R(i,j)
*/
for(j=0;j<Nleft;++j)
if(j!=i && j!=q[i]) {
if(j!=q2[i])
tmpR = calcR2(Nleft, i, j, q2[i], b);
else
tmpR = calcR2(Nleft, i, j, q[i], b);
if(tmpR<minR1 || jmin==-1)
{
minR1=tmpR;
jmin = j;
}
}
/*
and now the $j'$ that minimizes $R(j',q[i])$
*/
for(j=0;j<Nleft;++j)
if(j!=i && j!=q[i]) {
if(j!=q2[i])
tmpR = calcR2(Nleft, j, q[i], q2[i], b);
else
tmpR = calcR2(Nleft, j, q[i], i, b);
if(tmpR<minR2 || jpmin==-1) {
minR2=tmpR;
jpmin = j;
}
}
/*
Now fnd which of the three is the smallest
*/
if(minR1<minR2 && minR1<R[i]) {
ip = jmin;
if(printLevel>1)
fprintf(outfile,
"Extended Tournament New Winner(A): (%d, %d) R=%g\n",
i, ip, minR1);
}
else if(minR2<minR1 && minR2<R[i]) {
i = jpmin;
if(printLevel>1)
fprintf(outfile,
"Extended Tournament New Winner(B): (%d, %d) R=%g\n",
i, ip, minR2);
}
if(printLevel>3)
fprintf(outfile, "R=%g, R1=%g, R2=%g\n", oldR, minR1, minR2);
}
/*
Find the $jj$ that minimizes $R(q(i),i,jj)$ and then print out
the LLR and LLR' values.
*/
jjmin=-1;
for(jj=0;jj<Nleft;++jj)
if(jj!=i && jj!=ip
&& (((tR=calcR(Nleft, ip, jj, i))<LLRp) || jjmin==-1)) {
jjmin = jj;
LLRp = tR;
}
LLRp *= 0.5;
if( (LLR[i]<1e-6) && (LLRp<1e-6) ) {
if(!warnFlag) {
fprintf(stderr,
"warning: tie scores encountered; topology may depend on sequence order!\n");
warnFlag = True;
}
if(printLevel>1) {
fprintf(outfile,
"warning: tie scores encountered; topology may depend on sequence order!\n");
fprintf(outfile, "taxon %s and taxon %s\n\n",
nodes[i]->name, nodes[ip]->name);
}
}
if(printLevel>0) {
fprintf(outfile,
"\nJoin taxon %s to taxon %s (%s next best choice)\n",
nodes[i]->name, nodes[ip]->name, nodes[q2[i]]->name);
fprintf(outfile, " p-value = %g\n",
DMAX(1.0/(exp(LLR[i])+1.0), 1.0/(exp(LLRp)+1.0)));
if(printLevel>1) {
fprintf(outfile,"\nJoin taxon %s to taxon %s; R=%g\n",
nodes[i]->name, nodes[ip]->name, minR);
if(ip2!=-1 && ip2!=i && ip2!=ip)
fprintf(outfile, "Second best pair (%s, %s); R=%g\n",
nodes[ip2]->name, nodes[q[ip2]]->name, min2R);
else
fprintf(outfile, "No second best pair\n");
}
}
/*
Note due to the way we shuffle around nodes after joining:
i->Nnext, New->i, ip<->Nleft-1, if ip is less than i and
i=Nleft-1 then the new node will be in position ip not i!!
But tc (the global that is suppose to point to the position
of the new node for calcb) is set to i so this will screw us
up. The simpliest solution is to make sure i<ip; swap if they
are not.
*/
if(ip<i) {
int tt;
tt=i;
i=ip;
ip=tt;
}
/*
Need to calculate the new branch lengths $\bar b_{i;i'}$ and
$\bar b_{i';i}$, eq. 0.19.
Note if the z-score is negative then we calculate $\phi$ eq
(0.26) and use it to renormalize $d_{i,i'}$ and recompute
$b_{i;i'}$ and $b_{i';i}$.
*/
if(Zscore[i]<0.0) {
double phi_iip, dBar_iip;
phi_iip = calcPhi(Nleft, i, ip);
if(printLevel>2)
fprintf(outfile, "Renormalizing z[%d,%d] = %g\n", i, ip, Zscore[i]);
if(phi_iip>0) {
dBar_iip = D(i,ip)-phi_iip;
if(printLevel>2)
fprintf(outfile, "phi=%g dBar_iip=%g\n", phi_iip, dBar_iip);
/* renormalize the b's */
if( dBar_iip >= fabs(deltaB[i][ip]) )
b[i][ip] = (deltaB[i][ip] + dBar_iip)/2.0;
else if( dBar_iip < -deltaB[i][ip] )
b[i][ip] = 0.0;
else
b[i][ip] = dBar_iip;
if( dBar_iip >= fabs(deltaB[ip][i]) )
b[ip][i] = (deltaB[ip][i] + dBar_iip)/2.0;
else if( dBar_iip < -deltaB[ip][i] )
b[ip][i] = 0.0;
else
b[ip][i] = dBar_iip;
}
}
nodes[i ]->rho = b[i][ip];
nodes[ip]->rho = b[ip][i];
if(nodes[i ]->rho < 0.0) {
if(printLevel>0)
fprintf(outfile,
"WARNING: Negative branch length %g set to zero\n",
nodes[i ]->rho);
nodes[i ]->rho = 0.0;
nodes[ip]->rho = D(i,ip);
}
else if(nodes[ip]->rho < 0.0) {
if(printLevel>0)
fprintf(outfile,
"WARNING: Negative branch length %g set to zero\n",
nodes[ip]->rho);
nodes[ip]->rho = 0.0;
nodes[i ]->rho = D(i,ip);
}
if(printLevel>3) {
fprintf(outfile, "\\bar b_[%d%d] = %g b_[%d%d]=%g\n",
i, ip, nodes[i]->rho, i, ip, b[i][ip]);
fprintf(outfile, "\\bar b_[%d%d] = %g b_[%d%d]=%g\n\n",
ip, i, nodes[ip]->rho, ip, i, b[ip][i]);
}
newNode = createNode();
newNode->ind = Nnext;
newNode->child_r = nodes[i];
newNode->child_l = nodes[ip];
newNode->name = nodes[i]->name;
nodes[Nnext] = newNode;
/*
Calculate $\sigma^2_\infty(i\bar\imath)$ (eq. 0.27) for each
of the joined taxa.
*/
sigma_inf_i = 0.0;
sigma_inf_ip = 0.0;
for(j=0;j<Nleft;++j) {
if(j!=i && j!=ip) {
sigma_inf_i
+= sigma_na(DMAX(b[i][ip],MINB)+C(i),
DMAX(D(i,j)-b[i][ip],MINB)+C(j) );
sigma_inf_ip
+= sigma_na(DMAX(b[ip][i],MINB)+C(ip),
DMAX(D(ip,j)-b[ip][i],MINB)+C(j) );
}
}
/*
Add \|EPSILON| here to make the following formulae a bit simplier
*/
sigma_inf_i += EPSILON;
sigma_inf_ip += EPSILON;
/*
Calculate the new distances from eq. 0.24
$$
d_{\bar\imath k} = {{(d_{ik}-b_{i;i'}+\phi_i)/\sigma^2_\infty(i\bar\imath)+
(d_{i'j}-b_{i';i}+\phi_{i'})/\sigma^2_\infty(i'\bar\imath)}
\over{
{1\over\sigma^2_\infty(i'\bar\imath)} +
{1\over\sigma^2_\infty(i'\bar\imath)}}}
$$
where\hfill\break
$i=$ \|newNode->child_r->ind|,\hfill\break
$i'=$ \|newNode->child_l->ind|,\hfill\break
$b_{i;i'}=$ \|newNode->child_r->rho|,\hfill\break
$b_{i';i}=$ \|newNode->child_l->rho|
Also calcuate the renormalization terms $c_{i;j}$ (eq 0.43 ver0.2.5)
and $c_i$
*/
for(j=0;j<Nleft;++j) {
if(j!=i && j!=ip) {
/* $1/\sigma^2_\infty(i\bar\imath)+1/\sigma^2_\infty(i'\bar\imath)$ */
double norm =
1.0/( 1.0/sigma_inf_i + 1.0/sigma_inf_ip);
/*
First calcuate the new distances
*/
D(Nnext,j) = D(j,Nnext) =
norm *
(
(D(i,j)-RHO(newNode->child_r))/(sigma_inf_i)
+
(D(ip,j)-RHO(newNode->child_l))/(sigma_inf_ip)
);
if(D(Nnext,j)<0.0)
D(Nnext,j) = D(j,Nnext) = 0.0;
}
}
D(Nnext,Nnext) = 0.0;
/*
And now the new renormalization quantity $c_{\bar\imath}$
N.B. eq 0.30 has been rewritten from
$$
{1\over{{1\over X}+{1\over Y}}}
$$
to
$$
{XY\over X+Y}
$$
which is better behaved numerically when $X$ or $Y$ is
small (and cheeper since it only has one division).
*/
sig_r = sigma2t(C(i)+DMAX(RHO(newNode->child_r), MINB));
sig_l = sigma2t(C(ip)+DMAX(RHO(newNode->child_l), MINB));
if(sigma_inf_i+sigma_inf_ip>0.0) {
if(sigma_inf_i+sigma_inf_ip < .9*sqrt(DBL_MAX) && /* no overflow */
sigma_inf_i+sigma_inf_ip > .9*sqrt(DBL_MIN)) /* no underflow */
{
tmp=
(sig_r*SQR(sigma_inf_ip)+ sig_l*SQR(sigma_inf_i))
/
SQR(sigma_inf_i+sigma_inf_ip);
}
else if(sigma_inf_ip > sigma_inf_i) /* to avoid over/underflow */
{
sigma_inf_rat = sigma_inf_i / sigma_inf_ip;
tmp =
sig_r*1.0+sig_l*SQR(sigma_inf_rat)
/
SQR(1.0+sigma_inf_rat);
}
else
{
sigma_inf_rat = sigma_inf_ip / sigma_inf_i;
tmp =
sig_r*SQR(sigma_inf_rat)+sig_l*1.0
/
SQR(1.0+sigma_inf_rat);
}
C(Nnext) = sigma2tinv( tmp );
}
else
C(Nnext) = sigma2tinv(0.0);
/* if(!
(C(Nnext)<=DMAX(DMAX(RHO(newNode->child_r),MINB)+C(i)+1e-14,
DMAX(RHO(newNode->child_l),MINB)+C(ip)+1e-14)))
{
printf("C(Nnext=%d)=%g\n"
"RHO_R=%g C(i=%d)=%g sig_r=%g\nRHO_L=%g C(ip=%d)=%g sig_l=%g -- %g\n",
Nnext, C(Nnext),
RHO(newNode->child_r), i, C(i), sig_r,
RHO(newNode->child_l), ip, C(ip), sig_l,
sig_r*sig_l/(sig_r+sig_l));
fflush(stdout);
}
assert((C(Nnext)<=DMAX(DMAX(RHO(newNode->child_r),MINB)+C(i)+1e-14,
DMAX(RHO(newNode->child_l),MINB)+C(ip)+1e-14)));
*/
/*
Swap $i$ node to the empty node at the end of the list and
place the new node in position $i$ */
nodes[Nnext] = nodes[i];
nodes[i] = newNode;
/*
Swap the $ip$ node and the last node on the list this moves
$ip$ to the end. When we decrease \|Nleft| by one there will be
on less node and the two joined nodes $i$ and $ip$ will now be
after then end (\|Nleft|) of the list
*/
tmpNode = nodes[ip];
nodes[ip] = nodes[Nleft-1];
nodes[Nleft-1] = tmpNode;
/*
In the new node set the child indecies to the
new indexes of the the joined nodes. This info
will be used by \|sigma2_3| in the renormalization
step
*/
newNode->cind_r=Nnext;
newNode->cind_l=Nleft-1;
/*
Set up the \|ta|, \|tb| and \|tc| node array indices. \|ta|
and \|tb| point to the two taxa that where just joined, and
\|tc| points to the newly created taxon.
These globals will be used in the next call to \|calcb|.
*/
ta = Nnext;
tb = Nleft - 1;
tc = i;
--Nleft;
++Nnext;
/*
Print out the values of the various variables
*/
if(printLevel>2) {
int a, b;
fprintf(outfile, "\nReduced d_ij=\n");
for(a=0;a<Nleft;++a)
{
for(b=0;b<Nleft;++b)
fprintf(outfile,"%7.4g ", D(a,b));
fprintf(outfile,"\n");
}
fprintf(outfile,"\n");
}
if(printLevel>3) {
int a, b;
for(a=0;a<Nnext;++a) {
for(b=0;b<Nnext;++b)
fprintf(outfile,"%7.4g ", mD[a][b]);
fprintf(outfile,"\n");
}
fprintf(outfile,"\n");
fprintf(outfile, "c_i = ");
for(a=0;a<Nleft;++a) {
fprintf(outfile,"%7.4g ", C(a));
}
fprintf(outfile,"\n");
for(a=0;a<Nnext;++a) {
fprintf(outfile,"%7.4g ", vC[a]);
}
fprintf(outfile,"\n");
fprintf(outfile, "\n");
}
}
/*
\section{Final three taxa}
Now there are just three taxa left. They will join to the root
node of our tree. Find their branch lengths (which we can do
exactly) and set up the root node to be passed back on return from
this functin.
*/
root = createRootNode();
if(!root) printError("build::buildTree:out of memory-root");
root->child_l = nodes[0];
root->child_m = nodes[1];
root->child_r = nodes[2];
/*
Now get the root branch lengths. We can solve this exactly since
we have three equations and three unknows. The equations to solve
are:
$$
\rho_0+\rho_1 = d_{01},
\rho_0+\rho_2 = d_{02},
\rho_1+\rho_2 = d_{12}
$$
And the solution is:
$$
\rho_0={1 \over 2}\left(d_{01}+d_{02}-d_{12}\right),
\rho_1={1 \over 2}\left(d_{01}-d_{02}+d_{12}\right),
\rho_2={1 \over 2}\left(-d_{01}+d_{02}+d_{12}\right)
$$
*/
root->child_l->rho = 0.5*( D(0,1)+D(0,2)-D(1,2));
root->child_m->rho = 0.5*( D(0,1)-D(0,2)+D(1,2));
root->child_r->rho = 0.5*(-D(0,1)+D(0,2)+D(1,2));
/* check for negative lengths and set to zero if found and decrease
the other each by half the the negative length (note + a neg
number is a decrease) */
if(root->child_l->rho < 0.0) {
root->child_m->rho += 0.5*root->child_l->rho;
root->child_r->rho += 0.5*root->child_l->rho;
root->child_l->rho=0.0;
}
if(root->child_m->rho < 0.0) {
root->child_l->rho += 0.5*root->child_m->rho;
root->child_r->rho += 0.5*root->child_m->rho;
root->child_m->rho=0.0;
}
if(root->child_r->rho < 0.0) {
root->child_l->rho += 0.5*root->child_r->rho;
root->child_m->rho += 0.5*root->child_r->rho;
root->child_r->rho=0.0;
}
/*
Clean up
*/
freeMatrix(mD);
freeMatrix(b);
freeMatrix(delta2B);
freeMatrix(deltaB);
if(recalcB)
freeMatrix(oldDeltaB);
freeMatrix(s);
freeVector(R);
freeVector(LLR);
freeVector(Zscore);
freeVector(vC);
freeMatrix(mS);
freeMatrix(mDelB);
freeMatrix(mDel2B);
free(nodes);
free(q);
free(q2);
return(root);
}
void palPertue( double date, double u[13], int *jstat ) {
/* Distance from EMB at which Earth and Moon are treated separately */
const double RNE=1.0;
/* Coincidence with major planet distance */
const double COINC=0.0001;
/* Coefficient relating timestep to perturbing force */
const double TSC=1e-4;
/* Minimum and maximum timestep (days) */
const double TSMIN = 0.01;
const double TSMAX = 10.0;
/* Age limit for major-planet state vector (days) */
const double AGEPMO=5.0;
/* Age limit for major-planet mean elements (days) */
const double AGEPEL=50.0;
/* Margin for error when deciding whether to renew the planetary data */
const double TINY=1e-6;
/* Age limit for the body's osculating elements (before rectification) */
const double AGEBEL=100.0;
/* Gaussian gravitational constant squared */
const double GCON2 = PAL__GCON * PAL__GCON;
/* The final epoch */
double TFINAL;
/* The body's current universal elements */
double UL[13];
/* Current reference epoch */
double T0;
/* Timespan from latest orbit rectification to final epoch (days) */
double TSPAN;
/* Time left to go before integration is complete */
double TLEFT;
/* Time direction flag: +1=forwards, -1=backwards */
double FB;
/* First-time flag */
int FIRST = 0;
/*
* The current perturbations
*/
/* Epoch (days relative to current reference epoch) */
double RTN;
/* Position (AU) */
double PERP[3];
/* Velocity (AU/d) */
double PERV[3];
/* Acceleration (AU/d/d) */
double PERA[3];
/* Length of current timestep (days), and half that */
double TS,HTS;
/* Epoch of middle of timestep */
double T;
/* Epoch of planetary mean elements */
double TPEL = 0.0;
/* Planet number (1=Mercury, 2=Venus, 3=EMB...8=Neptune) */
int NP;
/* Planetary universal orbital elements */
double UP[8][13];
/* Epoch of planetary state vectors */
double TPMO = 0.0;
/* State vectors for the major planets (AU,AU/s) */
double PVIN[8][6];
/* Earth velocity and position vectors (AU,AU/s) */
double VB[3],PB[3],VH[3],PE[3];
/* Moon geocentric state vector (AU,AU/s) and position part */
double PVM[6],PM[3];
/* Date to J2000 de-precession matrix */
double PMAT[3][3];
/*
* Correction terms for extrapolated major planet vectors
*/
/* Sun-to-planet distances squared multiplied by 3 */
double R2X3[8];
/* Sunward acceleration terms, G/2R^3 */
double GC[8];
/* Tangential-to-circular correction factor */
double FC;
/* Radial correction factor due to Sunwards acceleration */
double FG;
/* The body's unperturbed and perturbed state vectors (AU,AU/s) */
double PV0[6],PV[6];
/* The body's perturbed and unperturbed heliocentric distances (AU) cubed */
double R03,R3;
/* The perturbating accelerations, indirect and direct */
double FI[3],FD[3];
/* Sun-to-planet vector, and distance cubed */
double RHO[3],RHO3;
/* Body-to-planet vector, and distance cubed */
double DELTA[3],DELTA3;
/* Miscellaneous */
int I,J;
double R2,W,DT,DT2,R,FT;
int NE;
/* Planetary inverse masses, Mercury through Neptune then Earth and Moon */
const double AMAS[10] = {
6023600., 408523.5, 328900.5, 3098710.,
1047.355, 3498.5, 22869., 19314.,
332946.038, 27068709.
};
/* Preset the status to OK. */
*jstat = 0;
/* Copy the final epoch. */
TFINAL = date;
/* Copy the elements (which will be periodically updated). */
for (I=0; I<13; I++) {
UL[I] = u[I];
}
/* Initialize the working reference epoch. */
T0=UL[2];
/* Total timespan (days) and hence time left. */
TSPAN = TFINAL-T0;
TLEFT = TSPAN;
/* Warn if excessive. */
if (fabs(TSPAN) > 36525.0) *jstat=101;
/* Time direction: +1 for forwards, -1 for backwards. */
FB = COPYSIGN(1.0,TSPAN);
/* Initialize relative epoch for start of current timestep. */
RTN = 0.0;
/* Reset the perturbations (position, velocity, acceleration). */
for (I=0; I<3; I++) {
PERP[I] = 0.0;
PERV[I] = 0.0;
PERA[I] = 0.0;
}
/* Set "first iteration" flag. */
FIRST = 1;
/* Step through the time left. */
while (FB*TLEFT > 0.0) {
/* Magnitude of current acceleration due to planetary attractions. */
if (FIRST) {
TS = TSMIN;
} else {
R2 = 0.0;
for (I=0; I<3; I++) {
W = FD[I];
R2 = R2+W*W;
}
W = sqrt(R2);
/* Use the acceleration to decide how big a timestep can be tolerated. */
if (W != 0.0) {
TS = DMIN(TSMAX,DMAX(TSMIN,TSC/W));
} else {
TS = TSMAX;
}
}
TS = TS*FB;
/* Override if final epoch is imminent. */
TLEFT = TSPAN-RTN;
if (fabs(TS) > fabs(TLEFT)) TS=TLEFT;
/* Epoch of middle of timestep. */
HTS = TS/2.0;
T = T0+RTN+HTS;
/* Is it time to recompute the major-planet elements? */
if (FIRST || fabs(T-TPEL)-AGEPEL >= TINY) {
/* Yes: go forward in time by just under the maximum allowed. */
TPEL = T+FB*AGEPEL;
/* Compute the state vector for the new epoch. */
for (NP=1; NP<=8; NP++) {
palPlanet(TPEL,NP,PV,&J);
/* Warning if remote epoch, abort if error. */
if (J == 1) {
*jstat = 102;
} else if (J != 0) {
goto ABORT;
}
/* Transform the vector into universal elements. */
palPv2ue(PV,TPEL,0.0,&(UP[NP-1][0]),&J);
if (J != 0) goto ABORT;
}
}
/* Is it time to recompute the major-planet motions? */
if (FIRST || fabs(T-TPMO)-AGEPMO >= TINY) {
/* Yes: look ahead. */
TPMO = T+FB*AGEPMO;
/* Compute the motions of each planet (AU,AU/d). */
for (NP=1; NP<=8; NP++) {
/* The planet's position and velocity (AU,AU/s). */
palUe2pv(TPMO,&(UP[NP-1][0]),&(PVIN[NP-1][0]),&J);
if (J != 0) goto ABORT;
/* Scale velocity to AU/d. */
for (J=3; J<6; J++) {
PVIN[NP-1][J] = PVIN[NP-1][J]*PAL__SPD;
}
/* Precompute also the extrapolation correction terms. */
R2 = 0.0;
for (I=0; I<3; I++) {
W = PVIN[NP-1][I];
R2 = R2+W*W;
}
R2X3[NP-1] = R2*3.0;
GC[NP-1] = GCON2/(2.0*R2*sqrt(R2));
}
}
/* Reset the first-time flag. */
FIRST = 0;
/* Unperturbed motion of the body at middle of timestep (AU,AU/s). */
palUe2pv(T,UL,PV0,&J);
if (J != 0) goto ABORT;
/* Perturbed position of the body (AU) and heliocentric distance cubed. */
R2 = 0.0;
for (I=0; I<3; I++) {
W = PV0[I]+PERP[I]+(PERV[I]+PERA[I]*HTS/2.0)*HTS;
PV[I] = W;
R2 = R2+W*W;
}
R3 = R2*sqrt(R2);
/* The body's unperturbed heliocentric distance cubed. */
R2 = 0.0;
for (I=0; I<3; I++) {
W = PV0[I];
R2 = R2+W*W;
}
R03 = R2*sqrt(R2);
/* Compute indirect and initialize direct parts of the perturbation. */
for (I=0; I<3; I++) {
FI[I] = PV0[I]/R03-PV[I]/R3;
FD[I] = 0.0;
}
/* Ready to compute the direct planetary effects. */
/* Reset the "near-Earth" flag. */
NE = 0;
/* Interval from state-vector epoch to middle of current timestep. */
DT = T-TPMO;
DT2 = DT*DT;
/* Planet by planet, including separate Earth and Moon. */
for (NP=1; NP<10; NP++) {
/* Which perturbing body? */
if (NP <= 8) {
/* Planet: compute the extrapolation in longitude (squared). */
R2 = 0.0;
for (J=3; J<6; J++) {
W = PVIN[NP-1][J]*DT;
R2 = R2+W*W;
}
/* Hence the tangential-to-circular correction factor. */
FC = 1.0+R2/R2X3[NP-1];
/* The radial correction factor due to the inwards acceleration. */
FG = 1.0-GC[NP-1]*DT2;
/* Planet's position. */
for (I=0; I<3; I++) {
RHO[I] = FG*(PVIN[NP-1][I]+FC*PVIN[NP-1][I+3]*DT);
}
} else if (NE) {
/* Near-Earth and either Earth or Moon. */
if (NP == 9) {
/* Earth: position. */
palEpv(T,PE,VH,PB,VB);
for (I=0; I<3; I++) {
RHO[I] = PE[I];
}
} else {
/* Moon: position. */
palPrec(palEpj(T),2000.0,PMAT);
palDmoon(T,PVM);
eraRxp(PMAT,PVM,PM);
for (I=0; I<3; I++) {
RHO[I] = PM[I]+PE[I];
}
}
}
/* Proceed unless Earth or Moon and not the near-Earth case. */
if (NP <= 8 || NE) {
/* Heliocentric distance cubed. */
R2 = 0.0;
for (I=0; I<3; I++) {
W = RHO[I];
R2 = R2+W*W;
}
R = sqrt(R2);
RHO3 = R2*R;
/* Body-to-planet vector, and distance. */
R2 = 0.0;
for (I=0; I<3; I++) {
W = RHO[I]-PV[I];
DELTA[I] = W;
R2 = R2+W*W;
}
R = sqrt(R2);
/* If this is the EMB, set the near-Earth flag appropriately. */
if (NP == 3 && R < RNE) NE = 1;
/* Proceed unless EMB and this is the near-Earth case. */
if ( ! (NE && NP == 3) ) {
/* If too close, ignore this planet and set a warning. */
if (R < COINC) {
*jstat = NP;
} else {
/* Accumulate "direct" part of perturbation acceleration. */
DELTA3 = R2*R;
W = AMAS[NP-1];
for (I=0; I<3; I++) {
FD[I] = FD[I]+(DELTA[I]/DELTA3-RHO[I]/RHO3)/W;
}
}
}
}
}
/* Update the perturbations to the end of the timestep. */
RTN += TS;
for (I=0; I<3; I++) {
W = (FI[I]+FD[I])*GCON2;
FT = W*TS;
PERP[I] = PERP[I]+(PERV[I]+FT/2.0)*TS;
PERV[I] = PERV[I]+FT;
PERA[I] = W;
}
/* Time still to go. */
TLEFT = TSPAN-RTN;
/* Is it either time to rectify the orbit or the last time through? */
if (fabs(RTN) >= AGEBEL || FB*TLEFT <= 0.0) {
/* Yes: update to the end of the current timestep. */
T0 += RTN;
RTN = 0.0;
/* The body's unperturbed motion (AU,AU/s). */
palUe2pv(T0,UL,PV0,&J);
if (J != 0) goto ABORT;
/* Add and re-initialize the perturbations. */
for (I=0; I<3; I++) {
J = I+3;
PV[I] = PV0[I]+PERP[I];
PV[J] = PV0[J]+PERV[I]/PAL__SPD;
PERP[I] = 0.0;
PERV[I] = 0.0;
PERA[I] = FD[I]*GCON2;
}
/* Use the position and velocity to set up new universal elements. */
palPv2ue(PV,T0,0.0,UL,&J);
if (J != 0) goto ABORT;
/* Adjust the timespan and time left. */
TSPAN = TFINAL-T0;
TLEFT = TSPAN;
}
/* Next timestep. */
}
/* Return the updated universal-element set. */
for (I=0; I<13; I++) {
u[I] = UL[I];
}
/* Finished. */
return;
/* Miscellaneous numerical error. */
ABORT:
*jstat = -1;
return;
}
/* This function determines the present equation of state
* in case the HPM method is selected. It normally does this
* by following the ionization history of two fiducial gas
* elements at the mean density, and at 1.1 times the mean density.
* From the pressure values, and effective EQS index is then computed.
*/
void hpm_find_eqs_selfconsistent(void)
{
double dt, dtime, hubble_a = 0, a3inv;
double time_hubble_a, dmax1, dmax2;
double u0, u1, meanWeight, temp;
if(All.ComovingIntegrationOn)
{
/* Factors for comoving integration of hydro */
a3inv = 1 / (All.Time * All.Time * All.Time);
#if defined(DEDM_HUBBLE) || defined(VDE)
hubble_a = getH_a(All.Time);
#else
hubble_a = All.Omega0 / (All.Time * All.Time * All.Time)
+ (1 - All.Omega0 - All.OmegaLambda) / (All.Time * All.Time)
#ifdef DARKENERGY
+ DarkEnergy_a(All.Time);
#else
+ All.OmegaLambda;
#endif
#endif
hubble_a = All.Hubble * sqrt(hubble_a);
time_hubble_a = All.Time * hubble_a;
}
else
a3inv = time_hubble_a = 1;
dt = (P[0].Ti_endstep - P[0].Ti_begstep) * All.Timebase_interval; /* the time-step */
if(All.ComovingIntegrationOn)
dtime = All.Time * dt / time_hubble_a;
else
dtime = dt;
All.HPM_rho0 = All.OmegaBaryon * 3 * All.Hubble * All.Hubble / (8 * M_PI * All.G);
All.HPM_rho1 = 1.1 * All.HPM_rho0;
u0 = All.HPM_entr0 / GAMMA_MINUS1 * pow(All.HPM_rho0 * a3inv, GAMMA_MINUS1);
u1 = All.HPM_entr1 / GAMMA_MINUS1 * pow(All.HPM_rho1 * a3inv, GAMMA_MINUS1);
u0 = DoCooling(DMAX(All.MinEgySpec, u0), All.HPM_rho0 * a3inv, dtime, &All.HPM_ne0);
u1 = DoCooling(DMAX(All.MinEgySpec, u1), All.HPM_rho1 * a3inv, dtime, &All.HPM_ne1);
All.HPM_entr0 = u0 * GAMMA_MINUS1 / pow(All.HPM_rho0 * a3inv, GAMMA_MINUS1);
All.HPM_entr1 = u1 * GAMMA_MINUS1 / pow(All.HPM_rho1 * a3inv, GAMMA_MINUS1);
/* Note: All.HPM_P0 is a "comoving pressure", i.e. computed in gadget's
* internal unit convention using the comoving density and the physical entropy.
*/
All.HPM_P0 = All.HPM_entr0 * pow(All.HPM_rho0, GAMMA);
All.HPM_P1 = All.HPM_entr1 * pow(All.HPM_rho1, GAMMA);
All.HPM_alpha = log(All.HPM_P1 / All.HPM_P0) / log(All.HPM_rho1 / All.HPM_rho0);
/* compute the temperature corresponding to P0, for information purposes only */
meanWeight = 4.0 / (3 * HYDROGEN_MASSFRAC + 1 + 4 * HYDROGEN_MASSFRAC * All.HPM_ne0) * PROTONMASS;
temp = meanWeight / BOLTZMANN * GAMMA_MINUS1 * u0 * All.UnitEnergy_in_cgs / All.UnitMass_in_g;
if(ThisTask == 0)
{
printf("IGM-EQS: a=%g T0=%g P0=%g alpha=%g\n", All.Time, temp, All.HPM_P0, All.HPM_alpha);
fflush(stdout);
}
}
/*! This routine finds all neighbours `j' that can interact with
* \f$ r_{ij} < h_i \f$ OR if \f$ r_{ij} < h_j \f$.
*/
int subfind_ngb_treefind_linkpairs(MyDouble searchcenter[3], double hsml, int target, int *startnode,
int mode, double *hmax, int *nexport, int *nsend_local)
{
int numngb, i, no, p, task, nexport_save, exported = 0;
struct NODE *current;
double dx, dy, dz, dist, r2;
#ifdef PERIODIC
MyDouble xtmp;
#endif
nexport_save = *nexport;
*hmax = 0;
numngb = 0;
no = *startnode;
while(no >= 0)
{
if(no < All.MaxPart) /* single particle */
{
p = no;
no = Nextnode[no];
#ifdef DENSITY_SPLIT_BY_TYPE
if(!((1 << P[p].Type) & (DENSITY_SPLIT_BY_TYPE)))
#else
if(!((1 << P[p].Type) & (FOF_PRIMARY_LINK_TYPES)))
#endif
continue;
dist = DMAX(P[p].DM_Hsml, hsml);
dx = NGB_PERIODIC_LONG_X(P[p].Pos[0] - searchcenter[0]);
if(dx > dist)
continue;
dy = NGB_PERIODIC_LONG_Y(P[p].Pos[1] - searchcenter[1]);
if(dy > dist)
continue;
dz = NGB_PERIODIC_LONG_Z(P[p].Pos[2] - searchcenter[2]);
if(dz > dist)
continue;
if((r2 = (dx * dx + dy * dy + dz * dz)) > dist * dist)
continue;
Dist2list[numngb] = r2;
Ngblist[numngb++] = p;
}
else
{
if(no >= All.MaxPart + MaxNodes) /* pseudo particle */
{
if(mode == 1)
endrun(12312);
if(target >= 0) /* if no target is given, export will not occur */
{
exported = 1;
if(Exportflag[task = DomainTask[no - (All.MaxPart + MaxNodes)]] != target)
{
Exportflag[task] = target;
Exportnodecount[task] = NODELISTLENGTH;
}
if(Exportnodecount[task] == NODELISTLENGTH)
{
if(*nexport >= All.BunchSize)
{
*nexport = nexport_save;
if(nexport_save == 0)
endrun(13004); /* in this case, the buffer is too small to process even a single particle */
for(task = 0; task < NTask; task++)
nsend_local[task] = 0;
for(no = 0; no < nexport_save; no++)
nsend_local[DataIndexTable[no].Task]++;
return -1;
}
Exportnodecount[task] = 0;
Exportindex[task] = *nexport;
DataIndexTable[*nexport].Task = task;
DataIndexTable[*nexport].Index = target;
DataIndexTable[*nexport].IndexGet = *nexport;
*nexport = *nexport + 1;
nsend_local[task]++;
}
DataNodeList[Exportindex[task]].NodeList[Exportnodecount[task]++] =
DomainNodeIndex[no - (All.MaxPart + MaxNodes)];
if(Exportnodecount[task] < NODELISTLENGTH)
DataNodeList[Exportindex[task]].NodeList[Exportnodecount[task]] = -1;
}
no = Nextnode[no - MaxNodes];
continue;
}
current = &Nodes[no];
if(mode == 1)
{
if(current->u.d.bitflags & (1 << BITFLAG_TOPLEVEL)) /* we reached a top-level node again, which means that we are done with the branch */
{
*startnode = -1;
return numngb;
}
}
dist = DMAX(Extnodes[no].hmax, hsml) + 0.5 * current->len;
no = current->u.d.sibling; /* in case the node can be discarded */
dx = NGB_PERIODIC_LONG_X(current->center[0] - searchcenter[0]);
if(dx > dist)
continue;
dy = NGB_PERIODIC_LONG_Y(current->center[1] - searchcenter[1]);
if(dy > dist)
continue;
dz = NGB_PERIODIC_LONG_Z(current->center[2] - searchcenter[2]);
if(dz > dist)
continue;
/* now test against the minimal sphere enclosing everything */
dist += FACT1 * current->len;
if(dx * dx + dy * dy + dz * dz > dist * dist)
continue;
no = current->u.d.nextnode; /* ok, we need to open the node */
}
}
if(mode == 0) /* local particle */
if(exported == 0) /* completely local */
if(numngb >= All.DesNumNgb)
{
R2list = mymalloc(" R2list", sizeof(struct r2data) * numngb);
for(i = 0; i < numngb; i++)
{
R2list[i].index = Ngblist[i];
R2list[i].r2 = Dist2list[i];
}
#ifdef OMP_SORT
omp_qsort(R2list, numngb, sizeof(struct r2data), subfind_ngb_compare_dist);
#else
qsort(R2list, numngb, sizeof(struct r2data), subfind_ngb_compare_dist);
#endif
*hmax = sqrt(R2list[All.DesNumNgb - 1].r2);
numngb = All.DesNumNgb;
for(i = 0; i < numngb; i++)
{
Ngblist[i] = R2list[i].index;
Dist2list[i] = R2list[i].r2;
}
myfree(R2list);
}
*startnode = -1;
return numngb;
}
void subfind_find_linkngb(void)
{
long long ntot;
int i, j, ndone, ndone_flag, npleft, dummy, iter = 0, save_DesNumNgb;
MyFloat *Left, *Right;
char *Todo;
int ngrp, recvTask, place, nexport, nimport;
double t0, t1;
if(ThisTask == 0)
printf("Start find_linkngb (%d particles on task=%d)\n", NumPartGroup, ThisTask);
save_DesNumNgb = All.DesNumNgb;
All.DesNumNgb = All.DesLinkNgb; /* for simplicity, reset this value */
/* allocate buffers to arrange communication */
Ngblist = (int *) mymalloc("Ngblist", NumPartGroup * sizeof(int));
Dist2list = (double *) mymalloc("Dist2list", NumPartGroup * sizeof(double));
All.BunchSize =
(int) ((All.BufferSize * 1024 * 1024) / (sizeof(struct data_index) + sizeof(struct data_nodelist) +
sizeof(struct linkngbdata_in) + sizeof(struct linkngbdata_out) +
sizemax(sizeof(struct linkngbdata_in),
sizeof(struct linkngbdata_out))));
DataIndexTable =
(struct data_index *) mymalloc("DataIndexTable", All.BunchSize * sizeof(struct data_index));
DataNodeList =
(struct data_nodelist *) mymalloc("DataNodeList", All.BunchSize * sizeof(struct data_nodelist));
Left = mymalloc("Left", sizeof(MyFloat) * NumPartGroup);
Right = mymalloc("Right", sizeof(MyFloat) * NumPartGroup);
Todo = mymalloc("Todo", sizeof(char) * NumPartGroup);
for(i = 0; i < NumPartGroup; i++)
{
Left[i] = Right[i] = 0;
Todo[i] = 1;
}
/* we will repeat the whole thing for those particles where we didn't find enough neighbours */
do
{
t0 = second();
i = 0; /* begin with this index */
do
{
for(j = 0; j < NTask; j++)
{
Send_count[j] = 0;
Exportflag[j] = -1;
}
/* do local particles and prepare export list */
for(nexport = 0; i < NumPartGroup; i++)
{
if(Todo[i])
{
if(subfind_linkngb_evaluate(i, 0, &nexport, Send_count) < 0)
break;
}
}
#ifdef OMP_SORT
omp_qsort(DataIndexTable, nexport, sizeof(struct data_index), data_index_compare);
#else
qsort(DataIndexTable, nexport, sizeof(struct data_index), data_index_compare);
#endif
MPI_Alltoall(Send_count, 1, MPI_INT, Recv_count, 1, MPI_INT, MPI_COMM_WORLD);
for(j = 0, nimport = 0, Recv_offset[0] = 0, Send_offset[0] = 0; j < NTask; j++)
{
nimport += Recv_count[j];
if(j > 0)
{
Send_offset[j] = Send_offset[j - 1] + Send_count[j - 1];
Recv_offset[j] = Recv_offset[j - 1] + Recv_count[j - 1];
}
}
LinkngbDataGet =
(struct linkngbdata_in *) mymalloc(" LinkngbDataGet",
nimport * sizeof(struct linkngbdata_in));
LinkngbDataIn =
(struct linkngbdata_in *) mymalloc(" LinkngbDataIn",
nexport * sizeof(struct linkngbdata_in));
/* prepare particle data for export */
for(j = 0; j < nexport; j++)
{
place = DataIndexTable[j].Index;
LinkngbDataIn[j].Pos[0] = P[place].Pos[0];
LinkngbDataIn[j].Pos[1] = P[place].Pos[1];
LinkngbDataIn[j].Pos[2] = P[place].Pos[2];
LinkngbDataIn[j].DM_Hsml = P[place].DM_Hsml;
memcpy(LinkngbDataIn[j].NodeList,
DataNodeList[DataIndexTable[j].IndexGet].NodeList, NODELISTLENGTH * sizeof(int));
}
/* exchange particle data */
for(ngrp = 1; ngrp < (1 << PTask); ngrp++)
{
recvTask = ThisTask ^ ngrp;
if(recvTask < NTask)
{
if(Send_count[recvTask] > 0 || Recv_count[recvTask] > 0)
{
/* get the particles */
MPI_Sendrecv(&LinkngbDataIn[Send_offset[recvTask]],
Send_count[recvTask] * sizeof(struct linkngbdata_in), MPI_BYTE,
recvTask, TAG_DENS_A,
&LinkngbDataGet[Recv_offset[recvTask]],
Recv_count[recvTask] * sizeof(struct linkngbdata_in), MPI_BYTE,
recvTask, TAG_DENS_A, MPI_COMM_WORLD, MPI_STATUS_IGNORE);
}
}
}
myfree(LinkngbDataIn);
LinkngbDataResult =
(struct linkngbdata_out *) mymalloc(" LinkngbDataResult",
nimport * sizeof(struct linkngbdata_out));
LinkngbDataOut =
(struct linkngbdata_out *) mymalloc(" LinkngbDataOut",
nexport * sizeof(struct linkngbdata_out));
/* now do the particles that were sent to us */
for(j = 0; j < nimport; j++)
subfind_linkngb_evaluate(j, 1, &dummy, &dummy);
if(i >= NumPartGroup)
ndone_flag = 1;
else
ndone_flag = 0;
MPI_Allreduce(&ndone_flag, &ndone, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD);
/* get the result */
for(ngrp = 1; ngrp < (1 << PTask); ngrp++)
{
recvTask = ThisTask ^ ngrp;
if(recvTask < NTask)
{
if(Send_count[recvTask] > 0 || Recv_count[recvTask] > 0)
{
/* send the results */
MPI_Sendrecv(&LinkngbDataResult[Recv_offset[recvTask]],
Recv_count[recvTask] * sizeof(struct linkngbdata_out),
MPI_BYTE, recvTask, TAG_DENS_B,
&LinkngbDataOut[Send_offset[recvTask]],
Send_count[recvTask] * sizeof(struct linkngbdata_out),
MPI_BYTE, recvTask, TAG_DENS_B, MPI_COMM_WORLD, MPI_STATUS_IGNORE);
}
}
}
/* add the result to the local particles */
for(j = 0; j < nexport; j++)
{
place = DataIndexTable[j].Index;
P[place].DM_NumNgb += LinkngbDataOut[j].Ngb;
}
myfree(LinkngbDataOut);
myfree(LinkngbDataResult);
myfree(LinkngbDataGet);
}
while(ndone < NTask);
/* do final operations on results */
for(i = 0, npleft = 0; i < NumPartGroup; i++)
{
/* now check whether we had enough neighbours */
if(Todo[i])
{
if(P[i].DM_NumNgb != All.DesLinkNgb &&
((Right[i] - Left[i]) > 1.0e-3 * Left[i] || Left[i] == 0 || Right[i] == 0))
{
/* need to redo this particle */
npleft++;
if(P[i].DM_NumNgb < All.DesLinkNgb)
Left[i] = DMAX(P[i].DM_Hsml, Left[i]);
else
{
if(Right[i] != 0)
{
if(P[i].DM_Hsml < Right[i])
Right[i] = P[i].DM_Hsml;
}
else
Right[i] = P[i].DM_Hsml;
}
if(iter >= MAXITER - 10)
{
printf
("i=%d task=%d ID=%d DM_Hsml=%g Left=%g Right=%g Ngbs=%g Right-Left=%g\n pos=(%g|%g|%g)\n",
i, ThisTask, (int) P[i].ID, P[i].DM_Hsml, Left[i], Right[i],
(double) P[i].DM_NumNgb, Right[i] - Left[i], P[i].Pos[0], P[i].Pos[1], P[i].Pos[2]);
fflush(stdout);
}
if(Right[i] > 0 && Left[i] > 0)
P[i].DM_Hsml = pow(0.5 * (pow(Left[i], 3) + pow(Right[i], 3)), 1.0 / 3);
else
{
if(Right[i] == 0 && Left[i] == 0)
endrun(8189); /* can't occur */
if(Right[i] == 0 && Left[i] > 0)
P[i].DM_Hsml *= 1.26;
if(Right[i] > 0 && Left[i] == 0)
P[i].DM_Hsml /= 1.26;
}
}
else
Todo[i] = 0;
}
}
sumup_large_ints(1, &npleft, &ntot);
t1 = second();
if(ntot > 0)
{
iter++;
if(iter > 0 && ThisTask == 0)
{
printf("find linkngb iteration %d: need to repeat for %d%09d particles. (took %g sec)\n", iter,
(int) (ntot / 1000000000), (int) (ntot % 1000000000), timediff(t0, t1));
fflush(stdout);
}
if(iter > MAXITER)
{
printf("failed to converge in neighbour iteration in density()\n");
fflush(stdout);
endrun(1155);
}
}
}
while(ntot > 0);
myfree(Todo);
myfree(Right);
myfree(Left);
myfree(DataNodeList);
myfree(DataIndexTable);
myfree(Dist2list);
myfree(Ngblist);
All.DesNumNgb = save_DesNumNgb; /* restore it */
}
void cs_find_hot_neighbours(void)
{
MyFloat *Left, *Right;
int nimport;
int i, j, n, ndone_flag, dummy;
int ndone, ntot, npleft;
int iter = 0;
int ngrp, sendTask, recvTask;
int place, nexport;
double dmax1, dmax2;
double xhyd, yhel, ne, mu, energy, temp;
double a3inv;
if(All.ComovingIntegrationOn)
a3inv = 1 / (All.Time * All.Time * All.Time);
else
a3inv = 1;
/* allocate buffers to arrange communication */
Left = (MyFloat *) mymalloc(NumPart * sizeof(MyFloat));
Right = (MyFloat *) mymalloc(NumPart * sizeof(MyFloat));
Ngblist = (int *) mymalloc(NumPart * sizeof(int));
All.BunchSize =
(int) ((All.BufferSize * 1024 * 1024) / (sizeof(struct data_index) + sizeof(struct data_nodelist) +
sizeof(struct hotngbs_in) + sizeof(struct hotngbs_out) +
sizemax(sizeof(struct hotngbs_in), sizeof(struct hotngbs_out))));
DataIndexTable = (struct data_index *) mymalloc(All.BunchSize * sizeof(struct data_index));
DataNodeList = (struct data_nodelist *) mymalloc(All.BunchSize * sizeof(struct data_nodelist));
CPU_Step[CPU_MISC] += measure_time();
for(n = FirstActiveParticle; n >= 0; n = NextActiveParticle[n])
{
if(P[n].Type == 0)
{
/* select reservoir and cold phase particles */
if(P[n].EnergySN > 0 && SphP[n].d.Density * a3inv > All.PhysDensThresh * All.DensFrac_Phase)
{
xhyd = P[n].Zm[6] / P[n].Mass;
yhel = (1 - xhyd) / (4. * xhyd);
ne = SphP[n].Ne;
mu = (1 + 4 * yhel) / (1 + yhel + ne);
energy = SphP[n].Entropy * P[n].Mass / GAMMA_MINUS1 * pow(SphP[n].d.Density * a3inv, GAMMA_MINUS1); /* Total Energys */
temp = GAMMA_MINUS1 / BOLTZMANN * energy / P[n].Mass * PROTONMASS * mu;
temp *= All.UnitEnergy_in_cgs / All.UnitMass_in_g; /* Temperature in Kelvin */
if(temp < All.Tcrit_Phase)
{
Left[n] = Right[n] = 0;
if(!(SphP[n].HotHsml > 0.))
SphP[n].HotHsml = All.InitialHotHsmlFactor * PPP[n].Hsml; /* Estimation of HotHsml : ONLY first step */
P[n].Type = 10; /* temporarily mark particles of interest with this number */
}
}
}
}
/* we will repeat the whole thing for those particles where we didn't find enough neighbours */
do
{
i = FirstActiveParticle; /* beginn with this index */
do
{
for(j = 0; j < NTask; j++)
{
Send_count[j] = 0;
Exportflag[j] = -1;
}
/* do local particles and prepare export list */
for(nexport = 0; i >= 0; i = NextActiveParticle[i])
if(P[i].Type == 10 && P[i].TimeBin >= 0)
{
if(cs_hotngbs_evaluate(i, 0, &nexport, Send_count) < 0)
break;
}
#ifdef MYSORT
mysort_dataindex(DataIndexTable, nexport, sizeof(struct data_index), data_index_compare);
#else
qsort(DataIndexTable, nexport, sizeof(struct data_index), data_index_compare);
#endif
MPI_Allgather(Send_count, NTask, MPI_INT, Sendcount_matrix, NTask, MPI_INT, MPI_COMM_WORLD);
for(j = 0, nimport = 0, Recv_offset[0] = 0, Send_offset[0] = 0; j < NTask; j++)
{
Recv_count[j] = Sendcount_matrix[j * NTask + ThisTask];
nimport += Recv_count[j];
if(j > 0)
{
Send_offset[j] = Send_offset[j - 1] + Send_count[j - 1];
Recv_offset[j] = Recv_offset[j - 1] + Recv_count[j - 1];
}
}
HotNgbsGet = (struct hotngbs_in *) mymalloc(nimport * sizeof(struct hotngbs_in));
HotNgbsIn = (struct hotngbs_in *) mymalloc(nexport * sizeof(struct hotngbs_in));
/* prepare particle data for export */
for(j = 0; j < nexport; j++)
{
place = DataIndexTable[j].Index;
HotNgbsIn[j].Pos[0] = P[place].Pos[0];
HotNgbsIn[j].Pos[1] = P[place].Pos[1];
HotNgbsIn[j].Pos[2] = P[place].Pos[2];
HotNgbsIn[j].HotHsml = SphP[place].HotHsml;
HotNgbsIn[j].Entropy = SphP[place].Entropy;
memcpy(HotNgbsIn[j].NodeList,
DataNodeList[DataIndexTable[j].IndexGet].NodeList, NODELISTLENGTH * sizeof(int));
}
for(ngrp = 1; ngrp < (1 << PTask); ngrp++)
{
sendTask = ThisTask;
recvTask = ThisTask ^ ngrp;
if(recvTask < NTask)
{
if(Send_count[recvTask] > 0 || Recv_count[recvTask] > 0)
{
/* get the particles */
MPI_Sendrecv(&HotNgbsIn[Send_offset[recvTask]],
Send_count[recvTask] * sizeof(struct hotngbs_in), MPI_BYTE,
recvTask, TAG_DENS_A,
&HotNgbsGet[Recv_offset[recvTask]],
Recv_count[recvTask] * sizeof(struct hotngbs_in), MPI_BYTE,
recvTask, TAG_DENS_A, MPI_COMM_WORLD, MPI_STATUS_IGNORE);
}
}
}
myfree(HotNgbsIn);
HotNgbsResult = (struct hotngbs_out *) mymalloc(nimport * sizeof(struct hotngbs_out));
HotNgbsOut = (struct hotngbs_out *) mymalloc(nexport * sizeof(struct hotngbs_out));
/* now do the particles that need to be exported */
for(j = 0; j < nimport; j++)
cs_hotngbs_evaluate(j, 1, &dummy, &dummy);
if(i < 0)
ndone_flag = 1;
else
ndone_flag = 0;
MPI_Allreduce(&ndone_flag, &ndone, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD);
/* get the result */
for(ngrp = 1; ngrp < (1 << PTask); ngrp++)
{
sendTask = ThisTask;
recvTask = ThisTask ^ ngrp;
if(recvTask < NTask)
{
if(Send_count[recvTask] > 0 || Recv_count[recvTask] > 0)
{
/* send the results */
MPI_Sendrecv(&HotNgbsResult[Recv_offset[recvTask]],
Recv_count[recvTask] * sizeof(struct hotngbs_out),
MPI_BYTE, recvTask, TAG_DENS_B,
&HotNgbsOut[Send_offset[recvTask]],
Send_count[recvTask] * sizeof(struct hotngbs_out),
MPI_BYTE, recvTask, TAG_DENS_B, MPI_COMM_WORLD, MPI_STATUS_IGNORE);
}
}
}
/* add the result to the local particles */
for(j = 0; j < nexport; j++)
{
place = DataIndexTable[j].Index;
SphP[place].da.dDensityAvg += HotNgbsOut[j].DensitySum;
SphP[place].ea.dEntropyAvg += HotNgbsOut[j].EntropySum;
SphP[place].HotNgbNum += HotNgbsOut[j].HotNgbNum;
}
myfree(HotNgbsOut);
myfree(HotNgbsResult);
myfree(HotNgbsGet);
}
while(ndone < NTask);
/* do final operations on results */
for(i = FirstActiveParticle, npleft = 0; i >= 0; i = NextActiveParticle[i])
{
if(P[i].Type == 10 && P[i].TimeBin >= 0)
{
#ifdef FLTROUNDOFFREDUCTION
SphP[i].da.DensityAvg = FLT(SphP[i].da.dDensityAvg);
SphP[i].ea.EntropyAvg = FLT(SphP[i].ea.dEntropyAvg);
#endif
if(SphP[i].HotNgbNum > 0)
{
SphP[i].da.DensityAvg /= SphP[i].HotNgbNum;
SphP[i].ea.EntropyAvg /= SphP[i].HotNgbNum;
}
else
{
SphP[i].da.DensityAvg = 0;
SphP[i].ea.EntropyAvg = 0;
}
/* now check whether we had enough neighbours */
if(SphP[i].HotNgbNum < (All.DesNumNgb - All.MaxNumHotNgbDeviation) ||
(SphP[i].HotNgbNum > (All.DesNumNgb + All.MaxNumHotNgbDeviation)))
{
/* need to redo this particle */
npleft++;
if(Left[i] > 0 && Right[i] > 0)
if((Right[i] - Left[i]) < 1.0e-3 * Left[i])
{
/* this one should be ok */
npleft--;
P[i].TimeBin = -P[i].TimeBin - 1; /* Mark as inactive */
continue;
}
if(SphP[i].HotNgbNum < (All.DesNumNgb - All.MaxNumHotNgbDeviation))
Left[i] = DMAX(SphP[i].HotHsml, Left[i]);
else
{
if(Right[i] != 0)
{
if(SphP[i].HotHsml < Right[i])
Right[i] = SphP[i].HotHsml;
}
else
Right[i] = SphP[i].HotHsml;
}
if(Left[i] > All.MaxHotHsmlParam * PPP[i].Hsml) /* prevent us from searching too far */
{
npleft--;
P[i].TimeBin = -P[i].TimeBin - 1; /* Mark as inactive */
/* Ad-hoc definition of SAvg and RhoAvg when there are no hot neighbours */
/* Note that a minimum nunmber of hot neighbours are required for promotion, see c_enrichment.c */
if(SphP[i].HotNgbNum == 0)
{
SphP[i].da.DensityAvg = SphP[i].d.Density / 100;
SphP[i].ea.EntropyAvg = SphP[i].Entropy * 1000;
printf("WARNING: Used ad-hoc values for SAvg and RhoAvg, No hot neighbours\n");
}
continue;
}
if(iter >= MAXITER_HOT - 10)
{
printf
("i=%d task=%d ID=%d Hsml=%g Left=%g Right=%g Ngbs=%g Right-Left=%g\n pos=(%g|%g|%g)\n",
i, ThisTask, P[i].ID, SphP[i].HotHsml, Left[i], Right[i],
(float) SphP[i].HotNgbNum, Right[i] - Left[i], P[i].Pos[0], P[i].Pos[1],
P[i].Pos[2]);
fflush(stdout);
}
if(Right[i] > 0 && Left[i] > 0)
SphP[i].HotHsml = pow(0.5 * (pow(Left[i], 3) + pow(Right[i], 3)), 1.0 / 3);
else
{
if(Right[i] == 0 && Left[i] == 0)
endrun(8188); /* can't occur */
if(Right[i] == 0 && Left[i] > 0)
SphP[i].HotHsml *= 1.26;
if(Right[i] > 0 && Left[i] == 0)
SphP[i].HotHsml /= 1.26;
}
}
else
P[i].TimeBin = -P[i].TimeBin - 1; /* Mark as inactive */
}
}
MPI_Allreduce(&npleft, &ntot, 1, MPI_INT, MPI_SUM, MPI_COMM_WORLD);
if(ntot > 0)
{
iter++;
if(iter > 0 && ThisTask == 0)
{
printf("hotngb iteration %d: need to repeat for %d particles.\n", iter, ntot);
fflush(stdout);
}
if(iter > MAXITER_HOT)
{
printf("failed to converge in hot-neighbour iteration\n");
fflush(stdout);
endrun(1155);
}
}
}
while(ntot > 0);
myfree(DataNodeList);
myfree(DataIndexTable);
myfree(Ngblist);
myfree(Right);
myfree(Left);
for(i = FirstActiveParticle; i >= 0; i = NextActiveParticle[i])
if(P[i].Type == 10)
{
P[i].Type = 0;
/* mark as active again */
if(P[i].TimeBin < 0)
P[i].TimeBin = -P[i].TimeBin - 1;
}
CPU_Step[CPU_HOTNGBS] += measure_time();
}
void read_ic(char *fname)
{
int i, num_files, rest_files, ngroups, gr, filenr, masterTask, lastTask, groupMaster;
double u_init, molecular_weight, dmax1, dmax2;
char buf[500];
CPU_Step[CPU_MISC] += measure_time();
#ifdef RESCALEVINI
if(ThisTask == 0 && RestartFlag == 0)
{
fprintf(stdout, "\nRescaling v_ini !\n\n");
fflush(stdout);
}
#endif
NumPart = 0;
N_gas = 0;
All.TotNumPart = 0;
num_files = find_files(fname);
#if defined(SAVE_HSML_IN_IC_ORDER) || defined(SUBFIND_RESHUFFLE_CATALOGUE)
NumPartPerFile = (long long *) mymalloc(num_files * sizeof(long long));
if(ThisTask == 0)
get_particle_numbers(fname, num_files);
MPI_Bcast(NumPartPerFile, num_files * sizeof(long long), MPI_BYTE, 0, MPI_COMM_WORLD);
#endif
rest_files = num_files;
while(rest_files > NTask)
{
sprintf(buf, "%s.%d", fname, ThisTask + (rest_files - NTask));
if(All.ICFormat == 3)
sprintf(buf, "%s.%d.hdf5", fname, ThisTask + (rest_files - NTask));
#if defined(SAVE_HSML_IN_IC_ORDER) || defined(SUBFIND_RESHUFFLE_CATALOGUE)
FileNr = ThisTask + (rest_files - NTask);
#endif
ngroups = NTask / All.NumFilesWrittenInParallel;
if((NTask % All.NumFilesWrittenInParallel))
ngroups++;
groupMaster = (ThisTask / ngroups) * ngroups;
for(gr = 0; gr < ngroups; gr++)
{
if(ThisTask == (groupMaster + gr)) /* ok, it's this processor's turn */
read_file(buf, ThisTask, ThisTask);
MPI_Barrier(MPI_COMM_WORLD);
}
rest_files -= NTask;
}
if(rest_files > 0)
{
distribute_file(rest_files, 0, 0, NTask - 1, &filenr, &masterTask, &lastTask);
if(num_files > 1)
{
sprintf(buf, "%s.%d", fname, filenr);
if(All.ICFormat == 3)
sprintf(buf, "%s.%d.hdf5", fname, filenr);
#if defined(SAVE_HSML_IN_IC_ORDER) || defined(SUBFIND_RESHUFFLE_CATALOGUE)
FileNr = filenr;
#endif
}
else
{
sprintf(buf, "%s", fname);
if(All.ICFormat == 3)
sprintf(buf, "%s.hdf5", fname);
#if defined(SAVE_HSML_IN_IC_ORDER) || defined(SUBFIND_RESHUFFLE_CATALOGUE)
FileNr = 0;
#endif
}
ngroups = rest_files / All.NumFilesWrittenInParallel;
if((rest_files % All.NumFilesWrittenInParallel))
ngroups++;
for(gr = 0; gr < ngroups; gr++)
{
if((filenr / All.NumFilesWrittenInParallel) == gr) /* ok, it's this processor's turn */
read_file(buf, masterTask, lastTask);
MPI_Barrier(MPI_COMM_WORLD);
}
}
#if defined(SUBFIND_RESHUFFLE_CATALOGUE)
subfind_reshuffle_free();
#endif
myfree_msg(CommBuffer, "CommBuffer");
if(header.flag_ic_info != FLAG_SECOND_ORDER_ICS)
{
/* this makes sure that masses are initialized in the case that the mass-block
is empty for this particle type */
for(i = 0; i < NumPart; i++)
{
if(All.MassTable[P[i].Type] != 0)
P[i].Mass = All.MassTable[P[i].Type];
}
}
#ifdef GENERATE_GAS_IN_ICS
int count, j;
double fac, d, a, b, rho;
if(RestartFlag == 0)
{
header.flag_entropy_instead_u = 0;
for(i = 0, count = 0; i < NumPart; i++)
if(P[i].Type == 1)
count++;
memmove(P + count, P, sizeof(struct particle_data) * NumPart);
NumPart += count;
N_gas += count;
if(N_gas > All.MaxPartSph)
{
printf("Task=%d ends up getting more SPH particles (%d) than allowed (%d)\n",
ThisTask, N_gas, All.MaxPartSph);
endrun(111);
}
fac = All.OmegaBaryon / All.Omega0;
rho = All.Omega0 * 3 * All.Hubble * All.Hubble / (8 * M_PI * All.G);
for(i = count, j = 0; i < NumPart; i++)
if(P[i].Type == 1)
{
P[j] = P[i];
d = pow(P[i].Mass / rho, 1.0 / 3);
a = 0.5 * All.OmegaBaryon / All.Omega0 * d;
b = 0.5 * (All.Omega0 - All.OmegaBaryon) / All.Omega0 * d;
P[j].Mass *= fac;
P[i].Mass *= (1 - fac);
P[j].Type = 0;
P[j].ID += 1000000000;
P[i].Pos[0] += a;
P[i].Pos[1] += a;
P[i].Pos[2] += a;
P[j].Pos[0] -= b;
P[j].Pos[1] -= b;
P[j].Pos[2] -= b;
j++;
}
All.MassTable[0] = fac * All.MassTable[1];
All.MassTable[1] *= (1 - fac);
}
#endif
#if defined(BLACK_HOLES) && defined(SWALLOWGAS)
if(RestartFlag == 0)
{
All.MassTable[5] = 0;
}
#endif
#ifdef SFR
if(RestartFlag == 0)
{
if(All.MassTable[4] == 0 && All.MassTable[0] > 0)
{
All.MassTable[0] = 0;
All.MassTable[4] = 0;
}
}
#endif
u_init = (1.0 / GAMMA_MINUS1) * (BOLTZMANN / PROTONMASS) * All.InitGasTemp;
u_init *= All.UnitMass_in_g / All.UnitEnergy_in_cgs; /* unit conversion */
if(All.InitGasTemp > 1.0e4) /* assuming FULL ionization */
molecular_weight = 4 / (8 - 5 * (1 - HYDROGEN_MASSFRAC));
else /* assuming NEUTRAL GAS */
molecular_weight = 4 / (1 + 3 * HYDROGEN_MASSFRAC);
u_init /= molecular_weight;
All.InitGasU = u_init;
if(RestartFlag == 0)
{
if(All.InitGasTemp > 0)
{
for(i = 0; i < N_gas; i++)
{
if(ThisTask == 0 && i == 0 && SphP[i].Entropy == 0)
printf("Initializing u from InitGasTemp !\n");
if(SphP[i].Entropy == 0)
SphP[i].Entropy = All.InitGasU;
/* Note: the coversion to entropy will be done in the function init(),
after the densities have been computed */
}
}
}
for(i = 0; i < N_gas; i++)
SphP[i].Entropy = DMAX(All.MinEgySpec, SphP[i].Entropy);
#ifdef EOS_DEGENERATE
for(i = 0; i < N_gas; i++)
SphP[i].u = 0;
#endif
MPI_Barrier(MPI_COMM_WORLD);
if(ThisTask == 0)
{
printf("reading done.\n");
fflush(stdout);
}
if(ThisTask == 0)
{
printf("Total number of particles : %d%09d\n\n",
(int) (All.TotNumPart / 1000000000), (int) (All.TotNumPart % 1000000000));
fflush(stdout);
}
CPU_Step[CPU_SNAPSHOT] += measure_time();
}
void palRefro( double zobs, double hm, double tdk, double pmb,
double rh, double wl, double phi, double tlr,
double eps, double * ref ) {
/*
* Fixed parameters
*/
/* 93 degrees in radians */
const double D93 = 1.623156204;
/* Universal gas constant */
const double GCR = 8314.32;
/* Molecular weight of dry air */
const double DMD = 28.9644;
/* Molecular weight of water vapour */
const double DMW = 18.0152;
/* Mean Earth radius (metre) */
const double S = 6378120.;
/* Exponent of temperature dependence of water vapour pressure */
const double DELTA = 18.36;
/* Height of tropopause (metre) */
const double HT = 11000.;
/* Upper limit for refractive effects (metre) */
const double HS = 80000.;
/* Numerical integration: maximum number of strips. */
const int ISMAX=16384l;
/* Local variables */
int is, k, n, i, j;
int optic, loop; /* booleans */
double zobs1,zobs2,hmok,tdkok,pmbok,rhok,wlok,alpha,
tol,wlsq,gb,a,gamal,gamma,gamm2,delm2,
tdc,psat,pwo,w,
c1,c2,c3,c4,c5,c6,r0,tempo,dn0,rdndr0,sk0,f0,
rt,tt,dnt,rdndrt,sine,zt,ft,dnts,rdndrp,zts,fts,
rs,dns,rdndrs,zs,fs,refold,z0,zrange,fb,ff,fo,fe,
h,r,sz,rg,dr,tg,dn,rdndr,t,f,refp,reft;
/* The refraction integrand */
#define refi(DN,RDNDR) RDNDR/(DN+RDNDR)
/* Transform ZOBS into the normal range. */
zobs1 = palDrange(zobs);
zobs2 = DMIN(fabs(zobs1),D93);
/* keep other arguments within safe bounds. */
hmok = DMIN(DMAX(hm,-1e3),HS);
tdkok = DMIN(DMAX(tdk,100.0),500.0);
pmbok = DMIN(DMAX(pmb,0.0),10000.0);
rhok = DMIN(DMAX(rh,0.0),1.0);
wlok = DMAX(wl,0.1);
alpha = DMIN(DMAX(fabs(tlr),0.001),0.01);
/* tolerance for iteration. */
tol = DMIN(DMAX(fabs(eps),1e-12),0.1)/2.0;
/* decide whether optical/ir or radio case - switch at 100 microns. */
optic = wlok < 100.0;
/* set up model atmosphere parameters defined at the observer. */
wlsq = wlok*wlok;
gb = 9.784*(1.0-0.0026*cos(phi+phi)-0.00000028*hmok);
if (optic) {
a = (287.6155+(1.62887+0.01360/wlsq)/wlsq) * 273.15e-6/1013.25;
} else {
a = 77.6890e-6;
}
gamal = (gb*DMD)/GCR;
gamma = gamal/alpha;
gamm2 = gamma-2.0;
delm2 = DELTA-2.0;
tdc = tdkok-273.15;
psat = pow(10.0,(0.7859+0.03477*tdc)/(1.0+0.00412*tdc)) *
(1.0+pmbok*(4.5e-6+6.0e-10*tdc*tdc));
if (pmbok > 0.0) {
pwo = rhok*psat/(1.0-(1.0-rhok)*psat/pmbok);
} else {
pwo = 0.0;
}
w = pwo*(1.0-DMW/DMD)*gamma/(DELTA-gamma);
c1 = a*(pmbok+w)/tdkok;
if (optic) {
c2 = (a*w+11.2684e-6*pwo)/tdkok;
} else {
c2 = (a*w+6.3938e-6*pwo)/tdkok;
}
c3 = (gamma-1.0)*alpha*c1/tdkok;
c4 = (DELTA-1.0)*alpha*c2/tdkok;
if (optic) {
c5 = 0.0;
c6 = 0.0;
} else {
c5 = 375463e-6*pwo/tdkok;
c6 = c5*delm2*alpha/(tdkok*tdkok);
}
/* conditions at the observer. */
r0 = S+hmok;
pal1Atmt(r0,tdkok,alpha,gamm2,delm2,c1,c2,c3,c4,c5,c6,
r0,&tempo,&dn0,&rdndr0);
sk0 = dn0*r0*sin(zobs2);
f0 = refi(dn0,rdndr0);
/* conditions in the troposphere at the tropopause. */
rt = S+DMAX(HT,hmok);
pal1Atmt(r0,tdkok,alpha,gamm2,delm2,c1,c2,c3,c4,c5,c6,
rt,&tt,&dnt,&rdndrt);
sine = sk0/(rt*dnt);
zt = atan2(sine,sqrt(DMAX(1.0-sine*sine,0.0)));
ft = refi(dnt,rdndrt);
/* conditions in the stratosphere at the tropopause. */
pal1Atms(rt,tt,dnt,gamal,rt,&dnts,&rdndrp);
sine = sk0/(rt*dnts);
zts = atan2(sine,sqrt(DMAX(1.0-sine*sine,0.0)));
fts = refi(dnts,rdndrp);
/* conditions at the stratosphere limit. */
rs = S+HS;
pal1Atms(rt,tt,dnt,gamal,rs,&dns,&rdndrs);
sine = sk0/(rs*dns);
zs = atan2(sine,sqrt(DMAX(1.0-sine*sine,0.0)));
fs = refi(dns,rdndrs);
/* variable initialization to avoid compiler warning. */
reft = 0.0;
/* integrate the refraction integral in two parts; first in the
* troposphere (k=1), then in the stratosphere (k=2). */
for (k=1; k<=2; k++) {
/* initialize previous refraction to ensure at least two iterations. */
refold = 1.0;
/* start off with 8 strips. */
is = 8;
/* start z, z range, and start and end values. */
if (k==1) {
z0 = zobs2;
zrange = zt-z0;
fb = f0;
ff = ft;
} else {
z0 = zts;
zrange = zs-z0;
fb = fts;
ff = fs;
}
/* sums of odd and even values. */
fo = 0.0;
fe = 0.0;
/* first time through the loop we have to do every point. */
n = 1;
/* start of iteration loop (terminates at specified precision). */
loop = 1;
while (loop) {
/* strip width. */
h = zrange/((double)is);
/* initialize distance from earth centre for quadrature pass. */
if (k == 1) {
r = r0;
} else {
r = rt;
}
/* one pass (no need to compute evens after first time). */
for (i=1; i<is; i+=n) {
/* sine of observed zenith distance. */
sz = sin(z0+h*(double)(i));
/* find r (to the nearest metre, maximum four iterations). */
if (sz > 1e-20) {
w = sk0/sz;
rg = r;
dr = 1.0e6;
j = 0;
while ( fabs(dr) > 1.0 && j < 4 ) {
j++;
if (k==1) {
pal1Atmt(r0,tdkok,alpha,gamm2,delm2,
c1,c2,c3,c4,c5,c6,rg,&tg,&dn,&rdndr);
} else {
pal1Atms(rt,tt,dnt,gamal,rg,&dn,&rdndr);
}
dr = (rg*dn-w)/(dn+rdndr);
rg = rg-dr;
}
r = rg;
}
/* find the refractive index and integrand at r. */
if (k==1) {
pal1Atmt(r0,tdkok,alpha,gamm2,delm2,
c1,c2,c3,c4,c5,c6,r,&t,&dn,&rdndr);
} else {
pal1Atms(rt,tt,dnt,gamal,r,&dn,&rdndr);
}
f = refi(dn,rdndr);
/* accumulate odd and (first time only) even values. */
if (n==1 && i%2 == 0) {
fe += f;
} else {
fo += f;
}
}
/* evaluate the integrand using simpson's rule. */
refp = h*(fb+4.0*fo+2.0*fe+ff)/3.0;
/* has the required precision been achieved (or can't be)? */
if (fabs(refp-refold) > tol && is < ISMAX) {
/* no: prepare for next iteration.*/
/* save current value for convergence test. */
refold = refp;
/* double the number of strips. */
is += is;
/* sum of all current values = sum of next pass's even values. */
fe += fo;
/* prepare for new odd values. */
fo = 0.0;
/* skip even values next time. */
n = 2;
} else {
/* yes: save troposphere component and terminate the loop. */
if (k==1) reft = refp;
loop = 0;
}
}
}
/* result. */
*ref = reft+refp;
if (zobs1 < 0.0) *ref = -(*ref);
}
bool rkqs(double y[], double dydx[], int n, double *x, double htry, double eps,
double yscal[], double *hdid, double *hnext,
void (*derivs)(double , double [], double [], int, long, double), long node)
{
void rkck(double y[], double dydx[], int n, double x, double h,
double yout[], double yerr[], void (*derivs)(double , double [], double [], int, long, double), long node);
int i;
double errmax,h,htemp,xnew,*yerr,*ytemp;
bool success = false;
double *epsi;
// y[] - c(step)
// dydx[] - dcdt(step)
// yscal - scaling of errors
yerr=dvector(1,n);
ytemp=dvector(1,n);
h=htry; //set stepsize to initial trial value
epsi=dvector(1,n);
for (i=1;i<=n;i++)
epsi[i]=eps;
//epsi[2]= eps*1000;
//epsi[20]= eps*1000;
//epsi[21]= eps*1000;
for (;;) {
rkck(y,dydx,n,*x,h,ytemp,yerr,derivs, node); // take a step --> update yerr, ytemp
//evaluate accuracy
errmax=0.0;
//for (i=1;i<=n;i++)
//yscal[i]=fabs(y[i])+fabs(dydx[i]*h)+TINY; // for Runge Kutta, this is done in driver routine odeint
//yscal[i]= eps + eps*DMAX(fabs(y[i]),fabs(ytemp[i]));
//yscal[i]= 0 + eps*fabs(y[i]);
for (i=1;i<=n;i++)
//if(i==2 || i==20 || i==21 )
// errmax=DMAX(errmax,errmax/10); // find max rel. error |d0/d1|
// errmax=DMAX(errmax, fabs(yerr[i]/yscal[i])); // find max rel. error |d0/d1|
errmax=DMAX(errmax, fabs(yerr[i]/yscal[i])/(epsi[i])); // find max rel. error |d0/d1|
//errmax += pow(yerr[i]/yscal[i],2);
//errmax = DMAX(errmax, pow(yerr[i]/yscal[i],2));
//errmax /= eps; // SCALE relative to required tolerance
//errmax = sqrt(errmax/n);
//errmax = sqrt(errmax);
if(DEBUGRK>0){
rkqs_yerr << "node" << node <<" " << *x << " " << h << " ";
for (i=1;i<=25;i++) rkqs_yerr << " " << fabs(yerr[ idcs[i] ]) ;
rkqs_yerr << "\n";
rkqs_ytemp << "node" << node <<" " << *x << " " << h << " ";
for (i=1;i<=25;i++) rkqs_ytemp << " " << ytemp[ idcs[i] ] ;
rkqs_ytemp << "\n";
rkqs_errmax << "node" << node <<" " << *x << " " << h << " ";
for (i=1;i<=25;i++) {
rkqs_errmax << " " << fabs((yerr[ idcs[i] ] / yscal[ idcs[i] ]))/epsi[i];
}
rkqs_errmax << " " << errmax;
rkqs_errmax << "\n";
}
if (errmax <= 1.0) break; // success, break and compute next step size
// failed, truncation error too large
htemp=SAFETY*h*pow(errmax,PSHRNK); // reduce step size
h=(h >= 0.0 ? (htemp,0.1*h) : DMIN(htemp,0.1*h)); // no more than factor of 1/10
xnew=(*x)+h;
if (xnew == *x){
std::cout << "step size underflow in rkqs" << "\n";
//nrerror("stepsize underflow in rkqs");
free_dvector(ytemp,1,n);
free_dvector(yerr,1,n);
success = false;
return success;
}
}
if(DEBUGRK>0){
rkqs_yerr << "\n";
rkqs_ytemp << "\n";
rkqs_errmax << "\n";
}
if (errmax > ERRCON) *hnext=SAFETY*h*pow(errmax,PGROW);
else *hnext=5.0*h;
//if(*hnext > 3500) *hnext=3500;
*x += (*hdid=h);
for (i=1;i<=n;i++) y[i]=ytemp[i]; // update y[i] concentration vector
free_dvector(ytemp,1,n);
free_dvector(yerr,1,n);
free_dvector(epsi,1,n);
success = true;
return success;
}
void
_pl_h_set_attributes (S___(Plotter *_plotter))
{
double desired_hpgl_pen_width;
double width, height, diagonal_p1_p2_distance;
/* first, compute desired linewidth in scaled HP-GL coors (i.e. as
fraction of diagonal distance between P1,P2) */
width = (double)(HPGL_SCALED_DEVICE_RIGHT - HPGL_SCALED_DEVICE_LEFT);
height = (double)(HPGL_SCALED_DEVICE_TOP - HPGL_SCALED_DEVICE_BOTTOM);
diagonal_p1_p2_distance = sqrt (width * width + height * height);
desired_hpgl_pen_width
= _plotter->drawstate->device_line_width / diagonal_p1_p2_distance;
/* if plotter's policy on dashing lines needs to be adjusted, do so */
if (_plotter->hpgl_version == 2
&& (_plotter->drawstate->dash_array_in_effect
|| (_plotter->hpgl_line_type !=
_hpgl_line_type[_plotter->drawstate->line_type])
|| (_plotter->hpgl_pen_width != desired_hpgl_pen_width)))
/* HP-GL/2 case, and we need to emit HP-GL/2 instructions that define a
new line type. Why? Several possibilities: (1) user called
linedash(), in which case we always define the line type here, or
(2) user called linemod() to change the canonical line style, in
which case we need to define a line type here containing the
corresponding dash array, or (3) user called linewidth(), in which
case we need to define the new line type here because (in the
canonical line style case) the dash lengths we'll use depend on the
line width. */
{
double min_sing_val, max_sing_val;
double *dashbuf, dash_cycle_length;
int i, num_dashes;
/* compute minimum singular value of user->device coordinate map,
which we use as a multiplicative factor to convert line widths
(cf. g_linewidth.c), dash lengths, etc. */
_matrix_sing_vals (_plotter->drawstate->transform.m,
&min_sing_val, &max_sing_val);
if (_plotter->drawstate->dash_array_in_effect)
/* user invoked linedash() */
{
num_dashes = _plotter->drawstate->dash_array_len;
if (num_dashes > 0)
dashbuf = (double *)_pl_xmalloc (num_dashes * sizeof(double));
else
dashbuf = NULL; /* solid line */
dash_cycle_length = 0.0;
for (i = 0; i < num_dashes; i++)
{
/* convert dash length to device coordinates */
dashbuf[i] = min_sing_val * _plotter->drawstate->dash_array[i];
dash_cycle_length += dashbuf[i];
}
}
else
/* have a canonical line type, but since this is HP-GL/2, rather
than pre-HP-GL/2 or generic HP-GL, we'll implement it as a
user-defined line type for accuracy */
{
if (_plotter->drawstate->line_type == PL_L_SOLID)
{
num_dashes = 0;
dash_cycle_length = 0.0;
dashbuf = NULL;
}
else
{
const int *dash_array;
double scale;
num_dashes =
_pl_g_line_styles[_plotter->drawstate->line_type].dash_array_len;
dashbuf = (double *)_pl_xmalloc (num_dashes * sizeof(double));
/* scale the array of integers by line width (actually by
floored line width; see comments at head of file) */
dash_array = _pl_g_line_styles[_plotter->drawstate->line_type].dash_array;
scale = DMAX(MIN_DASH_UNIT,_plotter->drawstate->device_line_width);
dash_cycle_length = 0.0;
for (i = 0; i < num_dashes; i++)
{
dashbuf[i] = scale * dash_array[i];
dash_cycle_length += dashbuf[i];
}
}
}
if (num_dashes == 0 || dash_cycle_length == 0.0)
/* just switch to solid line type */
{
strcpy (_plotter->data->page->point, "LT;");
_update_buffer (_plotter->data->page);
_plotter->hpgl_line_type = HPGL_L_SOLID;
}
else
/* create user-defined line-type, and switch to it */
{
bool odd_length = (num_dashes & 1 ? true : false);
/* create user-defined line type */
sprintf (_plotter->data->page->point, "UL%d",
SPECIAL_HPGL_LINE_TYPE);
_update_buffer (_plotter->data->page);
for (i = 0; i < num_dashes; i++)
{
sprintf (_plotter->data->page->point, ",%.3f",
/* dash length as frac of iteration interval */
100.0 * (odd_length ? 0.5 : 1.0)
* dashbuf[i] / dash_cycle_length);
_update_buffer (_plotter->data->page);
}
if (odd_length)
/* if an odd number of dashes, emit the dash array twice
(HP-GL/2 doesn't handle odd-length patterns the way that
Postscript does, so an even-length pattern is better) */
{
for (i = 0; i < num_dashes; i++)
{
sprintf (_plotter->data->page->point, ",%.3f",
/* dash length as frac of iteration interval */
100.0 * (odd_length ? 0.5 : 1.0)
* dashbuf[i] / dash_cycle_length);
_update_buffer (_plotter->data->page);
}
}
sprintf (_plotter->data->page->point, ";");
_update_buffer (_plotter->data->page);
/* switch to new line type */
{
double width, height, diagonal_p1_p2_distance;
double iter_interval;
/* specify iteration interval as percentage of P1-P2 distance */
width = (double)(HPGL_SCALED_DEVICE_RIGHT-HPGL_SCALED_DEVICE_LEFT);
height = (double)(HPGL_SCALED_DEVICE_TOP-HPGL_SCALED_DEVICE_BOTTOM);
diagonal_p1_p2_distance = sqrt (width * width + height * height);
iter_interval = 100 * (odd_length ? 2 : 1) * (dash_cycle_length/diagonal_p1_p2_distance);
sprintf (_plotter->data->page->point, "LT%d,%.4f;",
SPECIAL_HPGL_LINE_TYPE, iter_interval);
_update_buffer (_plotter->data->page);
if (_plotter->drawstate->dash_array_in_effect)
_plotter->hpgl_line_type = SPECIAL_HPGL_LINE_TYPE;
else
/* keep track of plotter's line type as if it were
one of the built-in ones */
_plotter->hpgl_line_type =
_hpgl_line_type[_plotter->drawstate->line_type];
}
}
free (dashbuf);
}
/* Not HP-GL/2, so the only line types at our disposal are HP-GL's
traditional line types. Check whether we need to switch. */
if (_plotter->hpgl_version < 2
&& ((_plotter->hpgl_line_type !=
_hpgl_line_type[_plotter->drawstate->line_type])
|| /* special case #1, mapped to "shortdashed" */
(_plotter->drawstate->dash_array_in_effect
&& _plotter->drawstate->dash_array_len == 2
&& (_plotter->drawstate->dash_array[1]
== _plotter->drawstate->dash_array[0]))
|| /* special case #2, mapped to "dotted" */
(_plotter->drawstate->dash_array_in_effect
&& _plotter->drawstate->dash_array_len == 2
&& (_plotter->drawstate->dash_array[1]
> (3 - FUZZ) * _plotter->drawstate->dash_array[0])
&& (_plotter->drawstate->dash_array[1]
< (3 + FUZZ) * _plotter->drawstate->dash_array[0]))))
/* switch to one of HP-GL's traditional line types */
{
double dash_cycle_length, iter_interval;
double min_sing_val, max_sing_val;
int line_type;
if (_plotter->drawstate->dash_array_in_effect
&& _plotter->drawstate->dash_array_len == 2
&& (_plotter->drawstate->dash_array[1]
== _plotter->drawstate->dash_array[0]))
/* special case #1, user-specified dashing (equal on/off lengths):
treat effectively as "shortdashed" line mode */
{
/* Minimum singular value is the nominal device-frame line width
divided by the actual user-frame line-width (see
g_linewidth.c), so it's the user->device frame conversion
factor. */
_matrix_sing_vals (_plotter->drawstate->transform.m,
&min_sing_val, &max_sing_val);
dash_cycle_length =
min_sing_val * 2.0 * _plotter->drawstate->dash_array[0];
line_type = PL_L_SHORTDASHED;
}
else if (_plotter->drawstate->dash_array_in_effect
&& _plotter->drawstate->dash_array_len == 2
&& (_plotter->drawstate->dash_array[1]
> (3 - FUZZ) * _plotter->drawstate->dash_array[0])
&& (_plotter->drawstate->dash_array[1]
< (3 + FUZZ) * _plotter->drawstate->dash_array[0]))
/* special case #2, user-specified dashing (dash on length = 1/4 of
cycle length): treat effectively as "dotted" line mode */
{
/* Minimum singular value is the nominal device-frame line width
divided by the actual user-frame line-width (see
g_linewidth.c), so it's the user->device frame conversion
factor. */
_matrix_sing_vals (_plotter->drawstate->transform.m,
&min_sing_val, &max_sing_val);
dash_cycle_length =
min_sing_val * 2.0 * 4.0 * _plotter->drawstate->dash_array[0];
line_type = PL_L_DOTTED;
}
else
/* general case: user must have changed canonical line types by
invoking linemod(); will implement new line style as one of the
traditional HP-GL line types. */
{
const int *dash_array;
int i, num_dashes;
double scale;
dash_array = _pl_g_line_styles[_plotter->drawstate->line_type].dash_array;
num_dashes =
_pl_g_line_styles[_plotter->drawstate->line_type].dash_array_len;
/* compute iter interval in device coors, scaling by floored line
width (see comments at head of file) */
scale = DMAX(MIN_DASH_UNIT,_plotter->drawstate->device_line_width);
if (scale < 1.0)
scale = 1.0;
dash_cycle_length = 0.0;
for (i = 0; i < num_dashes; i++)
dash_cycle_length += scale * dash_array[i];
line_type = _plotter->drawstate->line_type;
}
/* compute iteration interval as percentage of P1-P2 distance */
{
double width, height, diagonal_p1_p2_distance;
width = (double)(HPGL_SCALED_DEVICE_RIGHT-HPGL_SCALED_DEVICE_LEFT);
height = (double)(HPGL_SCALED_DEVICE_TOP-HPGL_SCALED_DEVICE_BOTTOM);
diagonal_p1_p2_distance = sqrt (width * width + height * height);
iter_interval = 100 * (dash_cycle_length/diagonal_p1_p2_distance);
}
switch (line_type)
{
case PL_L_SOLID:
/* "solid" */
strcpy (_plotter->data->page->point, "LT;");
break;
case PL_L_DOTTED:
/* "dotted": emulate dots by selecting shortdashed pattern with a
short iteration interval */
sprintf (_plotter->data->page->point,
"LT%d,%.4f;",
HPGL_L_SHORTDASHED,
0.5 * iter_interval);
break;
case PL_L_DOTDOTDOTDASHED:
/* not a native line type before HP-GL/2; use "dotdotdashed" */
sprintf (_plotter->data->page->point,
"LT%d,%.4f;",
HPGL_L_DOTDOTDASHED,
iter_interval);
break;
default:
sprintf (_plotter->data->page->point,
"LT%d,%.4f;",
_hpgl_line_type[_plotter->drawstate->line_type],
iter_interval);
}
_update_buffer (_plotter->data->page);
_plotter->hpgl_line_type =
_hpgl_line_type[_plotter->drawstate->line_type];
}
/* if plotter's line attributes don't agree with what they should be,
adjust them (HP-GL/2 only) */
if (_plotter->hpgl_version == 2)
{
if ((_plotter->hpgl_cap_style
!= _hpgl_cap_style[_plotter->drawstate->cap_type])
|| (_plotter->hpgl_join_style
!= _hpgl_join_style[_plotter->drawstate->join_type]))
{
sprintf (_plotter->data->page->point, "LA1,%d,2,%d;",
_hpgl_cap_style[_plotter->drawstate->cap_type],
_hpgl_join_style[_plotter->drawstate->join_type]);
_update_buffer (_plotter->data->page);
_plotter->hpgl_cap_style =
_hpgl_cap_style[_plotter->drawstate->cap_type];
_plotter->hpgl_join_style =
_hpgl_join_style[_plotter->drawstate->join_type];
}
}
/* if plotter's miter limit doesn't agree with what it should be, update
it (HP-GL/2 only) */
if (_plotter->hpgl_version == 2
&& _plotter->hpgl_miter_limit != _plotter->drawstate->miter_limit)
{
double new_limit = _plotter->drawstate->miter_limit;
int new_limit_integer;
if (new_limit > 32767.0) /* clamp */
new_limit = 32767.0;
else if (new_limit < 1.0)
new_limit = 1.0;
new_limit_integer = (int)new_limit; /* floor */
sprintf (_plotter->data->page->point, "LA3,%d;", new_limit_integer);
_update_buffer (_plotter->data->page);
_plotter->hpgl_miter_limit = _plotter->drawstate->miter_limit;
}
/* if plotter's pen width doesn't agree with what it should be (i.e. the
device-frame version of our line width), update it (HP-GL/2 only) */
if (_plotter->hpgl_version == 2)
{
if (_plotter->hpgl_pen_width != desired_hpgl_pen_width)
{
sprintf (_plotter->data->page->point, "PW%.4f;",
100.0 * desired_hpgl_pen_width);
_update_buffer (_plotter->data->page);
_plotter->hpgl_pen_width = desired_hpgl_pen_width;
}
}
}
/*extern int kmax,kount;
extern double *xp,**yp,dxsav;
*/
bool odeint(double ystart[], int nvar, double x1, double x2, double eps, double h1,
double hmin, double *nexth, int *nok, int *nbad,
void (*derivs)(double, double [], double [], int, long, double),
bool (*stifbs)(double [], double [], int, double *, double, double, double [],
double *, double *, void (*)(double, double [], double [], int, long, double), long),
bool (*rkqs)(double [], double [], int, double *, double , double , double [],
double *, double *, void (*)(double , double [], double [], int, long, double),long),
long node, int SolverType)
{
int nstp,i;
// double xsav,x,hnext,hdid,h;
double x,hdid,hnext,h;
double *yscal,*y,*dydx;
bool success=false;
//if(TSTEPINFO>0){
// if(aktueller_zeitschritt = 1)
// tstepinfo.open("tstepinfo.txt");
// else
// tstepinfo.open("tstepinfo.txt", std::ios::app);
// tstepinfo << "Timestep: " << aktueller_zeitschritt << " Time: " << x1 << " Node: " << node << "\n";
//}
// if(DEBUGRK>0){
//
// odeint_derivs.precision(12);
// odeint_derivs.open("odeint_derivs.txt");
// odeint_yscal.precision(12);
// odeint_yscal.open("odeint_yscal.txt");
// odeint_ystart.precision(12);
// odeint_ystart.open("odeint_ystart.txt");
// rkqs_yerr.precision(12);
// rkqs_yerr.open("rkqs_yerr.txt");
// rkqs_ytemp.precision(12);
// rkqs_ytemp.open("rkqs_ytemp.txt");
// rkqs_errmax.precision(12);
// rkqs_errmax.open("rkqs_errmax.txt");
// rkck_derivs.precision(12);
// rkck_derivs.open("rkck_derivs.txt");
// rkck_ytemp.precision(12);
// rkck_ytemp.open("rkck_ytemp.txt");
//}
// ystart[1..nvar] starting values
// nvar = no. species
// x1 ... x2 = time interval
// eps required accuracy
// h1 first trial step size
// hmin min step size
// nexth next estimated step size
// nok, no of good steps
// nbad no of bad steps
yscal=dvector(1,nvar); // scaling of error
y=dvector(1,nvar); // to store start concentrations
dydx=dvector(1,nvar); // to store derivatives dcdt
x=x1; // current time during time stepping, start with x1 = t0
h=SIGN(h1,x2-x1);
// *nok = (*nbad) = kount = 0;
*nok = (*nbad) = 0;
// to store start concentrations
for (i=1;i<=nvar;i++) y[i]=ystart[i];
//if(DEBUGRK>0){
// odeint_derivs << "T_start: " << x1 << ", h0: " << h << ", T_end: " << x2 << "\n";
// odeint_ystart << "T_start: " << x1 << ", h0: " << h << ", T_end: " << x2 << "\n";
// odeint_yscal << "T_start: " << x1 << ", h0: " << h << ", T_end: " << x2 << "\n";
//rkqs_yerr << "T_start: " << x1 << ", h0: " << h << ", T_end: " << x2 << "\n";
//rkqs_ytemp << "T_start: " << x1 << ", h0: " << h << ", T_end: " << x2 << "\n";
//rkqs_errmax << "T_start: " << x1 << ", h0: " << h << ", T_end: " << x2 << "\n";
//rkck_derivs << "T_start: " << x1 << ", h0: " << h << ", T_end: " << x2 << "\n";
//rkck_ytemp << "T_start: " << x1 << ", h0: " << h << ", T_end: " << x2 << "\n";
// odeint_ystart << "node" << node <<" " << x << " " << h << " " ;
// for (i=1;i<=25;i++) odeint_ystart << " " << y[ idcs[i] ] ;
// odeint_ystart << "\n";
//}
//no storage of intermediate results
//if (kmax > 0) xsav=x-dxsav*2.0;
for (nstp=1;nstp<=MAXSTEP;nstp++)
{
// calculate derivatives with external user-provided function */
(*derivs)(x,y,dydx,nvar,node, h);
//if(DEBUGRK>0){
// odeint_derivs << "node" << node << " " << x << " ";
// odeint_derivs << h <<" ";
// for (i=1;i<=25;i++) odeint_derivs << " " << dydx[ idcs[i] ] ;
// odeint_derivs << "\n";
//}
// Preconditioning
// Scaling used to monitor accuracy
if(SolverType==1) {
for (i=1;i<=nvar;i++) yscal[i]=DMAX(1,fabs(y[i])); // recommended for stiff problems
//for (i=1;i<=nvar;i++) yscal[i]=DMAX(1.0,fabs(y[i])); // recommended for stiff problems
}
else if(SolverType==2){
//for (i=1;i<=nvar;i++) yscal[i]=DMAX(1,fabs(y[i])); // recommended for stiff problems
for (i=1;i<=nvar;i++) yscal[i]=fabs(y[i])+fabs(dydx[i]*h)+TINY; // for Runge Kutta
}
//if(DEBUGRK>0){
//
// odeint_yscal << "node" << node <<" " << x << " ";
// odeint_yscal << h <<" ";
// for (i=1;i<=25;i++) odeint_yscal << " " << yscal[ idcs[i] ] ;
// odeint_yscal << "\n";
//}
//no storage of intermediate results
//if (kmax > 0 && kount < kmax-1 && fabs(x-xsav) > fabs(dxsav)) {
// xp[++kount]=x;
// for (i=1;i<=nvar;i++) yp[i][kount]=y[i];
// xsav=x;
//}
// if stepsize can overshoot, limit to x2-x
if ((x+h-x2)*(x+h-x1) > 0.0) h=x2-x;
// call stepper
if(SolverType==1){ // stiff burlisch-stoer
success = (*stifbs)(y,dydx,nvar,&x,h,eps,yscal,&hdid,&hnext,derivs, node);
if(success==0) {
free_dvector(dydx,1,nvar);
free_dvector(y,1,nvar);
free_dvector(yscal,1,nvar);
return success;
}
}
else if(SolverType==2){ // Runge Kutta
success = (*rkqs)(y,dydx,nvar,&x,h,eps,yscal,&hdid,&hnext,derivs,node);
if(success==0) {
free_dvector(dydx,1,nvar);
free_dvector(y,1,nvar);
free_dvector(yscal,1,nvar);
return success;
}
}
//if(DEBUGRK>0){
// odeint_ystart << "node" << node <<" " << x << " " << hdid << " " ;
// for (i=1;i<=25;i++) odeint_ystart << " " << y[ idcs[i] ] ;
// odeint_ystart << "\n";
//}
// save info on success or failure
if (hdid == h) ++(*nok); else ++(*nbad);
if ((x-x2)*(x2-x1) >= 0.0)
{
for (i=1;i<=nvar;i++) ystart[i]=y[i];
//if (kmax) {
// xp[++kount]=x;
// for (i=1;i<=nvar;i++) yp[i][kount]=y[i];
//}
free_dvector(dydx,1,nvar);
free_dvector(y,1,nvar);
free_dvector(yscal,1,nvar);
*nexth=hnext;
success = true;
//if(DEBUGRK>0){
// odeint_ystart.close();
// odeint_derivs.close();
// odeint_yscal.close();
// rkqs_yerr.close();
// rkqs_ytemp.close();
// rkqs_errmax.close();
// rkck_derivs.close();
// rkck_ytemp.close();
//}
return success;
}
if (fabs(hnext) <= hmin) //CB
{
std::cout << "Step size too small in odeint" << "\n";
//nrerror("Step size too small in odeint");
free_dvector(dydx,1,nvar);
free_dvector(y,1,nvar);
free_dvector(yscal,1,nvar);
success = false;
return success;
}
h=hnext;
}
//CB
std::cout << "Too many steps in routine odeint" << "\n";
//nrerror("Too many steps in routine odeint");
free_dvector(dydx,1,nvar);
free_dvector(y,1,nvar);
free_dvector(yscal,1,nvar);
success = false;
return success;
}
void add_along_lines_of_sight(void)
{
int n, bin, i, iz0, iz1, iz;
double dx, dy, dz, r, r2, ne, nh0, nHeII, utherm, temp, meanWeight;
double u, wk, weight, a3inv, h3inv;
double z0, z1, dmax1, dmax2;
for(i = 0; i < PIXELS; i++)
{
Los->Rho[i] = 0;
Los->Vpec[i] = 0;
Los->Temp[i] = 0;
Los->Metallicity[i] = 0;
Los->RhoHI[i] = 0;
Los->NHI[i] = 0;
Los->VpecHI[i] = 0;
Los->TempHI[i] = 0;
Los->TauHI[i] = 0;
Los->RhoHeII[i] = 0;
Los->NHeII[i] = 0;
Los->VpecHeII[i] = 0;
Los->TempHeII[i] = 0;
Los->TauHeII[i] = 0;
}
a3inv = 1.0 / (All.Time * All.Time * All.Time);
for(n = 0; n < N_gas; n++)
{
if(P[n].Type == 0)
{
dx = los_periodic(P[n].Pos[Los->xaxis] - Los->Xpos);
dy = los_periodic(P[n].Pos[Los->yaxis] - Los->Ypos);
r2 = dx * dx + dy * dy;
if(r2 < PPP[n].Hsml * PPP[n].Hsml)
{
z0 = (P[n].Pos[Los->zaxis] - PPP[n].Hsml) / All.BoxSize * PIXELS;
z1 = (P[n].Pos[Los->zaxis] + PPP[n].Hsml) / All.BoxSize * PIXELS;
iz0 = (int) z0;
iz1 = (int) z1;
if(z0 < 0)
iz0 -= 1;
for(iz = iz0; iz <= iz1; iz++)
{
dz = los_periodic((iz + 0.5) / PIXELS * All.BoxSize - P[n].Pos[Los->zaxis]);
r = sqrt(r2 + dz * dz);
if(PPP[n].Hsml > All.BoxSize)
{
printf("Here:%d n=%d %g\n", ThisTask, n, PPP[n].Hsml);
endrun(89);
}
if(r < PPP[n].Hsml)
{
u = r / PPP[n].Hsml;
h3inv = 1.0 / (PPP[n].Hsml * PPP[n].Hsml * PPP[n].Hsml);
if(u < 0.5)
wk = h3inv * (KERNEL_COEFF_1 + KERNEL_COEFF_2 * (u - 1) * u * u);
else
wk = h3inv * KERNEL_COEFF_5 * (1.0 - u) * (1.0 - u) * (1.0 - u);
bin = iz;
while(bin >= PIXELS)
bin -= PIXELS;
while(bin < 0)
bin += PIXELS;
ne = SphP[n].Ne;
utherm = DMAX(All.MinEgySpec,
SphP[n].Entropy / GAMMA_MINUS1 * pow(SphP[n].d.Density *
a3inv, GAMMA_MINUS1));
AbundanceRatios(utherm, SphP[n].d.Density * a3inv, &ne, &nh0, &nHeII);
meanWeight = 4.0 / (3 * HYDROGEN_MASSFRAC + 1 + 4 * HYDROGEN_MASSFRAC * ne);
temp = meanWeight * PROTONMASS / BOLTZMANN * GAMMA_MINUS1 * utherm
* All.UnitEnergy_in_cgs / All.UnitMass_in_g;
/* do total gas */
weight = P[n].Mass * wk;
Los->Rho[bin] += weight;
Los->Metallicity[bin] += P[n].Metallicity * weight;
Los->Temp[bin] += temp * weight;
Los->Vpec[bin] += P[n].Vel[Los->zaxis] * weight;
/* do neutral hydrogen */
weight = nh0 * HYDROGEN_MASSFRAC * P[n].Mass * wk;
Los->RhoHI[bin] += weight;
Los->TempHI[bin] += temp * weight;
Los->VpecHI[bin] += P[n].Vel[Los->zaxis] * weight;
/* do HeII */
weight = 4 * nHeII * HYDROGEN_MASSFRAC * P[n].Mass * wk;
Los->RhoHeII[bin] += weight;
Los->TempHeII[bin] += temp * weight;
Los->VpecHeII[bin] += P[n].Vel[Los->zaxis] * weight;
}
}
}
}
}
}
void
array_bounds (const Point *p, int length,
bool transpose_axes, int clip_mode,
double *min_x, double *min_y, double *max_x, double *max_y,
bool spec_min_x, bool spec_min_y,
bool spec_max_x, bool spec_max_y)
{
/* keep compilers happy */
double user_min_x = 0.0, user_min_y = 0.0;
double user_max_x = 0.0, user_max_y = 0.0;
double local_min_x = 0.0, local_min_y = 0.0;
double local_max_x = 0.0, local_max_y = 0.0;
double xx, yy, oldxx, oldyy;
bool point_seen = false;
int i;
if (length == 0)
/* adopt a convention */
{
if (!spec_min_x)
*min_x = 0.0;
if (!spec_min_y)
*min_y = 0.0;
if (!spec_max_x)
*max_x = *min_x;
if (!spec_max_y)
*max_y = *min_y;
return;
}
if (spec_min_x)
user_min_x = *min_x;
else /* won't use user_min_x */
local_min_x = DBL_MAX;
if (spec_max_x)
user_max_x = *max_x;
else /* won't use user_max_x */
local_max_x = -(DBL_MAX);
/* special case: user specified both bounds, but min > max (reversed axis) */
if (spec_min_x && spec_max_x && user_min_x > user_max_x)
{
double tmp;
tmp = user_min_x;
user_min_x = user_max_x;
user_max_x = tmp;
}
if (spec_min_y)
user_min_y = *min_y;
else
local_min_y = DBL_MAX; /* won't use user_min_y */
if (spec_max_y)
user_max_y = *max_y;
else /* won't use user_max_y */
local_max_y = -(DBL_MAX);
/* special case: user specified both bounds, but min > max (reversed axis) */
if (spec_min_y && spec_max_y && user_min_y > user_max_y)
{
double tmp;
tmp = user_min_y;
user_min_y = user_max_y;
user_max_y = tmp;
}
/* loop through points in array; examine each line segment */
oldxx = oldyy = 0.0; /* previous point */
for (i = 0; i < length; i++)
{
double xxr[2], yyr[2]; /* storage for `relevant points' */
int n, j;
int effective_clip_mode;
/* get new point */
xx = (transpose_axes ? p[i].y : p[i].x);
yy = (transpose_axes ? p[i].x : p[i].y);
/* determine clipping mode (see compute_relevant_points() below) */
if (i == 0 || p[i].pendown == false
|| (p[i].linemode <= 0 && p[i].fill_fraction < 0.0))
/* no polyline or filling, each point is isolated */
effective_clip_mode = 0;
else if (p[i].fill_fraction >= 0.0)
effective_clip_mode = 2;
else
effective_clip_mode = clip_mode;
n = compute_relevant_points (xx, yy, oldxx, oldyy,
effective_clip_mode,
user_min_x, user_min_y,
user_max_x, user_max_y,
spec_min_x, spec_min_y,
spec_max_x, spec_max_y,
xxr, yyr);
/* loop through relevant points, updating bounding box */
for (j = 0; j < n; j++)
{
point_seen = true;
if (!spec_min_x)
local_min_x = DMIN(local_min_x, xxr[j]);
if (!spec_min_y)
local_min_y = DMIN(local_min_y, yyr[j]);
if (!spec_max_x)
local_max_x = DMAX(local_max_x, xxr[j]);
if (!spec_max_y)
local_max_y = DMAX(local_max_y, yyr[j]);
}
oldxx = xx;
oldyy = yy;
}
if (!point_seen)
/* a convention */
local_min_x = local_min_y = local_max_x = local_max_y = 0.0;
/* pass back bounds that user didn't specify */
if (!spec_min_x)
*min_x = local_min_x;
if (!spec_min_y)
*min_y = local_min_y;
if (!spec_max_x)
*max_x = local_max_x;
if (!spec_max_y)
*max_y = local_max_y;
return;
}
/* Ouput: y=updated_conc, xx=end_time, hdid=achieved_stepsize , hnext= estimated_next_ss */
bool stifbs(double y[], double dydx[], int nv, double *xx, double htry, double eps,
double yscal[], double *hdid, double *hnext,
void (*derivs)(double, double [], double [], int, long, double), long node)
{
int i,iq,k,kk,km;
static int first=1,kmax,kopt,nvold = -1;
static double epsold = -1.0,xnew;
double eps1,errmax,fact,h,red,scale,work,wrkmin,xest;
double *dfdx,**dfdy,*err,*yerr,*ysav,*yseq;
static double a[IMAXX+1];
static double alf[KMAXX+1][KMAXX+1];
static int nseq[IMAXX+1]={0,2,6,10,14,22,34,50,70};
// static int nseq[IMAXX+1]={0,2,6,10,14,22,34,50,70,98,138,194,274,386};
// Num Recip S. 744
// Differenz zwischen zwei Werten muss ein Vielfaches von 4 sein
// So wählen, dass Verhältnis der Werte <= 5/7 ist
// z.B. 10, 14 -> 10/14 <= 5/7
// nächster wäre 18, aber 14/18 > 5/7, deshalb 22 mit 14/22 <= 5/7
int reduct,exitflag=0;
km=0; //SB avoid warnings
red = 0.0; //SB avoid warning
errmax = 0.0; // SB avoid warning
scale = 0.0; // SB avoid warning
bool success = true;
d=dmatrix(1,nv,1,KMAXX);
dfdx=dvector(1,nv);
dfdy=dmatrix(1,nv,1,nv);
err=dvector(1,KMAXX);
x=dvector(1,KMAXX);
yerr=dvector(1,nv);
ysav=dvector(1,nv);
yseq=dvector(1,nv);
// reinitialize as eps is a new tolerance
// or if nv have changed
if(eps != epsold || nv != nvold)
{
*hnext = xnew = -1.0e29; // impossible values
eps1=SAFE1*eps;
// compute work coefficients Ak
a[1]=nseq[1]+1;
for (k=1;k<=KMAXX;k++) a[k+1]=a[k]+nseq[k+1];
// compute alpha(k,q)
for (iq=2;iq<=KMAXX;iq++)
{
for (k=1;k<iq;k++)
alf[k][iq]=pow(eps1,((a[k+1]-a[iq+1])/
((a[iq+1]-a[1]+1.0)*(2*k+1))));
}
epsold=eps;
// save nv
nvold=nv;
// add cost of Jacobian evals to work coeffs a[]
a[1] += nv;
for (k=1;k<=KMAXX;k++) a[k+1]=a[k]+nseq[k+1];
// Determine opt. row no. for convergence
for (kopt=2;kopt<KMAXX;kopt++)
if (a[kopt+1] > a[kopt]*alf[kopt-1][kopt]) break;
kmax=kopt;
}
h=htry;
// save starting values
for (i=1;i<=nv;i++) ysav[i]=y[i];
// evaluate jacobian matrix, update dfdx, dfdy
jacobn(*xx,y,dfdx,dfdy,nv,node);
// new stepsize or new integration --> re-establish order window
if (*xx != xnew || h != (*hnext))
{
first=1;
kopt=kmax;
}
reduct=0;
// start stepping
for (;;)
{
// evaluate the sequence of modified midpoint integrations
for (k=1;k<=kmax;k++)
{
xnew=(*xx)+h;
if (xnew == (*xx)) //CB
{
std::cout << "step size underflow in stifbs" << "\n";
//nrerror("step size underflow in stifbs");
success = false;
free_dvector(yseq,1,nv);
free_dvector(ysav,1,nv);
free_dvector(yerr,1,nv);
free_dvector(x,1,KMAXX);
free_dvector(err,1,KMAXX);
free_dmatrix(dfdy,1,nv,1,nv);
free_dvector(dfdx,1,nv);
free_dmatrix(d,1,KMAXX,1,KMAXX);
return success;
}
// semi-implicite midpoint algorithm
success = simpr(ysav,dydx,dfdx,dfdy,nv,*xx,h,nseq[k],yseq,derivs,node);
if(success==0){
free_dvector(yseq,1,nv);
free_dvector(ysav,1,nv);
free_dvector(yerr,1,nv);
free_dvector(x,1,KMAXX);
free_dvector(err,1,KMAXX);
free_dmatrix(dfdy,1,nv,1,nv);
free_dvector(dfdx,1,nv);
free_dmatrix(d,1,KMAXX,1,KMAXX);
return success;
}
// squared since error is even
xest=DSQR(h/nseq[k]);
pzextr(k,xest,yseq,y,yerr,nv);
// compute normalized error estimate eps(k)
if (k != 1)
{
errmax=TINY;
for (i=1;i<=nv;i++) errmax=DMAX(errmax,fabs(yerr[i]/yscal[i]));
// scale error relative to tolerance
errmax /= eps;
km=k-1;
err[km]=pow(errmax/SAFE1,1.0/(double)(2*km+1));
}
if (k != 1 && (k >= kopt-1 || first))
{
if (errmax < 1.0)
{
exitflag=1;
break;
}
if (k == kmax || k == kopt+1)
{
red=SAFE2/err[km];
break;
}
else if (k == kopt && alf[kopt-1][kopt] < err[km])
{
red=1.0/err[km];
break;
}
else if (kopt == kmax && alf[km][kmax-1] < err[km])
{
red=alf[km][kmax-1]*SAFE2/err[km];
break;
}
else if (alf[km][kopt] < err[km])
{
red=alf[km][kopt-1]/err[km];
break;
}
}
}
// if (exitflag) std::cout << " Exitflag > 0 in stifbs of biodegradation" << "\n";
if (exitflag) break;
// reduce stepsize by at least REDMIN and at most by REDMAX
red=DMIN(red,REDMIN);
red=DMAX(red,REDMAX);
h *= red;
reduct=1;
} // try again
// successfull step was taken
*xx=xnew;
*hdid=h;
first=0;
wrkmin=1.0e35;
// compute optimal row for convergence and corresponding stepsize
for (kk=1;kk<=km;kk++)
{
fact=DMAX(err[kk],SCALMX);
work=fact*a[kk+1];
if (work < wrkmin)
{
scale=fact;
wrkmin=work;
kopt=kk+1;
}
}
*hnext=h/scale;
if (kopt >= k && kopt != kmax && !reduct)
{
// check for possible order increse but not if stepsize was just reduced
fact=DMAX(scale/alf[kopt-1][kopt],SCALMX);
if (a[kopt+1]*fact <= wrkmin)
{
*hnext=h/fact;
kopt++;
}
}
free_dvector(yseq,1,nv);
free_dvector(ysav,1,nv);
free_dvector(yerr,1,nv);
free_dvector(x,1,KMAXX);
free_dvector(err,1,KMAXX);
free_dmatrix(dfdy,1,nv,1,nv);
free_dvector(dfdx,1,nv);
free_dmatrix(d,1,KMAXX,1,KMAXX);
return success;
}
double
calcR(int N, int i, int j, int jp)
{
/* modifications by billb for 0.2.8.5 */
double lnerfcj, lnerfcjp;
double argj, argjp;
double Dbpp_jjp, Dbpp_jpj;
double Dbpp_ijp, Dbpp_ij;
double Dbpp_jjpB, Dbpp_jpjB; /*B at end means "bar" or $\overline x$*/
double spp_jjp, spp_jpj;
double spp_ijp,spp_ij;
double sijpjBB, sijjpBB;
double sijpjB, sijjpB, sjjpiB;
double norm;
double normj, normjp;
double dijpB,dijB;
double bi, bj, bjp;
#define SIGMA23P(x,y,z) (sigma2_3p(x,y,z,oldDeltaB[x][z]))
if(recalcB)
{
norm = 1.0/(SIGMA23P(j,i,jp)+SIGMA23P(jp,i,j)+EPSILON);
normj = 1.0/(SIGMA23P(i,j,jp)+SIGMA23P(jp,j,i)+EPSILON);
normjp = 1.0/(SIGMA23P(i,jp,j)+SIGMA23P(j,jp,i)+EPSILON);
}
else
{
norm = 1.0/(sigma2_3(j,i,jp)+sigma2_3(jp,i,j)+EPSILON);
normj = 1.0/(sigma2_3(i,j,jp)+sigma2_3(jp,j,i)+EPSILON);
normjp = 1.0/(sigma2_3(i,jp,j)+sigma2_3(j,jp,i)+EPSILON);
}
if(norm<0.0) {
fprintf(stderr, "%s::%d\n", __FILE__, __LINE__);
if(recalcB)
fprintf(stderr, "Norm < 0 i=%d j=%d jp=%d norm=%g sigs %g %g\n",
i,j,jp,norm,
SIGMA23P(i,j,jp),SIGMA23P(i,jp,j));
else
fprintf(stderr, "Norm < 0 i=%d j=%d jp=%d norm=%g sigs %g %g\n",
i,j,jp,norm,
sigma2_3(i,j,jp),sigma2_3(i,jp,j));
exit(1);
}
#ifdef DEBUG
if(recalcB)
fprintf(stdout, "i=%d j=%d jp=%d normj=%g sigs %g %g\n",
i,j,jp,normj,
SIGMA23P(j,i,jp),SIGMA23P(j,jp,i));
else
fprintf(stdout, "i=%d j=%d jp=%d normj=%g sigs %g %g\n",
i,j,jp,normj,
sigma2_3(j,i,jp),sigma2_3(j,jp,i));
#endif
spp_jjp = (s[j][jp] - norm) + EPSILON;
spp_jpj = (s[jp][j] - norm) + EPSILON;
spp_ijp = (s[i][jp] - normj) + EPSILON;
spp_ij = (s[i][j] - normjp) + EPSILON;
#ifdef DEBUG
fprintf(stdout, "spp_jjp=%g, spp_jpj=%g, spp_ijp=%g, spp_ij=%g\n",
spp_jjp, spp_jpj, spp_ijp, spp_ij);
fprintf(stdout, " spp_ijp=%g, s[i][jp]=%g, normj=%g\n",
spp_ijp, s[i][jp], normj);
#endif
Dbpp_jjp =
(s[j][jp]*deltaB[j][jp] - (D(i,j)-D(i,jp))*norm)/(spp_jjp/*+EPSILON*/);
Dbpp_jpj =
(s[jp][j]*deltaB[jp][j] - (D(i,jp)-D(i,j))*norm)/(spp_jpj/*+EPSILON*/);
Dbpp_ijp =
(s[i][jp]*deltaB[i][jp] - (D(i,j)-D(jp,j))*normj)/(spp_ijp/*+EPSILON*/);
Dbpp_ij =
(s[i][j]*deltaB[i][j] - (D(i,jp)-D(j,jp))*normjp)/(spp_ij/*+EPSILON*/);
if(useSigmaBar)
{
sijjpB = sigma2_3(i,j,jp);
sijpjB = sigma2_3(i,jp,j);
sjjpiB = sigma2_3(j,jp,i);
}
else
{
bj = DMAX( (D(j, jp)+Dbpp_jjp)/2.0, MINB );
bjp = DMAX( (D(j, jp)-Dbpp_jjp)/2.0, MINB );
bi =
(
DMAX(D(i,j)-bj, MINB)/(sigma2_3(i,j,jp)+EPSILON)
+
DMAX(D(i,jp)-bjp, MINB)/(sigma2_3(i,jp,j)+EPSILON)
)/(1.0/(sigma2_3(i,j,jp)+EPSILON)+1.0/(sigma2_3(i,jp,j)+EPSILON));
sijjpB = sigma_na(bi+C(i),bj+C(j));
sijpjB = sigma_na(bi+C(i),bjp+C(jp));
sjjpiB = sigma_na(bj+C(j),bjp+C(jp));
}
if(useBarValues)
{
sijpjBB = 1.0/(1.0/(sijpjB+1.0/spp_jjp)+1.0/(sjjpiB+1.0/spp_ijp));
sijjpBB = 1.0/(1.0/(sijjpB+1.0/spp_jjp)+1.0/(sjjpiB+1.0/spp_ij));
dijpB = (D(i,jp)/(sijpjB+1.0/spp_jjp)+D(j,jp)/(sjjpiB+1.0/spp_ijp))*
sijpjBB;
dijB = (D(i,j)/(sijjpB+1.0/spp_jpj)+D(j,jp)/(sjjpiB+1.0/spp_ij))*
sijjpBB;
Dbpp_jjpB = (Dbpp_jjp/(sijpjB+1.0/spp_jjp)+Dbpp_ijp/(sjjpiB+1.0/spp_ijp))*
sijpjBB;
Dbpp_jpjB = (Dbpp_jpj/(sijjpB+1.0/spp_jpj)+Dbpp_ij/(sjjpiB+1.0/spp_ij))*
sijjpBB;
}
else
{
sijpjBB = 1.0/spp_jjp + sijpjB;
sijjpBB = 1.0/spp_jpj + sijjpB;
dijpB = D(i,jp);
dijB = D(i,j);
Dbpp_jjpB = Dbpp_jjp;
Dbpp_jpjB = Dbpp_jpj;
}
argj = (D(i,j)-Dbpp_jjpB-dijpB)
/sqrt(2.0*(sijpjBB+sijjpB));
argjp = (D(i,jp)-Dbpp_jpjB-dijB)
/sqrt(2.0*(sijjpBB+sijpjB));
#ifdef DEBUG
fprintf(stdout, "ijjp=%d%d%d, bi=%g, bj=%g, bjp=%g,\n\t"
"C(i)=%g, C(j)=%g, C(jp)=%g\n",
i,j,jp,bi, bj, bjp, C(i), C(j), C(jp));
fprintf(stdout, "sijjpB=%g, sijpjB=%g, sjjpiB=%g\n",sijjpB, sijpjB, sjjpiB);
fprintf(stdout, "sijpjBB=%g sijjpB=%g, sijjpBB=%g sijpjB=%g\n\n",
sijpjBB,sijjpB,sijjpBB,sijpjB);
#endif
#ifdef OFF
if(argjp!=-argj) {
fprintf(stderr, "%s::%d\n", __FILE__, __LINE__);
fprintf(stderr, "FATAL ERROR argjp!=-argj\n");
fprintf(stderr,"%d%d%d %.16g %.16g %.16g %.16g sig %g %g"
"bi %g bj %g bjp %g norm %g spp %g %g diff %g\n",
i,j,jp,argj, argjp,Dbpp_jjp,Dbpp_jpj ,
sigma2_3p(i,j,jp), sigma2_3p(i,jp,j), bi, bj, bjp, norm,
spp_jjp, spp_jpj, argjp+argj);
exit(0);
}
#endif
if(argj>0.0)
lnerfcj = log(derfcx(argj)) - argj*argj;
else
lnerfcj = log(derfc(argj));
if(argjp>0.0)
lnerfcjp = log(derfcx(argjp)) - argjp*argjp;
else
lnerfcjp = log(derfc(argjp));
#ifdef DEBUG
fprintf(stdout,">>>%lf, %lf || %lf %lf %g %g\n"
"===========================\n\n",
s[i][j]*(delta2B[i][j]-SQR(deltaB[i][j]))
-s[i][jp]*(delta2B[i][jp]-SQR(deltaB[i][jp])),
-2.0*(lnerfcj-lnerfcjp), lnerfcj, lnerfcjp, argj, argjp);
#endif
if(!n_Flag)
return( (s[i][j]*(delta2B[i][j]-SQR(deltaB[i][j]))
-s[i][jp]*(delta2B[i][jp]-SQR(deltaB[i][jp])))/(((double)N)-3.0)
-2.0*(lnerfcj-lnerfcjp));
else {
double Y;
Y = (sigma2_3(i,jp,j) + sigma2_3(j,jp,i) + 1.0/spp_ij)
/(sigma2_3(i,jp,j) + sigma2_3(j,jp,i)+(((double)N)-3.0)/spp_ij);
return(Y*(s[i][j]*(delta2B[i][j]-SQR(deltaB[i][j]))
-s[i][jp]*(delta2B[i][jp]-SQR(deltaB[i][jp])))
-2.0*(lnerfcj-lnerfcjp));
}
}
