174 INTEGER info, lda, m, n
177 COMPLEX*16 a( lda, * ), d( * )
184 parameter( one = 1.0d+0 )
186 parameter( cone = ( 1.0d+0, 0.0d+0 ) )
189 DOUBLE PRECISION sfmin
190 INTEGER i, iinfo, n1, n2
201 INTRINSIC abs, dble, dcmplx, dimag, dsign, max, min
204 DOUBLE PRECISION cabs1
207 cabs1( z ) = abs( dble( z ) ) + abs( dimag( z ) )
216 ELSE IF( n.LT.0 )
THEN
218 ELSE IF( lda.LT.max( 1, m ) )
THEN
222 CALL xerbla(
'ZLAUNHR_COL_GETRFNP2', -info )
228 IF( min( m, n ).EQ.0 )
238 d( 1 ) = dcmplx( -dsign( one, dble( a( 1, 1 ) ) ) )
242 a( 1, 1 ) = a( 1, 1 ) - d( 1 )
244 ELSE IF( n.EQ.1 )
THEN
251 d( 1 ) = dcmplx( -dsign( one, dble( a( 1, 1 ) ) ) )
255 a( 1, 1 ) = a( 1, 1 ) - d( 1 )
265 IF( cabs1( a( 1, 1 ) ) .GE. sfmin )
THEN
266 CALL zscal( m-1, cone / a( 1, 1 ), a( 2, 1 ), 1 )
269 a( i, 1 ) = a( i, 1 ) / a( 1, 1 )
287 CALL ztrsm(
'R',
'U',
'N',
'N', m-n1, n1, cone, a, lda,
288 $ a( n1+1, 1 ), lda )
292 CALL ztrsm(
'L',
'L',
'N',
'U', n1, n2, cone, a, lda,
293 $ a( 1, n1+1 ), lda )
298 CALL zgemm(
'N',
'N', m-n1, n2, n1, -cone, a( n1+1, 1 ), lda,
299 $ a( 1, n1+1 ), lda, cone, a( n1+1, n1+1 ), lda )
double precision function dlamch(CMACH)
DLAMCH
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine zscal(N, ZA, ZX, INCX)
ZSCAL
subroutine zgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
ZGEMM
subroutine ztrsm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
ZTRSM
recursive subroutine zlaunhr_col_getrfnp2(M, N, A, LDA, D, INFO)
ZLAUNHR_COL_GETRFNP2