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

   1 #include "clapack.h"
   2
   3 /* Table of constant values */
   4
   5 static integer c__1 = 1;
   6
   7 doublereal slanst_(char *norm, integer *n, real *d__, real *e)
   8 {
   9     /* System generated locals */
  10     integer i__1;
  11     real ret_val, r__1, r__2, r__3, r__4, r__5;
  12
  13     /* Builtin functions */
  14     double sqrt(doublereal);
  15
  16     /* Local variables */
  17     integer i__;
  18     real sum, scale;
  19     extern logical lsame_(char *, char *);
  20     real anorm;
  21     extern /* Subroutine */ int slassq_(integer *, real *, integer *, real *,
  22             real *);
  23
  24
  25 /*  -- LAPACK auxiliary routine (version 3.1) -- */
  26 /*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
  27 /*     November 2006 */
  28
  29 /*     .. Scalar Arguments .. */
  30 /*     .. */
  31 /*     .. Array Arguments .. */
  32 /*     .. */
  33
  34 /*  Purpose */
  35 /*  ======= */
  36
  37 /*  SLANST  returns the value of the one norm,  or the Frobenius norm, or */
  38 /*  the  infinity norm,  or the  element of  largest absolute value  of a */
  39 /*  real symmetric tridiagonal matrix A. */
  40
  41 /*  Description */
  42 /*  =========== */
  43
  44 /*  SLANST returns the value */
  45
  46 /*     SLANST = ( max(abs(A(i,j))), NORM = 'M' or 'm' */
  47 /*              ( */
  48 /*              ( norm1(A),         NORM = '1', 'O' or 'o' */
  49 /*              ( */
  50 /*              ( normI(A),         NORM = 'I' or 'i' */
  51 /*              ( */
  52 /*              ( normF(A),         NORM = 'F', 'f', 'E' or 'e' */
  53
  54 /*  where  norm1  denotes the  one norm of a matrix (maximum column sum), */
  55 /*  normI  denotes the  infinity norm  of a matrix  (maximum row sum) and */
  56 /*  normF  denotes the  Frobenius norm of a matrix (square root of sum of */
  57 /*  squares).  Note that  max(abs(A(i,j)))  is not a consistent matrix norm. */
  58
  59 /*  Arguments */
  60 /*  ========= */
  61
  62 /*  NORM    (input) CHARACTER*1 */
  63 /*          Specifies the value to be returned in SLANST as described */
  64 /*          above. */
  65
  66 /*  N       (input) INTEGER */
  67 /*          The order of the matrix A.  N >= 0.  When N = 0, SLANST is */
  68 /*          set to zero. */
  69
  70 /*  D       (input) REAL array, dimension (N) */
  71 /*          The diagonal elements of A. */
  72
  73 /*  E       (input) REAL array, dimension (N-1) */
  74 /*          The (n-1) sub-diagonal or super-diagonal elements of A. */
  75
  76 /*  ===================================================================== */
  77
  78 /*     .. Parameters .. */
  79 /*     .. */
  80 /*     .. Local Scalars .. */
  81 /*     .. */
  82 /*     .. External Functions .. */
  83 /*     .. */
  84 /*     .. External Subroutines .. */
  85 /*     .. */
  86 /*     .. Intrinsic Functions .. */
  87 /*     .. */
  88 /*     .. Executable Statements .. */
  89
  90     /* Parameter adjustments */
  91     --e;
  92     --d__;
  93
  94     /* Function Body */
  95     if (*n <= 0) {
  96         anorm = 0.f;
  97     } else if (lsame_(norm, "M")) {
  98
  99 /*        Find max(abs(A(i,j))). */
 100
 101         anorm = (r__1 = d__[*n], dabs(r__1));
 102         i__1 = *n - 1;
 103         for (i__ = 1; i__ <= i__1; ++i__) {
 104 /* Computing MAX */
 105             r__2 = anorm, r__3 = (r__1 = d__[i__], dabs(r__1));
 106             anorm = dmax(r__2,r__3);
 107 /* Computing MAX */
 108             r__2 = anorm, r__3 = (r__1 = e[i__], dabs(r__1));
 109             anorm = dmax(r__2,r__3);
 110 /* L10: */
 111         }
 112     } else if (lsame_(norm, "O") || *(unsigned char *)
 113             norm == '1' || lsame_(norm, "I")) {
 114
 115 /*        Find norm1(A). */
 116
 117         if (*n == 1) {
 118             anorm = dabs(d__[1]);
 119         } else {
 120 /* Computing MAX */
 121             r__3 = dabs(d__[1]) + dabs(e[1]), r__4 = (r__1 = e[*n - 1], dabs(
 122                     r__1)) + (r__2 = d__[*n], dabs(r__2));
 123             anorm = dmax(r__3,r__4);
 124             i__1 = *n - 1;
 125             for (i__ = 2; i__ <= i__1; ++i__) {
 126 /* Computing MAX */
 127                 r__4 = anorm, r__5 = (r__1 = d__[i__], dabs(r__1)) + (r__2 =
 128                         e[i__], dabs(r__2)) + (r__3 = e[i__ - 1], dabs(r__3));
 129                 anorm = dmax(r__4,r__5);
 130 /* L20: */
 131             }
 132         }
 133     } else if (lsame_(norm, "F") || lsame_(norm, "E")) {
 134
 135 /*        Find normF(A). */
 136
 137         scale = 0.f;
 138         sum = 1.f;
 139         if (*n > 1) {
 140             i__1 = *n - 1;
 141             slassq_(&i__1, &e[1], &c__1, &scale, &sum);
 142             sum *= 2;
 143         }
 144         slassq_(n, &d__[1], &c__1, &scale, &sum);
 145         anorm = scale * sqrt(sum);
 146     }
 147
 148     ret_val = anorm;
 149     return ret_val;
 150
 151 /*     End of SLANST */
 152
 153 } /* slanst_ */