340 SUBROUTINE dlaqp2rk( M, N, NRHS, IOFFSET, KMAX, ABSTOL, RELTOL,
341 $ KP1, MAXC2NRM, A, LDA, K, MAXC2NRMK,
342 $ RELMAXC2NRMK, JPIV, TAU, VN1, VN2, WORK,
351 INTEGER INFO, IOFFSET, KP1, K, KMAX, LDA, M, N, NRHS
352 DOUBLE PRECISION ABSTOL, MAXC2NRM, MAXC2NRMK, RELMAXC2NRMK,
357 DOUBLE PRECISION A( LDA, * ), TAU( * ), VN1( * ), VN2( * ),
364 DOUBLE PRECISION ZERO, ONE
365 PARAMETER ( ZERO = 0.0d+0, one = 1.0d+0 )
368 INTEGER I, ITEMP, J, JMAXC2NRM, KK, KP, MINMNFACT,
370 DOUBLE PRECISION AIKK, HUGEVAL, TEMP, TEMP2, TOL3Z
376 INTRINSIC abs, max, min, sqrt
381 DOUBLE PRECISION DLAMCH, DNRM2
382 EXTERNAL disnan, dlamch, idamax, dnrm2
398 minmnfact = min( m-ioffset, n )
399 minmnupdt = min( m-ioffset, n+nrhs )
400 kmax = min( kmax, minmnfact )
401 tol3z = sqrt( dlamch(
'Epsilon' ) )
402 hugeval = dlamch(
'Overflow' )
431 kp = ( kk-1 ) + idamax( n-kk+1, vn1( kk ), 1 )
438 maxc2nrmk = vn1( kp )
450 IF( disnan( maxc2nrmk ) )
THEN
460 relmaxc2nrmk = maxc2nrmk
477 IF( maxc2nrmk.EQ.zero )
THEN
509 IF( info.EQ.0 .AND. maxc2nrmk.GT.hugeval )
THEN
510 info = n + kk - 1 + kp
525 relmaxc2nrmk = maxc2nrmk / maxc2nrm
527 IF( maxc2nrmk.LE.abstol .OR. relmaxc2nrmk.LE.reltol )
THEN
566 CALL dswap( m, a( 1, kp ), 1, a( 1, kk ), 1 )
567 vn1( kp ) = vn1( kk )
568 vn2( kp ) = vn2( kk )
570 jpiv( kp ) = jpiv( kk )
580 CALL dlarfg( m-i+1, a( i, kk ), a( i+1, kk ), 1,
596 IF( disnan( tau(kk) ) )
THEN
602 maxc2nrmk = tau( kk )
603 relmaxc2nrmk = tau( kk )
623 IF( kk.LT.minmnupdt )
THEN
626 CALL dlarf(
'Left', m-i+1, n+nrhs-kk, a( i, kk ), 1,
627 $ tau( kk ), a( i, kk+1 ), lda, work( 1 ) )
631 IF( kk.LT.minmnfact )
THEN
638 IF( vn1( j ).NE.zero )
THEN
643 temp = one - ( abs( a( i, j ) ) / vn1( j ) )**2
644 temp = max( temp, zero )
645 temp2 = temp*( vn1( j ) / vn2( j ) )**2
646 IF( temp2 .LE. tol3z )
THEN
653 vn1( j ) = dnrm2( m-i, a( i+1, j ), 1 )
663 vn1( j ) = vn1( j )*sqrt( temp )
685 IF( k.LT.minmnfact )
THEN
687 jmaxc2nrm = k + idamax( n-k, vn1( k+1 ), 1 )
688 maxc2nrmk = vn1( jmaxc2nrm )
693 relmaxc2nrmk = maxc2nrmk / maxc2nrm
705 DO j = k + 1, minmnfact
subroutine dlaqp2rk(m, n, nrhs, ioffset, kmax, abstol, reltol, kp1, maxc2nrm, a, lda, k, maxc2nrmk, relmaxc2nrmk, jpiv, tau, vn1, vn2, work, info)
DLAQP2RK computes truncated QR factorization with column pivoting of a real matrix block using Level ...
subroutine dlarf(side, m, n, v, incv, tau, c, ldc, work)
DLARF applies an elementary reflector to a general rectangular matrix.
subroutine dlarfg(n, alpha, x, incx, tau)
DLARFG generates an elementary reflector (Householder matrix).
subroutine dswap(n, dx, incx, dy, incy)
DSWAP