148 SUBROUTINE sopmtr( SIDE, UPLO, TRANS, M, N, AP, TAU, C, LDC, WORK,
156 CHARACTER SIDE, TRANS, UPLO
157 INTEGER INFO, LDC, M, N
160 REAL AP( * ), C( LDC, * ), TAU( * ), WORK( * )
167 parameter( one = 1.0e+0 )
170 LOGICAL FORWRD, LEFT, NOTRAN, UPPER
171 INTEGER I, I1, I2, I3, IC, II, JC, MI, NI, NQ
189 left = lsame( side,
'L' )
190 notran = lsame( trans,
'N' )
191 upper = lsame( uplo,
'U' )
200 IF( .NOT.left .AND. .NOT.lsame( side,
'R' ) )
THEN
202 ELSE IF( .NOT.upper .AND. .NOT.lsame( uplo,
'L' ) )
THEN
204 ELSE IF( .NOT.notran .AND. .NOT.lsame( trans,
'T' ) )
THEN
206 ELSE IF( m.LT.0 )
THEN
208 ELSE IF( n.LT.0 )
THEN
210 ELSE IF( ldc.LT.max( 1, m ) )
THEN
214 CALL xerbla(
'SOPMTR', -info )
220 IF( m.EQ.0 .OR. n.EQ.0 )
227 forwrd = ( left .AND. notran ) .OR.
228 $ ( .NOT.left .AND. .NOT.notran )
239 ii = nq*( nq+1 ) / 2 - 1
265 CALL slarf( side, mi, ni, ap( ii-i+1 ), 1, tau( i ), c, ldc,
279 forwrd = ( left .AND. .NOT.notran ) .OR.
280 $ ( .NOT.left .AND. notran )
291 ii = nq*( nq+1 ) / 2 - 1
321 CALL slarf( side, mi, ni, ap( ii ), 1, tau( i ),
322 $ c( ic, jc ), ldc, work )
subroutine xerbla(srname, info)
subroutine slarf(side, m, n, v, incv, tau, c, ldc, work)
SLARF applies an elementary reflector to a general rectangular matrix.
subroutine sopmtr(side, uplo, trans, m, n, ap, tau, c, ldc, work, info)
SOPMTR