Annotation of rpl/lapack/lapack/zlansy.f, revision 1.19

1.11      bertrand    1: *> \brief \b ZLANSY returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a complex symmetric matrix.
1.8       bertrand    2: *
                      3: *  =========== DOCUMENTATION ===========
                      4: *
1.16      bertrand    5: * Online html documentation available at
                      6: *            http://www.netlib.org/lapack/explore-html/
1.8       bertrand    7: *
                      8: *> \htmlonly
1.16      bertrand    9: *> Download ZLANSY + dependencies
                     10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zlansy.f">
                     11: *> [TGZ]</a>
                     12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zlansy.f">
                     13: *> [ZIP]</a>
                     14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zlansy.f">
1.8       bertrand   15: *> [TXT]</a>
1.16      bertrand   16: *> \endhtmlonly
1.8       bertrand   17: *
                     18: *  Definition:
                     19: *  ===========
                     20: *
                     21: *       DOUBLE PRECISION FUNCTION ZLANSY( NORM, UPLO, N, A, LDA, WORK )
1.16      bertrand   22: *
1.8       bertrand   23: *       .. Scalar Arguments ..
                     24: *       CHARACTER          NORM, UPLO
                     25: *       INTEGER            LDA, N
                     26: *       ..
                     27: *       .. Array Arguments ..
                     28: *       DOUBLE PRECISION   WORK( * )
                     29: *       COMPLEX*16         A( LDA, * )
                     30: *       ..
1.16      bertrand   31: *
1.8       bertrand   32: *
                     33: *> \par Purpose:
                     34: *  =============
                     35: *>
                     36: *> \verbatim
                     37: *>
                     38: *> ZLANSY  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: *> complex symmetric matrix A.
                     41: *> \endverbatim
                     42: *>
                     43: *> \return ZLANSY
                     44: *> \verbatim
                     45: *>
                     46: *>    ZLANSY = ( 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 ZLANSY as described
                     67: *>          above.
                     68: *> \endverbatim
                     69: *>
                     70: *> \param[in] UPLO
                     71: *> \verbatim
                     72: *>          UPLO is CHARACTER*1
                     73: *>          Specifies whether the upper or lower triangular part of the
                     74: *>          symmetric matrix A is to be referenced.
                     75: *>          = 'U':  Upper triangular part of A is referenced
                     76: *>          = 'L':  Lower triangular part of A is referenced
                     77: *> \endverbatim
                     78: *>
                     79: *> \param[in] N
                     80: *> \verbatim
                     81: *>          N is INTEGER
                     82: *>          The order of the matrix A.  N >= 0.  When N = 0, ZLANSY is
                     83: *>          set to zero.
                     84: *> \endverbatim
                     85: *>
                     86: *> \param[in] A
                     87: *> \verbatim
                     88: *>          A is COMPLEX*16 array, dimension (LDA,N)
                     89: *>          The symmetric matrix A.  If UPLO = 'U', the leading n by n
                     90: *>          upper triangular part of A contains the upper triangular part
                     91: *>          of the matrix A, and the strictly lower triangular part of A
                     92: *>          is not referenced.  If UPLO = 'L', the leading n by n lower
                     93: *>          triangular part of A contains the lower triangular part of
                     94: *>          the matrix A, and the strictly upper triangular part of A is
                     95: *>          not referenced.
                     96: *> \endverbatim
                     97: *>
                     98: *> \param[in] LDA
                     99: *> \verbatim
                    100: *>          LDA is INTEGER
                    101: *>          The leading dimension of the array A.  LDA >= max(N,1).
                    102: *> \endverbatim
                    103: *>
                    104: *> \param[out] WORK
                    105: *> \verbatim
                    106: *>          WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK)),
                    107: *>          where LWORK >= N when NORM = 'I' or '1' or 'O'; otherwise,
                    108: *>          WORK is not referenced.
                    109: *> \endverbatim
                    110: *
                    111: *  Authors:
                    112: *  ========
                    113: *
1.16      bertrand  114: *> \author Univ. of Tennessee
                    115: *> \author Univ. of California Berkeley
                    116: *> \author Univ. of Colorado Denver
                    117: *> \author NAG Ltd.
1.8       bertrand  118: *
1.16      bertrand  119: *> \date December 2016
1.8       bertrand  120: *
                    121: *> \ingroup complex16SYauxiliary
                    122: *
                    123: *  =====================================================================
1.1       bertrand  124:       DOUBLE PRECISION FUNCTION ZLANSY( NORM, UPLO, N, A, LDA, WORK )
                    125: *
1.16      bertrand  126: *  -- LAPACK auxiliary routine (version 3.7.0) --
1.1       bertrand  127: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
                    128: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
1.16      bertrand  129: *     December 2016
1.1       bertrand  130: *
1.19    ! bertrand  131:       IMPLICIT NONE
1.1       bertrand  132: *     .. Scalar Arguments ..
                    133:       CHARACTER          NORM, UPLO
                    134:       INTEGER            LDA, N
                    135: *     ..
                    136: *     .. Array Arguments ..
                    137:       DOUBLE PRECISION   WORK( * )
                    138:       COMPLEX*16         A( LDA, * )
                    139: *     ..
                    140: *
                    141: * =====================================================================
                    142: *
                    143: *     .. Parameters ..
                    144:       DOUBLE PRECISION   ONE, ZERO
                    145:       PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
                    146: *     ..
                    147: *     .. Local Scalars ..
                    148:       INTEGER            I, J
1.19    ! bertrand  149:       DOUBLE PRECISION   ABSA, SUM, VALUE
        !           150: *     ..
        !           151: *     .. Local Arrays ..
        !           152:       DOUBLE PRECISION   SSQ( 2 ), COLSSQ( 2 )
1.1       bertrand  153: *     ..
                    154: *     .. External Functions ..
1.11      bertrand  155:       LOGICAL            LSAME, DISNAN
                    156:       EXTERNAL           LSAME, DISNAN
1.1       bertrand  157: *     ..
                    158: *     .. External Subroutines ..
1.19    ! bertrand  159:       EXTERNAL           ZLASSQ, DCOMBSSQ
1.1       bertrand  160: *     ..
                    161: *     .. Intrinsic Functions ..
1.11      bertrand  162:       INTRINSIC          ABS, SQRT
1.1       bertrand  163: *     ..
                    164: *     .. Executable Statements ..
                    165: *
                    166:       IF( N.EQ.0 ) THEN
                    167:          VALUE = ZERO
                    168:       ELSE IF( LSAME( NORM, 'M' ) ) THEN
                    169: *
                    170: *        Find max(abs(A(i,j))).
                    171: *
                    172:          VALUE = ZERO
                    173:          IF( LSAME( UPLO, 'U' ) ) THEN
                    174:             DO 20 J = 1, N
                    175:                DO 10 I = 1, J
1.11      bertrand  176:                   SUM = ABS( A( I, J ) )
                    177:                   IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
1.1       bertrand  178:    10          CONTINUE
                    179:    20       CONTINUE
                    180:          ELSE
                    181:             DO 40 J = 1, N
                    182:                DO 30 I = J, N
1.11      bertrand  183:                   SUM = ABS( A( I, J ) )
                    184:                   IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
1.1       bertrand  185:    30          CONTINUE
                    186:    40       CONTINUE
                    187:          END IF
                    188:       ELSE IF( ( LSAME( NORM, 'I' ) ) .OR. ( LSAME( NORM, 'O' ) ) .OR.
                    189:      $         ( NORM.EQ.'1' ) ) THEN
                    190: *
                    191: *        Find normI(A) ( = norm1(A), since A is symmetric).
                    192: *
                    193:          VALUE = ZERO
                    194:          IF( LSAME( UPLO, 'U' ) ) THEN
                    195:             DO 60 J = 1, N
                    196:                SUM = ZERO
                    197:                DO 50 I = 1, J - 1
                    198:                   ABSA = ABS( A( I, J ) )
                    199:                   SUM = SUM + ABSA
                    200:                   WORK( I ) = WORK( I ) + ABSA
                    201:    50          CONTINUE
                    202:                WORK( J ) = SUM + ABS( A( J, J ) )
                    203:    60       CONTINUE
                    204:             DO 70 I = 1, N
1.11      bertrand  205:                SUM = WORK( I )
                    206:                IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
1.1       bertrand  207:    70       CONTINUE
                    208:          ELSE
                    209:             DO 80 I = 1, N
                    210:                WORK( I ) = ZERO
                    211:    80       CONTINUE
                    212:             DO 100 J = 1, N
                    213:                SUM = WORK( J ) + ABS( A( J, J ) )
                    214:                DO 90 I = J + 1, N
                    215:                   ABSA = ABS( A( I, J ) )
                    216:                   SUM = SUM + ABSA
                    217:                   WORK( I ) = WORK( I ) + ABSA
                    218:    90          CONTINUE
1.11      bertrand  219:                IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM
1.1       bertrand  220:   100       CONTINUE
                    221:          END IF
                    222:       ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
                    223: *
                    224: *        Find normF(A).
1.19    ! bertrand  225: *        SSQ(1) is scale
        !           226: *        SSQ(2) is sum-of-squares
        !           227: *        For better accuracy, sum each column separately.
        !           228: *
        !           229:          SSQ( 1 ) = ZERO
        !           230:          SSQ( 2 ) = ONE
        !           231: *
        !           232: *        Sum off-diagonals
1.1       bertrand  233: *
                    234:          IF( LSAME( UPLO, 'U' ) ) THEN
                    235:             DO 110 J = 2, N
1.19    ! bertrand  236:                COLSSQ( 1 ) = ZERO
        !           237:                COLSSQ( 2 ) = ONE
        !           238:                CALL ZLASSQ( J-1, A( 1, J ), 1, COLSSQ(1), COLSSQ(2) )
        !           239:                CALL DCOMBSSQ( SSQ, COLSSQ )
1.1       bertrand  240:   110       CONTINUE
                    241:          ELSE
                    242:             DO 120 J = 1, N - 1
1.19    ! bertrand  243:                COLSSQ( 1 ) = ZERO
        !           244:                COLSSQ( 2 ) = ONE
        !           245:                CALL ZLASSQ( N-J, A( J+1, J ), 1, COLSSQ(1), COLSSQ(2) )
        !           246:                CALL DCOMBSSQ( SSQ, COLSSQ )
1.1       bertrand  247:   120       CONTINUE
                    248:          END IF
1.19    ! bertrand  249:          SSQ( 2 ) = 2*SSQ( 2 )
        !           250: *
        !           251: *        Sum diagonal
        !           252: *
        !           253:          COLSSQ( 1 ) = ZERO
        !           254:          COLSSQ( 2 ) = ONE
        !           255:          CALL ZLASSQ( N, A, LDA+1, COLSSQ( 1 ), COLSSQ( 2 ) )
        !           256:          CALL DCOMBSSQ( SSQ, COLSSQ )
        !           257:          VALUE = SSQ( 1 )*SQRT( SSQ( 2 ) )
1.1       bertrand  258:       END IF
                    259: *
                    260:       ZLANSY = VALUE
                    261:       RETURN
                    262: *
                    263: *     End of ZLANSY
                    264: *
                    265:       END

CVSweb interface <joel.bertrand@systella.fr>