3 /* Table of constant values */
5 static integer c__1 = 1;
7 doublereal slange_(char *norm, integer *m, integer *n, real *a, integer *lda,
10 /* System generated locals */
11 integer a_dim1, a_offset, i__1, i__2;
12 real ret_val, r__1, r__2, r__3;
14 /* Builtin functions */
15 double sqrt(doublereal);
20 extern logical lsame_(char *, char *);
22 extern /* Subroutine */ int slassq_(integer *, real *, integer *, real *,
26 /* -- LAPACK auxiliary routine (version 3.1) -- */
27 /* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
30 /* .. Scalar Arguments .. */
32 /* .. Array Arguments .. */
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 */
45 /* SLANGE returns the value */
47 /* SLANGE = ( max(abs(A(i,j))), NORM = 'M' or 'm' */
49 /* ( norm1(A), NORM = '1', 'O' or 'o' */
51 /* ( normI(A), NORM = 'I' or 'i' */
53 /* ( normF(A), NORM = 'F', 'f', 'E' or 'e' */
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. */
63 /* NORM (input) CHARACTER*1 */
64 /* Specifies the value to be returned in SLANGE as described */
67 /* M (input) INTEGER */
68 /* The number of rows of the matrix A. M >= 0. When M = 0, */
69 /* SLANGE is set to zero. */
71 /* N (input) INTEGER */
72 /* The number of columns of the matrix A. N >= 0. When N = 0, */
73 /* SLANGE is set to zero. */
75 /* A (input) REAL array, dimension (LDA,N) */
76 /* The m by n matrix A. */
78 /* LDA (input) INTEGER */
79 /* The leading dimension of the array A. LDA >= max(M,1). */
81 /* WORK (workspace) REAL array, dimension (MAX(1,LWORK)), */
82 /* where LWORK >= M when NORM = 'I'; otherwise, WORK is not */
85 /* ===================================================================== */
87 /* .. Parameters .. */
89 /* .. Local Scalars .. */
91 /* .. External Subroutines .. */
93 /* .. External Functions .. */
95 /* .. Intrinsic Functions .. */
97 /* .. Executable Statements .. */
99 /* Parameter adjustments */
101 a_offset = 1 + a_dim1;
106 if (min(*m,*n) == 0) {
108 } else if (lsame_(norm, "M")) {
110 /* Find max(abs(A(i,j))). */
114 for (j = 1; j <= i__1; ++j) {
116 for (i__ = 1; i__ <= i__2; ++i__) {
118 r__2 = value, r__3 = (r__1 = a[i__ + j * a_dim1], dabs(r__1));
119 value = dmax(r__2,r__3);
124 } else if (lsame_(norm, "O") || *(unsigned char *)
131 for (j = 1; j <= i__1; ++j) {
134 for (i__ = 1; i__ <= i__2; ++i__) {
135 sum += (r__1 = a[i__ + j * a_dim1], dabs(r__1));
138 value = dmax(value,sum);
141 } else if (lsame_(norm, "I")) {
146 for (i__ = 1; i__ <= i__1; ++i__) {
151 for (j = 1; j <= i__1; ++j) {
153 for (i__ = 1; i__ <= i__2; ++i__) {
154 work[i__] += (r__1 = a[i__ + j * a_dim1], dabs(r__1));
161 for (i__ = 1; i__ <= i__1; ++i__) {
163 r__1 = value, r__2 = work[i__];
164 value = dmax(r__1,r__2);
167 } else if (lsame_(norm, "F") || lsame_(norm, "E")) {
174 for (j = 1; j <= i__1; ++j) {
175 slassq_(m, &a[j * a_dim1 + 1], &c__1, &scale, &sum);
178 value = scale * sqrt(sum);