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
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine slarf(SIDE, M, N, V, INCV, TAU, C, LDC, WORK)
SLARF applies an elementary reflector to a general rectangular matrix.