![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to zupgtr.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / lapack / lapack|
Return to zupgtr.f CVS log | Up to [local] / rpl / lapack / lapack |
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