150 SUBROUTINE dopmtr( SIDE, UPLO, TRANS, M, N, AP, TAU, C, LDC, WORK,
159 CHARACTER SIDE, TRANS, UPLO
160 INTEGER INFO, LDC, M, N
163 DOUBLE PRECISION AP( * ), C( ldc, * ), TAU( * ), WORK( * )
170 parameter ( one = 1.0d+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(
'DOPMTR', -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 dlarf( 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 dlarf( side, mi, ni, ap( ii ), 1, tau( i ),
325 $ c( ic, jc ), ldc, work )
subroutine dlarf(SIDE, M, N, V, INCV, TAU, C, LDC, WORK)
DLARF applies an elementary reflector to a general rectangular matrix.
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dopmtr(SIDE, UPLO, TRANS, M, N, AP, TAU, C, LDC, WORK, INFO)
DOPMTR