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
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