154 SUBROUTINE dlasyf_aa( UPLO, J1, M, NB, A, LDA, IPIV,
155 $ h, ldh, work, info )
166 INTEGER M, NB, J1, LDA, LDH, INFO
170 DOUBLE PRECISION A( lda, * ), H( ldh, * ), WORK( * )
175 DOUBLE PRECISION ZERO, ONE
176 parameter ( zero = 0.0d+0, one = 1.0d+0 )
179 INTEGER J, K, K1, I1, I2
180 DOUBLE PRECISION PIV, ALPHA
184 INTEGER IDAMAX, ILAENV
185 EXTERNAL lsame, ilaenv, idamax
203 IF( lsame( uplo,
'U' ) )
THEN
210 IF ( j.GT.min(m, nb) )
231 CALL dgemv(
'No transpose', m-j+1, j-k1,
232 $ -one, h( j, k1 ), ldh,
234 $ one, h( j, j ), 1 )
239 CALL dcopy( m-j+1, h( j, j ), 1, work( 1 ), 1 )
247 CALL daxpy( m-j+1, alpha, a( k-2, j ), lda, work( 1 ), 1 )
252 a( k, j ) = work( 1 )
261 CALL daxpy( m-j, alpha, a( k-1, j+1 ), lda,
267 i2 = idamax( m-j, work( 2 ), 1 ) + 1
272 IF( (i2.NE.2) .AND. (piv.NE.0) )
THEN
277 work( i2 ) = work( i1 )
284 CALL dswap( i2-i1-1, a( j1+i1-1, i1+1 ), lda,
285 $ a( j1+i1, i2 ), 1 )
289 CALL dswap( 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 dswap( i1-1, h( i1, 1 ), ldh, h( i2, 1 ), ldh )
303 IF( i1.GT.(k1-1) )
THEN
308 CALL dswap( 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 dcopy( 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 dcopy( m-j-1, work( 3 ), 1, a( k, j+2 ), lda )
339 CALL dscal( m-j-1, alpha, a( k, j+2 ), lda )
341 CALL dlaset(
'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 dgemv(
'No transpose', m-j+1, j-k1,
382 $ -one, h( j, k1 ), ldh,
384 $ one, h( j, j ), 1 )
389 CALL dcopy( m-j+1, h( j, j ), 1, work( 1 ), 1 )
397 CALL daxpy( m-j+1, alpha, a( j, k-2 ), 1, work( 1 ), 1 )
402 a( j, k ) = work( 1 )
411 CALL daxpy( m-j, alpha, a( j+1, k-1 ), 1,
417 i2 = idamax( m-j, work( 2 ), 1 ) + 1
422 IF( (i2.NE.2) .AND. (piv.NE.0) )
THEN
427 work( i2 ) = work( i1 )
434 CALL dswap( i2-i1-1, a( i1+1, j1+i1-1 ), 1,
435 $ a( i2, j1+i1 ), lda )
439 CALL dswap( 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 dswap( i1-1, h( i1, 1 ), ldh, h( i2, 1 ), ldh )
453 IF( i1.GT.(k1-1) )
THEN
458 CALL dswap( 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 dcopy( 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 dcopy( m-j-1, work( 3 ), 1, a( j+2, k ), 1 )
488 CALL dscal( m-j-1, alpha, a( j+2, k ), 1 )
490 CALL dlaset(
'Full', m-j-1, 1, zero, zero,
494 IF( (a( j, k ).EQ.zero) .AND. (info.EQ.0) )
THEN
subroutine dcopy(N, DX, INCX, DY, INCY)
DCOPY
subroutine dgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
DGEMV
subroutine daxpy(N, DA, DX, INCX, DY, INCY)
DAXPY
subroutine dlaset(UPLO, M, N, ALPHA, BETA, A, LDA)
DLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
subroutine dswap(N, DX, INCX, DY, INCY)
DSWAP
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dscal(N, DA, DX, INCX)
DSCAL
subroutine dlasyf_aa(UPLO, J1, M, NB, A, LDA, IPIV, H, LDH, WORK, INFO)
DLASYF_AA