154 SUBROUTINE clasyf_aa( UPLO, J1, M, NB, A, LDA, IPIV,
155 $ h, ldh, work, info )
166 INTEGER M, NB, J1, LDA, LDH, INFO
170 COMPLEX A( lda, * ), H( ldh, * ), WORK( * )
176 parameter ( zero = 0.0e+0, one = 1.0e+0 )
179 INTEGER J, K, K1, I1, I2
184 INTEGER ICAMAX, ILAENV
185 EXTERNAL lsame, ilaenv, icamax
203 IF( lsame( uplo,
'U' ) )
THEN
210 IF ( j.GT.min(m, nb) )
231 CALL cgemv(
'No transpose', m-j+1, j-k1,
232 $ -one, h( j, k1 ), ldh,
234 $ one, h( j, j ), 1 )
239 CALL ccopy( m-j+1, h( j, j ), 1, work( 1 ), 1 )
247 CALL caxpy( m-j+1, alpha, a( k-2, j ), lda, work( 1 ), 1 )
252 a( k, j ) = work( 1 )
261 CALL caxpy( m-j, alpha, a( k-1, j+1 ), lda,
267 i2 = icamax( m-j, work( 2 ), 1 ) + 1
272 IF( (i2.NE.2) .AND. (piv.NE.0) )
THEN
277 work( i2 ) = work( i1 )
284 CALL cswap( i2-i1-1, a( j1+i1-1, i1+1 ), lda,
285 $ a( j1+i1, i2 ), 1 )
289 CALL cswap( 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 cswap( i1-1, h( i1, 1 ), ldh, h( i2, 1 ), ldh )
303 IF( i1.GT.(k1-1) )
THEN
308 CALL cswap( 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 ccopy( 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 ccopy( m-j-1, work( 3 ), 1, a( k, j+2 ), lda )
339 CALL cscal( m-j-1, alpha, a( k, j+2 ), lda )
341 CALL claset(
'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 cgemv(
'No transpose', m-j+1, j-k1,
382 $ -one, h( j, k1 ), ldh,
384 $ one, h( j, j ), 1 )
389 CALL ccopy( m-j+1, h( j, j ), 1, work( 1 ), 1 )
397 CALL caxpy( m-j+1, alpha, a( j, k-2 ), 1, work( 1 ), 1 )
402 a( j, k ) = work( 1 )
411 CALL caxpy( m-j, alpha, a( j+1, k-1 ), 1,
417 i2 = icamax( m-j, work( 2 ), 1 ) + 1
422 IF( (i2.NE.2) .AND. (piv.NE.0) )
THEN
427 work( i2 ) = work( i1 )
434 CALL cswap( i2-i1-1, a( i1+1, j1+i1-1 ), 1,
435 $ a( i2, j1+i1 ), lda )
439 CALL cswap( 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 cswap( i1-1, h( i1, 1 ), ldh, h( i2, 1 ), ldh )
453 IF( i1.GT.(k1-1) )
THEN
458 CALL cswap( 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 ccopy( 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 ccopy( m-j-1, work( 3 ), 1, a( j+2, k ), 1 )
488 CALL cscal( m-j-1, alpha, a( j+2, k ), 1 )
490 CALL claset(
'Full', m-j-1, 1, zero, zero,
494 IF( (a( j, k ).EQ.zero) .AND. (info.EQ.0) )
THEN
subroutine claset(UPLO, M, N, ALPHA, BETA, A, LDA)
CLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
subroutine cscal(N, CA, CX, INCX)
CSCAL
subroutine cgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
CGEMV
subroutine clasyf_aa(UPLO, J1, M, NB, A, LDA, IPIV, H, LDH, WORK, INFO)
CLASYF_AA
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine ccopy(N, CX, INCX, CY, INCY)
CCOPY
subroutine cswap(N, CX, INCX, CY, INCY)
CSWAP
subroutine caxpy(N, CA, CX, INCX, CY, INCY)
CAXPY