172 SUBROUTINE sormtr( SIDE, UPLO, TRANS, M, N, A, LDA, TAU, C, LDC,
173 $ work, lwork, info )
181 CHARACTER side, trans, uplo
182 INTEGER info, lda, ldc, lwork, m, n
185 REAL a( lda, * ), c( ldc, * ), tau( * ),
192 LOGICAL left, lquery, upper
193 INTEGER i1, i2, iinfo, lwkopt, mi, ni, nb, nq, nw
211 left =
lsame( side,
'L' )
212 upper =
lsame( uplo,
'U' )
213 lquery = ( lwork.EQ.-1 )
224 IF( .NOT.left .AND. .NOT.
lsame( side,
'R' ) )
THEN
226 ELSE IF( .NOT.upper .AND. .NOT.
lsame( uplo,
'L' ) )
THEN
228 ELSE IF( .NOT.
lsame( trans,
'N' ) .AND. .NOT.
lsame( trans,
'T' ) )
231 ELSE IF( m.LT.0 )
THEN
233 ELSE IF( n.LT.0 )
THEN
235 ELSE IF( lda.LT.max( 1, nq ) )
THEN
237 ELSE IF( ldc.LT.max( 1, m ) )
THEN
239 ELSE IF( lwork.LT.max( 1, nw ) .AND. .NOT.lquery )
THEN
246 nb =
ilaenv( 1,
'SORMQL', side // trans, m-1, n, m-1,
249 nb =
ilaenv( 1,
'SORMQL', side // trans, m, n-1, n-1,
254 nb =
ilaenv( 1,
'SORMQR', side // trans, m-1, n, m-1,
257 nb =
ilaenv( 1,
'SORMQR', side // trans, m, n-1, n-1,
261 lwkopt = max( 1, nw )*nb
266 CALL
xerbla(
'SORMTR', -info )
268 ELSE IF( lquery )
THEN
274 IF( m.EQ.0 .OR. n.EQ.0 .OR. nq.EQ.1 )
THEN
291 CALL
sormql( side, trans, mi, ni, nq-1, a( 1, 2 ), lda, tau, c,
292 $ ldc, work, lwork, iinfo )
304 CALL
sormqr( side, trans, mi, ni, nq-1, a( 2, 1 ), lda, tau,
305 $ c( i1, i2 ), ldc, work, lwork, iinfo )
subroutine sormtr(SIDE, UPLO, TRANS, M, N, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
SORMTR
subroutine sormql(SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
SORMQL
subroutine sormqr(SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
SORMQR
subroutine xerbla(SRNAME, INFO)
XERBLA
logical function lsame(CA, CB)
LSAME
integer function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)