SRC/zlantp.f

   1 *> \brief \b ZLANTP returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a triangular matrix supplied in packed form.
   2 *
   3 *  =========== DOCUMENTATION ===========
   4 *
   5 * Online html documentation available at
   6 *            http://www.netlib.org/lapack/explore-html/
   7 *
   8 *> \htmlonly
   9 *> Download ZLANTP + dependencies
  10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zlantp.f">
  11 *> [TGZ]</a>
  12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zlantp.f">
  13 *> [ZIP]</a>
  14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zlantp.f">
  15 *> [TXT]</a>
  16 *> \endhtmlonly
  17 *
  18 *  Definition:
  19 *  ===========
  20 *
  21 *       DOUBLE PRECISION FUNCTION ZLANTP( NORM, UPLO, DIAG, N, AP, WORK )
  22 *
  23 *       .. Scalar Arguments ..
  24 *       CHARACTER          DIAG, NORM, UPLO
  25 *       INTEGER            N
  26 *       ..
  27 *       .. Array Arguments ..
  28 *       DOUBLE PRECISION   WORK( * )
  29 *       COMPLEX*16         AP( * )
  30 *       ..
  31 *
  32 *
  33 *> \par Purpose:
  34 *  =============
  35 *>
  36 *> \verbatim
  37 *>
  38 *> ZLANTP  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
  40 *> triangular matrix A, supplied in packed form.
  41 *> \endverbatim
  42 *>
  43 *> \return ZLANTP
  44 *> \verbatim
  45 *>
  46 *>    ZLANTP = ( max(abs(A(i,j))), NORM = 'M' or 'm'
  47 *>             (
  48 *>             ( norm1(A),         NORM = '1', 'O' or 'o'
  49 *>             (
  50 *>             ( normI(A),         NORM = 'I' or 'i'
  51 *>             (
  52 *>             ( normF(A),         NORM = 'F', 'f', 'E' or 'e'
  53 *>
  54 *> where  norm1  denotes the  one norm of a matrix (maximum column sum),
  55 *> normI  denotes the  infinity norm  of a matrix  (maximum row sum) and
  56 *> normF  denotes the  Frobenius norm of a matrix (square root of sum of
  57 *> squares).  Note that  max(abs(A(i,j)))  is not a consistent matrix norm.
  58 *> \endverbatim
  59 *
  60 *  Arguments:
  61 *  ==========
  62 *
  63 *> \param[in] NORM
  64 *> \verbatim
  65 *>          NORM is CHARACTER*1
  66 *>          Specifies the value to be returned in ZLANTP as described
  67 *>          above.
  68 *> \endverbatim
  69 *>
  70 *> \param[in] UPLO
  71 *> \verbatim
  72 *>          UPLO is CHARACTER*1
  73 *>          Specifies whether the matrix A is upper or lower triangular.
  74 *>          = 'U':  Upper triangular
  75 *>          = 'L':  Lower triangular
  76 *> \endverbatim
  77 *>
  78 *> \param[in] DIAG
  79 *> \verbatim
  80 *>          DIAG is CHARACTER*1
  81 *>          Specifies whether or not the matrix A is unit triangular.
  82 *>          = 'N':  Non-unit triangular
  83 *>          = 'U':  Unit triangular
  84 *> \endverbatim
  85 *>
  86 *> \param[in] N
  87 *> \verbatim
  88 *>          N is INTEGER
  89 *>          The order of the matrix A.  N >= 0.  When N = 0, ZLANTP is
  90 *>          set to zero.
  91 *> \endverbatim
  92 *>
  93 *> \param[in] AP
  94 *> \verbatim
  95 *>          AP is COMPLEX*16 array, dimension (N*(N+1)/2)
  96 *>          The upper or lower triangular matrix A, packed columnwise in
  97 *>          a linear array.  The j-th column of A is stored in the array
  98 *>          AP as follows:
  99 *>          if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
 100 *>          if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.
 101 *>          Note that when DIAG = 'U', the elements of the array AP
 102 *>          corresponding to the diagonal elements of the matrix A are
 103 *>          not referenced, but are assumed to be one.
 104 *> \endverbatim
 105 *>
 106 *> \param[out] WORK
 107 *> \verbatim
 108 *>          WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK)),
 109 *>          where LWORK >= N when NORM = 'I'; otherwise, WORK is not
 110 *>          referenced.
 111 *> \endverbatim
 112 *
 113 *  Authors:
 114 *  ========
 115 *
 116 *> \author Univ. of Tennessee
 117 *> \author Univ. of California Berkeley
 118 *> \author Univ. of Colorado Denver
 119 *> \author NAG Ltd.
 120 *
 121 *> \date September 2012
 122 *
 123 *> \ingroup complex16OTHERauxiliary
 124 *
 125 *  =====================================================================
 126       DOUBLE PRECISION FUNCTION ZLANTP( NORM, UPLO, DIAG, N, AP, WORK )
 127 *
 128 *  -- LAPACK auxiliary routine (version 3.4.2) --
 129 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 130 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 131 *     September 2012
 132 *
 133 *     .. Scalar Arguments ..
 134       CHARACTER          DIAG, NORM, UPLO
 135       INTEGER            N
 136 *     ..
 137 *     .. Array Arguments ..
 138       DOUBLE PRECISION   WORK( * )
 139       COMPLEX*16         AP( * )
 140 *     ..
 141 *
 142 * =====================================================================
 143 *
 144 *     .. Parameters ..
 145       DOUBLE PRECISION   ONE, ZERO
 146       PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
 147 *     ..
 148 *     .. Local Scalars ..
 149       LOGICAL            UDIAG
 150       INTEGER            I, J, K
 151       DOUBLE PRECISION   SCALE, SUM, VALUE
 152 *     ..
 153 *     .. External Functions ..
 154       LOGICAL            LSAME, DISNAN
 155       EXTERNAL           LSAME, DISNAN
 156 *     ..
 157 *     .. External Subroutines ..
 158       EXTERNAL           ZLASSQ
 159 *     ..
 160 *     .. Intrinsic Functions ..
 161       INTRINSIC          ABS, SQRT
 162 *     ..
 163 *     .. Executable Statements ..
 164 *
 165       IF( N.EQ.0 ) THEN
 166          VALUE = ZERO
 167       ELSE IF( LSAME( NORM, 'M' ) ) THEN
 168 *
 169 *        Find max(abs(A(i,j))).
 170 *
 171          K = 1
 172          IF( LSAME( DIAG, 'U' ) ) THEN
 173             VALUE = ONE
 174             IF( LSAME( UPLO, 'U' ) ) THEN
 175                DO 20 J = 1, N
 176                   DO 10 I = K, K + J - 2
 177                      SUM = ABS( AP( I ) )
 178                      IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
 179    10             CONTINUE
 180                   K = K + J
 181    20          CONTINUE
 182             ELSE
 183                DO 40 J = 1, N
 184                   DO 30 I = K + 1, K + N - J
 185                      SUM = ABS( AP( I ) )
 186                      IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
 187    30             CONTINUE
 188                   K = K + N - J + 1
 189    40          CONTINUE
 190             END IF
 191          ELSE
 192             VALUE = ZERO
 193             IF( LSAME( UPLO, 'U' ) ) THEN
 194                DO 60 J = 1, N
 195                   DO 50 I = K, K + J - 1
 196                      SUM = ABS( AP( I ) )
 197                      IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
 198    50             CONTINUE
 199                   K = K + J
 200    60          CONTINUE
 201             ELSE
 202                DO 80 J = 1, N
 203                   DO 70 I = K, K + N - J
 204                      SUM = ABS( AP( I ) )
 205                      IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
 206    70             CONTINUE
 207                   K = K + N - J + 1
 208    80          CONTINUE
 209             END IF
 210          END IF
 211       ELSE IF( ( LSAME( NORM, 'O' ) ) .OR. ( NORM.EQ.'1' ) ) THEN
 212 *
 213 *        Find norm1(A).
 214 *
 215          VALUE = ZERO
 216          K = 1
 217          UDIAG = LSAME( DIAG, 'U' )
 218          IF( LSAME( UPLO, 'U' ) ) THEN
 219             DO 110 J = 1, N
 220                IF( UDIAG ) THEN
 221                   SUM = ONE
 222                   DO 90 I = K, K + J - 2
 223                      SUM = SUM + ABS( AP( I ) )
 224    90             CONTINUE
 225                ELSE
 226                   SUM = ZERO
 227                   DO 100 I = K, K + J - 1
 228                      SUM = SUM + ABS( AP( I ) )
 229   100             CONTINUE
 230                END IF
 231                K = K + J
 232                IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
 233   110       CONTINUE
 234          ELSE
 235             DO 140 J = 1, N
 236                IF( UDIAG ) THEN
 237                   SUM = ONE
 238                   DO 120 I = K + 1, K + N - J
 239                      SUM = SUM + ABS( AP( I ) )
 240   120             CONTINUE
 241                ELSE
 242                   SUM = ZERO
 243                   DO 130 I = K, K + N - J
 244                      SUM = SUM + ABS( AP( I ) )
 245   130             CONTINUE
 246                END IF
 247                K = K + N - J + 1
 248                IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
 249   140       CONTINUE
 250          END IF
 251       ELSE IF( LSAME( NORM, 'I' ) ) THEN
 252 *
 253 *        Find normI(A).
 254 *
 255          K = 1
 256          IF( LSAME( UPLO, 'U' ) ) THEN
 257             IF( LSAME( DIAG, 'U' ) ) THEN
 258                DO 150 I = 1, N
 259                   WORK( I ) = ONE
 260   150          CONTINUE
 261                DO 170 J = 1, N
 262                   DO 160 I = 1, J - 1
 263                      WORK( I ) = WORK( I ) + ABS( AP( K ) )
 264                      K = K + 1
 265   160             CONTINUE
 266                   K = K + 1
 267   170          CONTINUE
 268             ELSE
 269                DO 180 I = 1, N
 270                   WORK( I ) = ZERO
 271   180          CONTINUE
 272                DO 200 J = 1, N
 273                   DO 190 I = 1, J
 274                      WORK( I ) = WORK( I ) + ABS( AP( K ) )
 275                      K = K + 1
 276   190             CONTINUE
 277   200          CONTINUE
 278             END IF
 279          ELSE
 280             IF( LSAME( DIAG, 'U' ) ) THEN
 281                DO 210 I = 1, N
 282                   WORK( I ) = ONE
 283   210          CONTINUE
 284                DO 230 J = 1, N
 285                   K = K + 1
 286                   DO 220 I = J + 1, N
 287                      WORK( I ) = WORK( I ) + ABS( AP( K ) )
 288                      K = K + 1
 289   220             CONTINUE
 290   230          CONTINUE
 291             ELSE
 292                DO 240 I = 1, N
 293                   WORK( I ) = ZERO
 294   240          CONTINUE
 295                DO 260 J = 1, N
 296                   DO 250 I = J, N
 297                      WORK( I ) = WORK( I ) + ABS( AP( K ) )
 298                      K = K + 1
 299   250             CONTINUE
 300   260          CONTINUE
 301             END IF
 302          END IF
 303          VALUE = ZERO
 304          DO 270 I = 1, N
 305             SUM = WORK( I )
 306             IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
 307   270    CONTINUE
 308       ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
 309 *
 310 *        Find normF(A).
 311 *
 312          IF( LSAME( UPLO, 'U' ) ) THEN
 313             IF( LSAME( DIAG, 'U' ) ) THEN
 314                SCALE = ONE
 315                SUM = N
 316                K = 2
 317                DO 280 J = 2, N
 318                   CALL ZLASSQ( J-1, AP( K ), 1, SCALE, SUM )
 319                   K = K + J
 320   280          CONTINUE
 321             ELSE
 322                SCALE = ZERO
 323                SUM = ONE
 324                K = 1
 325                DO 290 J = 1, N
 326                   CALL ZLASSQ( J, AP( K ), 1, SCALE, SUM )
 327                   K = K + J
 328   290          CONTINUE
 329             END IF
 330          ELSE
 331             IF( LSAME( DIAG, 'U' ) ) THEN
 332                SCALE = ONE
 333                SUM = N
 334                K = 2
 335                DO 300 J = 1, N - 1
 336                   CALL ZLASSQ( N-J, AP( K ), 1, SCALE, SUM )
 337                   K = K + N - J + 1
 338   300          CONTINUE
 339             ELSE
 340                SCALE = ZERO
 341                SUM = ONE
 342                K = 1
 343                DO 310 J = 1, N
 344                   CALL ZLASSQ( N-J+1, AP( K ), 1, SCALE, SUM )
 345                   K = K + N - J + 1
 346   310          CONTINUE
 347             END IF
 348          END IF
 349          VALUE = SCALE*SQRT( SUM )
 350       END IF
 351 *
 352       ZLANTP = VALUE
 353       RETURN
 354 *
 355 *     End of ZLANTP
 356 *
 357       END