163 SUBROUTINE dorm22( SIDE, TRANS, M, N, N1, N2, Q, LDQ, C, LDC,
164 $ work, lwork, info )
174 CHARACTER SIDE, TRANS
175 INTEGER M, N, N1, N2, LDQ, LDC, LWORK, INFO
178 DOUBLE PRECISION Q( ldq, * ), C( ldc, * ), WORK( * )
185 parameter ( one = 1.0d+0 )
188 LOGICAL LEFT, LQUERY, NOTRAN
189 INTEGER I, LDWORK, LEN, LWKOPT, NB, NQ, NW
199 INTRINSIC dble, max, min
206 left = lsame( side,
'L' )
207 notran = lsame( trans,
'N' )
208 lquery = ( lwork.EQ.-1 )
219 IF( n1.EQ.0 .OR. n2.EQ.0 ) nw = 1
220 IF( .NOT.left .AND. .NOT.lsame( side,
'R' ) )
THEN
222 ELSE IF( .NOT.lsame( trans,
'N' ) .AND. .NOT.lsame( trans,
'T' ) )
225 ELSE IF( m.LT.0 )
THEN
227 ELSE IF( n.LT.0 )
THEN
229 ELSE IF( n1.LT.0 .OR. n1+n2.NE.nq )
THEN
231 ELSE IF( n2.LT.0 )
THEN
233 ELSE IF( ldq.LT.max( 1, nq ) )
THEN
235 ELSE IF( ldc.LT.max( 1, m ) )
THEN
237 ELSE IF( lwork.LT.nw .AND. .NOT.lquery )
THEN
243 work( 1 ) = dble( lwkopt )
247 CALL xerbla(
'DORM22', -info )
249 ELSE IF( lquery )
THEN
255 IF( m.EQ.0 .OR. n.EQ.0 )
THEN
263 CALL dtrmm( side,
'Upper', trans,
'Non-Unit', m, n, one,
267 ELSE IF( n2.EQ.0 )
THEN
268 CALL dtrmm( side,
'Lower', trans,
'Non-Unit', m, n, one,
276 nb = max( 1, min( lwork, lwkopt ) / nq )
281 len = min( nb, n-i+1 )
286 CALL dlacpy(
'All', n1, len, c( n2+1, i ), ldc, work,
288 CALL dtrmm(
'Left',
'Lower',
'No Transpose',
'Non-Unit',
289 $ n1, len, one, q( 1, n2+1 ), ldq, work,
294 CALL dgemm(
'No Transpose',
'No Transpose', n1, len, n2,
295 $ one, q, ldq, c( 1, i ), ldc, one, work,
300 CALL dlacpy(
'All', n2, len, c( 1, i ), ldc,
301 $ work( n1+1 ), ldwork )
302 CALL dtrmm(
'Left',
'Upper',
'No Transpose',
'Non-Unit',
303 $ n2, len, one, q( n1+1, 1 ), ldq,
304 $ work( n1+1 ), ldwork )
308 CALL dgemm(
'No Transpose',
'No Transpose', n2, len, n1,
309 $ one, q( n1+1, n2+1 ), ldq, c( n2+1, i ), ldc,
310 $ one, work( n1+1 ), ldwork )
314 CALL dlacpy(
'All', m, len, work, ldwork, c( 1, i ),
319 len = min( nb, n-i+1 )
324 CALL dlacpy(
'All', n2, len, c( n1+1, i ), ldc, work,
326 CALL dtrmm(
'Left',
'Upper',
'Transpose',
'Non-Unit',
327 $ n2, len, one, q( n1+1, 1 ), ldq, work,
332 CALL dgemm(
'Transpose',
'No Transpose', n2, len, n1,
333 $ one, q, ldq, c( 1, i ), ldc, one, work,
338 CALL dlacpy(
'All', n1, len, c( 1, i ), ldc,
339 $ work( n2+1 ), ldwork )
340 CALL dtrmm(
'Left',
'Lower',
'Transpose',
'Non-Unit',
341 $ n1, len, one, q( 1, n2+1 ), ldq,
342 $ work( n2+1 ), ldwork )
346 CALL dgemm(
'Transpose',
'No Transpose', n1, len, n2,
347 $ one, q( n1+1, n2+1 ), ldq, c( n1+1, i ), ldc,
348 $ one, work( n2+1 ), ldwork )
352 CALL dlacpy(
'All', m, len, work, ldwork, c( 1, i ),
359 len = min( nb, m-i+1 )
364 CALL dlacpy(
'All', len, n2, c( i, n1+1 ), ldc, work,
366 CALL dtrmm(
'Right',
'Upper',
'No Transpose',
'Non-Unit',
367 $ len, n2, one, q( n1+1, 1 ), ldq, work,
372 CALL dgemm(
'No Transpose',
'No Transpose', len, n2, n1,
373 $ one, c( i, 1 ), ldc, q, ldq, one, work,
378 CALL dlacpy(
'All', len, n1, c( i, 1 ), ldc,
379 $ work( 1 + n2*ldwork ), ldwork )
380 CALL dtrmm(
'Right',
'Lower',
'No Transpose',
'Non-Unit',
381 $ len, n1, one, q( 1, n2+1 ), ldq,
382 $ work( 1 + n2*ldwork ), ldwork )
386 CALL dgemm(
'No Transpose',
'No Transpose', len, n1, n2,
387 $ one, c( i, n1+1 ), ldc, q( n1+1, n2+1 ), ldq,
388 $ one, work( 1 + n2*ldwork ), ldwork )
392 CALL dlacpy(
'All', len, n, work, ldwork, c( i, 1 ),
397 len = min( nb, m-i+1 )
402 CALL dlacpy(
'All', len, n1, c( i, n2+1 ), ldc, work,
404 CALL dtrmm(
'Right',
'Lower',
'Transpose',
'Non-Unit',
405 $ len, n1, one, q( 1, n2+1 ), ldq, work,
410 CALL dgemm(
'No Transpose',
'Transpose', len, n1, n2,
411 $ one, c( i, 1 ), ldc, q, ldq, one, work,
416 CALL dlacpy(
'All', len, n2, c( i, 1 ), ldc,
417 $ work( 1 + n1*ldwork ), ldwork )
418 CALL dtrmm(
'Right',
'Upper',
'Transpose',
'Non-Unit',
419 $ len, n2, one, q( n1+1, 1 ), ldq,
420 $ work( 1 + n1*ldwork ), ldwork )
424 CALL dgemm(
'No Transpose',
'Transpose', len, n2, n1,
425 $ one, c( i, n2+1 ), ldc, q( n1+1, n2+1 ), ldq,
426 $ one, work( 1 + n1*ldwork ), ldwork )
430 CALL dlacpy(
'All', len, n, work, ldwork, c( i, 1 ),
436 work( 1 ) = dble( lwkopt )
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
subroutine dorm22(SIDE, TRANS, M, N, N1, N2, Q, LDQ, C, LDC, WORK, LWORK, INFO)
DORM22 multiplies a general matrix by a banded orthogonal matrix.
subroutine dtrmm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
DTRMM
subroutine dgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
DGEMM
subroutine xerbla(SRNAME, INFO)
XERBLA