200 SUBROUTINE dlasr( SIDE, PIVOT, DIRECT, M, N, C, S, A, LDA )
208 CHARACTER DIRECT, PIVOT, SIDE
212 DOUBLE PRECISION A( lda, * ), C( * ), S( * )
218 DOUBLE PRECISION ONE, ZERO
219 parameter ( one = 1.0d+0, zero = 0.0d+0 )
223 DOUBLE PRECISION CTEMP, STEMP, TEMP
240 IF( .NOT.( lsame( side,
'L' ) .OR. lsame( side,
'R' ) ) )
THEN
242 ELSE IF( .NOT.( lsame( pivot,
'V' ) .OR. lsame( pivot,
243 $
'T' ) .OR. lsame( pivot,
'B' ) ) )
THEN
245 ELSE IF( .NOT.( lsame( direct,
'F' ) .OR. lsame( direct,
'B' ) ) )
248 ELSE IF( m.LT.0 )
THEN
250 ELSE IF( n.LT.0 )
THEN
252 ELSE IF( lda.LT.max( 1, m ) )
THEN
256 CALL xerbla(
'DLASR ', info )
262 IF( ( m.EQ.0 ) .OR. ( n.EQ.0 ) )
264 IF( lsame( side,
'L' ) )
THEN
268 IF( lsame( pivot,
'V' ) )
THEN
269 IF( lsame( direct,
'F' ) )
THEN
273 IF( ( ctemp.NE.one ) .OR. ( stemp.NE.zero ) )
THEN
276 a( j+1, i ) = ctemp*temp - stemp*a( j, i )
277 a( j, i ) = stemp*temp + ctemp*a( j, i )
281 ELSE IF( lsame( direct,
'B' ) )
THEN
282 DO 40 j = m - 1, 1, -1
285 IF( ( ctemp.NE.one ) .OR. ( stemp.NE.zero ) )
THEN
288 a( j+1, i ) = ctemp*temp - stemp*a( j, i )
289 a( j, i ) = stemp*temp + ctemp*a( j, i )
294 ELSE IF( lsame( pivot,
'T' ) )
THEN
295 IF( lsame( direct,
'F' ) )
THEN
299 IF( ( ctemp.NE.one ) .OR. ( stemp.NE.zero ) )
THEN
302 a( j, i ) = ctemp*temp - stemp*a( 1, i )
303 a( 1, i ) = stemp*temp + ctemp*a( 1, i )
307 ELSE IF( lsame( direct,
'B' ) )
THEN
311 IF( ( ctemp.NE.one ) .OR. ( stemp.NE.zero ) )
THEN
314 a( j, i ) = ctemp*temp - stemp*a( 1, i )
315 a( 1, i ) = stemp*temp + ctemp*a( 1, i )
320 ELSE IF( lsame( pivot,
'B' ) )
THEN
321 IF( lsame( direct,
'F' ) )
THEN
325 IF( ( ctemp.NE.one ) .OR. ( stemp.NE.zero ) )
THEN
328 a( j, i ) = stemp*a( m, i ) + ctemp*temp
329 a( m, i ) = ctemp*a( m, i ) - stemp*temp
333 ELSE IF( lsame( direct,
'B' ) )
THEN
334 DO 120 j = m - 1, 1, -1
337 IF( ( ctemp.NE.one ) .OR. ( stemp.NE.zero ) )
THEN
340 a( j, i ) = stemp*a( m, i ) + ctemp*temp
341 a( m, i ) = ctemp*a( m, i ) - stemp*temp
347 ELSE IF( lsame( side,
'R' ) )
THEN
351 IF( lsame( pivot,
'V' ) )
THEN
352 IF( lsame( direct,
'F' ) )
THEN
356 IF( ( ctemp.NE.one ) .OR. ( stemp.NE.zero ) )
THEN
359 a( i, j+1 ) = ctemp*temp - stemp*a( i, j )
360 a( i, j ) = stemp*temp + ctemp*a( i, j )
364 ELSE IF( lsame( direct,
'B' ) )
THEN
365 DO 160 j = n - 1, 1, -1
368 IF( ( ctemp.NE.one ) .OR. ( stemp.NE.zero ) )
THEN
371 a( i, j+1 ) = ctemp*temp - stemp*a( i, j )
372 a( i, j ) = stemp*temp + ctemp*a( i, j )
377 ELSE IF( lsame( pivot,
'T' ) )
THEN
378 IF( lsame( direct,
'F' ) )
THEN
382 IF( ( ctemp.NE.one ) .OR. ( stemp.NE.zero ) )
THEN
385 a( i, j ) = ctemp*temp - stemp*a( i, 1 )
386 a( i, 1 ) = stemp*temp + ctemp*a( i, 1 )
390 ELSE IF( lsame( direct,
'B' ) )
THEN
394 IF( ( ctemp.NE.one ) .OR. ( stemp.NE.zero ) )
THEN
397 a( i, j ) = ctemp*temp - stemp*a( i, 1 )
398 a( i, 1 ) = stemp*temp + ctemp*a( i, 1 )
403 ELSE IF( lsame( pivot,
'B' ) )
THEN
404 IF( lsame( direct,
'F' ) )
THEN
408 IF( ( ctemp.NE.one ) .OR. ( stemp.NE.zero ) )
THEN
411 a( i, j ) = stemp*a( i, n ) + ctemp*temp
412 a( i, n ) = ctemp*a( i, n ) - stemp*temp
416 ELSE IF( lsame( direct,
'B' ) )
THEN
417 DO 240 j = n - 1, 1, -1
420 IF( ( ctemp.NE.one ) .OR. ( stemp.NE.zero ) )
THEN
423 a( i, j ) = stemp*a( i, n ) + ctemp*temp
424 a( i, n ) = ctemp*a( i, n ) - stemp*temp
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dlasr(SIDE, PIVOT, DIRECT, M, N, C, S, A, LDA)
DLASR applies a sequence of plane rotations to a general rectangular matrix.