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

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