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 dopmtr(SIDE, UPLO, TRANS, M, N, AP, TAU, C, LDC, WORK, INFO)
DOPMTR
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dlarf(SIDE, M, N, V, INCV, TAU, C, LDC, WORK)
DLARF applies an elementary reflector to a general rectangular matrix.