#include "blaswrap.h" #include "f2c.h" doublereal slange_(char *norm, integer *m, integer *n, real *a, integer *lda, real *work) { /* -- LAPACK auxiliary routine (version 3.1) -- Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. November 2006 Purpose ======= SLANGE returns the value of the one norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a real matrix A. Description =========== SLANGE returns the value SLANGE = ( max(abs(A(i,j))), NORM = 'M' or 'm' ( ( norm1(A), NORM = '1', 'O' or 'o' ( ( normI(A), NORM = 'I' or 'i' ( ( normF(A), NORM = 'F', 'f', 'E' or 'e' where norm1 denotes the one norm of a matrix (maximum column sum), normI denotes the infinity norm of a matrix (maximum row sum) and normF denotes the Frobenius norm of a matrix (square root of sum of squares). Note that max(abs(A(i,j))) is not a consistent matrix norm. Arguments ========= NORM (input) CHARACTER*1 Specifies the value to be returned in SLANGE as described above. M (input) INTEGER The number of rows of the matrix A. M >= 0. When M = 0, SLANGE is set to zero. N (input) INTEGER The number of columns of the matrix A. N >= 0. When N = 0, SLANGE is set to zero. A (input) REAL array, dimension (LDA,N) The m by n matrix A. LDA (input) INTEGER The leading dimension of the array A. LDA >= max(M,1). WORK (workspace) REAL array, dimension (MAX(1,LWORK)), where LWORK >= M when NORM = 'I'; otherwise, WORK is not referenced. ===================================================================== Parameter adjustments */ /* Table of constant values */ static integer c__1 = 1; /* System generated locals */ integer a_dim1, a_offset, i__1, i__2; real ret_val, r__1, r__2, r__3; /* Builtin functions */ double sqrt(doublereal); /* Local variables */ static integer i__, j; static real sum, scale; extern logical lsame_(char *, char *); static real value; extern /* Subroutine */ int slassq_(integer *, real *, integer *, real *, real *); a_dim1 = *lda; a_offset = 1 + a_dim1; a -= a_offset; --work; /* Function Body */ if (min(*m,*n) == 0) { value = 0.f; } else if (lsame_(norm, "M")) { /* Find max(abs(A(i,j))). */ value = 0.f; i__1 = *n; for (j = 1; j <= i__1; ++j) { i__2 = *m; for (i__ = 1; i__ <= i__2; ++i__) { /* Computing MAX */ r__2 = value, r__3 = (r__1 = a[i__ + j * a_dim1], dabs(r__1)); value = dmax(r__2,r__3); /* L10: */ } /* L20: */ } } else if (lsame_(norm, "O") || *(unsigned char *) norm == '1') { /* Find norm1(A). */ value = 0.f; i__1 = *n; for (j = 1; j <= i__1; ++j) { sum = 0.f; i__2 = *m; for (i__ = 1; i__ <= i__2; ++i__) { sum += (r__1 = a[i__ + j * a_dim1], dabs(r__1)); /* L30: */ } value = dmax(value,sum); /* L40: */ } } else if (lsame_(norm, "I")) { /* Find normI(A). */ i__1 = *m; for (i__ = 1; i__ <= i__1; ++i__) { work[i__] = 0.f; /* L50: */ } i__1 = *n; for (j = 1; j <= i__1; ++j) { i__2 = *m; for (i__ = 1; i__ <= i__2; ++i__) { work[i__] += (r__1 = a[i__ + j * a_dim1], dabs(r__1)); /* L60: */ } /* L70: */ } value = 0.f; i__1 = *m; for (i__ = 1; i__ <= i__1; ++i__) { /* Computing MAX */ r__1 = value, r__2 = work[i__]; value = dmax(r__1,r__2); /* L80: */ } } else if (lsame_(norm, "F") || lsame_(norm, "E")) { /* Find normF(A). */ scale = 0.f; sum = 1.f; i__1 = *n; for (j = 1; j <= i__1; ++j) { slassq_(m, &a[j * a_dim1 + 1], &c__1, &scale, &sum); /* L90: */ } value = scale * sqrt(sum); } ret_val = value; return ret_val; /* End of SLANGE */ } /* slange_ */