Return to zupgtr.f CVS log

Up to [local] / rpl / lapack / lapack

Annotation of rpl/lapack/lapack/zupgtr.f, revision 1.1

1.1     ! bertrand    1:       SUBROUTINE ZUPGTR( UPLO, N, AP, TAU, Q, LDQ, WORK, INFO )
        !             2: *
        !             3: *  -- LAPACK routine (version 3.2) --
        !             4: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
        !             5: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
        !             6: *     November 2006
        !             7: *
        !             8: *     .. Scalar Arguments ..
        !             9:       CHARACTER          UPLO
        !            10:       INTEGER            INFO, LDQ, N
        !            11: *     ..
        !            12: *     .. Array Arguments ..
        !            13:       COMPLEX*16         AP( * ), Q( LDQ, * ), TAU( * ), WORK( * )
        !            14: *     ..
        !            15: *
        !            16: *  Purpose
        !            17: *  =======
        !            18: *
        !            19: *  ZUPGTR generates a complex unitary matrix Q which is defined as the
        !            20: *  product of n-1 elementary reflectors H(i) of order n, as returned by
        !            21: *  ZHPTRD using packed storage:
        !            22: *
        !            23: *  if UPLO = 'U', Q = H(n-1) . . . H(2) H(1),
        !            24: *
        !            25: *  if UPLO = 'L', Q = H(1) H(2) . . . H(n-1).
        !            26: *
        !            27: *  Arguments
        !            28: *  =========
        !            29: *
        !            30: *  UPLO    (input) CHARACTER*1
        !            31: *          = 'U': Upper triangular packed storage used in previous
        !            32: *                 call to ZHPTRD;
        !            33: *          = 'L': Lower triangular packed storage used in previous
        !            34: *                 call to ZHPTRD.
        !            35: *
        !            36: *  N       (input) INTEGER
        !            37: *          The order of the matrix Q. N >= 0.
        !            38: *
        !            39: *  AP      (input) COMPLEX*16 array, dimension (N*(N+1)/2)
        !            40: *          The vectors which define the elementary reflectors, as
        !            41: *          returned by ZHPTRD.
        !            42: *
        !            43: *  TAU     (input) COMPLEX*16 array, dimension (N-1)
        !            44: *          TAU(i) must contain the scalar factor of the elementary
        !            45: *          reflector H(i), as returned by ZHPTRD.
        !            46: *
        !            47: *  Q       (output) COMPLEX*16 array, dimension (LDQ,N)
        !            48: *          The N-by-N unitary matrix Q.
        !            49: *
        !            50: *  LDQ     (input) INTEGER
        !            51: *          The leading dimension of the array Q. LDQ >= max(1,N).
        !            52: *
        !            53: *  WORK    (workspace) COMPLEX*16 array, dimension (N-1)
        !            54: *
        !            55: *  INFO    (output) INTEGER
        !            56: *          = 0:  successful exit
        !            57: *          < 0:  if INFO = -i, the i-th argument had an illegal value
        !            58: *
        !            59: *  =====================================================================
        !            60: *
        !            61: *     .. Parameters ..
        !            62:       COMPLEX*16         CZERO, CONE
        !            63:       PARAMETER          ( CZERO = ( 0.0D+0, 0.0D+0 ),
        !            64:      $                   CONE = ( 1.0D+0, 0.0D+0 ) )
        !            65: *     ..
        !            66: *     .. Local Scalars ..
        !            67:       LOGICAL            UPPER
        !            68:       INTEGER            I, IINFO, IJ, J
        !            69: *     ..
        !            70: *     .. External Functions ..
        !            71:       LOGICAL            LSAME
        !            72:       EXTERNAL           LSAME
        !            73: *     ..
        !            74: *     .. External Subroutines ..
        !            75:       EXTERNAL           XERBLA, ZUNG2L, ZUNG2R
        !            76: *     ..
        !            77: *     .. Intrinsic Functions ..
        !            78:       INTRINSIC          MAX
        !            79: *     ..
        !            80: *     .. Executable Statements ..
        !            81: *
        !            82: *     Test the input arguments
        !            83: *
        !            84:       INFO = 0
        !            85:       UPPER = LSAME( UPLO, 'U' )
        !            86:       IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
        !            87:          INFO = -1
        !            88:       ELSE IF( N.LT.0 ) THEN
        !            89:          INFO = -2
        !            90:       ELSE IF( LDQ.LT.MAX( 1, N ) ) THEN
        !            91:          INFO = -6
        !            92:       END IF
        !            93:       IF( INFO.NE.0 ) THEN
        !            94:          CALL XERBLA( 'ZUPGTR', -INFO )
        !            95:          RETURN
        !            96:       END IF
        !            97: *
        !            98: *     Quick return if possible
        !            99: *
        !           100:       IF( N.EQ.0 )
        !           101:      $   RETURN
        !           102: *
        !           103:       IF( UPPER ) THEN
        !           104: *
        !           105: *        Q was determined by a call to ZHPTRD with UPLO = 'U'
        !           106: *
        !           107: *        Unpack the vectors which define the elementary reflectors and
        !           108: *        set the last row and column of Q equal to those of the unit
        !           109: *        matrix
        !           110: *
        !           111:          IJ = 2
        !           112:          DO 20 J = 1, N - 1
        !           113:             DO 10 I = 1, J - 1
        !           114:                Q( I, J ) = AP( IJ )
        !           115:                IJ = IJ + 1
        !           116:    10       CONTINUE
        !           117:             IJ = IJ + 2
        !           118:             Q( N, J ) = CZERO
        !           119:    20    CONTINUE
        !           120:          DO 30 I = 1, N - 1
        !           121:             Q( I, N ) = CZERO
        !           122:    30    CONTINUE
        !           123:          Q( N, N ) = CONE
        !           124: *
        !           125: *        Generate Q(1:n-1,1:n-1)
        !           126: *
        !           127:          CALL ZUNG2L( N-1, N-1, N-1, Q, LDQ, TAU, WORK, IINFO )
        !           128: *
        !           129:       ELSE
        !           130: *
        !           131: *        Q was determined by a call to ZHPTRD with UPLO = 'L'.
        !           132: *
        !           133: *        Unpack the vectors which define the elementary reflectors and
        !           134: *        set the first row and column of Q equal to those of the unit
        !           135: *        matrix
        !           136: *
        !           137:          Q( 1, 1 ) = CONE
        !           138:          DO 40 I = 2, N
        !           139:             Q( I, 1 ) = CZERO
        !           140:    40    CONTINUE
        !           141:          IJ = 3
        !           142:          DO 60 J = 2, N
        !           143:             Q( 1, J ) = CZERO
        !           144:             DO 50 I = J + 1, N
        !           145:                Q( I, J ) = AP( IJ )
        !           146:                IJ = IJ + 1
        !           147:    50       CONTINUE
        !           148:             IJ = IJ + 2
        !           149:    60    CONTINUE
        !           150:          IF( N.GT.1 ) THEN
        !           151: *
        !           152: *           Generate Q(2:n,2:n)
        !           153: *
        !           154:             CALL ZUNG2R( N-1, N-1, N-1, Q( 2, 2 ), LDQ, TAU, WORK,
        !           155:      $                   IINFO )
        !           156:          END IF
        !           157:       END IF
        !           158:       RETURN
        !           159: *
        !           160: *     End of ZUPGTR
        !           161: *
        !           162:       END