git.maemo.org Git - opencv/blob - 3rdparty/lapack/slabad.c

   1 #include "clapack.h"
   2
   3 /* Subroutine */ int slabad_(real *small, real *large)
   4 {
   5     /* Builtin functions */
   6     double r_lg10(real *), sqrt(doublereal);
   7
   8
   9 /*  -- LAPACK auxiliary routine (version 3.1) -- */
  10 /*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
  11 /*     November 2006 */
  12
  13 /*     .. Scalar Arguments .. */
  14 /*     .. */
  15
  16 /*  Purpose */
  17 /*  ======= */
  18
  19 /*  SLABAD takes as input the values computed by SLAMCH for underflow and */
  20 /*  overflow, and returns the square root of each of these values if the */
  21 /*  log of LARGE is sufficiently large.  This subroutine is intended to */
  22 /*  identify machines with a large exponent range, such as the Crays, and */
  23 /*  redefine the underflow and overflow limits to be the square roots of */
  24 /*  the values computed by SLAMCH.  This subroutine is needed because */
  25 /*  SLAMCH does not compensate for poor arithmetic in the upper half of */
  26 /*  the exponent range, as is found on a Cray. */
  27
  28 /*  Arguments */
  29 /*  ========= */
  30
  31 /*  SMALL   (input/output) REAL */
  32 /*          On entry, the underflow threshold as computed by SLAMCH. */
  33 /*          On exit, if LOG10(LARGE) is sufficiently large, the square */
  34 /*          root of SMALL, otherwise unchanged. */
  35
  36 /*  LARGE   (input/output) REAL */
  37 /*          On entry, the overflow threshold as computed by SLAMCH. */
  38 /*          On exit, if LOG10(LARGE) is sufficiently large, the square */
  39 /*          root of LARGE, otherwise unchanged. */
  40
  41 /*  ===================================================================== */
  42
  43 /*     .. Intrinsic Functions .. */
  44 /*     .. */
  45 /*     .. Executable Statements .. */
  46
  47 /*     If it looks like we're on a Cray, take the square root of */
  48 /*     SMALL and LARGE to avoid overflow and underflow problems. */
  49
  50     if (r_lg10(large) > 2e3f) {
  51         *small = sqrt(*small);
  52         *large = sqrt(*large);
  53     }
  54
  55     return 0;
  56
  57 /*     End of SLABAD */
  58
  59 } /* slabad_ */