SRC/dlanhs.f

   1 *> \brief \b DLANHS returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value of any element of an upper Hessenberg matrix.
   2 *
   3 *  =========== DOCUMENTATION ===========
   4 *
   5 * Online html documentation available at
   6 *            http://www.netlib.org/lapack/explore-html/
   7 *
   8 *> \htmlonly
   9 *> Download DLANHS + dependencies
  10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlanhs.f">
  11 *> [TGZ]</a>
  12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlanhs.f">
  13 *> [ZIP]</a>
  14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlanhs.f">
  15 *> [TXT]</a>
  16 *> \endhtmlonly
  17 *
  18 *  Definition:
  19 *  ===========
  20 *
  21 *       DOUBLE PRECISION FUNCTION DLANHS( NORM, N, A, LDA, WORK )
  22 *
  23 *       .. Scalar Arguments ..
  24 *       CHARACTER          NORM
  25 *       INTEGER            LDA, N
  26 *       ..
  27 *       .. Array Arguments ..
  28 *       DOUBLE PRECISION   A( LDA, * ), WORK( * )
  29 *       ..
  30 *
  31 *
  32 *> \par Purpose:
  33 *  =============
  34 *>
  35 *> \verbatim
  36 *>
  37 *> DLANHS  returns the value of the one norm,  or the Frobenius norm, or
  38 *> the  infinity norm,  or the  element of  largest absolute value  of a
  39 *> Hessenberg matrix A.
  40 *> \endverbatim
  41 *>
  42 *> \return DLANHS
  43 *> \verbatim
  44 *>
  45 *>    DLANHS = ( max(abs(A(i,j))), NORM = 'M' or 'm'
  46 *>             (
  47 *>             ( norm1(A),         NORM = '1', 'O' or 'o'
  48 *>             (
  49 *>             ( normI(A),         NORM = 'I' or 'i'
  50 *>             (
  51 *>             ( normF(A),         NORM = 'F', 'f', 'E' or 'e'
  52 *>
  53 *> where  norm1  denotes the  one norm of a matrix (maximum column sum),
  54 *> normI  denotes the  infinity norm  of a matrix  (maximum row sum) and
  55 *> normF  denotes the  Frobenius norm of a matrix (square root of sum of
  56 *> squares).  Note that  max(abs(A(i,j)))  is not a consistent matrix norm.
  57 *> \endverbatim
  58 *
  59 *  Arguments:
  60 *  ==========
  61 *
  62 *> \param[in] NORM
  63 *> \verbatim
  64 *>          NORM is CHARACTER*1
  65 *>          Specifies the value to be returned in DLANHS as described
  66 *>          above.
  67 *> \endverbatim
  68 *>
  69 *> \param[in] N
  70 *> \verbatim
  71 *>          N is INTEGER
  72 *>          The order of the matrix A.  N >= 0.  When N = 0, DLANHS is
  73 *>          set to zero.
  74 *> \endverbatim
  75 *>
  76 *> \param[in] A
  77 *> \verbatim
  78 *>          A is DOUBLE PRECISION array, dimension (LDA,N)
  79 *>          The n by n upper Hessenberg matrix A; the part of A below the
  80 *>          first sub-diagonal is not referenced.
  81 *> \endverbatim
  82 *>
  83 *> \param[in] LDA
  84 *> \verbatim
  85 *>          LDA is INTEGER
  86 *>          The leading dimension of the array A.  LDA >= max(N,1).
  87 *> \endverbatim
  88 *>
  89 *> \param[out] WORK
  90 *> \verbatim
  91 *>          WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK)),
  92 *>          where LWORK >= N when NORM = 'I'; otherwise, WORK is not
  93 *>          referenced.
  94 *> \endverbatim
  95 *
  96 *  Authors:
  97 *  ========
  98 *
  99 *> \author Univ. of Tennessee
 100 *> \author Univ. of California Berkeley
 101 *> \author Univ. of Colorado Denver
 102 *> \author NAG Ltd.
 103 *
 104 *> \date September 2012
 105 *
 106 *> \ingroup doubleOTHERauxiliary
 107 *
 108 *  =====================================================================
 109       DOUBLE PRECISION FUNCTION DLANHS( NORM, N, A, LDA, WORK )
 110 *
 111 *  -- LAPACK auxiliary routine (version 3.4.2) --
 112 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 113 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 114 *     September 2012
 115 *
 116 *     .. Scalar Arguments ..
 117       CHARACTER          NORM
 118       INTEGER            LDA, N
 119 *     ..
 120 *     .. Array Arguments ..
 121       DOUBLE PRECISION   A( LDA, * ), WORK( * )
 122 *     ..
 123 *
 124 * =====================================================================
 125 *
 126 *     .. Parameters ..
 127       DOUBLE PRECISION   ONE, ZERO
 128       PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
 129 *     ..
 130 *     .. Local Scalars ..
 131       INTEGER            I, J
 132       DOUBLE PRECISION   SCALE, SUM, VALUE
 133 *     ..
 134 *     .. External Subroutines ..
 135       EXTERNAL           DLASSQ
 136 *     ..
 137 *     .. External Functions ..
 138       LOGICAL            LSAME, DISNAN
 139       EXTERNAL           LSAME, DISNAN
 140 *     ..
 141 *     .. Intrinsic Functions ..
 142       INTRINSIC          ABS, MIN, SQRT
 143 *     ..
 144 *     .. Executable Statements ..
 145 *
 146       IF( N.EQ.0 ) THEN
 147          VALUE = ZERO
 148       ELSE IF( LSAME( NORM, 'M' ) ) THEN
 149 *
 150 *        Find max(abs(A(i,j))).
 151 *
 152          VALUE = ZERO
 153          DO 20 J = 1, N
 154             DO 10 I = 1, MIN( N, J+1 )
 155                SUM = ABS( A( I, J ) )
 156                IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
 157    10       CONTINUE
 158    20    CONTINUE
 159       ELSE IF( ( LSAME( NORM, 'O' ) ) .OR. ( NORM.EQ.'1' ) ) THEN
 160 *
 161 *        Find norm1(A).
 162 *
 163          VALUE = ZERO
 164          DO 40 J = 1, N
 165             SUM = ZERO
 166             DO 30 I = 1, MIN( N, J+1 )
 167                SUM = SUM + ABS( A( I, J ) )
 168    30       CONTINUE
 169             IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
 170    40    CONTINUE
 171       ELSE IF( LSAME( NORM, 'I' ) ) THEN
 172 *
 173 *        Find normI(A).
 174 *
 175          DO 50 I = 1, N
 176             WORK( I ) = ZERO
 177    50    CONTINUE
 178          DO 70 J = 1, N
 179             DO 60 I = 1, MIN( N, J+1 )
 180                WORK( I ) = WORK( I ) + ABS( A( I, J ) )
 181    60       CONTINUE
 182    70    CONTINUE
 183          VALUE = ZERO
 184          DO 80 I = 1, N
 185             SUM = WORK( I )
 186             IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
 187    80    CONTINUE
 188       ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
 189 *
 190 *        Find normF(A).
 191 *
 192          SCALE = ZERO
 193          SUM = ONE
 194          DO 90 J = 1, N
 195             CALL DLASSQ( MIN( N, J+1 ), A( 1, J ), 1, SCALE, SUM )
 196    90    CONTINUE
 197          VALUE = SCALE*SQRT( SUM )
 198       END IF
 199 *
 200       DLANHS = VALUE
 201       RETURN
 202 *
 203 *     End of DLANHS
 204 *
 205       END