1
/* -- translated by f2c (version 20050501).
2
You must link the resulting object file with libf2c:
3
on Microsoft Windows system, link with libf2c.lib;
4
on Linux or Unix systems, link with .../path/to/libf2c.a -lm
5
or, if you install libf2c.a in a standard place, with -lf2c -lm
6
-- in that order, at the end of the command line, as in
8
Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
10
http://www.netlib.org/f2c/libf2c.zip
14
#include "arpack_internal.h"
17
/* Table of constant values */
19
static integer c__1 = 1;
21
doublereal igraphdlanhs_(char *norm, integer *n, doublereal *a, integer *lda,
24
/* System generated locals */
25
integer a_dim1, a_offset, i__1, i__2, i__3, i__4;
26
doublereal ret_val, d__1, d__2, d__3;
28
/* Builtin functions */
29
double sqrt(doublereal);
32
static integer i__, j;
33
static doublereal sum, scale;
34
extern logical igraphlsame_(char *, char *);
35
static doublereal value;
36
extern /* Subroutine */ int igraphdlassq_(integer *, doublereal *, integer *,
37
doublereal *, doublereal *);
40
/* -- LAPACK auxiliary routine (version 3.0) -- */
41
/* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */
42
/* Courant Institute, Argonne National Lab, and Rice University */
43
/* October 31, 1992 */
45
/* .. Scalar Arguments .. */
47
/* .. Array Arguments .. */
53
/* DLANHS returns the value of the one norm, or the Frobenius norm, or */
54
/* the infinity norm, or the element of largest absolute value of a */
55
/* Hessenberg matrix A. */
60
/* DLANHS returns the value */
62
/* DLANHS = ( max(abs(A(i,j))), NORM = 'M' or 'm' */
64
/* ( norm1(A), NORM = '1', 'O' or 'o' */
66
/* ( normI(A), NORM = 'I' or 'i' */
68
/* ( normF(A), NORM = 'F', 'f', 'E' or 'e' */
70
/* where norm1 denotes the one norm of a matrix (maximum column sum), */
71
/* normI denotes the infinity norm of a matrix (maximum row sum) and */
72
/* normF denotes the Frobenius norm of a matrix (square root of sum of */
73
/* squares). Note that max(abs(A(i,j))) is not a matrix norm. */
78
/* NORM (input) CHARACTER*1 */
79
/* Specifies the value to be returned in DLANHS as described */
82
/* N (input) INTEGER */
83
/* The order of the matrix A. N >= 0. When N = 0, DLANHS is */
86
/* A (input) DOUBLE PRECISION array, dimension (LDA,N) */
87
/* The n by n upper Hessenberg matrix A; the part of A below the */
88
/* first sub-diagonal is not referenced. */
90
/* LDA (input) INTEGER */
91
/* The leading dimension of the array A. LDA >= max(N,1). */
93
/* WORK (workspace) DOUBLE PRECISION array, dimension (LWORK), */
94
/* where LWORK >= N when NORM = 'I'; otherwise, WORK is not */
97
/* ===================================================================== */
99
/* .. Parameters .. */
101
/* .. Local Scalars .. */
103
/* .. External Subroutines .. */
105
/* .. External Functions .. */
107
/* .. Intrinsic Functions .. */
109
/* .. Executable Statements .. */
111
/* Parameter adjustments */
113
a_offset = 1 + a_dim1;
120
} else if (igraphlsame_(norm, "M")) {
122
/* Find max(abs(A(i,j))). */
126
for (j = 1; j <= i__1; ++j) {
128
i__3 = *n, i__4 = j + 1;
129
i__2 = min(i__3,i__4);
130
for (i__ = 1; i__ <= i__2; ++i__) {
132
d__2 = value, d__3 = (d__1 = a[i__ + j * a_dim1], abs(d__1));
133
value = max(d__2,d__3);
138
} else if (igraphlsame_(norm, "O") || *(unsigned char *)
145
for (j = 1; j <= i__1; ++j) {
148
i__3 = *n, i__4 = j + 1;
149
i__2 = min(i__3,i__4);
150
for (i__ = 1; i__ <= i__2; ++i__) {
151
sum += (d__1 = a[i__ + j * a_dim1], abs(d__1));
154
value = max(value,sum);
157
} else if (igraphlsame_(norm, "I")) {
162
for (i__ = 1; i__ <= i__1; ++i__) {
167
for (j = 1; j <= i__1; ++j) {
169
i__3 = *n, i__4 = j + 1;
170
i__2 = min(i__3,i__4);
171
for (i__ = 1; i__ <= i__2; ++i__) {
172
work[i__] += (d__1 = a[i__ + j * a_dim1], abs(d__1));
179
for (i__ = 1; i__ <= i__1; ++i__) {
181
d__1 = value, d__2 = work[i__];
182
value = max(d__1,d__2);
185
} else if (igraphlsame_(norm, "F") || igraphlsame_(norm, "E")) {
192
for (j = 1; j <= i__1; ++j) {
194
i__3 = *n, i__4 = j + 1;
195
i__2 = min(i__3,i__4);
196
igraphdlassq_(&i__2, &a[j * a_dim1 + 1], &c__1, &scale, &sum);
199
value = scale * sqrt(sum);
207
} /* igraphdlanhs_ */
added
removed
src/lapack/dlanhs.c
