dc/d78/zlantp_8f_source.html

 *> \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.

 *

 *  =========== DOCUMENTATION ===========

 *

 * Online html documentation available at

 *            http://www.netlib.org/lapack/explore-html/

 *

 *> \htmlonly

 *> Download ZLANTP + dependencies

 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zlantp.f">

 *> [TGZ]</a>

 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zlantp.f">

 *> [ZIP]</a>

 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zlantp.f">

 *> [TXT]</a>

 *> \endhtmlonly

 *

 *  Definition:

 *  ===========

 *

 *       DOUBLE PRECISION FUNCTION ZLANTP( NORM, UPLO, DIAG, N, AP, WORK )

 *

 *       .. Scalar Arguments ..

 *       CHARACTER          DIAG, NORM, UPLO

 *       INTEGER            N

 *       ..

 *       .. Array Arguments ..

 *       DOUBLE PRECISION   WORK( * )

 *       COMPLEX*16         AP( * )

 *       ..

 *

 *

 *> \par Purpose:

 *  =============

 *>

 *> \verbatim

 *>

 *> ZLANTP  returns the value of the one norm,  or the Frobenius norm, or

 *> the  infinity norm,  or the  element of  largest absolute value  of a

 *> triangular matrix A, supplied in packed form.

 *> \endverbatim

 *>

 *> \return ZLANTP

 *> \verbatim

 *>

 *>    ZLANTP = ( 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.

 *> \endverbatim

 *

 *  Arguments:

 *  ==========

 *

 *> \param[in] NORM

 *> \verbatim

 *>          NORM is CHARACTER*1

 *>          Specifies the value to be returned in ZLANTP as described

 *>          above.

 *> \endverbatim

 *>

 *> \param[in] UPLO

 *> \verbatim

 *>          UPLO is CHARACTER*1

 *>          Specifies whether the matrix A is upper or lower triangular.

 *>          = 'U':  Upper triangular

 *>          = 'L':  Lower triangular

 *> \endverbatim

 *>

 *> \param[in] DIAG

 *> \verbatim

 *>          DIAG is CHARACTER*1

 *>          Specifies whether or not the matrix A is unit triangular.

 *>          = 'N':  Non-unit triangular

 *>          = 'U':  Unit triangular

 *> \endverbatim

 *>

 *> \param[in] N

 *> \verbatim

 *>          N is INTEGER

 *>          The order of the matrix A.  N >= 0.  When N = 0, ZLANTP is

 *>          set to zero.

 *> \endverbatim

 *>

 *> \param[in] AP

 *> \verbatim

 *>          AP is COMPLEX*16 array, dimension (N*(N+1)/2)

 *>          The upper or lower triangular matrix A, packed columnwise in

 *>          a linear array.  The j-th column of A is stored in the array

 *>          AP as follows:

 *>          if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;

 *>          if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = A(i,j) for j<=i<=n.

 *>          Note that when DIAG = 'U', the elements of the array AP

 *>          corresponding to the diagonal elements of the matrix A are

 *>          not referenced, but are assumed to be one.

 *> \endverbatim

 *>

 *> \param[out] WORK

 *> \verbatim

 *>          WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK)),

 *>          where LWORK >= N when NORM = 'I'; otherwise, WORK is not

 *>          referenced.

 *> \endverbatim

 *

 *  Authors:

 *  ========

 *

 *> \author Univ. of Tennessee

 *> \author Univ. of California Berkeley

 *> \author Univ. of Colorado Denver

 *> \author NAG Ltd.

 *

 *> \date September 2012

 *

 *> \ingroup complex16OTHERauxiliary

 *

 *  =====================================================================

       DOUBLE PRECISION FUNCTION zlantp( NORM, UPLO, DIAG, N, AP, WORK )

 *

 *  -- LAPACK auxiliary routine (version 3.4.2) --

 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --

 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--

 *     September 2012

 *

 *     .. Scalar Arguments ..

       CHARACTER          DIAG, NORM, UPLO

       INTEGER            N

 *     ..

 *     .. Array Arguments ..

       DOUBLE PRECISION   WORK( * )

       COMPLEX*16         AP( * )

 *     ..

 *

 * =====================================================================

 *

 *     .. Parameters ..

       DOUBLE PRECISION   ONE, ZERO

       parameter                ( one = 1.0d+0, zero = 0.0d+0 )

 *     ..

 *     .. Local Scalars ..

       LOGICAL            UDIAG

       INTEGER            I, J, K

       DOUBLE PRECISION   SCALE, SUM, VALUE

 *     ..

 *     .. External Functions ..

       LOGICAL            LSAME, DISNAN

       EXTERNAL           lsame, disnan

 *     ..

 *     .. External Subroutines ..

       EXTERNAL           zlassq

 *     ..

 *     .. Intrinsic Functions ..

       INTRINSIC          abs, sqrt

 *     ..

 *     .. Executable Statements ..

 *

       IF( n.EQ.0 ) THEN

          VALUE = zero

       ELSE IF( lsame( norm, 'M' ) ) THEN

 *

 *        Find max(abs(A(i,j))).

 *

          k = 1

          IF( lsame( diag, 'U' ) ) THEN

             VALUE = one

             IF( lsame( uplo, 'U' ) ) THEN

                DO 20 j = 1, n

                   DO 10 i = k, k + j - 2

                      sum = abs( ap( i ) )

                      IF( VALUE .LT. sum .OR. disnan( sum ) ) VALUE = sum

    10             CONTINUE

                   k = k + j

    20          CONTINUE

             ELSE

                DO 40 j = 1, n

                   DO 30 i = k + 1, k + n - j

                      sum = abs( ap( i ) )

                      IF( VALUE .LT. sum .OR. disnan( sum ) ) VALUE = sum

    30             CONTINUE

                   k = k + n - j + 1

    40          CONTINUE

             END IF

          ELSE

             VALUE = zero

             IF( lsame( uplo, 'U' ) ) THEN

                DO 60 j = 1, n

                   DO 50 i = k, k + j - 1

                      sum = abs( ap( i ) )

                      IF( VALUE .LT. sum .OR. disnan( sum ) ) VALUE = sum

    50             CONTINUE

                   k = k + j

    60          CONTINUE

             ELSE

                DO 80 j = 1, n

                   DO 70 i = k, k + n - j

                      sum = abs( ap( i ) )

                      IF( VALUE .LT. sum .OR. disnan( sum ) ) VALUE = sum

    70             CONTINUE

                   k = k + n - j + 1

    80          CONTINUE

             END IF

          END IF

       ELSE IF( ( lsame( norm, 'O' ) ) .OR. ( norm.EQ.'1' ) ) THEN

 *

 *        Find norm1(A).

 *

          VALUE = zero

          k = 1

          udiag = lsame( diag, 'U' )

          IF( lsame( uplo, 'U' ) ) THEN

             DO 110 j = 1, n

                IF( udiag ) THEN

                   sum = one

                   DO 90 i = k, k + j - 2

                      sum = sum + abs( ap( i ) )

    90             CONTINUE

                ELSE

                   sum = zero

                   DO 100 i = k, k + j - 1

                      sum = sum + abs( ap( i ) )

   100             CONTINUE

                END IF

                k = k + j

                IF( VALUE .LT. sum .OR. disnan( sum ) ) VALUE = sum

   110       CONTINUE

          ELSE

             DO 140 j = 1, n

                IF( udiag ) THEN

                   sum = one

                   DO 120 i = k + 1, k + n - j

                      sum = sum + abs( ap( i ) )

   120             CONTINUE

                ELSE

                   sum = zero

                   DO 130 i = k, k + n - j

                      sum = sum + abs( ap( i ) )

   130             CONTINUE

                END IF

                k = k + n - j + 1

                IF( VALUE .LT. sum .OR. disnan( sum ) ) VALUE = sum

   140       CONTINUE

          END IF

       ELSE IF( lsame( norm, 'I' ) ) THEN

 *

 *        Find normI(A).

 *

          k = 1

          IF( lsame( uplo, 'U' ) ) THEN

             IF( lsame( diag, 'U' ) ) THEN

                DO 150 i = 1, n

                   work( i ) = one

   150          CONTINUE

                DO 170 j = 1, n

                   DO 160 i = 1, j - 1

                      work( i ) = work( i ) + abs( ap( k ) )

                      k = k + 1

   160             CONTINUE

                   k = k + 1

   170          CONTINUE

             ELSE

                DO 180 i = 1, n

                   work( i ) = zero

   180          CONTINUE

                DO 200 j = 1, n

                   DO 190 i = 1, j

                      work( i ) = work( i ) + abs( ap( k ) )

                      k = k + 1

   190             CONTINUE

   200          CONTINUE

             END IF

          ELSE

             IF( lsame( diag, 'U' ) ) THEN

                DO 210 i = 1, n

                   work( i ) = one

   210          CONTINUE

                DO 230 j = 1, n

                   k = k + 1

                   DO 220 i = j + 1, n

                      work( i ) = work( i ) + abs( ap( k ) )

                      k = k + 1

   220             CONTINUE

   230          CONTINUE

             ELSE

                DO 240 i = 1, n

                   work( i ) = zero

   240          CONTINUE

                DO 260 j = 1, n

                   DO 250 i = j, n

                      work( i ) = work( i ) + abs( ap( k ) )

                      k = k + 1

   250             CONTINUE

   260          CONTINUE

             END IF

          END IF

          VALUE = zero

          DO 270 i = 1, n

             sum = work( i )

             IF( VALUE .LT. sum .OR. disnan( sum ) ) VALUE = sum

   270    CONTINUE

       ELSE IF( ( lsame( norm, 'F' ) ) .OR. ( lsame( norm, 'E' ) ) ) THEN

 *

 *        Find normF(A).

 *

          IF( lsame( uplo, 'U' ) ) THEN

             IF( lsame( diag, 'U' ) ) THEN

                scale = one

                sum = n

                k = 2

                DO 280 j = 2, n

                   CALL zlassq( j-1, ap( k ), 1, scale, sum )

                   k = k + j

   280          CONTINUE

             ELSE

                scale = zero

                sum = one

                k = 1

                DO 290 j = 1, n

                   CALL zlassq( j, ap( k ), 1, scale, sum )

                   k = k + j

   290          CONTINUE

             END IF

          ELSE

             IF( lsame( diag, 'U' ) ) THEN

                scale = one

                sum = n

                k = 2

                DO 300 j = 1, n - 1

                   CALL zlassq( n-j, ap( k ), 1, scale, sum )

                   k = k + n - j + 1

   300          CONTINUE

             ELSE

                scale = zero

                sum = one

                k = 1

                DO 310 j = 1, n

                   CALL zlassq( n-j+1, ap( k ), 1, scale, sum )

                   k = k + n - j + 1

   310          CONTINUE

             END IF

          END IF

          VALUE = scale*sqrt( sum )

       END IF

 *

       zlantp = VALUE

       RETURN

 *

 *     End of ZLANTP

 *

       END

zlassq
subroutine zlassq(N, X, INCX, SCALE, SUMSQ)
ZLASSQ updates a sum of squares represented in scaled form.
Definition: zlassq.f:108

zlantp
double precision function zlantp(NORM, UPLO, DIAG, N, AP, WORK)
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.
Definition: zlantp.f:127