3 /* Table of constant values */
5 static integer c__1 = 1;
7 doublereal dlange_(char *norm, integer *m, integer *n, doublereal *a, integer
8 *lda, doublereal *work)
10 /* System generated locals */
11 integer a_dim1, a_offset, i__1, i__2;
12 doublereal ret_val, d__1, d__2, d__3;
14 /* Builtin functions */
15 double sqrt(doublereal);
19 doublereal sum, scale;
20 extern logical lsame_(char *, char *);
22 extern /* Subroutine */ int dlassq_(integer *, doublereal *, integer *,
23 doublereal *, doublereal *);
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 /* DLANGE 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 /* DLANGE returns the value */
47 /* DLANGE = ( 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 DLANGE as described */
67 /* M (input) INTEGER */
68 /* The number of rows of the matrix A. M >= 0. When M = 0, */
69 /* DLANGE is set to zero. */
71 /* N (input) INTEGER */
72 /* The number of columns of the matrix A. N >= 0. When N = 0, */
73 /* DLANGE is set to zero. */
75 /* A (input) DOUBLE PRECISION 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) DOUBLE PRECISION 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 d__2 = value, d__3 = (d__1 = a[i__ + j * a_dim1], abs(d__1));
119 value = max(d__2,d__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 += (d__1 = a[i__ + j * a_dim1], abs(d__1));
138 value = max(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__] += (d__1 = a[i__ + j * a_dim1], abs(d__1));
161 for (i__ = 1; i__ <= i__1; ++i__) {
163 d__1 = value, d__2 = work[i__];
164 value = max(d__1,d__2);
167 } else if (lsame_(norm, "F") || lsame_(norm, "E")) {
174 for (j = 1; j <= i__1; ++j) {
175 dlassq_(m, &a[j * a_dim1 + 1], &c__1, &scale, &sum);
178 value = scale * sqrt(sum);