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 )