1 SUBROUTINE ZUNGHR( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, 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 INTEGER IHI, ILO, INFO, LDA, LWORK, N
10 * ..
11 * .. Array Arguments ..
12 COMPLEX*16 A( LDA, * ), TAU( * ), WORK( * )
13 * ..
14 *
15 * Purpose
16 * =======
17 *
18 * ZUNGHR generates a complex unitary matrix Q which is defined as the
19 * product of IHI-ILO elementary reflectors of order N, as returned by
20 * ZGEHRD:
21 *
22 * Q = H(ilo) H(ilo+1) . . . H(ihi-1).
23 *
24 * Arguments
25 * =========
26 *
27 * N (input) INTEGER
28 * The order of the matrix Q. N >= 0.
29 *
30 * ILO (input) INTEGER
31 * IHI (input) INTEGER
32 * ILO and IHI must have the same values as in the previous call
33 * of ZGEHRD. Q is equal to the unit matrix except in the
34 * submatrix Q(ilo+1:ihi,ilo+1:ihi).
35 * 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
36 *
37 * A (input/output) COMPLEX*16 array, dimension (LDA,N)
38 * On entry, the vectors which define the elementary reflectors,
39 * as returned by ZGEHRD.
40 * On exit, the N-by-N unitary matrix Q.
41 *
42 * LDA (input) INTEGER
43 * The leading dimension of the array A. LDA >= max(1,N).
44 *
45 * TAU (input) COMPLEX*16 array, dimension (N-1)
46 * TAU(i) must contain the scalar factor of the elementary
47 * reflector H(i), as returned by ZGEHRD.
48 *
49 * WORK (workspace/output) COMPLEX*16 array, dimension (MAX(1,LWORK))
50 * On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
51 *
52 * LWORK (input) INTEGER
53 * The dimension of the array WORK. LWORK >= IHI-ILO.
54 * For optimum performance LWORK >= (IHI-ILO)*NB, where NB is
55 * the optimal blocksize.
56 *
57 * If LWORK = -1, then a workspace query is assumed; the routine
58 * only calculates the optimal size of the WORK array, returns
59 * this value as the first entry of the WORK array, and no error
60 * message related to LWORK is issued by XERBLA.
61 *
62 * INFO (output) INTEGER
63 * = 0: successful exit
64 * < 0: if INFO = -i, the i-th argument had an illegal value
65 *
66 * =====================================================================
67 *
68 * .. Parameters ..
69 COMPLEX*16 ZERO, ONE
70 PARAMETER ( ZERO = ( 0.0D+0, 0.0D+0 ),
71 $ ONE = ( 1.0D+0, 0.0D+0 ) )
72 * ..
73 * .. Local Scalars ..
74 LOGICAL LQUERY
75 INTEGER I, IINFO, J, LWKOPT, NB, NH
76 * ..
77 * .. External Subroutines ..
78 EXTERNAL XERBLA, ZUNGQR
79 * ..
80 * .. External Functions ..
81 INTEGER ILAENV
82 EXTERNAL ILAENV
83 * ..
84 * .. Intrinsic Functions ..
85 INTRINSIC MAX, MIN
86 * ..
87 * .. Executable Statements ..
88 *
89 * Test the input arguments
90 *
91 INFO = 0
92 NH = IHI - ILO
93 LQUERY = ( LWORK.EQ.-1 )
94 IF( N.LT.0 ) THEN
95 INFO = -1
96 ELSE IF( ILO.LT.1 .OR. ILO.GT.MAX( 1, N ) ) THEN
97 INFO = -2
98 ELSE IF( IHI.LT.MIN( ILO, N ) .OR. IHI.GT.N ) THEN
99 INFO = -3
100 ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
101 INFO = -5
102 ELSE IF( LWORK.LT.MAX( 1, NH ) .AND. .NOT.LQUERY ) THEN
103 INFO = -8
104 END IF
105 *
106 IF( INFO.EQ.0 ) THEN
107 NB = ILAENV( 1, 'ZUNGQR', ' ', NH, NH, NH, -1 )
108 LWKOPT = MAX( 1, NH )*NB
109 WORK( 1 ) = LWKOPT
110 END IF
111 *
112 IF( INFO.NE.0 ) THEN
113 CALL XERBLA( 'ZUNGHR', -INFO )
114 RETURN
115 ELSE IF( LQUERY ) THEN
116 RETURN
117 END IF
118 *
119 * Quick return if possible
120 *
121 IF( N.EQ.0 ) THEN
122 WORK( 1 ) = 1
123 RETURN
124 END IF
125 *
126 * Shift the vectors which define the elementary reflectors one
127 * column to the right, and set the first ilo and the last n-ihi
128 * rows and columns to those of the unit matrix
129 *
130 DO 40 J = IHI, ILO + 1, -1
131 DO 10 I = 1, J - 1
132 A( I, J ) = ZERO
133 10 CONTINUE
134 DO 20 I = J + 1, IHI
135 A( I, J ) = A( I, J-1 )
136 20 CONTINUE
137 DO 30 I = IHI + 1, N
138 A( I, J ) = ZERO
139 30 CONTINUE
140 40 CONTINUE
141 DO 60 J = 1, ILO
142 DO 50 I = 1, N
143 A( I, J ) = ZERO
144 50 CONTINUE
145 A( J, J ) = ONE
146 60 CONTINUE
147 DO 80 J = IHI + 1, N
148 DO 70 I = 1, N
149 A( I, J ) = ZERO
150 70 CONTINUE
151 A( J, J ) = ONE
152 80 CONTINUE
153 *
154 IF( NH.GT.0 ) THEN
155 *
156 * Generate Q(ilo+1:ihi,ilo+1:ihi)
157 *
158 CALL ZUNGQR( NH, NH, NH, A( ILO+1, ILO+1 ), LDA, TAU( ILO ),
159 $ WORK, LWORK, IINFO )
160 END IF
161 WORK( 1 ) = LWKOPT
162 RETURN
163 *
164 * End of ZUNGHR
165 *
166 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 INTEGER IHI, ILO, INFO, LDA, LWORK, N
10 * ..
11 * .. Array Arguments ..
12 COMPLEX*16 A( LDA, * ), TAU( * ), WORK( * )
13 * ..
14 *
15 * Purpose
16 * =======
17 *
18 * ZUNGHR generates a complex unitary matrix Q which is defined as the
19 * product of IHI-ILO elementary reflectors of order N, as returned by
20 * ZGEHRD:
21 *
22 * Q = H(ilo) H(ilo+1) . . . H(ihi-1).
23 *
24 * Arguments
25 * =========
26 *
27 * N (input) INTEGER
28 * The order of the matrix Q. N >= 0.
29 *
30 * ILO (input) INTEGER
31 * IHI (input) INTEGER
32 * ILO and IHI must have the same values as in the previous call
33 * of ZGEHRD. Q is equal to the unit matrix except in the
34 * submatrix Q(ilo+1:ihi,ilo+1:ihi).
35 * 1 <= ILO <= IHI <= N, if N > 0; ILO=1 and IHI=0, if N=0.
36 *
37 * A (input/output) COMPLEX*16 array, dimension (LDA,N)
38 * On entry, the vectors which define the elementary reflectors,
39 * as returned by ZGEHRD.
40 * On exit, the N-by-N unitary matrix Q.
41 *
42 * LDA (input) INTEGER
43 * The leading dimension of the array A. LDA >= max(1,N).
44 *
45 * TAU (input) COMPLEX*16 array, dimension (N-1)
46 * TAU(i) must contain the scalar factor of the elementary
47 * reflector H(i), as returned by ZGEHRD.
48 *
49 * WORK (workspace/output) COMPLEX*16 array, dimension (MAX(1,LWORK))
50 * On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
51 *
52 * LWORK (input) INTEGER
53 * The dimension of the array WORK. LWORK >= IHI-ILO.
54 * For optimum performance LWORK >= (IHI-ILO)*NB, where NB is
55 * the optimal blocksize.
56 *
57 * If LWORK = -1, then a workspace query is assumed; the routine
58 * only calculates the optimal size of the WORK array, returns
59 * this value as the first entry of the WORK array, and no error
60 * message related to LWORK is issued by XERBLA.
61 *
62 * INFO (output) INTEGER
63 * = 0: successful exit
64 * < 0: if INFO = -i, the i-th argument had an illegal value
65 *
66 * =====================================================================
67 *
68 * .. Parameters ..
69 COMPLEX*16 ZERO, ONE
70 PARAMETER ( ZERO = ( 0.0D+0, 0.0D+0 ),
71 $ ONE = ( 1.0D+0, 0.0D+0 ) )
72 * ..
73 * .. Local Scalars ..
74 LOGICAL LQUERY
75 INTEGER I, IINFO, J, LWKOPT, NB, NH
76 * ..
77 * .. External Subroutines ..
78 EXTERNAL XERBLA, ZUNGQR
79 * ..
80 * .. External Functions ..
81 INTEGER ILAENV
82 EXTERNAL ILAENV
83 * ..
84 * .. Intrinsic Functions ..
85 INTRINSIC MAX, MIN
86 * ..
87 * .. Executable Statements ..
88 *
89 * Test the input arguments
90 *
91 INFO = 0
92 NH = IHI - ILO
93 LQUERY = ( LWORK.EQ.-1 )
94 IF( N.LT.0 ) THEN
95 INFO = -1
96 ELSE IF( ILO.LT.1 .OR. ILO.GT.MAX( 1, N ) ) THEN
97 INFO = -2
98 ELSE IF( IHI.LT.MIN( ILO, N ) .OR. IHI.GT.N ) THEN
99 INFO = -3
100 ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
101 INFO = -5
102 ELSE IF( LWORK.LT.MAX( 1, NH ) .AND. .NOT.LQUERY ) THEN
103 INFO = -8
104 END IF
105 *
106 IF( INFO.EQ.0 ) THEN
107 NB = ILAENV( 1, 'ZUNGQR', ' ', NH, NH, NH, -1 )
108 LWKOPT = MAX( 1, NH )*NB
109 WORK( 1 ) = LWKOPT
110 END IF
111 *
112 IF( INFO.NE.0 ) THEN
113 CALL XERBLA( 'ZUNGHR', -INFO )
114 RETURN
115 ELSE IF( LQUERY ) THEN
116 RETURN
117 END IF
118 *
119 * Quick return if possible
120 *
121 IF( N.EQ.0 ) THEN
122 WORK( 1 ) = 1
123 RETURN
124 END IF
125 *
126 * Shift the vectors which define the elementary reflectors one
127 * column to the right, and set the first ilo and the last n-ihi
128 * rows and columns to those of the unit matrix
129 *
130 DO 40 J = IHI, ILO + 1, -1
131 DO 10 I = 1, J - 1
132 A( I, J ) = ZERO
133 10 CONTINUE
134 DO 20 I = J + 1, IHI
135 A( I, J ) = A( I, J-1 )
136 20 CONTINUE
137 DO 30 I = IHI + 1, N
138 A( I, J ) = ZERO
139 30 CONTINUE
140 40 CONTINUE
141 DO 60 J = 1, ILO
142 DO 50 I = 1, N
143 A( I, J ) = ZERO
144 50 CONTINUE
145 A( J, J ) = ONE
146 60 CONTINUE
147 DO 80 J = IHI + 1, N
148 DO 70 I = 1, N
149 A( I, J ) = ZERO
150 70 CONTINUE
151 A( J, J ) = ONE
152 80 CONTINUE
153 *
154 IF( NH.GT.0 ) THEN
155 *
156 * Generate Q(ilo+1:ihi,ilo+1:ihi)
157 *
158 CALL ZUNGQR( NH, NH, NH, A( ILO+1, ILO+1 ), LDA, TAU( ILO ),
159 $ WORK, LWORK, IINFO )
160 END IF
161 WORK( 1 ) = LWKOPT
162 RETURN
163 *
164 * End of ZUNGHR
165 *
166 END