X-Git-Url: http://git.maemo.org/git/?p=opencv;a=blobdiff_plain;f=3rdparty%2Flapack%2Fdlarra.c;fp=3rdparty%2Flapack%2Fdlarra.c;h=803386776e9b6d8e67979c70c3e320b007374309;hp=0000000000000000000000000000000000000000;hb=e4c14cdbdf2fe805e79cd96ded236f57e7b89060;hpb=454138ff8a20f6edb9b65a910101403d8b520643 diff --git a/3rdparty/lapack/dlarra.c b/3rdparty/lapack/dlarra.c new file mode 100644 index 0000000..8033867 --- /dev/null +++ b/3rdparty/lapack/dlarra.c @@ -0,0 +1,143 @@ +#include "clapack.h" + +/* Subroutine */ int dlarra_(integer *n, doublereal *d__, doublereal *e, + doublereal *e2, doublereal *spltol, doublereal *tnrm, integer *nsplit, + integer *isplit, integer *info) +{ + /* System generated locals */ + integer i__1; + doublereal d__1, d__2; + + /* Builtin functions */ + double sqrt(doublereal); + + /* Local variables */ + integer i__; + doublereal tmp1, eabs; + + +/* -- LAPACK auxiliary routine (version 3.1) -- */ +/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */ +/* November 2006 */ + +/* .. Scalar Arguments .. */ +/* .. */ +/* .. Array Arguments .. */ +/* .. */ + +/* Purpose */ +/* ======= */ + +/* Compute the splitting points with threshold SPLTOL. */ +/* DLARRA sets any "small" off-diagonal elements to zero. */ + +/* Arguments */ +/* ========= */ + +/* N (input) INTEGER */ +/* The order of the matrix. N > 0. */ + +/* D (input) DOUBLE PRECISION array, dimension (N) */ +/* On entry, the N diagonal elements of the tridiagonal */ +/* matrix T. */ + +/* E (input/output) DOUBLE PRECISION array, dimension (N) */ +/* On entry, the first (N-1) entries contain the subdiagonal */ +/* elements of the tridiagonal matrix T; E(N) need not be set. */ +/* On exit, the entries E( ISPLIT( I ) ), 1 <= I <= NSPLIT, */ +/* are set to zero, the other entries of E are untouched. */ + +/* E2 (input/output) DOUBLE PRECISION array, dimension (N) */ +/* On entry, the first (N-1) entries contain the SQUARES of the */ +/* subdiagonal elements of the tridiagonal matrix T; */ +/* E2(N) need not be set. */ +/* On exit, the entries E2( ISPLIT( I ) ), */ +/* 1 <= I <= NSPLIT, have been set to zero */ + +/* SPLTOL (input) DOUBLE PRECISION */ +/* The threshold for splitting. Two criteria can be used: */ +/* SPLTOL<0 : criterion based on absolute off-diagonal value */ +/* SPLTOL>0 : criterion that preserves relative accuracy */ + +/* TNRM (input) DOUBLE PRECISION */ +/* The norm of the matrix. */ + +/* NSPLIT (output) INTEGER */ +/* The number of blocks T splits into. 1 <= NSPLIT <= N. */ + +/* ISPLIT (output) INTEGER array, dimension (N) */ +/* The splitting points, at which T breaks up into blocks. */ +/* The first block consists of rows/columns 1 to ISPLIT(1), */ +/* the second of rows/columns ISPLIT(1)+1 through ISPLIT(2), */ +/* etc., and the NSPLIT-th consists of rows/columns */ +/* ISPLIT(NSPLIT-1)+1 through ISPLIT(NSPLIT)=N. */ + + +/* INFO (output) INTEGER */ +/* = 0: successful exit */ + +/* Further Details */ +/* =============== */ + +/* Based on contributions by */ +/* Beresford Parlett, University of California, Berkeley, USA */ +/* Jim Demmel, University of California, Berkeley, USA */ +/* Inderjit Dhillon, University of Texas, Austin, USA */ +/* Osni Marques, LBNL/NERSC, USA */ +/* Christof Voemel, University of California, Berkeley, USA */ + +/* ===================================================================== */ + +/* .. Parameters .. */ +/* .. */ +/* .. Local Scalars .. */ +/* .. */ +/* .. Intrinsic Functions .. */ +/* .. */ +/* .. Executable Statements .. */ + + /* Parameter adjustments */ + --isplit; + --e2; + --e; + --d__; + + /* Function Body */ + *info = 0; +/* Compute splitting points */ + *nsplit = 1; + if (*spltol < 0.) { +/* Criterion based on absolute off-diagonal value */ + tmp1 = abs(*spltol) * *tnrm; + i__1 = *n - 1; + for (i__ = 1; i__ <= i__1; ++i__) { + eabs = (d__1 = e[i__], abs(d__1)); + if (eabs <= tmp1) { + e[i__] = 0.; + e2[i__] = 0.; + isplit[*nsplit] = i__; + ++(*nsplit); + } +/* L9: */ + } + } else { +/* Criterion that guarantees relative accuracy */ + i__1 = *n - 1; + for (i__ = 1; i__ <= i__1; ++i__) { + eabs = (d__1 = e[i__], abs(d__1)); + if (eabs <= *spltol * sqrt((d__1 = d__[i__], abs(d__1))) * sqrt(( + d__2 = d__[i__ + 1], abs(d__2)))) { + e[i__] = 0.; + e2[i__] = 0.; + isplit[*nsplit] = i__; + ++(*nsplit); + } +/* L10: */ + } + } + isplit[*nsplit] = *n; + return 0; + +/* End of DLARRA */ + +} /* dlarra_ */