double dselect(unsigned long k, unsigned long n, double *arr) {
unsigned long i=0,ir=0,j=0,l=0,mid=0;
double a=0.0,dtmp;
l=0;
ir=n-1;
for (;;) {
if (ir<=l+1) {
if (ir==l+1 && arr[ir]<arr[l]) { DSWAP(arr[l],arr[ir]); }
return arr[k];
}
else {
mid=(l+ir) >> 1; i=l+1;
DSWAP(arr[mid],arr[i]);
if (arr[i]>arr[ir]) { DSWAP(arr[i],arr[ir]); }
if (arr[l]>arr[ir]) { DSWAP(arr[l],arr[ir]); }
if (arr[i]>arr[l]) { DSWAP(arr[i],arr[l]); }
j=ir; a=arr[l];
for (;;) {
do i++; while (arr[i]<a); do j--; while (arr[j]>a);
if (j<i) break; DSWAP(arr[i],arr[j]);
}
arr[l]=arr[j]; arr[j]=a; if (j>=k) ir=j-1; if (j<=k) l=i;
}
}
}
void
F77_NAME(dswap)(const int *n, double *dx, const int *incx,
double *dy, const int *incy)
{
DSWAP(n, dx, incx, dy, incy);
}
/* quick-select median finder - order of input array is *not* preserved */
static int find_median (double *x, int n, double *xmed) /*{{{*/
{
int med, lo, hi;
if (x == NULL || n == 0 || xmed == NULL)
return -1;
#define DSWAP(i,j) do {double t_=x[(i)]; x[(i)]=x[(j)]; x[(j)]=t_;} while (0)
lo = 0;
hi = n-1;
med = (lo + hi)/2;
for (;;)
{
int l, h, mid;
/* one item left? */
if (hi <= lo)
{
*xmed = x[med];
return 0;
}
/* two items left? */
if (hi == lo+1)
{
if (x[lo] > x[hi]) DSWAP(lo, hi);
*xmed = x[med];
return 0;
}
/* order the current (lo,hi) values and their midpoint */
mid = (lo + hi) / 2;
if (x[mid] > x[hi]) DSWAP(mid, hi);
if (x[lo] > x[hi]) DSWAP(lo, hi);
if (x[mid] > x[lo]) DSWAP(mid, lo);
/* swap middle value to a safe place (lo+1)
* and process the items between [lo+2:hi]
*/
DSWAP(mid, lo+1);
/* scan the items between [lo+2, hi-1],
* inward from each end,
* swapping when necessary.
*/
l = lo + 1;
h = hi;
for (;;)
{
while (x[++l] < x[lo])
;
while (x[lo] < x[--h])
;
if (h < l)
break;
DSWAP(l, h);
}
/* swap the current low value to the spot
* where the scan pointers met
*/
DSWAP(lo, h);
/* update the endpoints, making sure that the median
* is bracketed.
*/
if (h <= med) lo = l;
if (h >= med) hi = h - 1;
}
#undef DSWAP
}
void DCHDC(double *a, INT *plda, INT *pp, double *work, INT jpvt[],
INT *pjob, INT *info)
/*double a[lda][1], work[1];*/
{
INT pu, pl, j, k, l, maxl, jtemp;
INT inc = 1;
double temp;
double maxdia;
double *ak, *apl, *akk, *aj, *apu, *all, *amaxl;
INT swapk, negk, length;
INT lda = *plda, p = *pp, job = *pjob;
/* ***first executable statement dchdc */
pl = 0;
pu = -1;
*info = p;
if (job != 0)
{
/* pivoting has been requested. rearrange the */
/* the elements according to jpvt. */
ak = a;
apl = a + pl*lda;
for(k = 0;k < p ;k++)
{
akk = ak + k;
swapk = jpvt[k] > 0;
negk = jpvt[k] < 0;
jpvt[k] = k+1;
if (negk)
{
jpvt[k] = -jpvt[k];
}
if (swapk)
{
if (k != pl)
{
DSWAP(&pl, ak, &inc, apl, &inc);
temp = *akk;
*akk = apl[pl];
apl[pl] = temp;
aj = apl + lda;
for(j = pl+1;j < p ;j++)
{
if (j < k)
{
temp = aj[pl];
aj[pl] = ak[j];
ak[j] = temp;
}
else if (j != k)
{
temp = aj[k];
aj[k] = aj[pl];
aj[pl] = temp;
}
aj += lda;
} /*for(j = pl+1;j < p ;j++)*/
jpvt[k] = jpvt[pl];
jpvt[pl] = k + 1;
} /*if (k != pl) */
pl++;
apl += lda;
} /*if (swapk) */
ak += lda;
} /*for(k = 0;k < p ;k++)*/
pu = p - 1;
apu = ak = a + (p-1)*lda;
for(k = p-1;k>=pl;k--)
{
akk = ak + k;
if (jpvt[k] < 0)
{
jpvt[k] = -jpvt[k];
if (pu != k)
{
DSWAP(&k, ak, &inc, apu, &inc);
temp = *akk;
*akk = apu[pu];
apu[pu] = temp;
aj = ak + lda;
for(j = k+1;j < p ;j++)
{
if (j < pu)
{
temp = aj[k];
aj[k] = apu[j];
apu[j] = temp;
}
else if (j != pu)
{
temp = aj[k];
aj[k] = aj[pu];
aj[pu] = temp;
}
aj += lda;
} /*for(j = k+1;j < p ;j++)*/
jtemp = jpvt[k];
jpvt[k] = jpvt[pu];
jpvt[pu] = jtemp;
} /*if (pu != k) */
pu--;
apu -= lda;
} /*if (jpvt[k] < 0) */
ak -= lda;
} /*for(k = p-1;k>=pl;k--)*/
} /*if (job != 0)*/
ak = a;
for(k = 0;k < p ;k++)
{
/* reduction loop. */
akk = ak + k;
maxdia = *akk;
maxl = k;
/* determine the pivot element. */
if (k >= pl && k < pu)
{
all = akk + lda + 1;
for(l = k+1;l <= pu ;l++)
{
if (*all > maxdia)
{
maxdia = *all;
maxl = l;
}
all += lda + 1;
}
}
/* quit if the pivot element is not positive. */
if (maxdia <= 0.0e0)
{
*info = k;
break;
}
if (k != maxl)
{
amaxl = a + maxl*lda;
/* start the pivoting and update jpvt. */
DSWAP(&k, ak, &inc, amaxl, &inc);
amaxl[maxl] = *akk;
*akk = maxdia;
jtemp = jpvt[maxl];
jpvt[maxl] = jpvt[k];
jpvt[k] = jtemp;
} /*if (k != maxl) */
/* reduction step. pivoting is contained across the rows. */
work[k] = sqrt(*akk);
*akk = work[k];
aj = ak + lda;
amaxl = a + maxl*lda;
for(j = k+1;j < p ;j++)
{
if (k != maxl)
{
temp = aj[k];
if (j < maxl)
{
aj[k] = amaxl[j];
amaxl[j] = temp;
}
else if (j != maxl)
{
aj[k] = aj[maxl];
aj[maxl] = temp;
}
} /*if (k != maxl)*/
aj[k] /= work[k];
work[j] = aj[k];
temp = -aj[k];
length = j - k;
DAXPY(&length, &temp, work + k + 1, &inc, aj + k + 1, &inc);
aj += lda;
} /*for(j = k+1;j < p ;j++)*/
incAndTest((p-k+3)*(p-k)/2,errorExit);
ak += lda;
}/*for(k = 0;k < p ;k++)*/
/* fall through*/
errorExit:
;
} /*dchdc()*/
