X-Git-Url: http://vcs.maemo.org/git/?a=blobdiff_plain;f=3rdparty%2Flapack%2Fslapy2.c;fp=3rdparty%2Flapack%2Fslapy2.c;h=e8054eb05d8cb17f3edcba79770c505ab03bf065;hb=e4c14cdbdf2fe805e79cd96ded236f57e7b89060;hp=0000000000000000000000000000000000000000;hpb=454138ff8a20f6edb9b65a910101403d8b520643;p=opencv diff --git a/3rdparty/lapack/slapy2.c b/3rdparty/lapack/slapy2.c new file mode 100644 index 0000000..e8054eb --- /dev/null +++ b/3rdparty/lapack/slapy2.c @@ -0,0 +1,60 @@ +#include "clapack.h" + +doublereal slapy2_(real *x, real *y) +{ + /* System generated locals */ + real ret_val, r__1; + + /* Builtin functions */ + double sqrt(doublereal); + + /* Local variables */ + real w, z__, xabs, yabs; + + +/* -- LAPACK auxiliary routine (version 3.1) -- */ +/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */ +/* November 2006 */ + +/* .. Scalar Arguments .. */ +/* .. */ + +/* Purpose */ +/* ======= */ + +/* SLAPY2 returns sqrt(x**2+y**2), taking care not to cause unnecessary */ +/* overflow. */ + +/* Arguments */ +/* ========= */ + +/* X (input) REAL */ +/* Y (input) REAL */ +/* X and Y specify the values x and y. */ + +/* ===================================================================== */ + +/* .. Parameters .. */ +/* .. */ +/* .. Local Scalars .. */ +/* .. */ +/* .. Intrinsic Functions .. */ +/* .. */ +/* .. Executable Statements .. */ + + xabs = dabs(*x); + yabs = dabs(*y); + w = dmax(xabs,yabs); + z__ = dmin(xabs,yabs); + if (z__ == 0.f) { + ret_val = w; + } else { +/* Computing 2nd power */ + r__1 = z__ / w; + ret_val = w * sqrt(r__1 * r__1 + 1.f); + } + return ret_val; + +/* End of SLAPY2 */ + +} /* slapy2_ */