154 SUBROUTINE slasyf_aa( UPLO, J1, M, NB, A, LDA, IPIV,
155 $ h, ldh, work, info )
166 INTEGER M, NB, J1, LDA, LDH, INFO
170 REAL A( lda, * ), H( ldh, * ), WORK( * )
176 parameter ( zero = 0.0e+0, one = 1.0e+0 )
179 INTEGER J, K, K1, I1, I2
184 INTEGER ISAMAX, ILAENV
185 EXTERNAL lsame, ilaenv, isamax
203 IF( lsame( uplo,
'U' ) )
THEN
210 IF ( j.GT.min(m, nb) )
231 CALL sgemv(
'No transpose', m-j+1, j-k1,
232 $ -one, h( j, k1 ), ldh,
234 $ one, h( j, j ), 1 )
239 CALL scopy( m-j+1, h( j, j ), 1, work( 1 ), 1 )
247 CALL saxpy( m-j+1, alpha, a( k-2, j ), lda, work( 1 ), 1 )
252 a( k, j ) = work( 1 )
261 CALL saxpy( m-j, alpha, a( k-1, j+1 ), lda,
267 i2 = isamax( m-j, work( 2 ), 1 ) + 1
272 IF( (i2.NE.2) .AND. (piv.NE.0) )
THEN
277 work( i2 ) = work( i1 )
284 CALL sswap( i2-i1-1, a( j1+i1-1, i1+1 ), lda,
285 $ a( j1+i1, i2 ), 1 )
289 CALL sswap( m-i2, a( j1+i1-1, i2+1 ), lda,
290 $ a( j1+i2-1, i2+1 ), lda )
294 piv = a( i1+j1-1, i1 )
295 a( j1+i1-1, i1 ) = a( j1+i2-1, i2 )
296 a( j1+i2-1, i2 ) = piv
300 CALL sswap( i1-1, h( i1, 1 ), ldh, h( i2, 1 ), ldh )
303 IF( i1.GT.(k1-1) )
THEN
308 CALL sswap( i1-k1+1, a( 1, i1 ), 1,
317 a( k, j+1 ) = work( 2 )
318 IF( (a( k, j ).EQ.zero ) .AND.
319 $ ( (j.EQ.m) .OR. (a( k, j+1 ).EQ.zero)))
THEN
329 CALL scopy( m-j, a( k+1, j+1 ), lda,
336 IF( a( k, j+1 ).NE.zero )
THEN
337 alpha = one / a( k, j+1 )
338 CALL scopy( m-j-1, work( 3 ), 1, a( k, j+2 ), lda )
339 CALL sscal( m-j-1, alpha, a( k, j+2 ), lda )
341 CALL slaset(
'Full', 1, m-j-1, zero, zero,
345 IF( (a( k, j ).EQ.zero) .AND. (info.EQ.0) )
THEN
360 IF( j.GT.min( m, nb ) )
381 CALL sgemv(
'No transpose', m-j+1, j-k1,
382 $ -one, h( j, k1 ), ldh,
384 $ one, h( j, j ), 1 )
389 CALL scopy( m-j+1, h( j, j ), 1, work( 1 ), 1 )
397 CALL saxpy( m-j+1, alpha, a( j, k-2 ), 1, work( 1 ), 1 )
402 a( j, k ) = work( 1 )
411 CALL saxpy( m-j, alpha, a( j+1, k-1 ), 1,
417 i2 = isamax( m-j, work( 2 ), 1 ) + 1
422 IF( (i2.NE.2) .AND. (piv.NE.0) )
THEN
427 work( i2 ) = work( i1 )
434 CALL sswap( i2-i1-1, a( i1+1, j1+i1-1 ), 1,
435 $ a( i2, j1+i1 ), lda )
439 CALL sswap( m-i2, a( i2+1, j1+i1-1 ), 1,
440 $ a( i2+1, j1+i2-1 ), 1 )
444 piv = a( i1, j1+i1-1 )
445 a( i1, j1+i1-1 ) = a( i2, j1+i2-1 )
446 a( i2, j1+i2-1 ) = piv
450 CALL sswap( i1-1, h( i1, 1 ), ldh, h( i2, 1 ), ldh )
453 IF( i1.GT.(k1-1) )
THEN
458 CALL sswap( i1-k1+1, a( i1, 1 ), lda,
467 a( j+1, k ) = work( 2 )
468 IF( (a( j, k ).EQ.zero) .AND.
469 $ ( (j.EQ.m) .OR. (a( j+1, k ).EQ.zero)) )
THEN
478 CALL scopy( m-j, a( j+1, k+1 ), 1,
485 IF( a( j+1, k ).NE.zero )
THEN
486 alpha = one / a( j+1, k )
487 CALL scopy( m-j-1, work( 3 ), 1, a( j+2, k ), 1 )
488 CALL sscal( m-j-1, alpha, a( j+2, k ), 1 )
490 CALL slaset(
'Full', m-j-1, 1, zero, zero,
494 IF( (a( j, k ).EQ.zero) .AND. (info.EQ.0) )
THEN
subroutine sgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
SGEMV
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine slaset(UPLO, M, N, ALPHA, BETA, A, LDA)
SLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
subroutine saxpy(N, SA, SX, INCX, SY, INCY)
SAXPY
subroutine sscal(N, SA, SX, INCX)
SSCAL
subroutine sswap(N, SX, INCX, SY, INCY)
SSWAP
subroutine scopy(N, SX, INCX, SY, INCY)
SCOPY
subroutine slasyf_aa(UPLO, J1, M, NB, A, LDA, IPIV, H, LDH, WORK, INFO)
SLASYF_AA