← Back to branch summary

~ubuntu-branches/debian/sid/octave3.0/sid

« back to all changes in this revision

Viewing changes to libcruft/lapack/zlanhs.f

  • Committer: Bazaar Package Importer
  • Author(s): Rafael Laboissiere
  • Date: 2007-12-23 16:04:15 UTC
  • Revision ID: james.westby@ubuntu.com-20071223160415-n4gk468dihy22e9v
Tags: upstream-3.0.0
Import upstream version 3.0.0

Show diffs side-by-side

added added

removed removed

Lines of Context:
libcruft/lapack/zlanhs.f
 
1
      DOUBLE PRECISION FUNCTION ZLANHS( NORM, N, A, LDA, WORK )
 
2
*
 
3
*  -- LAPACK auxiliary routine (version 3.1) --
 
4
*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
 
5
*     November 2006
 
6
*
 
7
*     .. Scalar Arguments ..
 
8
      CHARACTER          NORM
 
9
      INTEGER            LDA, N
 
10
*     ..
 
11
*     .. Array Arguments ..
 
12
      DOUBLE PRECISION   WORK( * )
 
13
      COMPLEX*16         A( LDA, * )
 
14
*     ..
 
15
*
 
16
*  Purpose
 
17
*  =======
 
18
*
 
19
*  ZLANHS  returns the value of the one norm,  or the Frobenius norm, or
 
20
*  the  infinity norm,  or the  element of  largest absolute value  of a
 
21
*  Hessenberg matrix A.
 
22
*
 
23
*  Description
 
24
*  ===========
 
25
*
 
26
*  ZLANHS returns the value
 
27
*
 
28
*     ZLANHS = ( max(abs(A(i,j))), NORM = 'M' or 'm'
 
29
*              (
 
30
*              ( norm1(A),         NORM = '1', 'O' or 'o'
 
31
*              (
 
32
*              ( normI(A),         NORM = 'I' or 'i'
 
33
*              (
 
34
*              ( normF(A),         NORM = 'F', 'f', 'E' or 'e'
 
35
*
 
36
*  where  norm1  denotes the  one norm of a matrix (maximum column sum),
 
37
*  normI  denotes the  infinity norm  of a matrix  (maximum row sum) and
 
38
*  normF  denotes the  Frobenius norm of a matrix (square root of sum of
 
39
*  squares).  Note that  max(abs(A(i,j)))  is not a consistent matrix norm.
 
40
*
 
41
*  Arguments
 
42
*  =========
 
43
*
 
44
*  NORM    (input) CHARACTER*1
 
45
*          Specifies the value to be returned in ZLANHS as described
 
46
*          above.
 
47
*
 
48
*  N       (input) INTEGER
 
49
*          The order of the matrix A.  N >= 0.  When N = 0, ZLANHS is
 
50
*          set to zero.
 
51
*
 
52
*  A       (input) COMPLEX*16 array, dimension (LDA,N)
 
53
*          The n by n upper Hessenberg matrix A; the part of A below the
 
54
*          first sub-diagonal is not referenced.
 
55
*
 
56
*  LDA     (input) INTEGER
 
57
*          The leading dimension of the array A.  LDA >= max(N,1).
 
58
*
 
59
*  WORK    (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK)),
 
60
*          where LWORK >= N when NORM = 'I'; otherwise, WORK is not
 
61
*          referenced.
 
62
*
 
63
* =====================================================================
 
64
*
 
65
*     .. Parameters ..
 
66
      DOUBLE PRECISION   ONE, ZERO
 
67
      PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
 
68
*     ..
 
69
*     .. Local Scalars ..
 
70
      INTEGER            I, J
 
71
      DOUBLE PRECISION   SCALE, SUM, VALUE
 
72
*     ..
 
73
*     .. External Functions ..
 
74
      LOGICAL            LSAME
 
75
      EXTERNAL           LSAME
 
76
*     ..
 
77
*     .. External Subroutines ..
 
78
      EXTERNAL           ZLASSQ
 
79
*     ..
 
80
*     .. Intrinsic Functions ..
 
81
      INTRINSIC          ABS, MAX, MIN, SQRT
 
82
*     ..
 
83
*     .. Executable Statements ..
 
84
*
 
85
      IF( N.EQ.0 ) THEN
 
86
         VALUE = ZERO
 
87
      ELSE IF( LSAME( NORM, 'M' ) ) THEN
 
88
*
 
89
*        Find max(abs(A(i,j))).
 
90
*
 
91
         VALUE = ZERO
 
92
         DO 20 J = 1, N
 
93
            DO 10 I = 1, MIN( N, J+1 )
 
94
               VALUE = MAX( VALUE, ABS( A( I, J ) ) )
 
95
   10       CONTINUE
 
96
   20    CONTINUE
 
97
      ELSE IF( ( LSAME( NORM, 'O' ) ) .OR. ( NORM.EQ.'1' ) ) THEN
 
98
*
 
99
*        Find norm1(A).
 
100
*
 
101
         VALUE = ZERO
 
102
         DO 40 J = 1, N
 
103
            SUM = ZERO
 
104
            DO 30 I = 1, MIN( N, J+1 )
 
105
               SUM = SUM + ABS( A( I, J ) )
 
106
   30       CONTINUE
 
107
            VALUE = MAX( VALUE, SUM )
 
108
   40    CONTINUE
 
109
      ELSE IF( LSAME( NORM, 'I' ) ) THEN
 
110
*
 
111
*        Find normI(A).
 
112
*
 
113
         DO 50 I = 1, N
 
114
            WORK( I ) = ZERO
 
115
   50    CONTINUE
 
116
         DO 70 J = 1, N
 
117
            DO 60 I = 1, MIN( N, J+1 )
 
118
               WORK( I ) = WORK( I ) + ABS( A( I, J ) )
 
119
   60       CONTINUE
 
120
   70    CONTINUE
 
121
         VALUE = ZERO
 
122
         DO 80 I = 1, N
 
123
            VALUE = MAX( VALUE, WORK( I ) )
 
124
   80    CONTINUE
 
125
      ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
 
126
*
 
127
*        Find normF(A).
 
128
*
 
129
         SCALE = ZERO
 
130
         SUM = ONE
 
131
         DO 90 J = 1, N
 
132
            CALL ZLASSQ( MIN( N, J+1 ), A( 1, J ), 1, SCALE, SUM )
 
133
   90    CONTINUE
 
134
         VALUE = SCALE*SQRT( SUM )
 
135
      END IF
 
136
*
 
137
      ZLANHS = VALUE
 
138
      RETURN
 
139
*
 
140
*     End of ZLANHS
 
141
*
 
142
      END