149 SUBROUTINE zgeqpf( M, N, A, LDA, JPVT, TAU, WORK, RWORK, INFO )
157 INTEGER info, lda, m, n
161 DOUBLE PRECISION rwork( * )
162 COMPLEX*16 a( lda, * ), tau( * ), work( * )
168 DOUBLE PRECISION zero, one
169 parameter( zero = 0.0d+0, one = 1.0d+0 )
172 INTEGER i, itemp,
j, ma, mn, pvt
173 DOUBLE PRECISION temp, temp2, tol3z
180 INTRINSIC abs, dcmplx, dconjg, max, min, sqrt
194 ELSE IF( n.LT.0 )
THEN
196 ELSE IF( lda.LT.max( 1, m ) )
THEN
200 CALL
xerbla(
'ZGEQPF', -info )
205 tol3z = sqrt(
dlamch(
'Epsilon'))
211 IF( jpvt( i ).NE.0 )
THEN
212 IF( i.NE.itemp )
THEN
213 CALL
zswap( m, a( 1, i ), 1, a( 1, itemp ), 1 )
214 jpvt( i ) = jpvt( itemp )
228 IF( itemp.GT.0 )
THEN
230 CALL
zgeqr2( m, ma, a, lda, tau, work, info )
232 CALL
zunm2r(
'Left',
'Conjugate transpose', m, n-ma, ma, a,
233 $ lda, tau, a( 1, ma+1 ), lda, work, info )
237 IF( itemp.LT.mn )
THEN
242 DO 20 i = itemp + 1, n
243 rwork( i ) =
dznrm2( m-itemp, a( itemp+1, i ), 1 )
244 rwork( n+i ) = rwork( i )
249 DO 40 i = itemp + 1, mn
253 pvt = ( i-1 ) +
idamax( n-i+1, rwork( i ), 1 )
256 CALL
zswap( m, a( 1, pvt ), 1, a( 1, i ), 1 )
258 jpvt( pvt ) = jpvt( i )
260 rwork( pvt ) = rwork( i )
261 rwork( n+pvt ) = rwork( n+i )
267 CALL
zlarfg( m-i+1, aii, a( min( i+1, m ), i ), 1,
276 a( i, i ) = dcmplx( one )
277 CALL
zlarf(
'Left', m-i+1, n-i, a( i, i ), 1,
278 $ dconjg( tau( i ) ), a( i, i+1 ), lda, work )
285 IF( rwork(
j ).NE.zero )
THEN
290 temp = abs( a( i,
j ) ) / rwork(
j )
291 temp = max( zero, ( one+temp )*( one-temp ) )
292 temp2 = temp*( rwork(
j ) / rwork( n+
j ) )**2
293 IF( temp2 .LE. tol3z )
THEN
295 rwork(
j ) =
dznrm2( m-i, a( i+1,
j ), 1 )
296 rwork( n+
j ) = rwork(
j )
302 rwork(
j ) = rwork(
j )*sqrt( temp )
subroutine zswap(N, ZX, INCX, ZY, INCY)
ZSWAP
subroutine zgeqr2(M, N, A, LDA, TAU, WORK, INFO)
ZGEQR2 computes the QR factorization of a general rectangular matrix using an unblocked algorithm...
subroutine zunm2r(SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, INFO)
ZUNM2R multiplies a general matrix by the unitary matrix from a QR factorization determined by cgeqrf...
subroutine zgeqpf(M, N, A, LDA, JPVT, TAU, WORK, RWORK, INFO)
ZGEQPF
subroutine zlarf(SIDE, M, N, V, INCV, TAU, C, LDC, WORK)
ZLARF applies an elementary reflector to a general rectangular matrix.
subroutine xerbla(SRNAME, INFO)
XERBLA
DOUBLE PRECISION function dznrm2(N, X, INCX)
DZNRM2
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
DOUBLE PRECISION function dlamch(CMACH)
DLAMCH
subroutine zlarfg(N, ALPHA, X, INCX, TAU)
ZLARFG generates an elementary reflector (Householder matrix).
INTEGER function idamax(N, DX, INCX)
IDAMAX