Annotation of rpl/lapack/lapack/zhbtrd.f, revision 1.1
1.1 ! bertrand 1: SUBROUTINE ZHBTRD( VECT, UPLO, N, KD, AB, LDAB, D, E, Q, LDQ,
! 2: $ WORK, INFO )
! 3: *
! 4: * -- LAPACK routine (version 3.2) --
! 5: * -- LAPACK is a software package provided by Univ. of Tennessee, --
! 6: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
! 7: * November 2006
! 8: *
! 9: * .. Scalar Arguments ..
! 10: CHARACTER UPLO, VECT
! 11: INTEGER INFO, KD, LDAB, LDQ, N
! 12: * ..
! 13: * .. Array Arguments ..
! 14: DOUBLE PRECISION D( * ), E( * )
! 15: COMPLEX*16 AB( LDAB, * ), Q( LDQ, * ), WORK( * )
! 16: * ..
! 17: *
! 18: * Purpose
! 19: * =======
! 20: *
! 21: * ZHBTRD reduces a complex Hermitian band matrix A to real symmetric
! 22: * tridiagonal form T by a unitary similarity transformation:
! 23: * Q**H * A * Q = T.
! 24: *
! 25: * Arguments
! 26: * =========
! 27: *
! 28: * VECT (input) CHARACTER*1
! 29: * = 'N': do not form Q;
! 30: * = 'V': form Q;
! 31: * = 'U': update a matrix X, by forming X*Q.
! 32: *
! 33: * UPLO (input) CHARACTER*1
! 34: * = 'U': Upper triangle of A is stored;
! 35: * = 'L': Lower triangle of A is stored.
! 36: *
! 37: * N (input) INTEGER
! 38: * The order of the matrix A. N >= 0.
! 39: *
! 40: * KD (input) INTEGER
! 41: * The number of superdiagonals of the matrix A if UPLO = 'U',
! 42: * or the number of subdiagonals if UPLO = 'L'. KD >= 0.
! 43: *
! 44: * AB (input/output) COMPLEX*16 array, dimension (LDAB,N)
! 45: * On entry, the upper or lower triangle of the Hermitian band
! 46: * matrix A, stored in the first KD+1 rows of the array. The
! 47: * j-th column of A is stored in the j-th column of the array AB
! 48: * as follows:
! 49: * if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
! 50: * if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
! 51: * On exit, the diagonal elements of AB are overwritten by the
! 52: * diagonal elements of the tridiagonal matrix T; if KD > 0, the
! 53: * elements on the first superdiagonal (if UPLO = 'U') or the
! 54: * first subdiagonal (if UPLO = 'L') are overwritten by the
! 55: * off-diagonal elements of T; the rest of AB is overwritten by
! 56: * values generated during the reduction.
! 57: *
! 58: * LDAB (input) INTEGER
! 59: * The leading dimension of the array AB. LDAB >= KD+1.
! 60: *
! 61: * D (output) DOUBLE PRECISION array, dimension (N)
! 62: * The diagonal elements of the tridiagonal matrix T.
! 63: *
! 64: * E (output) DOUBLE PRECISION array, dimension (N-1)
! 65: * The off-diagonal elements of the tridiagonal matrix T:
! 66: * E(i) = T(i,i+1) if UPLO = 'U'; E(i) = T(i+1,i) if UPLO = 'L'.
! 67: *
! 68: * Q (input/output) COMPLEX*16 array, dimension (LDQ,N)
! 69: * On entry, if VECT = 'U', then Q must contain an N-by-N
! 70: * matrix X; if VECT = 'N' or 'V', then Q need not be set.
! 71: *
! 72: * On exit:
! 73: * if VECT = 'V', Q contains the N-by-N unitary matrix Q;
! 74: * if VECT = 'U', Q contains the product X*Q;
! 75: * if VECT = 'N', the array Q is not referenced.
! 76: *
! 77: * LDQ (input) INTEGER
! 78: * The leading dimension of the array Q.
! 79: * LDQ >= 1, and LDQ >= N if VECT = 'V' or 'U'.
! 80: *
! 81: * WORK (workspace) COMPLEX*16 array, dimension (N)
! 82: *
! 83: * INFO (output) INTEGER
! 84: * = 0: successful exit
! 85: * < 0: if INFO = -i, the i-th argument had an illegal value
! 86: *
! 87: * Further Details
! 88: * ===============
! 89: *
! 90: * Modified by Linda Kaufman, Bell Labs.
! 91: *
! 92: * =====================================================================
! 93: *
! 94: * .. Parameters ..
! 95: DOUBLE PRECISION ZERO
! 96: PARAMETER ( ZERO = 0.0D+0 )
! 97: COMPLEX*16 CZERO, CONE
! 98: PARAMETER ( CZERO = ( 0.0D+0, 0.0D+0 ),
! 99: $ CONE = ( 1.0D+0, 0.0D+0 ) )
! 100: * ..
! 101: * .. Local Scalars ..
! 102: LOGICAL INITQ, UPPER, WANTQ
! 103: INTEGER I, I2, IBL, INCA, INCX, IQAEND, IQB, IQEND, J,
! 104: $ J1, J1END, J1INC, J2, JEND, JIN, JINC, K, KD1,
! 105: $ KDM1, KDN, L, LAST, LEND, NQ, NR, NRT
! 106: DOUBLE PRECISION ABST
! 107: COMPLEX*16 T, TEMP
! 108: * ..
! 109: * .. External Subroutines ..
! 110: EXTERNAL XERBLA, ZLACGV, ZLAR2V, ZLARGV, ZLARTG, ZLARTV,
! 111: $ ZLASET, ZROT, ZSCAL
! 112: * ..
! 113: * .. Intrinsic Functions ..
! 114: INTRINSIC ABS, DBLE, DCONJG, MAX, MIN
! 115: * ..
! 116: * .. External Functions ..
! 117: LOGICAL LSAME
! 118: EXTERNAL LSAME
! 119: * ..
! 120: * .. Executable Statements ..
! 121: *
! 122: * Test the input parameters
! 123: *
! 124: INITQ = LSAME( VECT, 'V' )
! 125: WANTQ = INITQ .OR. LSAME( VECT, 'U' )
! 126: UPPER = LSAME( UPLO, 'U' )
! 127: KD1 = KD + 1
! 128: KDM1 = KD - 1
! 129: INCX = LDAB - 1
! 130: IQEND = 1
! 131: *
! 132: INFO = 0
! 133: IF( .NOT.WANTQ .AND. .NOT.LSAME( VECT, 'N' ) ) THEN
! 134: INFO = -1
! 135: ELSE IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
! 136: INFO = -2
! 137: ELSE IF( N.LT.0 ) THEN
! 138: INFO = -3
! 139: ELSE IF( KD.LT.0 ) THEN
! 140: INFO = -4
! 141: ELSE IF( LDAB.LT.KD1 ) THEN
! 142: INFO = -6
! 143: ELSE IF( LDQ.LT.MAX( 1, N ) .AND. WANTQ ) THEN
! 144: INFO = -10
! 145: END IF
! 146: IF( INFO.NE.0 ) THEN
! 147: CALL XERBLA( 'ZHBTRD', -INFO )
! 148: RETURN
! 149: END IF
! 150: *
! 151: * Quick return if possible
! 152: *
! 153: IF( N.EQ.0 )
! 154: $ RETURN
! 155: *
! 156: * Initialize Q to the unit matrix, if needed
! 157: *
! 158: IF( INITQ )
! 159: $ CALL ZLASET( 'Full', N, N, CZERO, CONE, Q, LDQ )
! 160: *
! 161: * Wherever possible, plane rotations are generated and applied in
! 162: * vector operations of length NR over the index set J1:J2:KD1.
! 163: *
! 164: * The real cosines and complex sines of the plane rotations are
! 165: * stored in the arrays D and WORK.
! 166: *
! 167: INCA = KD1*LDAB
! 168: KDN = MIN( N-1, KD )
! 169: IF( UPPER ) THEN
! 170: *
! 171: IF( KD.GT.1 ) THEN
! 172: *
! 173: * Reduce to complex Hermitian tridiagonal form, working with
! 174: * the upper triangle
! 175: *
! 176: NR = 0
! 177: J1 = KDN + 2
! 178: J2 = 1
! 179: *
! 180: AB( KD1, 1 ) = DBLE( AB( KD1, 1 ) )
! 181: DO 90 I = 1, N - 2
! 182: *
! 183: * Reduce i-th row of matrix to tridiagonal form
! 184: *
! 185: DO 80 K = KDN + 1, 2, -1
! 186: J1 = J1 + KDN
! 187: J2 = J2 + KDN
! 188: *
! 189: IF( NR.GT.0 ) THEN
! 190: *
! 191: * generate plane rotations to annihilate nonzero
! 192: * elements which have been created outside the band
! 193: *
! 194: CALL ZLARGV( NR, AB( 1, J1-1 ), INCA, WORK( J1 ),
! 195: $ KD1, D( J1 ), KD1 )
! 196: *
! 197: * apply rotations from the right
! 198: *
! 199: *
! 200: * Dependent on the the number of diagonals either
! 201: * ZLARTV or ZROT is used
! 202: *
! 203: IF( NR.GE.2*KD-1 ) THEN
! 204: DO 10 L = 1, KD - 1
! 205: CALL ZLARTV( NR, AB( L+1, J1-1 ), INCA,
! 206: $ AB( L, J1 ), INCA, D( J1 ),
! 207: $ WORK( J1 ), KD1 )
! 208: 10 CONTINUE
! 209: *
! 210: ELSE
! 211: JEND = J1 + ( NR-1 )*KD1
! 212: DO 20 JINC = J1, JEND, KD1
! 213: CALL ZROT( KDM1, AB( 2, JINC-1 ), 1,
! 214: $ AB( 1, JINC ), 1, D( JINC ),
! 215: $ WORK( JINC ) )
! 216: 20 CONTINUE
! 217: END IF
! 218: END IF
! 219: *
! 220: *
! 221: IF( K.GT.2 ) THEN
! 222: IF( K.LE.N-I+1 ) THEN
! 223: *
! 224: * generate plane rotation to annihilate a(i,i+k-1)
! 225: * within the band
! 226: *
! 227: CALL ZLARTG( AB( KD-K+3, I+K-2 ),
! 228: $ AB( KD-K+2, I+K-1 ), D( I+K-1 ),
! 229: $ WORK( I+K-1 ), TEMP )
! 230: AB( KD-K+3, I+K-2 ) = TEMP
! 231: *
! 232: * apply rotation from the right
! 233: *
! 234: CALL ZROT( K-3, AB( KD-K+4, I+K-2 ), 1,
! 235: $ AB( KD-K+3, I+K-1 ), 1, D( I+K-1 ),
! 236: $ WORK( I+K-1 ) )
! 237: END IF
! 238: NR = NR + 1
! 239: J1 = J1 - KDN - 1
! 240: END IF
! 241: *
! 242: * apply plane rotations from both sides to diagonal
! 243: * blocks
! 244: *
! 245: IF( NR.GT.0 )
! 246: $ CALL ZLAR2V( NR, AB( KD1, J1-1 ), AB( KD1, J1 ),
! 247: $ AB( KD, J1 ), INCA, D( J1 ),
! 248: $ WORK( J1 ), KD1 )
! 249: *
! 250: * apply plane rotations from the left
! 251: *
! 252: IF( NR.GT.0 ) THEN
! 253: CALL ZLACGV( NR, WORK( J1 ), KD1 )
! 254: IF( 2*KD-1.LT.NR ) THEN
! 255: *
! 256: * Dependent on the the number of diagonals either
! 257: * ZLARTV or ZROT is used
! 258: *
! 259: DO 30 L = 1, KD - 1
! 260: IF( J2+L.GT.N ) THEN
! 261: NRT = NR - 1
! 262: ELSE
! 263: NRT = NR
! 264: END IF
! 265: IF( NRT.GT.0 )
! 266: $ CALL ZLARTV( NRT, AB( KD-L, J1+L ), INCA,
! 267: $ AB( KD-L+1, J1+L ), INCA,
! 268: $ D( J1 ), WORK( J1 ), KD1 )
! 269: 30 CONTINUE
! 270: ELSE
! 271: J1END = J1 + KD1*( NR-2 )
! 272: IF( J1END.GE.J1 ) THEN
! 273: DO 40 JIN = J1, J1END, KD1
! 274: CALL ZROT( KD-1, AB( KD-1, JIN+1 ), INCX,
! 275: $ AB( KD, JIN+1 ), INCX,
! 276: $ D( JIN ), WORK( JIN ) )
! 277: 40 CONTINUE
! 278: END IF
! 279: LEND = MIN( KDM1, N-J2 )
! 280: LAST = J1END + KD1
! 281: IF( LEND.GT.0 )
! 282: $ CALL ZROT( LEND, AB( KD-1, LAST+1 ), INCX,
! 283: $ AB( KD, LAST+1 ), INCX, D( LAST ),
! 284: $ WORK( LAST ) )
! 285: END IF
! 286: END IF
! 287: *
! 288: IF( WANTQ ) THEN
! 289: *
! 290: * accumulate product of plane rotations in Q
! 291: *
! 292: IF( INITQ ) THEN
! 293: *
! 294: * take advantage of the fact that Q was
! 295: * initially the Identity matrix
! 296: *
! 297: IQEND = MAX( IQEND, J2 )
! 298: I2 = MAX( 0, K-3 )
! 299: IQAEND = 1 + I*KD
! 300: IF( K.EQ.2 )
! 301: $ IQAEND = IQAEND + KD
! 302: IQAEND = MIN( IQAEND, IQEND )
! 303: DO 50 J = J1, J2, KD1
! 304: IBL = I - I2 / KDM1
! 305: I2 = I2 + 1
! 306: IQB = MAX( 1, J-IBL )
! 307: NQ = 1 + IQAEND - IQB
! 308: IQAEND = MIN( IQAEND+KD, IQEND )
! 309: CALL ZROT( NQ, Q( IQB, J-1 ), 1, Q( IQB, J ),
! 310: $ 1, D( J ), DCONJG( WORK( J ) ) )
! 311: 50 CONTINUE
! 312: ELSE
! 313: *
! 314: DO 60 J = J1, J2, KD1
! 315: CALL ZROT( N, Q( 1, J-1 ), 1, Q( 1, J ), 1,
! 316: $ D( J ), DCONJG( WORK( J ) ) )
! 317: 60 CONTINUE
! 318: END IF
! 319: *
! 320: END IF
! 321: *
! 322: IF( J2+KDN.GT.N ) THEN
! 323: *
! 324: * adjust J2 to keep within the bounds of the matrix
! 325: *
! 326: NR = NR - 1
! 327: J2 = J2 - KDN - 1
! 328: END IF
! 329: *
! 330: DO 70 J = J1, J2, KD1
! 331: *
! 332: * create nonzero element a(j-1,j+kd) outside the band
! 333: * and store it in WORK
! 334: *
! 335: WORK( J+KD ) = WORK( J )*AB( 1, J+KD )
! 336: AB( 1, J+KD ) = D( J )*AB( 1, J+KD )
! 337: 70 CONTINUE
! 338: 80 CONTINUE
! 339: 90 CONTINUE
! 340: END IF
! 341: *
! 342: IF( KD.GT.0 ) THEN
! 343: *
! 344: * make off-diagonal elements real and copy them to E
! 345: *
! 346: DO 100 I = 1, N - 1
! 347: T = AB( KD, I+1 )
! 348: ABST = ABS( T )
! 349: AB( KD, I+1 ) = ABST
! 350: E( I ) = ABST
! 351: IF( ABST.NE.ZERO ) THEN
! 352: T = T / ABST
! 353: ELSE
! 354: T = CONE
! 355: END IF
! 356: IF( I.LT.N-1 )
! 357: $ AB( KD, I+2 ) = AB( KD, I+2 )*T
! 358: IF( WANTQ ) THEN
! 359: CALL ZSCAL( N, DCONJG( T ), Q( 1, I+1 ), 1 )
! 360: END IF
! 361: 100 CONTINUE
! 362: ELSE
! 363: *
! 364: * set E to zero if original matrix was diagonal
! 365: *
! 366: DO 110 I = 1, N - 1
! 367: E( I ) = ZERO
! 368: 110 CONTINUE
! 369: END IF
! 370: *
! 371: * copy diagonal elements to D
! 372: *
! 373: DO 120 I = 1, N
! 374: D( I ) = AB( KD1, I )
! 375: 120 CONTINUE
! 376: *
! 377: ELSE
! 378: *
! 379: IF( KD.GT.1 ) THEN
! 380: *
! 381: * Reduce to complex Hermitian tridiagonal form, working with
! 382: * the lower triangle
! 383: *
! 384: NR = 0
! 385: J1 = KDN + 2
! 386: J2 = 1
! 387: *
! 388: AB( 1, 1 ) = DBLE( AB( 1, 1 ) )
! 389: DO 210 I = 1, N - 2
! 390: *
! 391: * Reduce i-th column of matrix to tridiagonal form
! 392: *
! 393: DO 200 K = KDN + 1, 2, -1
! 394: J1 = J1 + KDN
! 395: J2 = J2 + KDN
! 396: *
! 397: IF( NR.GT.0 ) THEN
! 398: *
! 399: * generate plane rotations to annihilate nonzero
! 400: * elements which have been created outside the band
! 401: *
! 402: CALL ZLARGV( NR, AB( KD1, J1-KD1 ), INCA,
! 403: $ WORK( J1 ), KD1, D( J1 ), KD1 )
! 404: *
! 405: * apply plane rotations from one side
! 406: *
! 407: *
! 408: * Dependent on the the number of diagonals either
! 409: * ZLARTV or ZROT is used
! 410: *
! 411: IF( NR.GT.2*KD-1 ) THEN
! 412: DO 130 L = 1, KD - 1
! 413: CALL ZLARTV( NR, AB( KD1-L, J1-KD1+L ), INCA,
! 414: $ AB( KD1-L+1, J1-KD1+L ), INCA,
! 415: $ D( J1 ), WORK( J1 ), KD1 )
! 416: 130 CONTINUE
! 417: ELSE
! 418: JEND = J1 + KD1*( NR-1 )
! 419: DO 140 JINC = J1, JEND, KD1
! 420: CALL ZROT( KDM1, AB( KD, JINC-KD ), INCX,
! 421: $ AB( KD1, JINC-KD ), INCX,
! 422: $ D( JINC ), WORK( JINC ) )
! 423: 140 CONTINUE
! 424: END IF
! 425: *
! 426: END IF
! 427: *
! 428: IF( K.GT.2 ) THEN
! 429: IF( K.LE.N-I+1 ) THEN
! 430: *
! 431: * generate plane rotation to annihilate a(i+k-1,i)
! 432: * within the band
! 433: *
! 434: CALL ZLARTG( AB( K-1, I ), AB( K, I ),
! 435: $ D( I+K-1 ), WORK( I+K-1 ), TEMP )
! 436: AB( K-1, I ) = TEMP
! 437: *
! 438: * apply rotation from the left
! 439: *
! 440: CALL ZROT( K-3, AB( K-2, I+1 ), LDAB-1,
! 441: $ AB( K-1, I+1 ), LDAB-1, D( I+K-1 ),
! 442: $ WORK( I+K-1 ) )
! 443: END IF
! 444: NR = NR + 1
! 445: J1 = J1 - KDN - 1
! 446: END IF
! 447: *
! 448: * apply plane rotations from both sides to diagonal
! 449: * blocks
! 450: *
! 451: IF( NR.GT.0 )
! 452: $ CALL ZLAR2V( NR, AB( 1, J1-1 ), AB( 1, J1 ),
! 453: $ AB( 2, J1-1 ), INCA, D( J1 ),
! 454: $ WORK( J1 ), KD1 )
! 455: *
! 456: * apply plane rotations from the right
! 457: *
! 458: *
! 459: * Dependent on the the number of diagonals either
! 460: * ZLARTV or ZROT is used
! 461: *
! 462: IF( NR.GT.0 ) THEN
! 463: CALL ZLACGV( NR, WORK( J1 ), KD1 )
! 464: IF( NR.GT.2*KD-1 ) THEN
! 465: DO 150 L = 1, KD - 1
! 466: IF( J2+L.GT.N ) THEN
! 467: NRT = NR - 1
! 468: ELSE
! 469: NRT = NR
! 470: END IF
! 471: IF( NRT.GT.0 )
! 472: $ CALL ZLARTV( NRT, AB( L+2, J1-1 ), INCA,
! 473: $ AB( L+1, J1 ), INCA, D( J1 ),
! 474: $ WORK( J1 ), KD1 )
! 475: 150 CONTINUE
! 476: ELSE
! 477: J1END = J1 + KD1*( NR-2 )
! 478: IF( J1END.GE.J1 ) THEN
! 479: DO 160 J1INC = J1, J1END, KD1
! 480: CALL ZROT( KDM1, AB( 3, J1INC-1 ), 1,
! 481: $ AB( 2, J1INC ), 1, D( J1INC ),
! 482: $ WORK( J1INC ) )
! 483: 160 CONTINUE
! 484: END IF
! 485: LEND = MIN( KDM1, N-J2 )
! 486: LAST = J1END + KD1
! 487: IF( LEND.GT.0 )
! 488: $ CALL ZROT( LEND, AB( 3, LAST-1 ), 1,
! 489: $ AB( 2, LAST ), 1, D( LAST ),
! 490: $ WORK( LAST ) )
! 491: END IF
! 492: END IF
! 493: *
! 494: *
! 495: *
! 496: IF( WANTQ ) THEN
! 497: *
! 498: * accumulate product of plane rotations in Q
! 499: *
! 500: IF( INITQ ) THEN
! 501: *
! 502: * take advantage of the fact that Q was
! 503: * initially the Identity matrix
! 504: *
! 505: IQEND = MAX( IQEND, J2 )
! 506: I2 = MAX( 0, K-3 )
! 507: IQAEND = 1 + I*KD
! 508: IF( K.EQ.2 )
! 509: $ IQAEND = IQAEND + KD
! 510: IQAEND = MIN( IQAEND, IQEND )
! 511: DO 170 J = J1, J2, KD1
! 512: IBL = I - I2 / KDM1
! 513: I2 = I2 + 1
! 514: IQB = MAX( 1, J-IBL )
! 515: NQ = 1 + IQAEND - IQB
! 516: IQAEND = MIN( IQAEND+KD, IQEND )
! 517: CALL ZROT( NQ, Q( IQB, J-1 ), 1, Q( IQB, J ),
! 518: $ 1, D( J ), WORK( J ) )
! 519: 170 CONTINUE
! 520: ELSE
! 521: *
! 522: DO 180 J = J1, J2, KD1
! 523: CALL ZROT( N, Q( 1, J-1 ), 1, Q( 1, J ), 1,
! 524: $ D( J ), WORK( J ) )
! 525: 180 CONTINUE
! 526: END IF
! 527: END IF
! 528: *
! 529: IF( J2+KDN.GT.N ) THEN
! 530: *
! 531: * adjust J2 to keep within the bounds of the matrix
! 532: *
! 533: NR = NR - 1
! 534: J2 = J2 - KDN - 1
! 535: END IF
! 536: *
! 537: DO 190 J = J1, J2, KD1
! 538: *
! 539: * create nonzero element a(j+kd,j-1) outside the
! 540: * band and store it in WORK
! 541: *
! 542: WORK( J+KD ) = WORK( J )*AB( KD1, J )
! 543: AB( KD1, J ) = D( J )*AB( KD1, J )
! 544: 190 CONTINUE
! 545: 200 CONTINUE
! 546: 210 CONTINUE
! 547: END IF
! 548: *
! 549: IF( KD.GT.0 ) THEN
! 550: *
! 551: * make off-diagonal elements real and copy them to E
! 552: *
! 553: DO 220 I = 1, N - 1
! 554: T = AB( 2, I )
! 555: ABST = ABS( T )
! 556: AB( 2, I ) = ABST
! 557: E( I ) = ABST
! 558: IF( ABST.NE.ZERO ) THEN
! 559: T = T / ABST
! 560: ELSE
! 561: T = CONE
! 562: END IF
! 563: IF( I.LT.N-1 )
! 564: $ AB( 2, I+1 ) = AB( 2, I+1 )*T
! 565: IF( WANTQ ) THEN
! 566: CALL ZSCAL( N, T, Q( 1, I+1 ), 1 )
! 567: END IF
! 568: 220 CONTINUE
! 569: ELSE
! 570: *
! 571: * set E to zero if original matrix was diagonal
! 572: *
! 573: DO 230 I = 1, N - 1
! 574: E( I ) = ZERO
! 575: 230 CONTINUE
! 576: END IF
! 577: *
! 578: * copy diagonal elements to D
! 579: *
! 580: DO 240 I = 1, N
! 581: D( I ) = AB( 1, I )
! 582: 240 CONTINUE
! 583: END IF
! 584: *
! 585: RETURN
! 586: *
! 587: * End of ZHBTRD
! 588: *
! 589: END
CVSweb interface <joel.bertrand@systella.fr>