150 SUBROUTINE sopmtr( SIDE, UPLO, TRANS, M, N, AP, TAU, C, LDC, WORK,
159 CHARACTER side, trans, uplo
160 INTEGER info, ldc, m, n
163 REAL ap( * ), c( ldc, * ), tau( * ), work( * )
170 parameter( one = 1.0e+0 )
173 LOGICAL forwrd, left, notran, upper
174 INTEGER i, i1, i2, i3, ic, ii, jc, mi, ni, nq
192 left =
lsame( side,
'L' )
193 notran =
lsame( trans,
'N' )
194 upper =
lsame( uplo,
'U' )
203 IF( .NOT.left .AND. .NOT.
lsame( side,
'R' ) )
THEN
205 ELSE IF( .NOT.upper .AND. .NOT.
lsame( uplo,
'L' ) )
THEN
207 ELSE IF( .NOT.notran .AND. .NOT.
lsame( trans,
'T' ) )
THEN
209 ELSE IF( m.LT.0 )
THEN
211 ELSE IF( n.LT.0 )
THEN
213 ELSE IF( ldc.LT.max( 1, m ) )
THEN
217 CALL
xerbla(
'SOPMTR', -info )
223 IF( m.EQ.0 .OR. n.EQ.0 )
230 forwrd = ( left .AND. notran ) .OR.
231 $ ( .NOT.left .AND. .NOT.notran )
242 ii = nq*( nq+1 ) / 2 - 1
268 CALL
slarf( side, mi, ni, ap( ii-i+1 ), 1, tau( i ), c, ldc,
282 forwrd = ( left .AND. .NOT.notran ) .OR.
283 $ ( .NOT.left .AND. notran )
294 ii = nq*( nq+1 ) / 2 - 1
324 CALL
slarf( side, mi, ni, ap( ii ), 1, tau( i ),
325 $ c( ic, jc ), ldc, work )
subroutine sopmtr(SIDE, UPLO, TRANS, M, N, AP, TAU, C, LDC, WORK, INFO)
SOPMTR
LOGICAL function lsame(CA, CB)
LSAME
subroutine slarf(SIDE, M, N, V, INCV, TAU, C, LDC, WORK)
SLARF applies an elementary reflector to a general rectangular matrix.
subroutine xerbla(SRNAME, INFO)
XERBLA