162 SUBROUTINE cunm22( SIDE, TRANS, M, N, N1, N2, Q, LDQ, C, LDC,
163 $ work, lwork, info )
173 CHARACTER SIDE, TRANS
174 INTEGER M, N, N1, N2, LDQ, LDC, LWORK, INFO
177 COMPLEX Q( ldq, * ), C( ldc, * ), WORK( * )
184 parameter ( one = ( 1.0e+0, 0.0e+0 ) )
187 LOGICAL LEFT, LQUERY, NOTRAN
188 INTEGER I, LDWORK, LEN, LWKOPT, NB, NQ, NW
198 INTRINSIC cmplx, max, min
205 left = lsame( side,
'L' )
206 notran = lsame( trans,
'N' )
207 lquery = ( lwork.EQ.-1 )
218 IF( n1.EQ.0 .OR. n2.EQ.0 ) nw = 1
219 IF( .NOT.left .AND. .NOT.lsame( side,
'R' ) )
THEN
221 ELSE IF( .NOT.lsame( trans,
'N' ) .AND. .NOT.lsame( trans,
'C' ) )
224 ELSE IF( m.LT.0 )
THEN
226 ELSE IF( n.LT.0 )
THEN
228 ELSE IF( n1.LT.0 .OR. n1+n2.NE.nq )
THEN
230 ELSE IF( n2.LT.0 )
THEN
232 ELSE IF( ldq.LT.max( 1, nq ) )
THEN
234 ELSE IF( ldc.LT.max( 1, m ) )
THEN
236 ELSE IF( lwork.LT.nw .AND. .NOT.lquery )
THEN
242 work( 1 ) = cmplx( lwkopt )
246 CALL xerbla(
'CUNM22', -info )
248 ELSE IF( lquery )
THEN
254 IF( m.EQ.0 .OR. n.EQ.0 )
THEN
262 CALL ctrmm( side,
'Upper', trans,
'Non-Unit', m, n, one,
266 ELSE IF( n2.EQ.0 )
THEN
267 CALL ctrmm( side,
'Lower', trans,
'Non-Unit', m, n, one,
275 nb = max( 1, min( lwork, lwkopt ) / nq )
280 len = min( nb, n-i+1 )
285 CALL clacpy(
'All', n1, len, c( n2+1, i ), ldc, work,
287 CALL ctrmm(
'Left',
'Lower',
'No Transpose',
'Non-Unit',
288 $ n1, len, one, q( 1, n2+1 ), ldq, work,
293 CALL cgemm(
'No Transpose',
'No Transpose', n1, len, n2,
294 $ one, q, ldq, c( 1, i ), ldc, one, work,
299 CALL clacpy(
'All', n2, len, c( 1, i ), ldc,
300 $ work( n1+1 ), ldwork )
301 CALL ctrmm(
'Left',
'Upper',
'No Transpose',
'Non-Unit',
302 $ n2, len, one, q( n1+1, 1 ), ldq,
303 $ work( n1+1 ), ldwork )
307 CALL cgemm(
'No Transpose',
'No Transpose', n2, len, n1,
308 $ one, q( n1+1, n2+1 ), ldq, c( n2+1, i ), ldc,
309 $ one, work( n1+1 ), ldwork )
313 CALL clacpy(
'All', m, len, work, ldwork, c( 1, i ),
318 len = min( nb, n-i+1 )
323 CALL clacpy(
'All', n2, len, c( n1+1, i ), ldc, work,
325 CALL ctrmm(
'Left',
'Upper',
'Conjugate',
'Non-Unit',
326 $ n2, len, one, q( n1+1, 1 ), ldq, work,
331 CALL cgemm(
'Conjugate',
'No Transpose', n2, len, n1,
332 $ one, q, ldq, c( 1, i ), ldc, one, work,
337 CALL clacpy(
'All', n1, len, c( 1, i ), ldc,
338 $ work( n2+1 ), ldwork )
339 CALL ctrmm(
'Left',
'Lower',
'Conjugate',
'Non-Unit',
340 $ n1, len, one, q( 1, n2+1 ), ldq,
341 $ work( n2+1 ), ldwork )
345 CALL cgemm(
'Conjugate',
'No Transpose', n1, len, n2,
346 $ one, q( n1+1, n2+1 ), ldq, c( n1+1, i ), ldc,
347 $ one, work( n2+1 ), ldwork )
351 CALL clacpy(
'All', m, len, work, ldwork, c( 1, i ),
358 len = min( nb, m-i+1 )
363 CALL clacpy(
'All', len, n2, c( i, n1+1 ), ldc, work,
365 CALL ctrmm(
'Right',
'Upper',
'No Transpose',
'Non-Unit',
366 $ len, n2, one, q( n1+1, 1 ), ldq, work,
371 CALL cgemm(
'No Transpose',
'No Transpose', len, n2, n1,
372 $ one, c( i, 1 ), ldc, q, ldq, one, work,
377 CALL clacpy(
'All', len, n1, c( i, 1 ), ldc,
378 $ work( 1 + n2*ldwork ), ldwork )
379 CALL ctrmm(
'Right',
'Lower',
'No Transpose',
'Non-Unit',
380 $ len, n1, one, q( 1, n2+1 ), ldq,
381 $ work( 1 + n2*ldwork ), ldwork )
385 CALL cgemm(
'No Transpose',
'No Transpose', len, n1, n2,
386 $ one, c( i, n1+1 ), ldc, q( n1+1, n2+1 ), ldq,
387 $ one, work( 1 + n2*ldwork ), ldwork )
391 CALL clacpy(
'All', len, n, work, ldwork, c( i, 1 ),
396 len = min( nb, m-i+1 )
401 CALL clacpy(
'All', len, n1, c( i, n2+1 ), ldc, work,
403 CALL ctrmm(
'Right',
'Lower',
'Conjugate',
'Non-Unit',
404 $ len, n1, one, q( 1, n2+1 ), ldq, work,
409 CALL cgemm(
'No Transpose',
'Conjugate', len, n1, n2,
410 $ one, c( i, 1 ), ldc, q, ldq, one, work,
415 CALL clacpy(
'All', len, n2, c( i, 1 ), ldc,
416 $ work( 1 + n1*ldwork ), ldwork )
417 CALL ctrmm(
'Right',
'Upper',
'Conjugate',
'Non-Unit',
418 $ len, n2, one, q( n1+1, 1 ), ldq,
419 $ work( 1 + n1*ldwork ), ldwork )
423 CALL cgemm(
'No Transpose',
'Conjugate', len, n2, n1,
424 $ one, c( i, n2+1 ), ldc, q( n1+1, n2+1 ), ldq,
425 $ one, work( 1 + n1*ldwork ), ldwork )
429 CALL clacpy(
'All', len, n, work, ldwork, c( i, 1 ),
435 work( 1 ) = cmplx( lwkopt )
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
subroutine ctrmm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
CTRMM
subroutine cgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
CGEMM
subroutine cunm22(SIDE, TRANS, M, N, N1, N2, Q, LDQ, C, LDC, WORK, LWORK, INFO)
CUNM22 multiplies a general matrix by a banded unitary matrix.