1 SUBROUTINE ZUNMHR( SIDE, TRANS, M, N, ILO, IHI, A, LDA, TAU, C,
2 $ LDC, WORK, LWORK, 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 SIDE, TRANS
11 INTEGER IHI, ILO, INFO, LDA, LDC, LWORK, M, N
12 * ..
13 * .. Array Arguments ..
14 COMPLEX*16 A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
15 * ..
16 *
17 * Purpose
18 * =======
19 *
20 * ZUNMHR overwrites the general complex M-by-N matrix C with
21 *
22 * SIDE = 'L' SIDE = 'R'
23 * TRANS = 'N': Q * C C * Q
24 * TRANS = 'C': Q**H * C C * Q**H
25 *
26 * where Q is a complex unitary matrix of order nq, with nq = m if
27 * SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of
28 * IHI-ILO elementary reflectors, as returned by ZGEHRD:
29 *
30 * Q = H(ilo) H(ilo+1) . . . H(ihi-1).
31 *
32 * Arguments
33 * =========
34 *
35 * SIDE (input) CHARACTER*1
36 * = 'L': apply Q or Q**H from the Left;
37 * = 'R': apply Q or Q**H from the Right.
38 *
39 * TRANS (input) CHARACTER*1
40 * = 'N': apply Q (No transpose)
41 * = 'C': apply Q**H (Conjugate transpose)
42 *
43 * M (input) INTEGER
44 * The number of rows of the matrix C. M >= 0.
45 *
46 * N (input) INTEGER
47 * The number of columns of the matrix C. N >= 0.
48 *
49 * ILO (input) INTEGER
50 * IHI (input) INTEGER
51 * ILO and IHI must have the same values as in the previous call
52 * of ZGEHRD. Q is equal to the unit matrix except in the
53 * submatrix Q(ilo+1:ihi,ilo+1:ihi).
54 * If SIDE = 'L', then 1 <= ILO <= IHI <= M, if M > 0, and
55 * ILO = 1 and IHI = 0, if M = 0;
56 * if SIDE = 'R', then 1 <= ILO <= IHI <= N, if N > 0, and
57 * ILO = 1 and IHI = 0, if N = 0.
58 *
59 * A (input) COMPLEX*16 array, dimension
60 * (LDA,M) if SIDE = 'L'
61 * (LDA,N) if SIDE = 'R'
62 * The vectors which define the elementary reflectors, as
63 * returned by ZGEHRD.
64 *
65 * LDA (input) INTEGER
66 * The leading dimension of the array A.
67 * LDA >= max(1,M) if SIDE = 'L'; LDA >= max(1,N) if SIDE = 'R'.
68 *
69 * TAU (input) COMPLEX*16 array, dimension
70 * (M-1) if SIDE = 'L'
71 * (N-1) if SIDE = 'R'
72 * TAU(i) must contain the scalar factor of the elementary
73 * reflector H(i), as returned by ZGEHRD.
74 *
75 * C (input/output) COMPLEX*16 array, dimension (LDC,N)
76 * On entry, the M-by-N matrix C.
77 * On exit, C is overwritten by Q*C or Q**H*C or C*Q**H or C*Q.
78 *
79 * LDC (input) INTEGER
80 * The leading dimension of the array C. LDC >= max(1,M).
81 *
82 * WORK (workspace/output) COMPLEX*16 array, dimension (MAX(1,LWORK))
83 * On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
84 *
85 * LWORK (input) INTEGER
86 * The dimension of the array WORK.
87 * If SIDE = 'L', LWORK >= max(1,N);
88 * if SIDE = 'R', LWORK >= max(1,M).
89 * For optimum performance LWORK >= N*NB if SIDE = 'L', and
90 * LWORK >= M*NB if SIDE = 'R', where NB is the optimal
91 * blocksize.
92 *
93 * If LWORK = -1, then a workspace query is assumed; the routine
94 * only calculates the optimal size of the WORK array, returns
95 * this value as the first entry of the WORK array, and no error
96 * message related to LWORK is issued by XERBLA.
97 *
98 * INFO (output) INTEGER
99 * = 0: successful exit
100 * < 0: if INFO = -i, the i-th argument had an illegal value
101 *
102 * =====================================================================
103 *
104 * .. Local Scalars ..
105 LOGICAL LEFT, LQUERY
106 INTEGER I1, I2, IINFO, LWKOPT, MI, NB, NH, NI, NQ, NW
107 * ..
108 * .. External Functions ..
109 LOGICAL LSAME
110 INTEGER ILAENV
111 EXTERNAL LSAME, ILAENV
112 * ..
113 * .. External Subroutines ..
114 EXTERNAL XERBLA, ZUNMQR
115 * ..
116 * .. Intrinsic Functions ..
117 INTRINSIC MAX, MIN
118 * ..
119 * .. Executable Statements ..
120 *
121 * Test the input arguments
122 *
123 INFO = 0
124 NH = IHI - ILO
125 LEFT = LSAME( SIDE, 'L' )
126 LQUERY = ( LWORK.EQ.-1 )
127 *
128 * NQ is the order of Q and NW is the minimum dimension of WORK
129 *
130 IF( LEFT ) THEN
131 NQ = M
132 NW = N
133 ELSE
134 NQ = N
135 NW = M
136 END IF
137 IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN
138 INFO = -1
139 ELSE IF( .NOT.LSAME( TRANS, 'N' ) .AND. .NOT.LSAME( TRANS, 'C' ) )
140 $ THEN
141 INFO = -2
142 ELSE IF( M.LT.0 ) THEN
143 INFO = -3
144 ELSE IF( N.LT.0 ) THEN
145 INFO = -4
146 ELSE IF( ILO.LT.1 .OR. ILO.GT.MAX( 1, NQ ) ) THEN
147 INFO = -5
148 ELSE IF( IHI.LT.MIN( ILO, NQ ) .OR. IHI.GT.NQ ) THEN
149 INFO = -6
150 ELSE IF( LDA.LT.MAX( 1, NQ ) ) THEN
151 INFO = -8
152 ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
153 INFO = -11
154 ELSE IF( LWORK.LT.MAX( 1, NW ) .AND. .NOT.LQUERY ) THEN
155 INFO = -13
156 END IF
157 *
158 IF( INFO.EQ.0 ) THEN
159 IF( LEFT ) THEN
160 NB = ILAENV( 1, 'ZUNMQR', SIDE // TRANS, NH, N, NH, -1 )
161 ELSE
162 NB = ILAENV( 1, 'ZUNMQR', SIDE // TRANS, M, NH, NH, -1 )
163 END IF
164 LWKOPT = MAX( 1, NW )*NB
165 WORK( 1 ) = LWKOPT
166 END IF
167 *
168 IF( INFO.NE.0 ) THEN
169 CALL XERBLA( 'ZUNMHR', -INFO )
170 RETURN
171 ELSE IF( LQUERY ) THEN
172 RETURN
173 END IF
174 *
175 * Quick return if possible
176 *
177 IF( M.EQ.0 .OR. N.EQ.0 .OR. NH.EQ.0 ) THEN
178 WORK( 1 ) = 1
179 RETURN
180 END IF
181 *
182 IF( LEFT ) THEN
183 MI = NH
184 NI = N
185 I1 = ILO + 1
186 I2 = 1
187 ELSE
188 MI = M
189 NI = NH
190 I1 = 1
191 I2 = ILO + 1
192 END IF
193 *
194 CALL ZUNMQR( SIDE, TRANS, MI, NI, NH, A( ILO+1, ILO ), LDA,
195 $ TAU( ILO ), C( I1, I2 ), LDC, WORK, LWORK, IINFO )
196 *
197 WORK( 1 ) = LWKOPT
198 RETURN
199 *
200 * End of ZUNMHR
201 *
202 END
2 $ LDC, WORK, LWORK, 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 SIDE, TRANS
11 INTEGER IHI, ILO, INFO, LDA, LDC, LWORK, M, N
12 * ..
13 * .. Array Arguments ..
14 COMPLEX*16 A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
15 * ..
16 *
17 * Purpose
18 * =======
19 *
20 * ZUNMHR overwrites the general complex M-by-N matrix C with
21 *
22 * SIDE = 'L' SIDE = 'R'
23 * TRANS = 'N': Q * C C * Q
24 * TRANS = 'C': Q**H * C C * Q**H
25 *
26 * where Q is a complex unitary matrix of order nq, with nq = m if
27 * SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of
28 * IHI-ILO elementary reflectors, as returned by ZGEHRD:
29 *
30 * Q = H(ilo) H(ilo+1) . . . H(ihi-1).
31 *
32 * Arguments
33 * =========
34 *
35 * SIDE (input) CHARACTER*1
36 * = 'L': apply Q or Q**H from the Left;
37 * = 'R': apply Q or Q**H from the Right.
38 *
39 * TRANS (input) CHARACTER*1
40 * = 'N': apply Q (No transpose)
41 * = 'C': apply Q**H (Conjugate transpose)
42 *
43 * M (input) INTEGER
44 * The number of rows of the matrix C. M >= 0.
45 *
46 * N (input) INTEGER
47 * The number of columns of the matrix C. N >= 0.
48 *
49 * ILO (input) INTEGER
50 * IHI (input) INTEGER
51 * ILO and IHI must have the same values as in the previous call
52 * of ZGEHRD. Q is equal to the unit matrix except in the
53 * submatrix Q(ilo+1:ihi,ilo+1:ihi).
54 * If SIDE = 'L', then 1 <= ILO <= IHI <= M, if M > 0, and
55 * ILO = 1 and IHI = 0, if M = 0;
56 * if SIDE = 'R', then 1 <= ILO <= IHI <= N, if N > 0, and
57 * ILO = 1 and IHI = 0, if N = 0.
58 *
59 * A (input) COMPLEX*16 array, dimension
60 * (LDA,M) if SIDE = 'L'
61 * (LDA,N) if SIDE = 'R'
62 * The vectors which define the elementary reflectors, as
63 * returned by ZGEHRD.
64 *
65 * LDA (input) INTEGER
66 * The leading dimension of the array A.
67 * LDA >= max(1,M) if SIDE = 'L'; LDA >= max(1,N) if SIDE = 'R'.
68 *
69 * TAU (input) COMPLEX*16 array, dimension
70 * (M-1) if SIDE = 'L'
71 * (N-1) if SIDE = 'R'
72 * TAU(i) must contain the scalar factor of the elementary
73 * reflector H(i), as returned by ZGEHRD.
74 *
75 * C (input/output) COMPLEX*16 array, dimension (LDC,N)
76 * On entry, the M-by-N matrix C.
77 * On exit, C is overwritten by Q*C or Q**H*C or C*Q**H or C*Q.
78 *
79 * LDC (input) INTEGER
80 * The leading dimension of the array C. LDC >= max(1,M).
81 *
82 * WORK (workspace/output) COMPLEX*16 array, dimension (MAX(1,LWORK))
83 * On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
84 *
85 * LWORK (input) INTEGER
86 * The dimension of the array WORK.
87 * If SIDE = 'L', LWORK >= max(1,N);
88 * if SIDE = 'R', LWORK >= max(1,M).
89 * For optimum performance LWORK >= N*NB if SIDE = 'L', and
90 * LWORK >= M*NB if SIDE = 'R', where NB is the optimal
91 * blocksize.
92 *
93 * If LWORK = -1, then a workspace query is assumed; the routine
94 * only calculates the optimal size of the WORK array, returns
95 * this value as the first entry of the WORK array, and no error
96 * message related to LWORK is issued by XERBLA.
97 *
98 * INFO (output) INTEGER
99 * = 0: successful exit
100 * < 0: if INFO = -i, the i-th argument had an illegal value
101 *
102 * =====================================================================
103 *
104 * .. Local Scalars ..
105 LOGICAL LEFT, LQUERY
106 INTEGER I1, I2, IINFO, LWKOPT, MI, NB, NH, NI, NQ, NW
107 * ..
108 * .. External Functions ..
109 LOGICAL LSAME
110 INTEGER ILAENV
111 EXTERNAL LSAME, ILAENV
112 * ..
113 * .. External Subroutines ..
114 EXTERNAL XERBLA, ZUNMQR
115 * ..
116 * .. Intrinsic Functions ..
117 INTRINSIC MAX, MIN
118 * ..
119 * .. Executable Statements ..
120 *
121 * Test the input arguments
122 *
123 INFO = 0
124 NH = IHI - ILO
125 LEFT = LSAME( SIDE, 'L' )
126 LQUERY = ( LWORK.EQ.-1 )
127 *
128 * NQ is the order of Q and NW is the minimum dimension of WORK
129 *
130 IF( LEFT ) THEN
131 NQ = M
132 NW = N
133 ELSE
134 NQ = N
135 NW = M
136 END IF
137 IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN
138 INFO = -1
139 ELSE IF( .NOT.LSAME( TRANS, 'N' ) .AND. .NOT.LSAME( TRANS, 'C' ) )
140 $ THEN
141 INFO = -2
142 ELSE IF( M.LT.0 ) THEN
143 INFO = -3
144 ELSE IF( N.LT.0 ) THEN
145 INFO = -4
146 ELSE IF( ILO.LT.1 .OR. ILO.GT.MAX( 1, NQ ) ) THEN
147 INFO = -5
148 ELSE IF( IHI.LT.MIN( ILO, NQ ) .OR. IHI.GT.NQ ) THEN
149 INFO = -6
150 ELSE IF( LDA.LT.MAX( 1, NQ ) ) THEN
151 INFO = -8
152 ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
153 INFO = -11
154 ELSE IF( LWORK.LT.MAX( 1, NW ) .AND. .NOT.LQUERY ) THEN
155 INFO = -13
156 END IF
157 *
158 IF( INFO.EQ.0 ) THEN
159 IF( LEFT ) THEN
160 NB = ILAENV( 1, 'ZUNMQR', SIDE // TRANS, NH, N, NH, -1 )
161 ELSE
162 NB = ILAENV( 1, 'ZUNMQR', SIDE // TRANS, M, NH, NH, -1 )
163 END IF
164 LWKOPT = MAX( 1, NW )*NB
165 WORK( 1 ) = LWKOPT
166 END IF
167 *
168 IF( INFO.NE.0 ) THEN
169 CALL XERBLA( 'ZUNMHR', -INFO )
170 RETURN
171 ELSE IF( LQUERY ) THEN
172 RETURN
173 END IF
174 *
175 * Quick return if possible
176 *
177 IF( M.EQ.0 .OR. N.EQ.0 .OR. NH.EQ.0 ) THEN
178 WORK( 1 ) = 1
179 RETURN
180 END IF
181 *
182 IF( LEFT ) THEN
183 MI = NH
184 NI = N
185 I1 = ILO + 1
186 I2 = 1
187 ELSE
188 MI = M
189 NI = NH
190 I1 = 1
191 I2 = ILO + 1
192 END IF
193 *
194 CALL ZUNMQR( SIDE, TRANS, MI, NI, NH, A( ILO+1, ILO ), LDA,
195 $ TAU( ILO ), C( I1, I2 ), LDC, WORK, LWORK, IINFO )
196 *
197 WORK( 1 ) = LWKOPT
198 RETURN
199 *
200 * End of ZUNMHR
201 *
202 END