diff --git a/lapack-netlib/SRC/cgeqp3rk.f b/lapack-netlib/SRC/cgeqp3rk.f
new file mode 100644
index 000000000..70789e64f
--- /dev/null
+++ b/lapack-netlib/SRC/cgeqp3rk.f
@@ -0,0 +1,1091 @@
+*> \brief \b CGEQP3RK computes a truncated Householder QR factorization with column pivoting of a complex m-by-n matrix A by using Level 3 BLAS and overwrites m-by-nrhs matrix B with Q**H * B.
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download CGEQP3RK + dependencies
+*>
+*> [TGZ]
+*>
+*> [ZIP]
+*>
+*> [TXT]
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE CGEQP3RK( M, N, NRHS, KMAX, ABSTOL, RELTOL, A, LDA,
+* $ K, MAXC2NRMK, RELMAXC2NRMK, JPIV, TAU,
+* $ WORK, LWORK, RWORK, IWORK, INFO )
+* IMPLICIT NONE
+*
+* .. Scalar Arguments ..
+* INTEGER INFO, K, KMAX, LDA, LWORK, M, N, NRHS
+* REAL ABSTOL, MAXC2NRMK, RELMAXC2NRMK, RELTOL
+* ..
+* .. Array Arguments ..
+* INTEGER IWORK( * ), JPIV( * )
+* REAL RWORK( * )
+* COMPLEX A( LDA, * ), TAU( * ), WORK( * )
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> CGEQP3RK performs two tasks simultaneously:
+*>
+*> Task 1: The routine computes a truncated (rank K) or full rank
+*> Householder QR factorization with column pivoting of a complex
+*> M-by-N matrix A using Level 3 BLAS. K is the number of columns
+*> that were factorized, i.e. factorization rank of the
+*> factor R, K <= min(M,N).
+*>
+*> A * P(K) = Q(K) * R(K) =
+*>
+*> = Q(K) * ( R11(K) R12(K) ) = Q(K) * ( R(K)_approx )
+*> ( 0 R22(K) ) ( 0 R(K)_residual ),
+*>
+*> where:
+*>
+*> P(K) is an N-by-N permutation matrix;
+*> Q(K) is an M-by-M orthogonal matrix;
+*> R(K)_approx = ( R11(K), R12(K) ) is a rank K approximation of the
+*> full rank factor R with K-by-K upper-triangular
+*> R11(K) and K-by-N rectangular R12(K). The diagonal
+*> entries of R11(K) appear in non-increasing order
+*> of absolute value, and absolute values of all of
+*> them exceed the maximum column 2-norm of R22(K)
+*> up to roundoff error.
+*> R(K)_residual = R22(K) is the residual of a rank K approximation
+*> of the full rank factor R. It is a
+*> an (M-K)-by-(N-K) rectangular matrix;
+*> 0 is a an (M-K)-by-K zero matrix.
+*>
+*> Task 2: At the same time, the routine overwrites a complex M-by-NRHS
+*> matrix B with Q(K)**H * B using Level 3 BLAS.
+*>
+*> =====================================================================
+*>
+*> The matrices A and B are stored on input in the array A as
+*> the left and right blocks A(1:M,1:N) and A(1:M, N+1:N+NRHS)
+*> respectively.
+*>
+*> N NRHS
+*> array_A = M [ mat_A, mat_B ]
+*>
+*> The truncation criteria (i.e. when to stop the factorization)
+*> can be any of the following:
+*>
+*> 1) The input parameter KMAX, the maximum number of columns
+*> KMAX to factorize, i.e. the factorization rank is limited
+*> to KMAX. If KMAX >= min(M,N), the criterion is not used.
+*>
+*> 2) The input parameter ABSTOL, the absolute tolerance for
+*> the maximum column 2-norm of the residual matrix R22(K). This
+*> means that the factorization stops if this norm is less or
+*> equal to ABSTOL. If ABSTOL < 0.0, the criterion is not used.
+*>
+*> 3) The input parameter RELTOL, the tolerance for the maximum
+*> column 2-norm matrix of the residual matrix R22(K) divided
+*> by the maximum column 2-norm of the original matrix A, which
+*> is equal to abs(R(1,1)). This means that the factorization stops
+*> when the ratio of the maximum column 2-norm of R22(K) to
+*> the maximum column 2-norm of A is less than or equal to RELTOL.
+*> If RELTOL < 0.0, the criterion is not used.
+*>
+*> 4) In case both stopping criteria ABSTOL or RELTOL are not used,
+*> and when the residual matrix R22(K) is a zero matrix in some
+*> factorization step K. ( This stopping criterion is implicit. )
+*>
+*> The algorithm stops when any of these conditions is first
+*> satisfied, otherwise the whole matrix A is factorized.
+*>
+*> To factorize the whole matrix A, use the values
+*> KMAX >= min(M,N), ABSTOL < 0.0 and RELTOL < 0.0.
+*>
+*> The routine returns:
+*> a) Q(K), R(K)_approx = ( R11(K), R12(K) ),
+*> R(K)_residual = R22(K), P(K), i.e. the resulting matrices
+*> of the factorization; P(K) is represented by JPIV,
+*> ( if K = min(M,N), R(K)_approx is the full factor R,
+*> and there is no residual matrix R(K)_residual);
+*> b) K, the number of columns that were factorized,
+*> i.e. factorization rank;
+*> c) MAXC2NRMK, the maximum column 2-norm of the residual
+*> matrix R(K)_residual = R22(K),
+*> ( if K = min(M,N), MAXC2NRMK = 0.0 );
+*> d) RELMAXC2NRMK equals MAXC2NRMK divided by MAXC2NRM, the maximum
+*> column 2-norm of the original matrix A, which is equal
+*> to abs(R(1,1)), ( if K = min(M,N), RELMAXC2NRMK = 0.0 );
+*> e) Q(K)**H * B, the matrix B with the orthogonal
+*> transformation Q(K)**H applied on the left.
+*>
+*> The N-by-N permutation matrix P(K) is stored in a compact form in
+*> the integer array JPIV. For 1 <= j <= N, column j
+*> of the matrix A was interchanged with column JPIV(j).
+*>
+*> The M-by-M orthogonal matrix Q is represented as a product
+*> of elementary Householder reflectors
+*>
+*> Q(K) = H(1) * H(2) * . . . * H(K),
+*>
+*> where K is the number of columns that were factorized.
+*>
+*> Each H(j) has the form
+*>
+*> H(j) = I - tau * v * v**H,
+*>
+*> where 1 <= j <= K and
+*> I is an M-by-M identity matrix,
+*> tau is a complex scalar,
+*> v is a complex vector with v(1:j-1) = 0 and v(j) = 1.
+*>
+*> v(j+1:M) is stored on exit in A(j+1:M,j) and tau in TAU(j).
+*>
+*> See the Further Details section for more information.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] M
+*> \verbatim
+*> M is INTEGER
+*> The number of rows of the matrix A. M >= 0.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> The number of columns of the matrix A. N >= 0.
+*> \endverbatim
+*>
+*> \param[in] NRHS
+*> \verbatim
+*> NRHS is INTEGER
+*> The number of right hand sides, i.e. the number of
+*> columns of the matrix B. NRHS >= 0.
+*> \endverbatim
+*>
+*> \param[in] KMAX
+*> \verbatim
+*> KMAX is INTEGER
+*>
+*> The first factorization stopping criterion. KMAX >= 0.
+*>
+*> The maximum number of columns of the matrix A to factorize,
+*> i.e. the maximum factorization rank.
+*>
+*> a) If KMAX >= min(M,N), then this stopping criterion
+*> is not used, the routine factorizes columns
+*> depending on ABSTOL and RELTOL.
+*>
+*> b) If KMAX = 0, then this stopping criterion is
+*> satisfied on input and the routine exits immediately.
+*> This means that the factorization is not performed,
+*> the matrices A and B are not modified, and
+*> the matrix A is itself the residual.
+*> \endverbatim
+*>
+*> \param[in] ABSTOL
+*> \verbatim
+*> ABSTOL is REAL
+*>
+*> The second factorization stopping criterion, cannot be NaN.
+*>
+*> The absolute tolerance (stopping threshold) for
+*> maximum column 2-norm of the residual matrix R22(K).
+*> The algorithm converges (stops the factorization) when
+*> the maximum column 2-norm of the residual matrix R22(K)
+*> is less than or equal to ABSTOL. Let SAFMIN = DLAMCH('S').
+*>
+*> a) If ABSTOL is NaN, then no computation is performed
+*> and an error message ( INFO = -5 ) is issued
+*> by XERBLA.
+*>
+*> b) If ABSTOL < 0.0, then this stopping criterion is not
+*> used, the routine factorizes columns depending
+*> on KMAX and RELTOL.
+*> This includes the case ABSTOL = -Inf.
+*>
+*> c) If 0.0 <= ABSTOL < 2*SAFMIN, then ABSTOL = 2*SAFMIN
+*> is used. This includes the case ABSTOL = -0.0.
+*>
+*> d) If 2*SAFMIN <= ABSTOL then the input value
+*> of ABSTOL is used.
+*>
+*> Let MAXC2NRM be the maximum column 2-norm of the
+*> whole original matrix A.
+*> If ABSTOL chosen above is >= MAXC2NRM, then this
+*> stopping criterion is satisfied on input and routine exits
+*> immediately after MAXC2NRM is computed. The routine
+*> returns MAXC2NRM in MAXC2NORMK,
+*> and 1.0 in RELMAXC2NORMK.
+*> This includes the case ABSTOL = +Inf. This means that the
+*> factorization is not performed, the matrices A and B are not
+*> modified, and the matrix A is itself the residual.
+*> \endverbatim
+*>
+*> \param[in] RELTOL
+*> \verbatim
+*> RELTOL is REAL
+*>
+*> The third factorization stopping criterion, cannot be NaN.
+*>
+*> The tolerance (stopping threshold) for the ratio
+*> abs(R(K+1,K+1))/abs(R(1,1)) of the maximum column 2-norm of
+*> the residual matrix R22(K) to the maximum column 2-norm of
+*> the original matrix A. The algorithm converges (stops the
+*> factorization), when abs(R(K+1,K+1))/abs(R(1,1)) A is less
+*> than or equal to RELTOL. Let EPS = DLAMCH('E').
+*>
+*> a) If RELTOL is NaN, then no computation is performed
+*> and an error message ( INFO = -6 ) is issued
+*> by XERBLA.
+*>
+*> b) If RELTOL < 0.0, then this stopping criterion is not
+*> used, the routine factorizes columns depending
+*> on KMAX and ABSTOL.
+*> This includes the case RELTOL = -Inf.
+*>
+*> c) If 0.0 <= RELTOL < EPS, then RELTOL = EPS is used.
+*> This includes the case RELTOL = -0.0.
+*>
+*> d) If EPS <= RELTOL then the input value of RELTOL
+*> is used.
+*>
+*> Let MAXC2NRM be the maximum column 2-norm of the
+*> whole original matrix A.
+*> If RELTOL chosen above is >= 1.0, then this stopping
+*> criterion is satisfied on input and routine exits
+*> immediately after MAXC2NRM is computed.
+*> The routine returns MAXC2NRM in MAXC2NORMK,
+*> and 1.0 in RELMAXC2NORMK.
+*> This includes the case RELTOL = +Inf. This means that the
+*> factorization is not performed, the matrices A and B are not
+*> modified, and the matrix A is itself the residual.
+*>
+*> NOTE: We recommend that RELTOL satisfy
+*> min( 10*max(M,N)*EPS, sqrt(EPS) ) <= RELTOL
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*> A is COMPLEX array, dimension (LDA,N+NRHS)
+*>
+*> On entry:
+*>
+*> a) The subarray A(1:M,1:N) contains the M-by-N matrix A.
+*> b) The subarray A(1:M,N+1:N+NRHS) contains the M-by-NRHS
+*> matrix B.
+*>
+*> N NRHS
+*> array_A = M [ mat_A, mat_B ]
+*>
+*> On exit:
+*>
+*> a) The subarray A(1:M,1:N) contains parts of the factors
+*> of the matrix A:
+*>
+*> 1) If K = 0, A(1:M,1:N) contains the original matrix A.
+*> 2) If K > 0, A(1:M,1:N) contains parts of the
+*> factors:
+*>
+*> 1. The elements below the diagonal of the subarray
+*> A(1:M,1:K) together with TAU(1:K) represent the
+*> orthogonal matrix Q(K) as a product of K Householder
+*> elementary reflectors.
+*>
+*> 2. The elements on and above the diagonal of
+*> the subarray A(1:K,1:N) contain K-by-N
+*> upper-trapezoidal matrix
+*> R(K)_approx = ( R11(K), R12(K) ).
+*> NOTE: If K=min(M,N), i.e. full rank factorization,
+*> then R_approx(K) is the full factor R which
+*> is upper-trapezoidal. If, in addition, M>=N,
+*> then R is upper-triangular.
+*>
+*> 3. The subarray A(K+1:M,K+1:N) contains (M-K)-by-(N-K)
+*> rectangular matrix R(K)_residual = R22(K).
+*>
+*> b) If NRHS > 0, the subarray A(1:M,N+1:N+NRHS) contains
+*> the M-by-NRHS product Q(K)**H * B.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*> LDA is INTEGER
+*> The leading dimension of the array A. LDA >= max(1,M).
+*> This is the leading dimension for both matrices, A and B.
+*> \endverbatim
+*>
+*> \param[out] K
+*> \verbatim
+*> K is INTEGER
+*> Factorization rank of the matrix A, i.e. the rank of
+*> the factor R, which is the same as the number of non-zero
+*> rows of the factor R. 0 <= K <= min(M,KMAX,N).
+*>
+*> K also represents the number of non-zero Householder
+*> vectors.
+*>
+*> NOTE: If K = 0, a) the arrays A and B are not modified;
+*> b) the array TAU(1:min(M,N)) is set to ZERO,
+*> if the matrix A does not contain NaN,
+*> otherwise the elements TAU(1:min(M,N))
+*> are undefined;
+*> c) the elements of the array JPIV are set
+*> as follows: for j = 1:N, JPIV(j) = j.
+*> \endverbatim
+*>
+*> \param[out] MAXC2NRMK
+*> \verbatim
+*> MAXC2NRMK is REAL
+*> The maximum column 2-norm of the residual matrix R22(K),
+*> when the factorization stopped at rank K. MAXC2NRMK >= 0.
+*>
+*> a) If K = 0, i.e. the factorization was not performed,
+*> the matrix A was not modified and is itself a residual
+*> matrix, then MAXC2NRMK equals the maximum column 2-norm
+*> of the original matrix A.
+*>
+*> b) If 0 < K < min(M,N), then MAXC2NRMK is returned.
+*>
+*> c) If K = min(M,N), i.e. the whole matrix A was
+*> factorized and there is no residual matrix,
+*> then MAXC2NRMK = 0.0.
+*>
+*> NOTE: MAXC2NRMK in the factorization step K would equal
+*> R(K+1,K+1) in the next factorization step K+1.
+*> \endverbatim
+*>
+*> \param[out] RELMAXC2NRMK
+*> \verbatim
+*> RELMAXC2NRMK is REAL
+*> The ratio MAXC2NRMK / MAXC2NRM of the maximum column
+*> 2-norm of the residual matrix R22(K) (when the factorization
+*> stopped at rank K) to the maximum column 2-norm of the
+*> whole original matrix A. RELMAXC2NRMK >= 0.
+*>
+*> a) If K = 0, i.e. the factorization was not performed,
+*> the matrix A was not modified and is itself a residual
+*> matrix, then RELMAXC2NRMK = 1.0.
+*>
+*> b) If 0 < K < min(M,N), then
+*> RELMAXC2NRMK = MAXC2NRMK / MAXC2NRM is returned.
+*>
+*> c) If K = min(M,N), i.e. the whole matrix A was
+*> factorized and there is no residual matrix,
+*> then RELMAXC2NRMK = 0.0.
+*>
+*> NOTE: RELMAXC2NRMK in the factorization step K would equal
+*> abs(R(K+1,K+1))/abs(R(1,1)) in the next factorization
+*> step K+1.
+*> \endverbatim
+*>
+*> \param[out] JPIV
+*> \verbatim
+*> JPIV is INTEGER array, dimension (N)
+*> Column pivot indices. For 1 <= j <= N, column j
+*> of the matrix A was interchanged with column JPIV(j).
+*>
+*> The elements of the array JPIV(1:N) are always set
+*> by the routine, for example, even when no columns
+*> were factorized, i.e. when K = 0, the elements are
+*> set as JPIV(j) = j for j = 1:N.
+*> \endverbatim
+*>
+*> \param[out] TAU
+*> \verbatim
+*> TAU is COMPLEX array, dimension (min(M,N))
+*> The scalar factors of the elementary reflectors.
+*>
+*> If 0 < K <= min(M,N), only the elements TAU(1:K) of
+*> the array TAU are modified by the factorization.
+*> After the factorization computed, if no NaN was found
+*> during the factorization, the remaining elements
+*> TAU(K+1:min(M,N)) are set to zero, otherwise the
+*> elements TAU(K+1:min(M,N)) are not set and therefore
+*> undefined.
+*> ( If K = 0, all elements of TAU are set to zero, if
+*> the matrix A does not contain NaN. )
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*> WORK is COMPLEX array, dimension (MAX(1,LWORK))
+*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*> LWORK is INTEGER
+*> The dimension of the array WORK.
+*. LWORK >= N+NRHS-1
+*> For optimal performance LWORK >= NB*( N+NRHS+1 ),
+*> where NB is the optimal block size for CGEQP3RK returned
+*> by ILAENV. Minimal block size MINNB=2.
+*>
+*> NOTE: The decision, whether to use unblocked BLAS 2
+*> or blocked BLAS 3 code is based not only on the dimension
+*> LWORK of the availbale workspace WORK, but also also on the
+*> matrix A dimension N via crossover point NX returned
+*> by ILAENV. (For N less than NX, unblocked code should be
+*> used.)
+*>
+*> If LWORK = -1, then a workspace query is assumed;
+*> the routine only calculates the optimal size of the WORK
+*> array, returns this value as the first entry of the WORK
+*> array, and no error message related to LWORK is issued
+*> by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] RWORK
+*> \verbatim
+*> RWORK is REAL array, dimension (2*N)
+*> \endverbatim
+*>
+*> \param[out] IWORK
+*> \verbatim
+*> IWORK is INTEGER array, dimension (N-1).
+*> Is a work array. ( IWORK is used to store indices
+*> of "bad" columns for norm downdating in the residual
+*> matrix in the blocked step auxiliary subroutine CLAQP3RK ).
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*> INFO is INTEGER
+*> 1) INFO = 0: successful exit.
+*> 2) INFO < 0: if INFO = -i, the i-th argument had an
+*> illegal value.
+*> 3) If INFO = j_1, where 1 <= j_1 <= N, then NaN was
+*> detected and the routine stops the computation.
+*> The j_1-th column of the matrix A or the j_1-th
+*> element of array TAU contains the first occurrence
+*> of NaN in the factorization step K+1 ( when K columns
+*> have been factorized ).
+*>
+*> On exit:
+*> K is set to the number of
+*> factorized columns without
+*> exception.
+*> MAXC2NRMK is set to NaN.
+*> RELMAXC2NRMK is set to NaN.
+*> TAU(K+1:min(M,N)) is not set and contains undefined
+*> elements. If j_1=K+1, TAU(K+1)
+*> may contain NaN.
+*> 4) If INFO = j_2, where N+1 <= j_2 <= 2*N, then no NaN
+*> was detected, but +Inf (or -Inf) was detected and
+*> the routine continues the computation until completion.
+*> The (j_2-N)-th column of the matrix A contains the first
+*> occurrence of +Inf (or -Inf) in the factorization
+*> step K+1 ( when K columns have been factorized ).
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \ingroup geqp3rk
+*
+*> \par Further Details:
+* =====================
+*
+*> \verbatim
+*> CGEQP3RK is based on the same BLAS3 Householder QR factorization
+*> algorithm with column pivoting as in CGEQP3 routine which uses
+*> CLARFG routine to generate Householder reflectors
+*> for QR factorization.
+*>
+*> We can also write:
+*>
+*> A = A_approx(K) + A_residual(K)
+*>
+*> The low rank approximation matrix A(K)_approx from
+*> the truncated QR factorization of rank K of the matrix A is:
+*>
+*> A(K)_approx = Q(K) * ( R(K)_approx ) * P(K)**T
+*> ( 0 0 )
+*>
+*> = Q(K) * ( R11(K) R12(K) ) * P(K)**T
+*> ( 0 0 )
+*>
+*> The residual A_residual(K) of the matrix A is:
+*>
+*> A_residual(K) = Q(K) * ( 0 0 ) * P(K)**T =
+*> ( 0 R(K)_residual )
+*>
+*> = Q(K) * ( 0 0 ) * P(K)**T
+*> ( 0 R22(K) )
+*>
+*> The truncated (rank K) factorization guarantees that
+*> the maximum column 2-norm of A_residual(K) is less than
+*> or equal to MAXC2NRMK up to roundoff error.
+*>
+*> NOTE: An approximation of the null vectors
+*> of A can be easily computed from R11(K)
+*> and R12(K):
+*>
+*> Null( A(K) )_approx = P * ( inv(R11(K)) * R12(K) )
+*> ( -I )
+*>
+*> \endverbatim
+*
+*> \par References:
+* ================
+*> [1] A Level 3 BLAS QR factorization algorithm with column pivoting developed in 1996.
+*> G. Quintana-Orti, Depto. de Informatica, Universidad Jaime I, Spain.
+*> X. Sun, Computer Science Dept., Duke University, USA.
+*> C. H. Bischof, Math. and Comp. Sci. Div., Argonne National Lab, USA.
+*> A BLAS-3 version of the QR factorization with column pivoting.
+*> LAPACK Working Note 114
+*> \htmlonly
+*> https://www.netlib.org/lapack/lawnspdf/lawn114.pdf
+*> \endhtmlonly
+*> and in
+*> SIAM J. Sci. Comput., 19(5):1486-1494, Sept. 1998.
+*> \htmlonly
+*> https://doi.org/10.1137/S1064827595296732
+*> \endhtmlonly
+*>
+*> [2] A partial column norm updating strategy developed in 2006.
+*> Z. Drmac and Z. Bujanovic, Dept. of Math., University of Zagreb, Croatia.
+*> On the failure of rank revealing QR factorization software – a case study.
+*> LAPACK Working Note 176.
+*> \htmlonly
+*> http://www.netlib.org/lapack/lawnspdf/lawn176.pdf
+*> \endhtmlonly
+*> and in
+*> ACM Trans. Math. Softw. 35, 2, Article 12 (July 2008), 28 pages.
+*> \htmlonly
+*> https://doi.org/10.1145/1377612.1377616
+*> \endhtmlonly
+*
+*> \par Contributors:
+* ==================
+*>
+*> \verbatim
+*>
+*> November 2023, Igor Kozachenko, James Demmel,
+*> Computer Science Division,
+*> University of California, Berkeley
+*>
+*> \endverbatim
+*
+* =====================================================================
+ SUBROUTINE CGEQP3RK( M, N, NRHS, KMAX, ABSTOL, RELTOL, A, LDA,
+ $ K, MAXC2NRMK, RELMAXC2NRMK, JPIV, TAU,
+ $ WORK, LWORK, RWORK, IWORK, INFO )
+ IMPLICIT NONE
+*
+* -- LAPACK computational routine --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*
+* .. Scalar Arguments ..
+ INTEGER INFO, K, KF, KMAX, LDA, LWORK, M, N, NRHS
+ REAL ABSTOL, MAXC2NRMK, RELMAXC2NRMK, RELTOL
+* ..
+* .. Array Arguments ..
+ INTEGER IWORK( * ), JPIV( * )
+ REAL RWORK( * )
+ COMPLEX A( LDA, * ), TAU( * ), WORK( * )
+* ..
+*
+* =====================================================================
+*
+* .. Parameters ..
+ INTEGER INB, INBMIN, IXOVER
+ PARAMETER ( INB = 1, INBMIN = 2, IXOVER = 3 )
+ REAL ZERO, ONE, TWO
+ PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0, TWO = 2.0E+0 )
+ COMPLEX CZERO
+ PARAMETER ( CZERO = ( 0.0E+0, 0.0E+0 ) )
+* ..
+* .. Local Scalars ..
+ LOGICAL LQUERY, DONE
+ INTEGER IINFO, IOFFSET, IWS, J, JB, JBF, JMAXB, JMAX,
+ $ JMAXC2NRM, KP1, LWKOPT, MINMN, N_SUB, NB,
+ $ NBMIN, NX
+ REAL EPS, HUGEVAL, MAXC2NRM, SAFMIN
+* ..
+* .. External Subroutines ..
+ EXTERNAL CLAQP2RK, CLAQP3RK, XERBLA
+* ..
+* .. External Functions ..
+ LOGICAL SISNAN
+ INTEGER ISAMAX, ILAENV
+ REAL SLAMCH, SCNRM2
+ EXTERNAL SISNAN, SLAMCH, SCNRM2, ISAMAX, ILAENV
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC CMPLX, MAX, MIN
+* ..
+* .. Executable Statements ..
+*
+* Test input arguments
+* ====================
+*
+ INFO = 0
+ LQUERY = ( LWORK.EQ.-1 )
+ IF( M.LT.0 ) THEN
+ INFO = -1
+ ELSE IF( N.LT.0 ) THEN
+ INFO = -2
+ ELSE IF( NRHS.LT.0 ) THEN
+ INFO = -3
+ ELSE IF( KMAX.LT.0 ) THEN
+ INFO = -4
+ ELSE IF( SISNAN( ABSTOL ) ) THEN
+ INFO = -5
+ ELSE IF( SISNAN( RELTOL ) ) THEN
+ INFO = -6
+ ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
+ INFO = -8
+ END IF
+*
+* If the input parameters M, N, NRHS, KMAX, LDA are valid:
+* a) Test the input workspace size LWORK for the minimum
+* size requirement IWS.
+* b) Determine the optimal block size NB and optimal
+* workspace size LWKOPT to be returned in WORK(1)
+* in case of (1) LWORK < IWS, (2) LQUERY = .TRUE.,
+* (3) when routine exits.
+* Here, IWS is the miminum workspace required for unblocked
+* code.
+*
+ IF( INFO.EQ.0 ) THEN
+ MINMN = MIN( M, N )
+ IF( MINMN.EQ.0 ) THEN
+ IWS = 1
+ LWKOPT = 1
+ ELSE
+*
+* Minimal workspace size in case of using only unblocked
+* BLAS 2 code in CLAQP2RK.
+* 1) CLAQP2RK: N+NRHS-1 to use in WORK array that is used
+* in CLARF subroutine inside CLAQP2RK to apply an
+* elementary reflector from the left.
+* TOTAL_WORK_SIZE = 3*N + NRHS - 1
+*
+ IWS = N + NRHS - 1
+*
+* Assign to NB optimal block size.
+*
+ NB = ILAENV( INB, 'CGEQP3RK', ' ', M, N, -1, -1 )
+*
+* A formula for the optimal workspace size in case of using
+* both unblocked BLAS 2 in CLAQP2RK and blocked BLAS 3 code
+* in CLAQP3RK.
+* 1) CGEQP3RK, CLAQP2RK, CLAQP3RK: 2*N to store full and
+* partial column 2-norms.
+* 2) CLAQP2RK: N+NRHS-1 to use in WORK array that is used
+* in CLARF subroutine to apply an elementary reflector
+* from the left.
+* 3) CLAQP3RK: NB*(N+NRHS) to use in the work array F that
+* is used to apply a block reflector from
+* the left.
+* 4) CLAQP3RK: NB to use in the auxilixary array AUX.
+* Sizes (2) and ((3) + (4)) should intersect, therefore
+* TOTAL_WORK_SIZE = 2*N + NB*( N+NRHS+1 ), given NBMIN=2.
+*
+ LWKOPT = 2*N + NB*( N+NRHS+1 )
+ END IF
+ WORK( 1 ) = CMPLX( LWKOPT )
+*
+ IF( ( LWORK.LT.IWS ) .AND. .NOT.LQUERY ) THEN
+ INFO = -15
+ END IF
+ END IF
+*
+* NOTE: The optimal workspace size is returned in WORK(1), if
+* the input parameters M, N, NRHS, KMAX, LDA are valid.
+*
+ IF( INFO.NE.0 ) THEN
+ CALL XERBLA( 'CGEQP3RK', -INFO )
+ RETURN
+ ELSE IF( LQUERY ) THEN
+ RETURN
+ END IF
+*
+* Quick return if possible for M=0 or N=0.
+*
+ IF( MINMN.EQ.0 ) THEN
+ K = 0
+ MAXC2NRMK = ZERO
+ RELMAXC2NRMK = ZERO
+ WORK( 1 ) = CMPLX( LWKOPT )
+ RETURN
+ END IF
+*
+* ==================================================================
+*
+* Initialize column pivot array JPIV.
+*
+ DO J = 1, N
+ JPIV( J ) = J
+ END DO
+*
+* ==================================================================
+*
+* Initialize storage for partial and exact column 2-norms.
+* a) The elements WORK(1:N) are used to store partial column
+* 2-norms of the matrix A, and may decrease in each computation
+* step; initialize to the values of complete columns 2-norms.
+* b) The elements WORK(N+1:2*N) are used to store complete column
+* 2-norms of the matrix A, they are not changed during the
+* computation; initialize the values of complete columns 2-norms.
+*
+ DO J = 1, N
+ RWORK( J ) = SCNRM2( M, A( 1, J ), 1 )
+ RWORK( N+J ) = RWORK( J )
+ END DO
+*
+* ==================================================================
+*
+* Compute the pivot column index and the maximum column 2-norm
+* for the whole original matrix stored in A(1:M,1:N).
+*
+ KP1 = ISAMAX( N, RWORK( 1 ), 1 )
+*
+* ==================================================================.
+*
+ IF( SISNAN( MAXC2NRM ) ) THEN
+*
+* Check if the matrix A contains NaN, set INFO parameter
+* to the column number where the first NaN is found and return
+* from the routine.
+*
+ K = 0
+ INFO = KP1
+*
+* Set MAXC2NRMK and RELMAXC2NRMK to NaN.
+*
+ MAXC2NRMK = MAXC2NRM
+ RELMAXC2NRMK = MAXC2NRM
+*
+* Array TAU is not set and contains undefined elements.
+*
+ WORK( 1 ) = CMPLX( LWKOPT )
+ RETURN
+ END IF
+*
+* ===================================================================
+*
+ IF( MAXC2NRM.EQ.ZERO ) THEN
+*
+* Check is the matrix A is a zero matrix, set array TAU and
+* return from the routine.
+*
+ K = 0
+ MAXC2NRMK = ZERO
+ RELMAXC2NRMK = ZERO
+*
+ DO J = 1, MINMN
+ TAU( J ) = CZERO
+ END DO
+*
+ WORK( 1 ) = CMPLX( LWKOPT )
+ RETURN
+*
+ END IF
+*
+* ===================================================================
+*
+ HUGEVAL = SLAMCH( 'Overflow' )
+*
+ IF( MAXC2NRM.GT.HUGEVAL ) THEN
+*
+* Check if the matrix A contains +Inf or -Inf, set INFO parameter
+* to the column number, where the first +/-Inf is found plus N,
+* and continue the computation.
+*
+ INFO = N + KP1
+*
+ END IF
+*
+* ==================================================================
+*
+* Quick return if possible for the case when the first
+* stopping criterion is satisfied, i.e. KMAX = 0.
+*
+ IF( KMAX.EQ.0 ) THEN
+ K = 0
+ MAXC2NRMK = MAXC2NRM
+ RELMAXC2NRMK = ONE
+ DO J = 1, MINMN
+ TAU( J ) = CZERO
+ END DO
+ WORK( 1 ) = CMPLX( LWKOPT )
+ RETURN
+ END IF
+*
+* ==================================================================
+*
+ EPS = SLAMCH('Epsilon')
+*
+* Adjust ABSTOL
+*
+ IF( ABSTOL.GE.ZERO ) THEN
+ SAFMIN = SLAMCH('Safe minimum')
+ ABSTOL = MAX( ABSTOL, TWO*SAFMIN )
+ END IF
+*
+* Adjust RELTOL
+*
+ IF( RELTOL.GE.ZERO ) THEN
+ RELTOL = MAX( RELTOL, EPS )
+ END IF
+*
+* ===================================================================
+*
+* JMAX is the maximum index of the column to be factorized,
+* which is also limited by the first stopping criterion KMAX.
+*
+ JMAX = MIN( KMAX, MINMN )
+*
+* ===================================================================
+*
+* Quick return if possible for the case when the second or third
+* stopping criterion for the whole original matrix is satified,
+* i.e. MAXC2NRM <= ABSTOL or RELMAXC2NRM <= RELTOL
+* (which is ONE <= RELTOL).
+*
+ IF( MAXC2NRM.LE.ABSTOL .OR. ONE.LE.RELTOL ) THEN
+*
+ K = 0
+ MAXC2NRMK = MAXC2NRM
+ RELMAXC2NRMK = ONE
+*
+ DO J = 1, MINMN
+ TAU( J ) = CZERO
+ END DO
+*
+ WORK( 1 ) = CMPLX( LWKOPT )
+ RETURN
+ END IF
+*
+* ==================================================================
+* Factorize columns
+* ==================================================================
+*
+* Determine the block size.
+*
+ NBMIN = 2
+ NX = 0
+*
+ IF( ( NB.GT.1 ) .AND. ( NB.LT.MINMN ) ) THEN
+*
+* Determine when to cross over from blocked to unblocked code.
+* (for N less than NX, unblocked code should be used).
+*
+ NX = MAX( 0, ILAENV( IXOVER, 'CGEQP3RK', ' ', M, N, -1, -1 ) )
+*
+ IF( NX.LT.MINMN ) THEN
+*
+* Determine if workspace is large enough for blocked code.
+*
+ IF( LWORK.LT.LWKOPT ) THEN
+*
+* Not enough workspace to use optimal block size that
+* is currently stored in NB.
+* Reduce NB and determine the minimum value of NB.
+*
+ NB = ( LWORK-2*N ) / ( N+1 )
+ NBMIN = MAX( 2, ILAENV( INBMIN, 'CGEQP3RK', ' ', M, N,
+ $ -1, -1 ) )
+*
+ END IF
+ END IF
+ END IF
+*
+* ==================================================================
+*
+* DONE is the boolean flag to rerpresent the case when the
+* factorization completed in the block factorization routine,
+* before the end of the block.
+*
+ DONE = .FALSE.
+*
+* J is the column index.
+*
+ J = 1
+*
+* (1) Use blocked code initially.
+*
+* JMAXB is the maximum column index of the block, when the
+* blocked code is used, is also limited by the first stopping
+* criterion KMAX.
+*
+ JMAXB = MIN( KMAX, MINMN - NX )
+*
+ IF( NB.GE.NBMIN .AND. NB.LT.JMAX .AND. JMAXB.GT.0 ) THEN
+*
+* Loop over the column blocks of the matrix A(1:M,1:JMAXB). Here:
+* J is the column index of a column block;
+* JB is the column block size to pass to block factorization
+* routine in a loop step;
+* JBF is the number of columns that were actually factorized
+* that was returned by the block factorization routine
+* in a loop step, JBF <= JB;
+* N_SUB is the number of columns in the submatrix;
+* IOFFSET is the number of rows that should not be factorized.
+*
+ DO WHILE( J.LE.JMAXB )
+*
+ JB = MIN( NB, JMAXB-J+1 )
+ N_SUB = N-J+1
+ IOFFSET = J-1
+*
+* Factorize JB columns among the columns A(J:N).
+*
+ CALL CLAQP3RK( M, N_SUB, NRHS, IOFFSET, JB, ABSTOL,
+ $ RELTOL, KP1, MAXC2NRM, A( 1, J ), LDA,
+ $ DONE, JBF, MAXC2NRMK, RELMAXC2NRMK,
+ $ JPIV( J ), TAU( J ),
+ $ RWORK( J ), RWORK( N+J ),
+ $ WORK( 1 ), WORK( JB+1 ),
+ $ N+NRHS-J+1, IWORK, IINFO )
+*
+* Set INFO on the first occurence of Inf.
+*
+ IF( IINFO.GT.N_SUB .AND. INFO.EQ.0 ) THEN
+ INFO = 2*IOFFSET + IINFO
+ END IF
+*
+ IF( DONE ) THEN
+*
+* Either the submatrix is zero before the end of the
+* column block, or ABSTOL or RELTOL criterion is
+* satisfied before the end of the column block, we can
+* return from the routine. Perform the following before
+* returning:
+* a) Set the number of factorized columns K,
+* K = IOFFSET + JBF from the last call of blocked
+* routine.
+* NOTE: 1) MAXC2NRMK and RELMAXC2NRMK are returned
+* by the block factorization routine;
+* 2) The remaining TAUs are set to ZERO by the
+* block factorization routine.
+*
+ K = IOFFSET + JBF
+*
+* Set INFO on the first occurrence of NaN, NaN takes
+* prcedence over Inf.
+*
+ IF( IINFO.LE.N_SUB .AND. IINFO.GT.0 ) THEN
+ INFO = IOFFSET + IINFO
+ END IF
+*
+* Return from the routine.
+*
+ WORK( 1 ) = CMPLX( LWKOPT )
+*
+ RETURN
+*
+ END IF
+*
+ J = J + JBF
+*
+ END DO
+*
+ END IF
+*
+* Use unblocked code to factor the last or only block.
+* J = JMAX+1 means we factorized the maximum possible number of
+* columns, that is in ELSE clause we need to compute
+* the MAXC2NORM and RELMAXC2NORM to return after we processed
+* the blocks.
+*
+ IF( J.LE.JMAX ) THEN
+*
+* N_SUB is the number of columns in the submatrix;
+* IOFFSET is the number of rows that should not be factorized.
+*
+ N_SUB = N-J+1
+ IOFFSET = J-1
+*
+ CALL CLAQP2RK( M, N_SUB, NRHS, IOFFSET, JMAX-J+1,
+ $ ABSTOL, RELTOL, KP1, MAXC2NRM, A( 1, J ), LDA,
+ $ KF, MAXC2NRMK, RELMAXC2NRMK, JPIV( J ),
+ $ TAU( J ), RWORK( J ), RWORK( N+J ),
+ $ WORK( 1 ), IINFO )
+*
+* ABSTOL or RELTOL criterion is satisfied when the number of
+* the factorized columns KF is smaller then the number
+* of columns JMAX-J+1 supplied to be factorized by the
+* unblocked routine, we can return from
+* the routine. Perform the following before returning:
+* a) Set the number of factorized columns K,
+* b) MAXC2NRMK and RELMAXC2NRMK are returned by the
+* unblocked factorization routine above.
+*
+ K = J - 1 + KF
+*
+* Set INFO on the first exception occurence.
+*
+* Set INFO on the first exception occurence of Inf or NaN,
+* (NaN takes precedence over Inf).
+*
+ IF( IINFO.GT.N_SUB .AND. INFO.EQ.0 ) THEN
+ INFO = 2*IOFFSET + IINFO
+ ELSE IF( IINFO.LE.N_SUB .AND. IINFO.GT.0 ) THEN
+ INFO = IOFFSET + IINFO
+ END IF
+*
+ ELSE
+*
+* Compute the return values for blocked code.
+*
+* Set the number of factorized columns if the unblocked routine
+* was not called.
+*
+ K = JMAX
+*
+* If there exits a residual matrix after the blocked code:
+* 1) compute the values of MAXC2NRMK, RELMAXC2NRMK of the
+* residual matrix, otherwise set them to ZERO;
+* 2) Set TAU(K+1:MINMN) to ZERO.
+*
+ IF( K.LT.MINMN ) THEN
+ JMAXC2NRM = K + ISAMAX( N-K, RWORK( K+1 ), 1 )
+ MAXC2NRMK = RWORK( JMAXC2NRM )
+ IF( K.EQ.0 ) THEN
+ RELMAXC2NRMK = ONE
+ ELSE
+ RELMAXC2NRMK = MAXC2NRMK / MAXC2NRM
+ END IF
+*
+ DO J = K + 1, MINMN
+ TAU( J ) = CZERO
+ END DO
+*
+ ELSE
+ MAXC2NRMK = ZERO
+ RELMAXC2NRMK = ZERO
+*
+ END IF
+*
+* END IF( J.LE.JMAX ) THEN
+*
+ END IF
+*
+ WORK( 1 ) = CMPLX( LWKOPT )
+*
+ RETURN
+*
+* End of CGEQP3RK
+*
+ END
diff --git a/lapack-netlib/SRC/claqp2rk.f b/lapack-netlib/SRC/claqp2rk.f
new file mode 100644
index 000000000..073ad0f88
--- /dev/null
+++ b/lapack-netlib/SRC/claqp2rk.f
@@ -0,0 +1,726 @@
+*> \brief \b CLAQP2RK computes truncated QR factorization with column pivoting of a complex matrix block using Level 2 BLAS and overwrites a complex m-by-nrhs matrix B with Q**H * B.
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download CLAQP2RK + dependencies
+*>
+*> [TGZ]
+*>
+*> [ZIP]
+*>
+*> [TXT]
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE CLAQP2RK( M, N, NRHS, IOFFSET, KMAX, ABSTOL, RELTOL,
+* $ KP1, MAXC2NRM, A, LDA, K, MAXC2NRMK,
+* $ RELMAXC2NRMK, JPIV, TAU, VN1, VN2, WORK,
+* $ INFO )
+* IMPLICIT NONE
+*
+* .. Scalar Arguments ..
+* INTEGER INFO, IOFFSET, KP1, K, KMAX, LDA, M, N, NRHS
+* REAL ABSTOL, MAXC2NRM, MAXC2NRMK, RELMAXC2NRMK,
+* $ RELTOL
+* ..
+* .. Array Arguments ..
+* INTEGER JPIV( * )
+* REAL VN1( * ), VN2( * )
+* COMPLEX A( LDA, * ), TAU( * ), WORK( * )
+* $
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> CLAQP2RK computes a truncated (rank K) or full rank Householder QR
+*> factorization with column pivoting of the complex matrix
+*> block A(IOFFSET+1:M,1:N) as
+*>
+*> A * P(K) = Q(K) * R(K).
+*>
+*> The routine uses Level 2 BLAS. The block A(1:IOFFSET,1:N)
+*> is accordingly pivoted, but not factorized.
+*>
+*> The routine also overwrites the right-hand-sides matrix block B
+*> stored in A(IOFFSET+1:M,N+1:N+NRHS) with Q(K)**H * B.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] M
+*> \verbatim
+*> M is INTEGER
+*> The number of rows of the matrix A. M >= 0.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> The number of columns of the matrix A. N >= 0.
+*> \endverbatim
+*>
+*> \param[in] NRHS
+*> \verbatim
+*> NRHS is INTEGER
+*> The number of right hand sides, i.e., the number of
+*> columns of the matrix B. NRHS >= 0.
+*> \endverbatim
+*>
+*> \param[in] IOFFSET
+*> \verbatim
+*> IOFFSET is INTEGER
+*> The number of rows of the matrix A that must be pivoted
+*> but not factorized. IOFFSET >= 0.
+*>
+*> IOFFSET also represents the number of columns of the whole
+*> original matrix A_orig that have been factorized
+*> in the previous steps.
+*> \endverbatim
+*>
+*> \param[in] KMAX
+*> \verbatim
+*> KMAX is INTEGER
+*>
+*> The first factorization stopping criterion. KMAX >= 0.
+*>
+*> The maximum number of columns of the matrix A to factorize,
+*> i.e. the maximum factorization rank.
+*>
+*> a) If KMAX >= min(M-IOFFSET,N), then this stopping
+*> criterion is not used, factorize columns
+*> depending on ABSTOL and RELTOL.
+*>
+*> b) If KMAX = 0, then this stopping criterion is
+*> satisfied on input and the routine exits immediately.
+*> This means that the factorization is not performed,
+*> the matrices A and B and the arrays TAU, IPIV
+*> are not modified.
+*> \endverbatim
+*>
+*> \param[in] ABSTOL
+*> \verbatim
+*> ABSTOL is REAL, cannot be NaN.
+*>
+*> The second factorization stopping criterion.
+*>
+*> The absolute tolerance (stopping threshold) for
+*> maximum column 2-norm of the residual matrix.
+*> The algorithm converges (stops the factorization) when
+*> the maximum column 2-norm of the residual matrix
+*> is less than or equal to ABSTOL.
+*>
+*> a) If ABSTOL < 0.0, then this stopping criterion is not
+*> used, the routine factorizes columns depending
+*> on KMAX and RELTOL.
+*> This includes the case ABSTOL = -Inf.
+*>
+*> b) If 0.0 <= ABSTOL then the input value
+*> of ABSTOL is used.
+*> \endverbatim
+*>
+*> \param[in] RELTOL
+*> \verbatim
+*> RELTOL is REAL, cannot be NaN.
+*>
+*> The third factorization stopping criterion.
+*>
+*> The tolerance (stopping threshold) for the ratio of the
+*> maximum column 2-norm of the residual matrix to the maximum
+*> column 2-norm of the original matrix A_orig. The algorithm
+*> converges (stops the factorization), when this ratio is
+*> less than or equal to RELTOL.
+*>
+*> a) If RELTOL < 0.0, then this stopping criterion is not
+*> used, the routine factorizes columns depending
+*> on KMAX and ABSTOL.
+*> This includes the case RELTOL = -Inf.
+*>
+*> d) If 0.0 <= RELTOL then the input value of RELTOL
+*> is used.
+*> \endverbatim
+*>
+*> \param[in] KP1
+*> \verbatim
+*> KP1 is INTEGER
+*> The index of the column with the maximum 2-norm in
+*> the whole original matrix A_orig determined in the
+*> main routine CGEQP3RK. 1 <= KP1 <= N_orig_mat.
+*> \endverbatim
+*>
+*> \param[in] MAXC2NRM
+*> \verbatim
+*> MAXC2NRM is REAL
+*> The maximum column 2-norm of the whole original
+*> matrix A_orig computed in the main routine CGEQP3RK.
+*> MAXC2NRM >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*> A is COMPLEX array, dimension (LDA,N+NRHS)
+*> On entry:
+*> the M-by-N matrix A and M-by-NRHS matrix B, as in
+*>
+*> N NRHS
+*> array_A = M [ mat_A, mat_B ]
+*>
+*> On exit:
+*> 1. The elements in block A(IOFFSET+1:M,1:K) below
+*> the diagonal together with the array TAU represent
+*> the orthogonal matrix Q(K) as a product of elementary
+*> reflectors.
+*> 2. The upper triangular block of the matrix A stored
+*> in A(IOFFSET+1:M,1:K) is the triangular factor obtained.
+*> 3. The block of the matrix A stored in A(1:IOFFSET,1:N)
+*> has been accordingly pivoted, but not factorized.
+*> 4. The rest of the array A, block A(IOFFSET+1:M,K+1:N+NRHS).
+*> The left part A(IOFFSET+1:M,K+1:N) of this block
+*> contains the residual of the matrix A, and,
+*> if NRHS > 0, the right part of the block
+*> A(IOFFSET+1:M,N+1:N+NRHS) contains the block of
+*> the right-hand-side matrix B. Both these blocks have been
+*> updated by multiplication from the left by Q(K)**H.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*> LDA is INTEGER
+*> The leading dimension of the array A. LDA >= max(1,M).
+*> \endverbatim
+*>
+*> \param[out] K
+*> \verbatim
+*> K is INTEGER
+*> Factorization rank of the matrix A, i.e. the rank of
+*> the factor R, which is the same as the number of non-zero
+*> rows of the factor R. 0 <= K <= min(M-IOFFSET,KMAX,N).
+*>
+*> K also represents the number of non-zero Householder
+*> vectors.
+*> \endverbatim
+*>
+*> \param[out] MAXC2NRMK
+*> \verbatim
+*> MAXC2NRMK is REAL
+*> The maximum column 2-norm of the residual matrix,
+*> when the factorization stopped at rank K. MAXC2NRMK >= 0.
+*> \endverbatim
+*>
+*> \param[out] RELMAXC2NRMK
+*> \verbatim
+*> RELMAXC2NRMK is REAL
+*> The ratio MAXC2NRMK / MAXC2NRM of the maximum column
+*> 2-norm of the residual matrix (when the factorization
+*> stopped at rank K) to the maximum column 2-norm of the
+*> whole original matrix A. RELMAXC2NRMK >= 0.
+*> \endverbatim
+*>
+*> \param[out] JPIV
+*> \verbatim
+*> JPIV is INTEGER array, dimension (N)
+*> Column pivot indices, for 1 <= j <= N, column j
+*> of the matrix A was interchanged with column JPIV(j).
+*> \endverbatim
+*>
+*> \param[out] TAU
+*> \verbatim
+*> TAU is COMPLEX array, dimension (min(M-IOFFSET,N))
+*> The scalar factors of the elementary reflectors.
+*> \endverbatim
+*>
+*> \param[in,out] VN1
+*> \verbatim
+*> VN1 is REAL array, dimension (N)
+*> The vector with the partial column norms.
+*> \endverbatim
+*>
+*> \param[in,out] VN2
+*> \verbatim
+*> VN2 is REAL array, dimension (N)
+*> The vector with the exact column norms.
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*> WORK is COMPLEX array, dimension (N-1)
+*> Used in CLARF subroutine to apply an elementary
+*> reflector from the left.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*> INFO is INTEGER
+*> 1) INFO = 0: successful exit.
+*> 2) If INFO = j_1, where 1 <= j_1 <= N, then NaN was
+*> detected and the routine stops the computation.
+*> The j_1-th column of the matrix A or the j_1-th
+*> element of array TAU contains the first occurrence
+*> of NaN in the factorization step K+1 ( when K columns
+*> have been factorized ).
+*>
+*> On exit:
+*> K is set to the number of
+*> factorized columns without
+*> exception.
+*> MAXC2NRMK is set to NaN.
+*> RELMAXC2NRMK is set to NaN.
+*> TAU(K+1:min(M,N)) is not set and contains undefined
+*> elements. If j_1=K+1, TAU(K+1)
+*> may contain NaN.
+*> 3) If INFO = j_2, where N+1 <= j_2 <= 2*N, then no NaN
+*> was detected, but +Inf (or -Inf) was detected and
+*> the routine continues the computation until completion.
+*> The (j_2-N)-th column of the matrix A contains the first
+*> occurrence of +Inf (or -Inf) in the factorization
+*> step K+1 ( when K columns have been factorized ).
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \ingroup laqp2rk
+*
+*> \par References:
+* ================
+*> [1] A Level 3 BLAS QR factorization algorithm with column pivoting developed in 1996.
+*> G. Quintana-Orti, Depto. de Informatica, Universidad Jaime I, Spain.
+*> X. Sun, Computer Science Dept., Duke University, USA.
+*> C. H. Bischof, Math. and Comp. Sci. Div., Argonne National Lab, USA.
+*> A BLAS-3 version of the QR factorization with column pivoting.
+*> LAPACK Working Note 114
+*> \htmlonly
+*> https://www.netlib.org/lapack/lawnspdf/lawn114.pdf
+*> \endhtmlonly
+*> and in
+*> SIAM J. Sci. Comput., 19(5):1486-1494, Sept. 1998.
+*> \htmlonly
+*> https://doi.org/10.1137/S1064827595296732
+*> \endhtmlonly
+*>
+*> [2] A partial column norm updating strategy developed in 2006.
+*> Z. Drmac and Z. Bujanovic, Dept. of Math., University of Zagreb, Croatia.
+*> On the failure of rank revealing QR factorization software – a case study.
+*> LAPACK Working Note 176.
+*> \htmlonly
+*> http://www.netlib.org/lapack/lawnspdf/lawn176.pdf
+*> \endhtmlonly
+*> and in
+*> ACM Trans. Math. Softw. 35, 2, Article 12 (July 2008), 28 pages.
+*> \htmlonly
+*> https://doi.org/10.1145/1377612.1377616
+*> \endhtmlonly
+*
+*> \par Contributors:
+* ==================
+*>
+*> \verbatim
+*>
+*> November 2023, Igor Kozachenko, James Demmel,
+*> Computer Science Division,
+*> University of California, Berkeley
+*>
+*> \endverbatim
+*
+* =====================================================================
+ SUBROUTINE CLAQP2RK( M, N, NRHS, IOFFSET, KMAX, ABSTOL, RELTOL,
+ $ KP1, MAXC2NRM, A, LDA, K, MAXC2NRMK,
+ $ RELMAXC2NRMK, JPIV, TAU, VN1, VN2, WORK,
+ $ INFO )
+ IMPLICIT NONE
+*
+* -- LAPACK auxiliary routine --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*
+* .. Scalar Arguments ..
+ INTEGER INFO, IOFFSET, KP1, K, KMAX, LDA, M, N, NRHS
+ REAL ABSTOL, MAXC2NRM, MAXC2NRMK, RELMAXC2NRMK,
+ $ RELTOL
+* ..
+* .. Array Arguments ..
+ INTEGER JPIV( * )
+ REAL VN1( * ), VN2( * )
+ COMPLEX A( LDA, * ), TAU( * ), WORK( * )
+* ..
+*
+* =====================================================================
+*
+* .. Parameters ..
+ REAL ZERO, ONE
+ PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
+ COMPLEX CZERO, CONE
+ PARAMETER ( CZERO = ( 0.0E+0, 0.0E+0 ),
+ $ CONE = ( 1.0E+0, 0.0E+0 ) )
+* ..
+* .. Local Scalars ..
+ INTEGER I, ITEMP, J, JMAXC2NRM, KK, KP, MINMNFACT,
+ $ MINMNUPDT
+ REAL HUGEVAL, TAUNAN, TEMP, TEMP2, TOL3Z
+ COMPLEX AIKK
+* ..
+* .. External Subroutines ..
+ EXTERNAL CLARF, CLARFG, CSWAP
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC ABS, REAL, CONJG, IMAG, MAX, MIN, SQRT
+* ..
+* .. External Functions ..
+ LOGICAL SISNAN
+ INTEGER ISAMAX
+ REAL SLAMCH, SCNRM2
+ EXTERNAL SISNAN, SLAMCH, ISAMAX, SCNRM2
+* ..
+* .. Executable Statements ..
+*
+* Initialize INFO
+*
+ INFO = 0
+*
+* MINMNFACT in the smallest dimension of the submatrix
+* A(IOFFSET+1:M,1:N) to be factorized.
+*
+* MINMNUPDT is the smallest dimension
+* of the subarray A(IOFFSET+1:M,1:N+NRHS) to be udated, which
+* contains the submatrices A(IOFFSET+1:M,1:N) and
+* B(IOFFSET+1:M,1:NRHS) as column blocks.
+*
+ MINMNFACT = MIN( M-IOFFSET, N )
+ MINMNUPDT = MIN( M-IOFFSET, N+NRHS )
+ KMAX = MIN( KMAX, MINMNFACT )
+ TOL3Z = SQRT( SLAMCH( 'Epsilon' ) )
+ HUGEVAL = SLAMCH( 'Overflow' )
+*
+* Compute the factorization, KK is the lomn loop index.
+*
+ DO KK = 1, KMAX
+*
+ I = IOFFSET + KK
+*
+ IF( I.EQ.1 ) THEN
+*
+* ============================================================
+*
+* We are at the first column of the original whole matrix A,
+* therefore we use the computed KP1 and MAXC2NRM from the
+* main routine.
+*
+ KP = KP1
+*
+* ============================================================
+*
+ ELSE
+*
+* ============================================================
+*
+* Determine the pivot column in KK-th step, i.e. the index
+* of the column with the maximum 2-norm in the
+* submatrix A(I:M,K:N).
+*
+ KP = ( KK-1 ) + ISAMAX( N-KK+1, VN1( KK ), 1 )
+*
+* Determine the maximum column 2-norm and the relative maximum
+* column 2-norm of the submatrix A(I:M,KK:N) in step KK.
+* RELMAXC2NRMK will be computed later, after somecondition
+* checks on MAXC2NRMK.
+*
+ MAXC2NRMK = VN1( KP )
+*
+* ============================================================
+*
+* Check if the submatrix A(I:M,KK:N) contains NaN, and set
+* INFO parameter to the column number, where the first NaN
+* is found and return from the routine.
+* We need to check the condition only if the
+* column index (same as row index) of the original whole
+* matrix is larger than 1, since the condition for whole
+* original matrix is checked in the main routine.
+*
+ IF( SISNAN( MAXC2NRMK ) ) THEN
+*
+* Set K, the number of factorized columns.
+* that are not zero.
+*
+ K = KK - 1
+ INFO = K + KP
+*
+* Set RELMAXC2NRMK to NaN.
+*
+ RELMAXC2NRMK = MAXC2NRMK
+*
+* Array TAU(K+1:MINMNFACT) is not set and contains
+* undefined elements.
+*
+ RETURN
+ END IF
+*
+* ============================================================
+*
+* Quick return, if the submatrix A(I:M,KK:N) is
+* a zero matrix.
+* We need to check the condition only if the
+* column index (same as row index) of the original whole
+* matrix is larger than 1, since the condition for whole
+* original matrix is checked in the main routine.
+*
+ IF( MAXC2NRMK.EQ.ZERO ) THEN
+*
+* Set K, the number of factorized columns.
+* that are not zero.
+*
+ K = KK - 1
+ RELMAXC2NRMK = ZERO
+*
+* Set TAUs corresponding to the columns that were not
+* factorized to ZERO, i.e. set TAU(KK:MINMNFACT) to CZERO.
+*
+ DO J = KK, MINMNFACT
+ TAU( J ) = CZERO
+ END DO
+*
+* Return from the routine.
+*
+ RETURN
+*
+ END IF
+*
+* ============================================================
+*
+* Check if the submatrix A(I:M,KK:N) contains Inf,
+* set INFO parameter to the column number, where
+* the first Inf is found plus N, and continue
+* the computation.
+* We need to check the condition only if the
+* column index (same as row index) of the original whole
+* matrix is larger than 1, since the condition for whole
+* original matrix is checked in the main routine.
+*
+ IF( INFO.EQ.0 .AND. MAXC2NRMK.GT.HUGEVAL ) THEN
+ INFO = N + KK - 1 + KP
+ END IF
+*
+* ============================================================
+*
+* Test for the second and third stopping criteria.
+* NOTE: There is no need to test for ABSTOL >= ZERO, since
+* MAXC2NRMK is non-negative. Similarly, there is no need
+* to test for RELTOL >= ZERO, since RELMAXC2NRMK is
+* non-negative.
+* We need to check the condition only if the
+* column index (same as row index) of the original whole
+* matrix is larger than 1, since the condition for whole
+* original matrix is checked in the main routine.
+
+ RELMAXC2NRMK = MAXC2NRMK / MAXC2NRM
+*
+ IF( MAXC2NRMK.LE.ABSTOL .OR. RELMAXC2NRMK.LE.RELTOL ) THEN
+*
+* Set K, the number of factorized columns.
+*
+ K = KK - 1
+*
+* Set TAUs corresponding to the columns that were not
+* factorized to ZERO, i.e. set TAU(KK:MINMNFACT) to CZERO.
+*
+ DO J = KK, MINMNFACT
+ TAU( J ) = CZERO
+ END DO
+*
+* Return from the routine.
+*
+ RETURN
+*
+ END IF
+*
+* ============================================================
+*
+* End ELSE of IF(I.EQ.1)
+*
+ END IF
+*
+* ===============================================================
+*
+* If the pivot column is not the first column of the
+* subblock A(1:M,KK:N):
+* 1) swap the KK-th column and the KP-th pivot column
+* in A(1:M,1:N);
+* 2) copy the KK-th element into the KP-th element of the partial
+* and exact 2-norm vectors VN1 and VN2. ( Swap is not needed
+* for VN1 and VN2 since we use the element with the index
+* larger than KK in the next loop step.)
+* 3) Save the pivot interchange with the indices relative to the
+* the original matrix A, not the block A(1:M,1:N).
+*
+ IF( KP.NE.KK ) THEN
+ CALL CSWAP( M, A( 1, KP ), 1, A( 1, KK ), 1 )
+ VN1( KP ) = VN1( KK )
+ VN2( KP ) = VN2( KK )
+ ITEMP = JPIV( KP )
+ JPIV( KP ) = JPIV( KK )
+ JPIV( KK ) = ITEMP
+ END IF
+*
+* Generate elementary reflector H(KK) using the column A(I:M,KK),
+* if the column has more than one element, otherwise
+* the elementary reflector would be an identity matrix,
+* and TAU(KK) = CZERO.
+*
+ IF( I.LT.M ) THEN
+ CALL CLARFG( M-I+1, A( I, KK ), A( I+1, KK ), 1,
+ $ TAU( KK ) )
+ ELSE
+ TAU( KK ) = CZERO
+ END IF
+*
+* Check if TAU(KK) contains NaN, set INFO parameter
+* to the column number where NaN is found and return from
+* the routine.
+* NOTE: There is no need to check TAU(KK) for Inf,
+* since CLARFG cannot produce TAU(KK) or Householder vector
+* below the diagonal containing Inf. Only BETA on the diagonal,
+* returned by CLARFG can contain Inf, which requires
+* TAU(KK) to contain NaN. Therefore, this case of generating Inf
+* by CLARFG is covered by checking TAU(KK) for NaN.
+*
+ IF( SISNAN( REAL( TAU(KK) ) ) ) THEN
+ TAUNAN = REAL( TAU(KK) )
+ ELSE IF( SISNAN( IMAG( TAU(KK) ) ) ) THEN
+ TAUNAN = IMAG( TAU(KK) )
+ ELSE
+ TAUNAN = ZERO
+ END IF
+*
+ IF( SISNAN( TAUNAN ) ) THEN
+ K = KK - 1
+ INFO = KK
+*
+* Set MAXC2NRMK and RELMAXC2NRMK to NaN.
+*
+ MAXC2NRMK = TAUNAN
+ RELMAXC2NRMK = TAUNAN
+*
+* Array TAU(KK:MINMNFACT) is not set and contains
+* undefined elements, except the first element TAU(KK) = NaN.
+*
+ RETURN
+ END IF
+*
+* Apply H(KK)**H to A(I:M,KK+1:N+NRHS) from the left.
+* ( If M >= N, then at KK = N there is no residual matrix,
+* i.e. no columns of A to update, only columns of B.
+* If M < N, then at KK = M-IOFFSET, I = M and we have a
+* one-row residual matrix in A and the elementary
+* reflector is a unit matrix, TAU(KK) = CZERO, i.e. no update
+* is needed for the residual matrix in A and the
+* right-hand-side-matrix in B.
+* Therefore, we update only if
+* KK < MINMNUPDT = min(M-IOFFSET, N+NRHS)
+* condition is satisfied, not only KK < N+NRHS )
+*
+ IF( KK.LT.MINMNUPDT ) THEN
+ AIKK = A( I, KK )
+ A( I, KK ) = CONE
+ CALL CLARF( 'Left', M-I+1, N+NRHS-KK, A( I, KK ), 1,
+ $ CONJG( TAU( KK ) ), A( I, KK+1 ), LDA,
+ $ WORK( 1 ) )
+ A( I, KK ) = AIKK
+ END IF
+*
+ IF( KK.LT.MINMNFACT ) THEN
+*
+* Update the partial column 2-norms for the residual matrix,
+* only if the residual matrix A(I+1:M,KK+1:N) exists, i.e.
+* when KK < min(M-IOFFSET, N).
+*
+ DO J = KK + 1, N
+ IF( VN1( J ).NE.ZERO ) THEN
+*
+* NOTE: The following lines follow from the analysis in
+* Lapack Working Note 176.
+*
+ TEMP = ONE - ( ABS( A( I, J ) ) / VN1( J ) )**2
+ TEMP = MAX( TEMP, ZERO )
+ TEMP2 = TEMP*( VN1( J ) / VN2( J ) )**2
+ IF( TEMP2 .LE. TOL3Z ) THEN
+*
+* Compute the column 2-norm for the partial
+* column A(I+1:M,J) by explicitly computing it,
+* and store it in both partial 2-norm vector VN1
+* and exact column 2-norm vector VN2.
+*
+ VN1( J ) = SCNRM2( M-I, A( I+1, J ), 1 )
+ VN2( J ) = VN1( J )
+*
+ ELSE
+*
+* Update the column 2-norm for the partial
+* column A(I+1:M,J) by removing one
+* element A(I,J) and store it in partial
+* 2-norm vector VN1.
+*
+ VN1( J ) = VN1( J )*SQRT( TEMP )
+*
+ END IF
+ END IF
+ END DO
+*
+ END IF
+*
+* End factorization loop
+*
+ END DO
+*
+* If we reached this point, all colunms have been factorized,
+* i.e. no condition was triggered to exit the routine.
+* Set the number of factorized columns.
+*
+ K = KMAX
+*
+* We reached the end of the loop, i.e. all KMAX columns were
+* factorized, we need to set MAXC2NRMK and RELMAXC2NRMK before
+* we return.
+*
+ IF( K.LT.MINMNFACT ) THEN
+*
+ JMAXC2NRM = K + ISAMAX( N-K, VN1( K+1 ), 1 )
+ MAXC2NRMK = VN1( JMAXC2NRM )
+*
+ IF( K.EQ.0 ) THEN
+ RELMAXC2NRMK = ONE
+ ELSE
+ RELMAXC2NRMK = MAXC2NRMK / MAXC2NRM
+ END IF
+*
+ ELSE
+ MAXC2NRMK = ZERO
+ RELMAXC2NRMK = ZERO
+ END IF
+*
+* We reached the end of the loop, i.e. all KMAX columns were
+* factorized, set TAUs corresponding to the columns that were
+* not factorized to ZERO, i.e. TAU(K+1:MINMNFACT) set to CZERO.
+*
+ DO J = K + 1, MINMNFACT
+ TAU( J ) = CZERO
+ END DO
+*
+ RETURN
+*
+* End of CLAQP2RK
+*
+ END
diff --git a/lapack-netlib/SRC/claqp3rk.f b/lapack-netlib/SRC/claqp3rk.f
new file mode 100644
index 000000000..af5e85645
--- /dev/null
+++ b/lapack-netlib/SRC/claqp3rk.f
@@ -0,0 +1,947 @@
+*> \brief \b CLAQP3RK computes a step of truncated QR factorization with column pivoting of a complex m-by-n matrix A using Level 3 BLAS and overwrites a complex m-by-nrhs matrix B with Q**H * B.
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download CLAQP3RK + dependencies
+*>
+*> [TGZ]
+*>
+*> [ZIP]
+*>
+*> [TXT]
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE CLAQP3RK( M, N, NRHS, IOFFSET, NB, ABSTOL,
+* $ RELTOL, KP1, MAXC2NRM, A, LDA, DONE, KB,
+* $ MAXC2NRMK, RELMAXC2NRMK, JPIV, TAU,
+* $ VN1, VN2, AUXV, F, LDF, IWORK, INFO )
+* IMPLICIT NONE
+* LOGICAL DONE
+* INTEGER INFO, IOFFSET, KB, KP1, LDA, LDF, M, N,
+* $ NB, NRHS
+* REAL ABSTOL, MAXC2NRM, MAXC2NRMK, RELMAXC2NRMK,
+* $ RELTOL
+* ..
+* .. Array Arguments ..
+* INTEGER IWORK( * ), JPIV( * )
+* REAL VN1( * ), VN2( * )
+* COMPLEX*16 A( LDA, * ), AUXV( * ), F( LDF, * ), TAU( * )
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> CLAQP3RK computes a step of truncated QR factorization with column
+*> pivoting of a complex M-by-N matrix A block A(IOFFSET+1:M,1:N)
+*> by using Level 3 BLAS as
+*>
+*> A * P(KB) = Q(KB) * R(KB).
+*>
+*> The routine tries to factorize NB columns from A starting from
+*> the row IOFFSET+1 and updates the residual matrix with BLAS 3
+*> xGEMM. The number of actually factorized columns is returned
+*> is smaller than NB.
+*>
+*> Block A(1:IOFFSET,1:N) is accordingly pivoted, but not factorized.
+*>
+*> The routine also overwrites the right-hand-sides B matrix stored
+*> in A(IOFFSET+1:M,1:N+1:N+NRHS) with Q(KB)**H * B.
+*>
+*> Cases when the number of factorized columns KB < NB:
+*>
+*> (1) In some cases, due to catastrophic cancellations, it cannot
+*> factorize all NB columns and need to update the residual matrix.
+*> Hence, the actual number of factorized columns in the block returned
+*> in KB is smaller than NB. The logical DONE is returned as FALSE.
+*> The factorization of the whole original matrix A_orig must proceed
+*> with the next block.
+*>
+*> (2) Whenever the stopping criterion ABSTOL or RELTOL is satisfied,
+*> the factorization of the whole original matrix A_orig is stopped,
+*> the logical DONE is returned as TRUE. The number of factorized
+*> columns which is smaller than NB is returned in KB.
+*>
+*> (3) In case both stopping criteria ABSTOL or RELTOL are not used,
+*> and when the residual matrix is a zero matrix in some factorization
+*> step KB, the factorization of the whole original matrix A_orig is
+*> stopped, the logical DONE is returned as TRUE. The number of
+*> factorized columns which is smaller than NB is returned in KB.
+*>
+*> (4) Whenever NaN is detected in the matrix A or in the array TAU,
+*> the factorization of the whole original matrix A_orig is stopped,
+*> the logical DONE is returned as TRUE. The number of factorized
+*> columns which is smaller than NB is returned in KB. The INFO
+*> parameter is set to the column index of the first NaN occurrence.
+*>
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] M
+*> \verbatim
+*> M is INTEGER
+*> The number of rows of the matrix A. M >= 0.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> The number of columns of the matrix A. N >= 0
+*> \endverbatim
+*>
+*> \param[in] NRHS
+*> \verbatim
+*> NRHS is INTEGER
+*> The number of right hand sides, i.e., the number of
+*> columns of the matrix B. NRHS >= 0.
+*> \endverbatim
+*>
+*> \param[in] IOFFSET
+*> \verbatim
+*> IOFFSET is INTEGER
+*> The number of rows of the matrix A that must be pivoted
+*> but not factorized. IOFFSET >= 0.
+*>
+*> IOFFSET also represents the number of columns of the whole
+*> original matrix A_orig that have been factorized
+*> in the previous steps.
+*> \endverbatim
+*>
+*> \param[in] NB
+*> \verbatim
+*> NB is INTEGER
+*> Factorization block size, i.e the number of columns
+*> to factorize in the matrix A. 0 <= NB
+*>
+*> If NB = 0, then the routine exits immediately.
+*> This means that the factorization is not performed,
+*> the matrices A and B and the arrays TAU, IPIV
+*> are not modified.
+*> \endverbatim
+*>
+*> \param[in] ABSTOL
+*> \verbatim
+*> ABSTOL is REAL, cannot be NaN.
+*>
+*> The absolute tolerance (stopping threshold) for
+*> maximum column 2-norm of the residual matrix.
+*> The algorithm converges (stops the factorization) when
+*> the maximum column 2-norm of the residual matrix
+*> is less than or equal to ABSTOL.
+*>
+*> a) If ABSTOL < 0.0, then this stopping criterion is not
+*> used, the routine factorizes columns depending
+*> on NB and RELTOL.
+*> This includes the case ABSTOL = -Inf.
+*>
+*> b) If 0.0 <= ABSTOL then the input value
+*> of ABSTOL is used.
+*> \endverbatim
+*>
+*> \param[in] RELTOL
+*> \verbatim
+*> RELTOL is REAL, cannot be NaN.
+*>
+*> The tolerance (stopping threshold) for the ratio of the
+*> maximum column 2-norm of the residual matrix to the maximum
+*> column 2-norm of the original matrix A_orig. The algorithm
+*> converges (stops the factorization), when this ratio is
+*> less than or equal to RELTOL.
+*>
+*> a) If RELTOL < 0.0, then this stopping criterion is not
+*> used, the routine factorizes columns depending
+*> on NB and ABSTOL.
+*> This includes the case RELTOL = -Inf.
+*>
+*> d) If 0.0 <= RELTOL then the input value of RELTOL
+*> is used.
+*> \endverbatim
+*>
+*> \param[in] KP1
+*> \verbatim
+*> KP1 is INTEGER
+*> The index of the column with the maximum 2-norm in
+*> the whole original matrix A_orig determined in the
+*> main routine CGEQP3RK. 1 <= KP1 <= N_orig.
+*> \endverbatim
+*>
+*> \param[in] MAXC2NRM
+*> \verbatim
+*> MAXC2NRM is REAL
+*> The maximum column 2-norm of the whole original
+*> matrix A_orig computed in the main routine CGEQP3RK.
+*> MAXC2NRM >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*> A is COMPLEX array, dimension (LDA,N+NRHS)
+*> On entry:
+*> the M-by-N matrix A and M-by-NRHS matrix B, as in
+*>
+*> N NRHS
+*> array_A = M [ mat_A, mat_B ]
+*>
+*> On exit:
+*> 1. The elements in block A(IOFFSET+1:M,1:KB) below
+*> the diagonal together with the array TAU represent
+*> the orthogonal matrix Q(KB) as a product of elementary
+*> reflectors.
+*> 2. The upper triangular block of the matrix A stored
+*> in A(IOFFSET+1:M,1:KB) is the triangular factor obtained.
+*> 3. The block of the matrix A stored in A(1:IOFFSET,1:N)
+*> has been accordingly pivoted, but not factorized.
+*> 4. The rest of the array A, block A(IOFFSET+1:M,KB+1:N+NRHS).
+*> The left part A(IOFFSET+1:M,KB+1:N) of this block
+*> contains the residual of the matrix A, and,
+*> if NRHS > 0, the right part of the block
+*> A(IOFFSET+1:M,N+1:N+NRHS) contains the block of
+*> the right-hand-side matrix B. Both these blocks have been
+*> updated by multiplication from the left by Q(KB)**H.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*> LDA is INTEGER
+*> The leading dimension of the array A. LDA >= max(1,M).
+*> \endverbatim
+*>
+*> \param[out]
+*> \verbatim
+*> DONE is LOGICAL
+*> TRUE: a) if the factorization completed before processing
+*> all min(M-IOFFSET,NB,N) columns due to ABSTOL
+*> or RELTOL criterion,
+*> b) if the factorization completed before processing
+*> all min(M-IOFFSET,NB,N) columns due to the
+*> residual matrix being a ZERO matrix.
+*> c) when NaN was detected in the matrix A
+*> or in the array TAU.
+*> FALSE: otherwise.
+*> \endverbatim
+*>
+*> \param[out] KB
+*> \verbatim
+*> KB is INTEGER
+*> Factorization rank of the matrix A, i.e. the rank of
+*> the factor R, which is the same as the number of non-zero
+*> rows of the factor R. 0 <= KB <= min(M-IOFFSET,NB,N).
+*>
+*> KB also represents the number of non-zero Householder
+*> vectors.
+*> \endverbatim
+*>
+*> \param[out] MAXC2NRMK
+*> \verbatim
+*> MAXC2NRMK is REAL
+*> The maximum column 2-norm of the residual matrix,
+*> when the factorization stopped at rank KB. MAXC2NRMK >= 0.
+*> \endverbatim
+*>
+*> \param[out] RELMAXC2NRMK
+*> \verbatim
+*> RELMAXC2NRMK is REAL
+*> The ratio MAXC2NRMK / MAXC2NRM of the maximum column
+*> 2-norm of the residual matrix (when the factorization
+*> stopped at rank KB) to the maximum column 2-norm of the
+*> original matrix A_orig. RELMAXC2NRMK >= 0.
+*> \endverbatim
+*>
+*> \param[out] JPIV
+*> \verbatim
+*> JPIV is INTEGER array, dimension (N)
+*> Column pivot indices, for 1 <= j <= N, column j
+*> of the matrix A was interchanged with column JPIV(j).
+*> \endverbatim
+*>
+*> \param[out] TAU
+*> \verbatim
+*> TAU is COMPLEX array, dimension (min(M-IOFFSET,N))
+*> The scalar factors of the elementary reflectors.
+*> \endverbatim
+*>
+*> \param[in,out] VN1
+*> \verbatim
+*> VN1 is REAL array, dimension (N)
+*> The vector with the partial column norms.
+*> \endverbatim
+*>
+*> \param[in,out] VN2
+*> \verbatim
+*> VN2 is REAL array, dimension (N)
+*> The vector with the exact column norms.
+*> \endverbatim
+*>
+*> \param[out] AUXV
+*> \verbatim
+*> AUXV is COMPLEX array, dimension (NB)
+*> Auxiliary vector.
+*> \endverbatim
+*>
+*> \param[out] F
+*> \verbatim
+*> F is COMPLEX array, dimension (LDF,NB)
+*> Matrix F**H = L*(Y**H)*A.
+*> \endverbatim
+*>
+*> \param[in] LDF
+*> \verbatim
+*> LDF is INTEGER
+*> The leading dimension of the array F. LDF >= max(1,N+NRHS).
+*> \endverbatim
+*>
+*> \param[out] IWORK
+*> \verbatim
+*> IWORK is INTEGER array, dimension (N-1).
+*> Is a work array. ( IWORK is used to store indices
+*> of "bad" columns for norm downdating in the residual
+*> matrix ).
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*> INFO is INTEGER
+*> 1) INFO = 0: successful exit.
+*> 2) If INFO = j_1, where 1 <= j_1 <= N, then NaN was
+*> detected and the routine stops the computation.
+*> The j_1-th column of the matrix A or the j_1-th
+*> element of array TAU contains the first occurrence
+*> of NaN in the factorization step KB+1 ( when KB columns
+*> have been factorized ).
+*>
+*> On exit:
+*> KB is set to the number of
+*> factorized columns without
+*> exception.
+*> MAXC2NRMK is set to NaN.
+*> RELMAXC2NRMK is set to NaN.
+*> TAU(KB+1:min(M,N)) is not set and contains undefined
+*> elements. If j_1=KB+1, TAU(KB+1)
+*> may contain NaN.
+*> 3) If INFO = j_2, where N+1 <= j_2 <= 2*N, then no NaN
+*> was detected, but +Inf (or -Inf) was detected and
+*> the routine continues the computation until completion.
+*> The (j_2-N)-th column of the matrix A contains the first
+*> occurrence of +Inf (or -Inf) in the actorization
+*> step KB+1 ( when KB columns have been factorized ).
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \ingroup laqp3rk
+*
+*> \par References:
+* ================
+*> [1] A Level 3 BLAS QR factorization algorithm with column pivoting developed in 1996.
+*> G. Quintana-Orti, Depto. de Informatica, Universidad Jaime I, Spain.
+*> X. Sun, Computer Science Dept., Duke University, USA.
+*> C. H. Bischof, Math. and Comp. Sci. Div., Argonne National Lab, USA.
+*> A BLAS-3 version of the QR factorization with column pivoting.
+*> LAPACK Working Note 114
+*> \htmlonly
+*> https://www.netlib.org/lapack/lawnspdf/lawn114.pdf
+*> \endhtmlonly
+*> and in
+*> SIAM J. Sci. Comput., 19(5):1486-1494, Sept. 1998.
+*> \htmlonly
+*> https://doi.org/10.1137/S1064827595296732
+*> \endhtmlonly
+*>
+*> [2] A partial column norm updating strategy developed in 2006.
+*> Z. Drmac and Z. Bujanovic, Dept. of Math., University of Zagreb, Croatia.
+*> On the failure of rank revealing QR factorization software – a case study.
+*> LAPACK Working Note 176.
+*> \htmlonly
+*> http://www.netlib.org/lapack/lawnspdf/lawn176.pdf
+*> \endhtmlonly
+*> and in
+*> ACM Trans. Math. Softw. 35, 2, Article 12 (July 2008), 28 pages.
+*> \htmlonly
+*> https://doi.org/10.1145/1377612.1377616
+*> \endhtmlonly
+*
+*> \par Contributors:
+* ==================
+*>
+*> \verbatim
+*>
+*> November 2023, Igor Kozachenko, James Demmel,
+*> Computer Science Division,
+*> University of California, Berkeley
+*>
+*> \endverbatim
+*
+* =====================================================================
+ SUBROUTINE CLAQP3RK( M, N, NRHS, IOFFSET, NB, ABSTOL,
+ $ RELTOL, KP1, MAXC2NRM, A, LDA, DONE, KB,
+ $ MAXC2NRMK, RELMAXC2NRMK, JPIV, TAU,
+ $ VN1, VN2, AUXV, F, LDF, IWORK, INFO )
+ IMPLICIT NONE
+*
+* -- LAPACK auxiliary routine --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*
+* .. Scalar Arguments ..
+ LOGICAL DONE
+ INTEGER INFO, IOFFSET, KB, KP1, LDA, LDF, M, N,
+ $ NB, NRHS
+ REAL ABSTOL, MAXC2NRM, MAXC2NRMK, RELMAXC2NRMK,
+ $ RELTOL
+* ..
+* .. Array Arguments ..
+ INTEGER IWORK( * ), JPIV( * )
+ REAL VN1( * ), VN2( * )
+ COMPLEX A( LDA, * ), AUXV( * ), F( LDF, * ), TAU( * )
+* ..
+*
+* =====================================================================
+*
+* .. Parameters ..
+ REAL ZERO, ONE
+ PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
+ COMPLEX CZERO, CONE
+ PARAMETER ( CZERO = ( 0.0E+0, 0.0E+0 ),
+ $ CONE = ( 1.0E+0, 0.0E+0 ) )
+* ..
+* .. Local Scalars ..
+ INTEGER ITEMP, J, K, MINMNFACT, MINMNUPDT,
+ $ LSTICC, KP, I, IF
+ REAL HUGEVAL, TAUNAN, TEMP, TEMP2, TOL3Z
+ COMPLEX AIK
+* ..
+* .. External Subroutines ..
+ EXTERNAL CGEMM, CGEMV, CLARFG, CSWAP
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC ABS, REAL, CONJG, IMAG, MAX, MIN, SQRT
+* ..
+* .. External Functions ..
+ LOGICAL SISNAN
+ INTEGER ISAMAX
+ REAL SLAMCH, SCNRM2
+ EXTERNAL SISNAN, SLAMCH, ISAMAX, SCNRM2
+* ..
+* .. Executable Statements ..
+*
+* Initialize INFO
+*
+ INFO = 0
+*
+* MINMNFACT in the smallest dimension of the submatrix
+* A(IOFFSET+1:M,1:N) to be factorized.
+*
+ MINMNFACT = MIN( M-IOFFSET, N )
+ MINMNUPDT = MIN( M-IOFFSET, N+NRHS )
+ NB = MIN( NB, MINMNFACT )
+ TOL3Z = SQRT( SLAMCH( 'Epsilon' ) )
+ HUGEVAL = SLAMCH( 'Overflow' )
+*
+* Compute factorization in a while loop over NB columns,
+* K is the column index in the block A(1:M,1:N).
+*
+ K = 0
+ LSTICC = 0
+ DONE = .FALSE.
+*
+ DO WHILE ( K.LT.NB .AND. LSTICC.EQ.0 )
+ K = K + 1
+ I = IOFFSET + K
+*
+ IF( I.EQ.1 ) THEN
+*
+* We are at the first column of the original whole matrix A_orig,
+* therefore we use the computed KP1 and MAXC2NRM from the
+* main routine.
+*
+ KP = KP1
+*
+ ELSE
+*
+* Determine the pivot column in K-th step, i.e. the index
+* of the column with the maximum 2-norm in the
+* submatrix A(I:M,K:N).
+*
+ KP = ( K-1 ) + ISAMAX( N-K+1, VN1( K ), 1 )
+*
+* Determine the maximum column 2-norm and the relative maximum
+* column 2-norm of the submatrix A(I:M,K:N) in step K.
+*
+ MAXC2NRMK = VN1( KP )
+*
+* ============================================================
+*
+* Check if the submatrix A(I:M,K:N) contains NaN, set
+* INFO parameter to the column number, where the first NaN
+* is found and return from the routine.
+* We need to check the condition only if the
+* column index (same as row index) of the original whole
+* matrix is larger than 1, since the condition for whole
+* original matrix is checked in the main routine.
+*
+ IF( SISNAN( MAXC2NRMK ) ) THEN
+*
+ DONE = .TRUE.
+*
+* Set KB, the number of factorized partial columns
+* that are non-zero in each step in the block,
+* i.e. the rank of the factor R.
+* Set IF, the number of processed rows in the block, which
+* is the same as the number of processed rows in
+* the original whole matrix A_orig.
+*
+ KB = K - 1
+ IF = I - 1
+ INFO = KB + KP
+*
+* Set RELMAXC2NRMK to NaN.
+*
+ RELMAXC2NRMK = MAXC2NRMK
+*
+* There is no need to apply the block reflector to the
+* residual of the matrix A stored in A(KB+1:M,KB+1:N),
+* since the submatrix contains NaN and we stop
+* the computation.
+* But, we need to apply the block reflector to the residual
+* right hand sides stored in A(KB+1:M,N+1:N+NRHS), if the
+* residual right hand sides exist. This occurs
+* when ( NRHS != 0 AND KB <= (M-IOFFSET) ):
+*
+* A(I+1:M,N+1:N+NRHS) := A(I+1:M,N+1:N+NRHS) -
+* A(I+1:M,1:KB) * F(N+1:N+NRHS,1:KB)**H.
+
+ IF( NRHS.GT.0 .AND. KB.LT.(M-IOFFSET) ) THEN
+ CALL CGEMM( 'No transpose', 'Conjugate transpose',
+ $ M-IF, NRHS, KB, -CONE, A( IF+1, 1 ), LDA,
+ $ F( N+1, 1 ), LDF, CONE, A( IF+1, N+1 ), LDA )
+ END IF
+*
+* There is no need to recompute the 2-norm of the
+* difficult columns, since we stop the factorization.
+*
+* Array TAU(KF+1:MINMNFACT) is not set and contains
+* undefined elements.
+*
+* Return from the routine.
+*
+ RETURN
+ END IF
+*
+* Quick return, if the submatrix A(I:M,K:N) is
+* a zero matrix. We need to check it only if the column index
+* (same as row index) is larger than 1, since the condition
+* for the whole original matrix A_orig is checked in the main
+* routine.
+*
+ IF( MAXC2NRMK.EQ.ZERO ) THEN
+*
+ DONE = .TRUE.
+*
+* Set KB, the number of factorized partial columns
+* that are non-zero in each step in the block,
+* i.e. the rank of the factor R.
+* Set IF, the number of processed rows in the block, which
+* is the same as the number of processed rows in
+* the original whole matrix A_orig.
+*
+ KB = K - 1
+ IF = I - 1
+ RELMAXC2NRMK = ZERO
+*
+* There is no need to apply the block reflector to the
+* residual of the matrix A stored in A(KB+1:M,KB+1:N),
+* since the submatrix is zero and we stop the computation.
+* But, we need to apply the block reflector to the residual
+* right hand sides stored in A(KB+1:M,N+1:N+NRHS), if the
+* residual right hand sides exist. This occurs
+* when ( NRHS != 0 AND KB <= (M-IOFFSET) ):
+*
+* A(I+1:M,N+1:N+NRHS) := A(I+1:M,N+1:N+NRHS) -
+* A(I+1:M,1:KB) * F(N+1:N+NRHS,1:KB)**H.
+*
+ IF( NRHS.GT.0 .AND. KB.LT.(M-IOFFSET) ) THEN
+ CALL CGEMM( 'No transpose', 'Conjugate transpose',
+ $ M-IF, NRHS, KB, -CONE, A( IF+1, 1 ), LDA,
+ $ F( N+1, 1 ), LDF, CONE, A( IF+1, N+1 ), LDA )
+ END IF
+*
+* There is no need to recompute the 2-norm of the
+* difficult columns, since we stop the factorization.
+*
+* Set TAUs corresponding to the columns that were not
+* factorized to ZERO, i.e. set TAU(KB+1:MINMNFACT) = CZERO,
+* which is equivalent to seting TAU(K:MINMNFACT) = CZERO.
+*
+ DO J = K, MINMNFACT
+ TAU( J ) = CZERO
+ END DO
+*
+* Return from the routine.
+*
+ RETURN
+*
+ END IF
+*
+* ============================================================
+*
+* Check if the submatrix A(I:M,K:N) contains Inf,
+* set INFO parameter to the column number, where
+* the first Inf is found plus N, and continue
+* the computation.
+* We need to check the condition only if the
+* column index (same as row index) of the original whole
+* matrix is larger than 1, since the condition for whole
+* original matrix is checked in the main routine.
+*
+ IF( INFO.EQ.0 .AND. MAXC2NRMK.GT.HUGEVAL ) THEN
+ INFO = N + K - 1 + KP
+ END IF
+*
+* ============================================================
+*
+* Test for the second and third tolerance stopping criteria.
+* NOTE: There is no need to test for ABSTOL.GE.ZERO, since
+* MAXC2NRMK is non-negative. Similarly, there is no need
+* to test for RELTOL.GE.ZERO, since RELMAXC2NRMK is
+* non-negative.
+* We need to check the condition only if the
+* column index (same as row index) of the original whole
+* matrix is larger than 1, since the condition for whole
+* original matrix is checked in the main routine.
+*
+ RELMAXC2NRMK = MAXC2NRMK / MAXC2NRM
+*
+ IF( MAXC2NRMK.LE.ABSTOL .OR. RELMAXC2NRMK.LE.RELTOL ) THEN
+*
+ DONE = .TRUE.
+*
+* Set KB, the number of factorized partial columns
+* that are non-zero in each step in the block,
+* i.e. the rank of the factor R.
+* Set IF, the number of processed rows in the block, which
+* is the same as the number of processed rows in
+* the original whole matrix A_orig;
+*
+ KB = K - 1
+ IF = I - 1
+*
+* Apply the block reflector to the residual of the
+* matrix A and the residual of the right hand sides B, if
+* the residual matrix and and/or the residual of the right
+* hand sides exist, i.e. if the submatrix
+* A(I+1:M,KB+1:N+NRHS) exists. This occurs when
+* KB < MINMNUPDT = min( M-IOFFSET, N+NRHS ):
+*
+* A(IF+1:M,K+1:N+NRHS) := A(IF+1:M,KB+1:N+NRHS) -
+* A(IF+1:M,1:KB) * F(KB+1:N+NRHS,1:KB)**H.
+*
+ IF( KB.LT.MINMNUPDT ) THEN
+ CALL CGEMM( 'No transpose', 'Conjugate transpose',
+ $ M-IF, N+NRHS-KB, KB,-CONE, A( IF+1, 1 ), LDA,
+ $ F( KB+1, 1 ), LDF, CONE, A( IF+1, KB+1 ), LDA )
+ END IF
+*
+* There is no need to recompute the 2-norm of the
+* difficult columns, since we stop the factorization.
+*
+* Set TAUs corresponding to the columns that were not
+* factorized to ZERO, i.e. set TAU(KB+1:MINMNFACT) = CZERO,
+* which is equivalent to seting TAU(K:MINMNFACT) = CZERO.
+*
+ DO J = K, MINMNFACT
+ TAU( J ) = CZERO
+ END DO
+*
+* Return from the routine.
+*
+ RETURN
+*
+ END IF
+*
+* ============================================================
+*
+* End ELSE of IF(I.EQ.1)
+*
+ END IF
+*
+* ===============================================================
+*
+* If the pivot column is not the first column of the
+* subblock A(1:M,K:N):
+* 1) swap the K-th column and the KP-th pivot column
+* in A(1:M,1:N);
+* 2) swap the K-th row and the KP-th row in F(1:N,1:K-1)
+* 3) copy the K-th element into the KP-th element of the partial
+* and exact 2-norm vectors VN1 and VN2. (Swap is not needed
+* for VN1 and VN2 since we use the element with the index
+* larger than K in the next loop step.)
+* 4) Save the pivot interchange with the indices relative to the
+* the original matrix A_orig, not the block A(1:M,1:N).
+*
+ IF( KP.NE.K ) THEN
+ CALL CSWAP( M, A( 1, KP ), 1, A( 1, K ), 1 )
+ CALL CSWAP( K-1, F( KP, 1 ), LDF, F( K, 1 ), LDF )
+ VN1( KP ) = VN1( K )
+ VN2( KP ) = VN2( K )
+ ITEMP = JPIV( KP )
+ JPIV( KP ) = JPIV( K )
+ JPIV( K ) = ITEMP
+ END IF
+*
+* Apply previous Householder reflectors to column K:
+* A(I:M,K) := A(I:M,K) - A(I:M,1:K-1)*F(K,1:K-1)**H.
+*
+ IF( K.GT.1 ) THEN
+ DO J = 1, K - 1
+ F( K, J ) = CONJG( F( K, J ) )
+ END DO
+ CALL CGEMV( 'No transpose', M-I+1, K-1, -CONE, A( I, 1 ),
+ $ LDA, F( K, 1 ), LDF, CONE, A( I, K ), 1 )
+ DO J = 1, K - 1
+ F( K, J ) = CONJG( F( K, J ) )
+ END DO
+ END IF
+*
+* Generate elementary reflector H(k) using the column A(I:M,K).
+*
+ IF( I.LT.M ) THEN
+ CALL CLARFG( M-I+1, A( I, K ), A( I+1, K ), 1, TAU( K ) )
+ ELSE
+ TAU( K ) = CZERO
+ END IF
+*
+* Check if TAU(K) contains NaN, set INFO parameter
+* to the column number where NaN is found and return from
+* the routine.
+* NOTE: There is no need to check TAU(K) for Inf,
+* since CLARFG cannot produce TAU(KK) or Householder vector
+* below the diagonal containing Inf. Only BETA on the diagonal,
+* returned by CLARFG can contain Inf, which requires
+* TAU(K) to contain NaN. Therefore, this case of generating Inf
+* by CLARFG is covered by checking TAU(K) for NaN.
+*
+ IF( SISNAN( REAL( TAU(K) ) ) ) THEN
+ TAUNAN = REAL( TAU(K) )
+ ELSE IF( SISNAN( IMAG( TAU(K) ) ) ) THEN
+ TAUNAN = IMAG( TAU(K) )
+ ELSE
+ TAUNAN = ZERO
+ END IF
+*
+ IF( SISNAN( TAUNAN ) ) THEN
+*
+ DONE = .TRUE.
+*
+* Set KB, the number of factorized partial columns
+* that are non-zero in each step in the block,
+* i.e. the rank of the factor R.
+* Set IF, the number of processed rows in the block, which
+* is the same as the number of processed rows in
+* the original whole matrix A_orig.
+*
+ KB = K - 1
+ IF = I - 1
+ INFO = K
+*
+* Set MAXC2NRMK and RELMAXC2NRMK to NaN.
+*
+ MAXC2NRMK = TAUNAN
+ RELMAXC2NRMK = TAUNAN
+*
+* There is no need to apply the block reflector to the
+* residual of the matrix A stored in A(KB+1:M,KB+1:N),
+* since the submatrix contains NaN and we stop
+* the computation.
+* But, we need to apply the block reflector to the residual
+* right hand sides stored in A(KB+1:M,N+1:N+NRHS), if the
+* residual right hand sides exist. This occurs
+* when ( NRHS != 0 AND KB <= (M-IOFFSET) ):
+*
+* A(I+1:M,N+1:N+NRHS) := A(I+1:M,N+1:N+NRHS) -
+* A(I+1:M,1:KB) * F(N+1:N+NRHS,1:KB)**H.
+*
+ IF( NRHS.GT.0 .AND. KB.LT.(M-IOFFSET) ) THEN
+ CALL CGEMM( 'No transpose', 'Conjugate transpose',
+ $ M-IF, NRHS, KB, -CONE, A( IF+1, 1 ), LDA,
+ $ F( N+1, 1 ), LDF, CONE, A( IF+1, N+1 ), LDA )
+ END IF
+*
+* There is no need to recompute the 2-norm of the
+* difficult columns, since we stop the factorization.
+*
+* Array TAU(KF+1:MINMNFACT) is not set and contains
+* undefined elements.
+*
+* Return from the routine.
+*
+ RETURN
+ END IF
+*
+* ===============================================================
+*
+ AIK = A( I, K )
+ A( I, K ) = CONE
+*
+* ===============================================================
+*
+* Compute the current K-th column of F:
+* 1) F(K+1:N,K) := tau(K) * A(I:M,K+1:N)**H * A(I:M,K).
+*
+ IF( K.LT.N+NRHS ) THEN
+ CALL CGEMV( 'Conjugate transpose', M-I+1, N+NRHS-K,
+ $ TAU( K ), A( I, K+1 ), LDA, A( I, K ), 1,
+ $ CZERO, F( K+1, K ), 1 )
+ END IF
+*
+* 2) Zero out elements above and on the diagonal of the
+* column K in matrix F, i.e elements F(1:K,K).
+*
+ DO J = 1, K
+ F( J, K ) = CZERO
+ END DO
+*
+* 3) Incremental updating of the K-th column of F:
+* F(1:N,K) := F(1:N,K) - tau(K) * F(1:N,1:K-1) * A(I:M,1:K-1)**H
+* * A(I:M,K).
+*
+ IF( K.GT.1 ) THEN
+ CALL CGEMV( 'Conjugate Transpose', M-I+1, K-1, -TAU( K ),
+ $ A( I, 1 ), LDA, A( I, K ), 1, CZERO,
+ $ AUXV( 1 ), 1 )
+*
+ CALL CGEMV( 'No transpose', N+NRHS, K-1, CONE,
+ $ F( 1, 1 ), LDF, AUXV( 1 ), 1, CONE,
+ $ F( 1, K ), 1 )
+ END IF
+*
+* ===============================================================
+*
+* Update the current I-th row of A:
+* A(I,K+1:N+NRHS) := A(I,K+1:N+NRHS)
+* - A(I,1:K)*F(K+1:N+NRHS,1:K)**H.
+*
+ IF( K.LT.N+NRHS ) THEN
+ CALL CGEMM( 'No transpose', 'Conjugate transpose',
+ $ 1, N+NRHS-K, K, -CONE, A( I, 1 ), LDA,
+ $ F( K+1, 1 ), LDF, CONE, A( I, K+1 ), LDA )
+ END IF
+*
+ A( I, K ) = AIK
+*
+* Update the partial column 2-norms for the residual matrix,
+* only if the residual matrix A(I+1:M,K+1:N) exists, i.e.
+* when K < MINMNFACT = min( M-IOFFSET, N ).
+*
+ IF( K.LT.MINMNFACT ) THEN
+*
+ DO J = K + 1, N
+ IF( VN1( J ).NE.ZERO ) THEN
+*
+* NOTE: The following lines follow from the analysis in
+* Lapack Working Note 176.
+*
+ TEMP = ABS( A( I, J ) ) / VN1( J )
+ TEMP = MAX( ZERO, ( ONE+TEMP )*( ONE-TEMP ) )
+ TEMP2 = TEMP*( VN1( J ) / VN2( J ) )**2
+ IF( TEMP2.LE.TOL3Z ) THEN
+*
+* At J-index, we have a difficult column for the
+* update of the 2-norm. Save the index of the previous
+* difficult column in IWORK(J-1).
+* NOTE: ILSTCC > 1, threfore we can use IWORK only
+* with N-1 elements, where the elements are
+* shifted by 1 to the left.
+*
+ IWORK( J-1 ) = LSTICC
+*
+* Set the index of the last difficult column LSTICC.
+*
+ LSTICC = J
+*
+ ELSE
+ VN1( J ) = VN1( J )*SQRT( TEMP )
+ END IF
+ END IF
+ END DO
+*
+ END IF
+*
+* End of while loop.
+*
+ END DO
+*
+* Now, afler the loop:
+* Set KB, the number of factorized columns in the block;
+* Set IF, the number of processed rows in the block, which
+* is the same as the number of processed rows in
+* the original whole matrix A_orig, IF = IOFFSET + KB.
+*
+ KB = K
+ IF = I
+*
+* Apply the block reflector to the residual of the matrix A
+* and the residual of the right hand sides B, if the residual
+* matrix and and/or the residual of the right hand sides
+* exist, i.e. if the submatrix A(I+1:M,KB+1:N+NRHS) exists.
+* This occurs when KB < MINMNUPDT = min( M-IOFFSET, N+NRHS ):
+*
+* A(IF+1:M,K+1:N+NRHS) := A(IF+1:M,KB+1:N+NRHS) -
+* A(IF+1:M,1:KB) * F(KB+1:N+NRHS,1:KB)**H.
+*
+ IF( KB.LT.MINMNUPDT ) THEN
+ CALL CGEMM( 'No transpose', 'Conjugate transpose',
+ $ M-IF, N+NRHS-KB, KB, -CONE, A( IF+1, 1 ), LDA,
+ $ F( KB+1, 1 ), LDF, CONE, A( IF+1, KB+1 ), LDA )
+ END IF
+*
+* Recompute the 2-norm of the difficult columns.
+* Loop over the index of the difficult columns from the largest
+* to the smallest index.
+*
+ DO WHILE( LSTICC.GT.0 )
+*
+* LSTICC is the index of the last difficult column is greater
+* than 1.
+* ITEMP is the index of the previous difficult column.
+*
+ ITEMP = IWORK( LSTICC-1 )
+*
+* Compute the 2-norm explicilty for the last difficult column and
+* save it in the partial and exact 2-norm vectors VN1 and VN2.
+*
+* NOTE: The computation of VN1( LSTICC ) relies on the fact that
+* SCNRM2 does not fail on vectors with norm below the value of
+* SQRT(SLAMCH('S'))
+*
+ VN1( LSTICC ) = SCNRM2( M-IF, A( IF+1, LSTICC ), 1 )
+ VN2( LSTICC ) = VN1( LSTICC )
+*
+* Downdate the index of the last difficult column to
+* the index of the previous difficult column.
+*
+ LSTICC = ITEMP
+*
+ END DO
+*
+ RETURN
+*
+* End of CLAQP3RK
+*
+ END
diff --git a/lapack-netlib/SRC/dgeqp3rk.f b/lapack-netlib/SRC/dgeqp3rk.f
new file mode 100644
index 000000000..ace97b712
--- /dev/null
+++ b/lapack-netlib/SRC/dgeqp3rk.f
@@ -0,0 +1,1081 @@
+*> \brief \b DGEQP3RK computes a truncated Householder QR factorization with column pivoting of a real m-by-n matrix A by using Level 3 BLAS and overwrites a real m-by-nrhs matrix B with Q**T * B.
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download DGEQP3RK + dependencies
+*>
+*> [TGZ]
+*>
+*> [ZIP]
+*>
+*> [TXT]
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE DGEQP3RK( M, N, NRHS, KMAX, ABSTOL, RELTOL, A, LDA,
+* $ K, MAXC2NRMK, RELMAXC2NRMK, JPIV, TAU,
+* $ WORK, LWORK, IWORK, INFO )
+* IMPLICIT NONE
+*
+* .. Scalar Arguments ..
+* INTEGER INFO, K, KMAX, LDA, LWORK, M, N, NRHS
+* DOUBLE PRECISION ABSTOL, MAXC2NRMK, RELMAXC2NRMK, RELTOL
+* ..
+* .. Array Arguments ..
+* INTEGER IWORK( * ), JPIV( * )
+* DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> DGEQP3RK performs two tasks simultaneously:
+*>
+*> Task 1: The routine computes a truncated (rank K) or full rank
+*> Householder QR factorization with column pivoting of a real
+*> M-by-N matrix A using Level 3 BLAS. K is the number of columns
+*> that were factorized, i.e. factorization rank of the
+*> factor R, K <= min(M,N).
+*>
+*> A * P(K) = Q(K) * R(K) =
+*>
+*> = Q(K) * ( R11(K) R12(K) ) = Q(K) * ( R(K)_approx )
+*> ( 0 R22(K) ) ( 0 R(K)_residual ),
+*>
+*> where:
+*>
+*> P(K) is an N-by-N permutation matrix;
+*> Q(K) is an M-by-M orthogonal matrix;
+*> R(K)_approx = ( R11(K), R12(K) ) is a rank K approximation of the
+*> full rank factor R with K-by-K upper-triangular
+*> R11(K) and K-by-N rectangular R12(K). The diagonal
+*> entries of R11(K) appear in non-increasing order
+*> of absolute value, and absolute values of all of
+*> them exceed the maximum column 2-norm of R22(K)
+*> up to roundoff error.
+*> R(K)_residual = R22(K) is the residual of a rank K approximation
+*> of the full rank factor R. It is a
+*> an (M-K)-by-(N-K) rectangular matrix;
+*> 0 is a an (M-K)-by-K zero matrix.
+*>
+*> Task 2: At the same time, the routine overwrites a real M-by-NRHS
+*> matrix B with Q(K)**T * B using Level 3 BLAS.
+*>
+*> =====================================================================
+*>
+*> The matrices A and B are stored on input in the array A as
+*> the left and right blocks A(1:M,1:N) and A(1:M, N+1:N+NRHS)
+*> respectively.
+*>
+*> N NRHS
+*> array_A = M [ mat_A, mat_B ]
+*>
+*> The truncation criteria (i.e. when to stop the factorization)
+*> can be any of the following:
+*>
+*> 1) The input parameter KMAX, the maximum number of columns
+*> KMAX to factorize, i.e. the factorization rank is limited
+*> to KMAX. If KMAX >= min(M,N), the criterion is not used.
+*>
+*> 2) The input parameter ABSTOL, the absolute tolerance for
+*> the maximum column 2-norm of the residual matrix R22(K). This
+*> means that the factorization stops if this norm is less or
+*> equal to ABSTOL. If ABSTOL < 0.0, the criterion is not used.
+*>
+*> 3) The input parameter RELTOL, the tolerance for the maximum
+*> column 2-norm matrix of the residual matrix R22(K) divided
+*> by the maximum column 2-norm of the original matrix A, which
+*> is equal to abs(R(1,1)). This means that the factorization stops
+*> when the ratio of the maximum column 2-norm of R22(K) to
+*> the maximum column 2-norm of A is less than or equal to RELTOL.
+*> If RELTOL < 0.0, the criterion is not used.
+*>
+*> 4) In case both stopping criteria ABSTOL or RELTOL are not used,
+*> and when the residual matrix R22(K) is a zero matrix in some
+*> factorization step K. ( This stopping criterion is implicit. )
+*>
+*> The algorithm stops when any of these conditions is first
+*> satisfied, otherwise the whole matrix A is factorized.
+*>
+*> To factorize the whole matrix A, use the values
+*> KMAX >= min(M,N), ABSTOL < 0.0 and RELTOL < 0.0.
+*>
+*> The routine returns:
+*> a) Q(K), R(K)_approx = ( R11(K), R12(K) ),
+*> R(K)_residual = R22(K), P(K), i.e. the resulting matrices
+*> of the factorization; P(K) is represented by JPIV,
+*> ( if K = min(M,N), R(K)_approx is the full factor R,
+*> and there is no residual matrix R(K)_residual);
+*> b) K, the number of columns that were factorized,
+*> i.e. factorization rank;
+*> c) MAXC2NRMK, the maximum column 2-norm of the residual
+*> matrix R(K)_residual = R22(K),
+*> ( if K = min(M,N), MAXC2NRMK = 0.0 );
+*> d) RELMAXC2NRMK equals MAXC2NRMK divided by MAXC2NRM, the maximum
+*> column 2-norm of the original matrix A, which is equal
+*> to abs(R(1,1)), ( if K = min(M,N), RELMAXC2NRMK = 0.0 );
+*> e) Q(K)**T * B, the matrix B with the orthogonal
+*> transformation Q(K)**T applied on the left.
+*>
+*> The N-by-N permutation matrix P(K) is stored in a compact form in
+*> the integer array JPIV. For 1 <= j <= N, column j
+*> of the matrix A was interchanged with column JPIV(j).
+*>
+*> The M-by-M orthogonal matrix Q is represented as a product
+*> of elementary Householder reflectors
+*>
+*> Q(K) = H(1) * H(2) * . . . * H(K),
+*>
+*> where K is the number of columns that were factorized.
+*>
+*> Each H(j) has the form
+*>
+*> H(j) = I - tau * v * v**T,
+*>
+*> where 1 <= j <= K and
+*> I is an M-by-M identity matrix,
+*> tau is a real scalar,
+*> v is a real vector with v(1:j-1) = 0 and v(j) = 1.
+*>
+*> v(j+1:M) is stored on exit in A(j+1:M,j) and tau in TAU(j).
+*>
+*> See the Further Details section for more information.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] M
+*> \verbatim
+*> M is INTEGER
+*> The number of rows of the matrix A. M >= 0.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> The number of columns of the matrix A. N >= 0.
+*> \endverbatim
+*>
+*> \param[in] NRHS
+*> \verbatim
+*> NRHS is INTEGER
+*> The number of right hand sides, i.e. the number of
+*> columns of the matrix B. NRHS >= 0.
+*> \endverbatim
+*>
+*> \param[in] KMAX
+*> \verbatim
+*> KMAX is INTEGER
+*>
+*> The first factorization stopping criterion. KMAX >= 0.
+*>
+*> The maximum number of columns of the matrix A to factorize,
+*> i.e. the maximum factorization rank.
+*>
+*> a) If KMAX >= min(M,N), then this stopping criterion
+*> is not used, the routine factorizes columns
+*> depending on ABSTOL and RELTOL.
+*>
+*> b) If KMAX = 0, then this stopping criterion is
+*> satisfied on input and the routine exits immediately.
+*> This means that the factorization is not performed,
+*> the matrices A and B are not modified, and
+*> the matrix A is itself the residual.
+*> \endverbatim
+*>
+*> \param[in] ABSTOL
+*> \verbatim
+*> ABSTOL is DOUBLE PRECISION
+*>
+*> The second factorization stopping criterion, cannot be NaN.
+*>
+*> The absolute tolerance (stopping threshold) for
+*> maximum column 2-norm of the residual matrix R22(K).
+*> The algorithm converges (stops the factorization) when
+*> the maximum column 2-norm of the residual matrix R22(K)
+*> is less than or equal to ABSTOL. Let SAFMIN = DLAMCH('S').
+*>
+*> a) If ABSTOL is NaN, then no computation is performed
+*> and an error message ( INFO = -5 ) is issued
+*> by XERBLA.
+*>
+*> b) If ABSTOL < 0.0, then this stopping criterion is not
+*> used, the routine factorizes columns depending
+*> on KMAX and RELTOL.
+*> This includes the case ABSTOL = -Inf.
+*>
+*> c) If 0.0 <= ABSTOL < 2*SAFMIN, then ABSTOL = 2*SAFMIN
+*> is used. This includes the case ABSTOL = -0.0.
+*>
+*> d) If 2*SAFMIN <= ABSTOL then the input value
+*> of ABSTOL is used.
+*>
+*> Let MAXC2NRM be the maximum column 2-norm of the
+*> whole original matrix A.
+*> If ABSTOL chosen above is >= MAXC2NRM, then this
+*> stopping criterion is satisfied on input and routine exits
+*> immediately after MAXC2NRM is computed. The routine
+*> returns MAXC2NRM in MAXC2NORMK,
+*> and 1.0 in RELMAXC2NORMK.
+*> This includes the case ABSTOL = +Inf. This means that the
+*> factorization is not performed, the matrices A and B are not
+*> modified, and the matrix A is itself the residual.
+*> \endverbatim
+*>
+*> \param[in] RELTOL
+*> \verbatim
+*> RELTOL is DOUBLE PRECISION
+*>
+*> The third factorization stopping criterion, cannot be NaN.
+*>
+*> The tolerance (stopping threshold) for the ratio
+*> abs(R(K+1,K+1))/abs(R(1,1)) of the maximum column 2-norm of
+*> the residual matrix R22(K) to the maximum column 2-norm of
+*> the original matrix A. The algorithm converges (stops the
+*> factorization), when abs(R(K+1,K+1))/abs(R(1,1)) A is less
+*> than or equal to RELTOL. Let EPS = DLAMCH('E').
+*>
+*> a) If RELTOL is NaN, then no computation is performed
+*> and an error message ( INFO = -6 ) is issued
+*> by XERBLA.
+*>
+*> b) If RELTOL < 0.0, then this stopping criterion is not
+*> used, the routine factorizes columns depending
+*> on KMAX and ABSTOL.
+*> This includes the case RELTOL = -Inf.
+*>
+*> c) If 0.0 <= RELTOL < EPS, then RELTOL = EPS is used.
+*> This includes the case RELTOL = -0.0.
+*>
+*> d) If EPS <= RELTOL then the input value of RELTOL
+*> is used.
+*>
+*> Let MAXC2NRM be the maximum column 2-norm of the
+*> whole original matrix A.
+*> If RELTOL chosen above is >= 1.0, then this stopping
+*> criterion is satisfied on input and routine exits
+*> immediately after MAXC2NRM is computed.
+*> The routine returns MAXC2NRM in MAXC2NORMK,
+*> and 1.0 in RELMAXC2NORMK.
+*> This includes the case RELTOL = +Inf. This means that the
+*> factorization is not performed, the matrices A and B are not
+*> modified, and the matrix A is itself the residual.
+*>
+*> NOTE: We recommend that RELTOL satisfy
+*> min( max(M,N)*EPS, sqrt(EPS) ) <= RELTOL
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*> A is DOUBLE PRECISION array, dimension (LDA,N+NRHS)
+*>
+*> On entry:
+*>
+*> a) The subarray A(1:M,1:N) contains the M-by-N matrix A.
+*> b) The subarray A(1:M,N+1:N+NRHS) contains the M-by-NRHS
+*> matrix B.
+*>
+*> N NRHS
+*> array_A = M [ mat_A, mat_B ]
+*>
+*> On exit:
+*>
+*> a) The subarray A(1:M,1:N) contains parts of the factors
+*> of the matrix A:
+*>
+*> 1) If K = 0, A(1:M,1:N) contains the original matrix A.
+*> 2) If K > 0, A(1:M,1:N) contains parts of the
+*> factors:
+*>
+*> 1. The elements below the diagonal of the subarray
+*> A(1:M,1:K) together with TAU(1:K) represent the
+*> orthogonal matrix Q(K) as a product of K Householder
+*> elementary reflectors.
+*>
+*> 2. The elements on and above the diagonal of
+*> the subarray A(1:K,1:N) contain K-by-N
+*> upper-trapezoidal matrix
+*> R(K)_approx = ( R11(K), R12(K) ).
+*> NOTE: If K=min(M,N), i.e. full rank factorization,
+*> then R_approx(K) is the full factor R which
+*> is upper-trapezoidal. If, in addition, M>=N,
+*> then R is upper-triangular.
+*>
+*> 3. The subarray A(K+1:M,K+1:N) contains (M-K)-by-(N-K)
+*> rectangular matrix R(K)_residual = R22(K).
+*>
+*> b) If NRHS > 0, the subarray A(1:M,N+1:N+NRHS) contains
+*> the M-by-NRHS product Q(K)**T * B.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*> LDA is INTEGER
+*> The leading dimension of the array A. LDA >= max(1,M).
+*> This is the leading dimension for both matrices, A and B.
+*> \endverbatim
+*>
+*> \param[out] K
+*> \verbatim
+*> K is INTEGER
+*> Factorization rank of the matrix A, i.e. the rank of
+*> the factor R, which is the same as the number of non-zero
+*> rows of the factor R. 0 <= K <= min(M,KMAX,N).
+*>
+*> K also represents the number of non-zero Householder
+*> vectors.
+*>
+*> NOTE: If K = 0, a) the arrays A and B are not modified;
+*> b) the array TAU(1:min(M,N)) is set to ZERO,
+*> if the matrix A does not contain NaN,
+*> otherwise the elements TAU(1:min(M,N))
+*> are undefined;
+*> c) the elements of the array JPIV are set
+*> as follows: for j = 1:N, JPIV(j) = j.
+*> \endverbatim
+*>
+*> \param[out] MAXC2NRMK
+*> \verbatim
+*> MAXC2NRMK is DOUBLE PRECISION
+*> The maximum column 2-norm of the residual matrix R22(K),
+*> when the factorization stopped at rank K. MAXC2NRMK >= 0.
+*>
+*> a) If K = 0, i.e. the factorization was not performed,
+*> the matrix A was not modified and is itself a residual
+*> matrix, then MAXC2NRMK equals the maximum column 2-norm
+*> of the original matrix A.
+*>
+*> b) If 0 < K < min(M,N), then MAXC2NRMK is returned.
+*>
+*> c) If K = min(M,N), i.e. the whole matrix A was
+*> factorized and there is no residual matrix,
+*> then MAXC2NRMK = 0.0.
+*>
+*> NOTE: MAXC2NRMK in the factorization step K would equal
+*> R(K+1,K+1) in the next factorization step K+1.
+*> \endverbatim
+*>
+*> \param[out] RELMAXC2NRMK
+*> \verbatim
+*> RELMAXC2NRMK is DOUBLE PRECISION
+*> The ratio MAXC2NRMK / MAXC2NRM of the maximum column
+*> 2-norm of the residual matrix R22(K) (when the factorization
+*> stopped at rank K) to the maximum column 2-norm of the
+*> whole original matrix A. RELMAXC2NRMK >= 0.
+*>
+*> a) If K = 0, i.e. the factorization was not performed,
+*> the matrix A was not modified and is itself a residual
+*> matrix, then RELMAXC2NRMK = 1.0.
+*>
+*> b) If 0 < K < min(M,N), then
+*> RELMAXC2NRMK = MAXC2NRMK / MAXC2NRM is returned.
+*>
+*> c) If K = min(M,N), i.e. the whole matrix A was
+*> factorized and there is no residual matrix,
+*> then RELMAXC2NRMK = 0.0.
+*>
+*> NOTE: RELMAXC2NRMK in the factorization step K would equal
+*> abs(R(K+1,K+1))/abs(R(1,1)) in the next factorization
+*> step K+1.
+*> \endverbatim
+*>
+*> \param[out] JPIV
+*> \verbatim
+*> JPIV is INTEGER array, dimension (N)
+*> Column pivot indices. For 1 <= j <= N, column j
+*> of the matrix A was interchanged with column JPIV(j).
+*>
+*> The elements of the array JPIV(1:N) are always set
+*> by the routine, for example, even when no columns
+*> were factorized, i.e. when K = 0, the elements are
+*> set as JPIV(j) = j for j = 1:N.
+*> \endverbatim
+*>
+*> \param[out] TAU
+*> \verbatim
+*> TAU is DOUBLE PRECISION array, dimension (min(M,N))
+*> The scalar factors of the elementary reflectors.
+*>
+*> If 0 < K <= min(M,N), only the elements TAU(1:K) of
+*> the array TAU are modified by the factorization.
+*> After the factorization computed, if no NaN was found
+*> during the factorization, the remaining elements
+*> TAU(K+1:min(M,N)) are set to zero, otherwise the
+*> elements TAU(K+1:min(M,N)) are not set and therefore
+*> undefined.
+*> ( If K = 0, all elements of TAU are set to zero, if
+*> the matrix A does not contain NaN. )
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*> WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
+*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*> LWORK is INTEGER
+*> The dimension of the array WORK.
+*. LWORK >= (3*N + NRHS - 1)
+*> For optimal performance LWORK >= (2*N + NB*( N+NRHS+1 )),
+*> where NB is the optimal block size for DGEQP3RK returned
+*> by ILAENV. Minimal block size MINNB=2.
+*>
+*> NOTE: The decision, whether to use unblocked BLAS 2
+*> or blocked BLAS 3 code is based not only on the dimension
+*> LWORK of the availbale workspace WORK, but also also on the
+*> matrix A dimension N via crossover point NX returned
+*> by ILAENV. (For N less than NX, unblocked code should be
+*> used.)
+*>
+*> If LWORK = -1, then a workspace query is assumed;
+*> the routine only calculates the optimal size of the WORK
+*> array, returns this value as the first entry of the WORK
+*> array, and no error message related to LWORK is issued
+*> by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] IWORK
+*> \verbatim
+*> IWORK is INTEGER array, dimension (N-1).
+*> Is a work array. ( IWORK is used to store indices
+*> of "bad" columns for norm downdating in the residual
+*> matrix in the blocked step auxiliary subroutine DLAQP3RK ).
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*> INFO is INTEGER
+*> 1) INFO = 0: successful exit.
+*> 2) INFO < 0: if INFO = -i, the i-th argument had an
+*> illegal value.
+*> 3) If INFO = j_1, where 1 <= j_1 <= N, then NaN was
+*> detected and the routine stops the computation.
+*> The j_1-th column of the matrix A or the j_1-th
+*> element of array TAU contains the first occurrence
+*> of NaN in the factorization step K+1 ( when K columns
+*> have been factorized ).
+*>
+*> On exit:
+*> K is set to the number of
+*> factorized columns without
+*> exception.
+*> MAXC2NRMK is set to NaN.
+*> RELMAXC2NRMK is set to NaN.
+*> TAU(K+1:min(M,N)) is not set and contains undefined
+*> elements. If j_1=K+1, TAU(K+1)
+*> may contain NaN.
+*> 4) If INFO = j_2, where N+1 <= j_2 <= 2*N, then no NaN
+*> was detected, but +Inf (or -Inf) was detected and
+*> the routine continues the computation until completion.
+*> The (j_2-N)-th column of the matrix A contains the first
+*> occurrence of +Inf (or -Inf) in the factorization
+*> step K+1 ( when K columns have been factorized ).
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \ingroup geqp3rk
+*
+*> \par Further Details:
+* =====================
+*
+*> \verbatim
+*> DGEQP3RK is based on the same BLAS3 Householder QR factorization
+*> algorithm with column pivoting as in DGEQP3 routine which uses
+*> DLARFG routine to generate Householder reflectors
+*> for QR factorization.
+*>
+*> We can also write:
+*>
+*> A = A_approx(K) + A_residual(K)
+*>
+*> The low rank approximation matrix A(K)_approx from
+*> the truncated QR factorization of rank K of the matrix A is:
+*>
+*> A(K)_approx = Q(K) * ( R(K)_approx ) * P(K)**T
+*> ( 0 0 )
+*>
+*> = Q(K) * ( R11(K) R12(K) ) * P(K)**T
+*> ( 0 0 )
+*>
+*> The residual A_residual(K) of the matrix A is:
+*>
+*> A_residual(K) = Q(K) * ( 0 0 ) * P(K)**T =
+*> ( 0 R(K)_residual )
+*>
+*> = Q(K) * ( 0 0 ) * P(K)**T
+*> ( 0 R22(K) )
+*>
+*> The truncated (rank K) factorization guarantees that
+*> the maximum column 2-norm of A_residual(K) is less than
+*> or equal to MAXC2NRMK up to roundoff error.
+*>
+*> NOTE: An approximation of the null vectors
+*> of A can be easily computed from R11(K)
+*> and R12(K):
+*>
+*> Null( A(K) )_approx = P * ( inv(R11(K)) * R12(K) )
+*> ( -I )
+*>
+*> \endverbatim
+*
+*> \par References:
+* ================
+*> [1] A Level 3 BLAS QR factorization algorithm with column pivoting developed in 1996.
+*> G. Quintana-Orti, Depto. de Informatica, Universidad Jaime I, Spain.
+*> X. Sun, Computer Science Dept., Duke University, USA.
+*> C. H. Bischof, Math. and Comp. Sci. Div., Argonne National Lab, USA.
+*> A BLAS-3 version of the QR factorization with column pivoting.
+*> LAPACK Working Note 114
+*> \htmlonly
+*> https://www.netlib.org/lapack/lawnspdf/lawn114.pdf
+*> \endhtmlonly
+*> and in
+*> SIAM J. Sci. Comput., 19(5):1486-1494, Sept. 1998.
+*> \htmlonly
+*> https://doi.org/10.1137/S1064827595296732
+*> \endhtmlonly
+*>
+*> [2] A partial column norm updating strategy developed in 2006.
+*> Z. Drmac and Z. Bujanovic, Dept. of Math., University of Zagreb, Croatia.
+*> On the failure of rank revealing QR factorization software – a case study.
+*> LAPACK Working Note 176.
+*> \htmlonly
+*> http://www.netlib.org/lapack/lawnspdf/lawn176.pdf
+*> \endhtmlonly
+*> and in
+*> ACM Trans. Math. Softw. 35, 2, Article 12 (July 2008), 28 pages.
+*> \htmlonly
+*> https://doi.org/10.1145/1377612.1377616
+*> \endhtmlonly
+*
+*> \par Contributors:
+* ==================
+*>
+*> \verbatim
+*>
+*> November 2023, Igor Kozachenko, James Demmel,
+*> Computer Science Division,
+*> University of California, Berkeley
+*>
+*> \endverbatim
+*
+* =====================================================================
+ SUBROUTINE DGEQP3RK( M, N, NRHS, KMAX, ABSTOL, RELTOL, A, LDA,
+ $ K, MAXC2NRMK, RELMAXC2NRMK, JPIV, TAU,
+ $ WORK, LWORK, IWORK, INFO )
+ IMPLICIT NONE
+*
+* -- LAPACK computational routine --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*
+* .. Scalar Arguments ..
+ INTEGER INFO, K, KF, KMAX, LDA, LWORK, M, N, NRHS
+ DOUBLE PRECISION ABSTOL, MAXC2NRMK, RELMAXC2NRMK, RELTOL
+* ..
+* .. Array Arguments ..
+ INTEGER IWORK( * ), JPIV( * )
+ DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
+* ..
+*
+* =====================================================================
+*
+* .. Parameters ..
+ INTEGER INB, INBMIN, IXOVER
+ PARAMETER ( INB = 1, INBMIN = 2, IXOVER = 3 )
+ DOUBLE PRECISION ZERO, ONE, TWO
+ PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0, TWO = 2.0D+0 )
+* ..
+* .. Local Scalars ..
+ LOGICAL LQUERY, DONE
+ INTEGER IINFO, IOFFSET, IWS, J, JB, JBF, JMAXB, JMAX,
+ $ JMAXC2NRM, KP1, LWKOPT, MINMN, N_SUB, NB,
+ $ NBMIN, NX
+ DOUBLE PRECISION EPS, HUGEVAL, MAXC2NRM, SAFMIN
+* ..
+* .. External Subroutines ..
+ EXTERNAL DLAQP2RK, DLAQP3RK, XERBLA
+* ..
+* .. External Functions ..
+ LOGICAL DISNAN
+ INTEGER IDAMAX, ILAENV
+ DOUBLE PRECISION DLAMCH, DNRM2
+ EXTERNAL DISNAN, DLAMCH, DNRM2, IDAMAX, ILAENV
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC DBLE, MAX, MIN
+* ..
+* .. Executable Statements ..
+*
+* Test input arguments
+* ====================
+*
+ INFO = 0
+ LQUERY = ( LWORK.EQ.-1 )
+ IF( M.LT.0 ) THEN
+ INFO = -1
+ ELSE IF( N.LT.0 ) THEN
+ INFO = -2
+ ELSE IF( NRHS.LT.0 ) THEN
+ INFO = -3
+ ELSE IF( KMAX.LT.0 ) THEN
+ INFO = -4
+ ELSE IF( DISNAN( ABSTOL ) ) THEN
+ INFO = -5
+ ELSE IF( DISNAN( RELTOL ) ) THEN
+ INFO = -6
+ ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
+ INFO = -8
+ END IF
+*
+* If the input parameters M, N, NRHS, KMAX, LDA are valid:
+* a) Test the input workspace size LWORK for the minimum
+* size requirement IWS.
+* b) Determine the optimal block size NB and optimal
+* workspace size LWKOPT to be returned in WORK(1)
+* in case of (1) LWORK < IWS, (2) LQUERY = .TRUE.,
+* (3) when routine exits.
+* Here, IWS is the miminum workspace required for unblocked
+* code.
+*
+ IF( INFO.EQ.0 ) THEN
+ MINMN = MIN( M, N )
+ IF( MINMN.EQ.0 ) THEN
+ IWS = 1
+ LWKOPT = 1
+ ELSE
+*
+* Minimal workspace size in case of using only unblocked
+* BLAS 2 code in DLAQP2RK.
+* 1) DGEQP3RK and DLAQP2RK: 2*N to store full and partial
+* column 2-norms.
+* 2) DLAQP2RK: N+NRHS-1 to use in WORK array that is used
+* in DLARF subroutine inside DLAQP2RK to apply an
+* elementary reflector from the left.
+* TOTAL_WORK_SIZE = 3*N + NRHS - 1
+*
+ IWS = 3*N + NRHS - 1
+*
+* Assign to NB optimal block size.
+*
+ NB = ILAENV( INB, 'DGEQP3RK', ' ', M, N, -1, -1 )
+*
+* A formula for the optimal workspace size in case of using
+* both unblocked BLAS 2 in DLAQP2RK and blocked BLAS 3 code
+* in DLAQP3RK.
+* 1) DGEQP3RK, DLAQP2RK, DLAQP3RK: 2*N to store full and
+* partial column 2-norms.
+* 2) DLAQP2RK: N+NRHS-1 to use in WORK array that is used
+* in DLARF subroutine to apply an elementary reflector
+* from the left.
+* 3) DLAQP3RK: NB*(N+NRHS) to use in the work array F that
+* is used to apply a block reflector from
+* the left.
+* 4) DLAQP3RK: NB to use in the auxilixary array AUX.
+* Sizes (2) and ((3) + (4)) should intersect, therefore
+* TOTAL_WORK_SIZE = 2*N + NB*( N+NRHS+1 ), given NBMIN=2.
+*
+ LWKOPT = 2*N + NB*( N+NRHS+1 )
+ END IF
+ WORK( 1 ) = DBLE( LWKOPT )
+*
+ IF( ( LWORK.LT.IWS ) .AND. .NOT.LQUERY ) THEN
+ INFO = -15
+ END IF
+ END IF
+*
+* NOTE: The optimal workspace size is returned in WORK(1), if
+* the input parameters M, N, NRHS, KMAX, LDA are valid.
+*
+ IF( INFO.NE.0 ) THEN
+ CALL XERBLA( 'DGEQP3RK', -INFO )
+ RETURN
+ ELSE IF( LQUERY ) THEN
+ RETURN
+ END IF
+*
+* Quick return if possible for M=0 or N=0.
+*
+ IF( MINMN.EQ.0 ) THEN
+ K = 0
+ MAXC2NRMK = ZERO
+ RELMAXC2NRMK = ZERO
+ WORK( 1 ) = DBLE( LWKOPT )
+ RETURN
+ END IF
+*
+* ==================================================================
+*
+* Initialize column pivot array JPIV.
+*
+ DO J = 1, N
+ JPIV( J ) = J
+ END DO
+*
+* ==================================================================
+*
+* Initialize storage for partial and exact column 2-norms.
+* a) The elements WORK(1:N) are used to store partial column
+* 2-norms of the matrix A, and may decrease in each computation
+* step; initialize to the values of complete columns 2-norms.
+* b) The elements WORK(N+1:2*N) are used to store complete column
+* 2-norms of the matrix A, they are not changed during the
+* computation; initialize the values of complete columns 2-norms.
+*
+ DO J = 1, N
+ WORK( J ) = DNRM2( M, A( 1, J ), 1 )
+ WORK( N+J ) = WORK( J )
+ END DO
+*
+* ==================================================================
+*
+* Compute the pivot column index and the maximum column 2-norm
+* for the whole original matrix stored in A(1:M,1:N).
+*
+ KP1 = IDAMAX( N, WORK( 1 ), 1 )
+ MAXC2NRM = WORK( KP1 )
+*
+* ==================================================================.
+*
+ IF( DISNAN( MAXC2NRM ) ) THEN
+*
+* Check if the matrix A contains NaN, set INFO parameter
+* to the column number where the first NaN is found and return
+* from the routine.
+*
+ K = 0
+ INFO = KP1
+*
+* Set MAXC2NRMK and RELMAXC2NRMK to NaN.
+*
+ MAXC2NRMK = MAXC2NRM
+ RELMAXC2NRMK = MAXC2NRM
+*
+* Array TAU is not set and contains undefined elements.
+*
+ WORK( 1 ) = DBLE( LWKOPT )
+ RETURN
+ END IF
+*
+* ===================================================================
+*
+ IF( MAXC2NRM.EQ.ZERO ) THEN
+*
+* Check is the matrix A is a zero matrix, set array TAU and
+* return from the routine.
+*
+ K = 0
+ MAXC2NRMK = ZERO
+ RELMAXC2NRMK = ZERO
+*
+ DO J = 1, MINMN
+ TAU( J ) = ZERO
+ END DO
+*
+ WORK( 1 ) = DBLE( LWKOPT )
+ RETURN
+*
+ END IF
+*
+* ===================================================================
+*
+ HUGEVAL = DLAMCH( 'Overflow' )
+*
+ IF( MAXC2NRM.GT.HUGEVAL ) THEN
+*
+* Check if the matrix A contains +Inf or -Inf, set INFO parameter
+* to the column number, where the first +/-Inf is found plus N,
+* and continue the computation.
+*
+ INFO = N + KP1
+*
+ END IF
+*
+* ==================================================================
+*
+* Quick return if possible for the case when the first
+* stopping criterion is satisfied, i.e. KMAX = 0.
+*
+ IF( KMAX.EQ.0 ) THEN
+ K = 0
+ MAXC2NRMK = MAXC2NRM
+ RELMAXC2NRMK = ONE
+ DO J = 1, MINMN
+ TAU( J ) = ZERO
+ END DO
+ WORK( 1 ) = DBLE( LWKOPT )
+ RETURN
+ END IF
+*
+* ==================================================================
+*
+ EPS = DLAMCH('Epsilon')
+*
+* Adjust ABSTOL
+*
+ IF( ABSTOL.GE.ZERO ) THEN
+ SAFMIN = DLAMCH('Safe minimum')
+ ABSTOL = MAX( ABSTOL, TWO*SAFMIN )
+ END IF
+*
+* Adjust RELTOL
+*
+ IF( RELTOL.GE.ZERO ) THEN
+ RELTOL = MAX( RELTOL, EPS )
+ END IF
+*
+* ===================================================================
+*
+* JMAX is the maximum index of the column to be factorized,
+* which is also limited by the first stopping criterion KMAX.
+*
+ JMAX = MIN( KMAX, MINMN )
+*
+* ===================================================================
+*
+* Quick return if possible for the case when the second or third
+* stopping criterion for the whole original matrix is satified,
+* i.e. MAXC2NRM <= ABSTOL or RELMAXC2NRM <= RELTOL
+* (which is ONE <= RELTOL).
+*
+ IF( MAXC2NRM.LE.ABSTOL .OR. ONE.LE.RELTOL ) THEN
+*
+ K = 0
+ MAXC2NRMK = MAXC2NRM
+ RELMAXC2NRMK = ONE
+*
+ DO J = 1, MINMN
+ TAU( J ) = ZERO
+ END DO
+*
+ WORK( 1 ) = DBLE( LWKOPT )
+ RETURN
+ END IF
+*
+* ==================================================================
+* Factorize columns
+* ==================================================================
+*
+* Determine the block size.
+*
+ NBMIN = 2
+ NX = 0
+*
+ IF( ( NB.GT.1 ) .AND. ( NB.LT.MINMN ) ) THEN
+*
+* Determine when to cross over from blocked to unblocked code.
+* (for N less than NX, unblocked code should be used).
+*
+ NX = MAX( 0, ILAENV( IXOVER, 'DGEQP3RK', ' ', M, N, -1, -1 ))
+*
+ IF( NX.LT.MINMN ) THEN
+*
+* Determine if workspace is large enough for blocked code.
+*
+ IF( LWORK.LT.LWKOPT ) THEN
+*
+* Not enough workspace to use optimal block size that
+* is currently stored in NB.
+* Reduce NB and determine the minimum value of NB.
+*
+ NB = ( LWORK-2*N ) / ( N+1 )
+ NBMIN = MAX( 2, ILAENV( INBMIN, 'DGEQP3RK', ' ', M, N,
+ $ -1, -1 ) )
+*
+ END IF
+ END IF
+ END IF
+*
+* ==================================================================
+*
+* DONE is the boolean flag to rerpresent the case when the
+* factorization completed in the block factorization routine,
+* before the end of the block.
+*
+ DONE = .FALSE.
+*
+* J is the column index.
+*
+ J = 1
+*
+* (1) Use blocked code initially.
+*
+* JMAXB is the maximum column index of the block, when the
+* blocked code is used, is also limited by the first stopping
+* criterion KMAX.
+*
+ JMAXB = MIN( KMAX, MINMN - NX )
+*
+ IF( NB.GE.NBMIN .AND. NB.LT.JMAX .AND. JMAXB.GT.0 ) THEN
+*
+* Loop over the column blocks of the matrix A(1:M,1:JMAXB). Here:
+* J is the column index of a column block;
+* JB is the column block size to pass to block factorization
+* routine in a loop step;
+* JBF is the number of columns that were actually factorized
+* that was returned by the block factorization routine
+* in a loop step, JBF <= JB;
+* N_SUB is the number of columns in the submatrix;
+* IOFFSET is the number of rows that should not be factorized.
+*
+ DO WHILE( J.LE.JMAXB )
+*
+ JB = MIN( NB, JMAXB-J+1 )
+ N_SUB = N-J+1
+ IOFFSET = J-1
+*
+* Factorize JB columns among the columns A(J:N).
+*
+ CALL DLAQP3RK( M, N_SUB, NRHS, IOFFSET, JB, ABSTOL,
+ $ RELTOL, KP1, MAXC2NRM, A( 1, J ), LDA,
+ $ DONE, JBF, MAXC2NRMK, RELMAXC2NRMK,
+ $ JPIV( J ), TAU( J ),
+ $ WORK( J ), WORK( N+J ),
+ $ WORK( 2*N+1 ), WORK( 2*N+JB+1 ),
+ $ N+NRHS-J+1, IWORK, IINFO )
+*
+* Set INFO on the first occurence of Inf.
+*
+ IF( IINFO.GT.N_SUB .AND. INFO.EQ.0 ) THEN
+ INFO = 2*IOFFSET + IINFO
+ END IF
+*
+ IF( DONE ) THEN
+*
+* Either the submatrix is zero before the end of the
+* column block, or ABSTOL or RELTOL criterion is
+* satisfied before the end of the column block, we can
+* return from the routine. Perform the following before
+* returning:
+* a) Set the number of factorized columns K,
+* K = IOFFSET + JBF from the last call of blocked
+* routine.
+* NOTE: 1) MAXC2NRMK and RELMAXC2NRMK are returned
+* by the block factorization routine;
+* 2) The remaining TAUs are set to ZERO by the
+* block factorization routine.
+*
+ K = IOFFSET + JBF
+*
+* Set INFO on the first occurrence of NaN, NaN takes
+* prcedence over Inf.
+*
+ IF( IINFO.LE.N_SUB .AND. IINFO.GT.0 ) THEN
+ INFO = IOFFSET + IINFO
+ END IF
+*
+* Return from the routine.
+*
+ WORK( 1 ) = DBLE( LWKOPT )
+*
+ RETURN
+*
+ END IF
+*
+ J = J + JBF
+*
+ END DO
+*
+ END IF
+*
+* Use unblocked code to factor the last or only block.
+* J = JMAX+1 means we factorized the maximum possible number of
+* columns, that is in ELSE clause we need to compute
+* the MAXC2NORM and RELMAXC2NORM to return after we processed
+* the blocks.
+*
+ IF( J.LE.JMAX ) THEN
+*
+* N_SUB is the number of columns in the submatrix;
+* IOFFSET is the number of rows that should not be factorized.
+*
+ N_SUB = N-J+1
+ IOFFSET = J-1
+*
+ CALL DLAQP2RK( M, N_SUB, NRHS, IOFFSET, JMAX-J+1,
+ $ ABSTOL, RELTOL, KP1, MAXC2NRM, A( 1, J ), LDA,
+ $ KF, MAXC2NRMK, RELMAXC2NRMK, JPIV( J ),
+ $ TAU( J ), WORK( J ), WORK( N+J ),
+ $ WORK( 2*N+1 ), IINFO )
+*
+* ABSTOL or RELTOL criterion is satisfied when the number of
+* the factorized columns KF is smaller then the number
+* of columns JMAX-J+1 supplied to be factorized by the
+* unblocked routine, we can return from
+* the routine. Perform the following before returning:
+* a) Set the number of factorized columns K,
+* b) MAXC2NRMK and RELMAXC2NRMK are returned by the
+* unblocked factorization routine above.
+*
+ K = J - 1 + KF
+*
+* Set INFO on the first exception occurence.
+*
+* Set INFO on the first exception occurence of Inf or NaN,
+* (NaN takes precedence over Inf).
+*
+ IF( IINFO.GT.N_SUB .AND. INFO.EQ.0 ) THEN
+ INFO = 2*IOFFSET + IINFO
+ ELSE IF( IINFO.LE.N_SUB .AND. IINFO.GT.0 ) THEN
+ INFO = IOFFSET + IINFO
+ END IF
+*
+ ELSE
+*
+* Compute the return values for blocked code.
+*
+* Set the number of factorized columns if the unblocked routine
+* was not called.
+*
+ K = JMAX
+*
+* If there exits a residual matrix after the blocked code:
+* 1) compute the values of MAXC2NRMK, RELMAXC2NRMK of the
+* residual matrix, otherwise set them to ZERO;
+* 2) Set TAU(K+1:MINMN) to ZERO.
+*
+ IF( K.LT.MINMN ) THEN
+ JMAXC2NRM = K + IDAMAX( N-K, WORK( K+1 ), 1 )
+ MAXC2NRMK = WORK( JMAXC2NRM )
+ IF( K.EQ.0 ) THEN
+ RELMAXC2NRMK = ONE
+ ELSE
+ RELMAXC2NRMK = MAXC2NRMK / MAXC2NRM
+ END IF
+*
+ DO J = K + 1, MINMN
+ TAU( J ) = ZERO
+ END DO
+*
+ END IF
+*
+* END IF( J.LE.JMAX ) THEN
+*
+ END IF
+*
+ WORK( 1 ) = DBLE( LWKOPT )
+*
+ RETURN
+*
+* End of DGEQP3RK
+*
+ END
diff --git a/lapack-netlib/SRC/dlaqp2rk.f b/lapack-netlib/SRC/dlaqp2rk.f
new file mode 100644
index 000000000..b5a84d0de
--- /dev/null
+++ b/lapack-netlib/SRC/dlaqp2rk.f
@@ -0,0 +1,713 @@
+*> \brief \b DLAQP2RK computes truncated QR factorization with column pivoting of a real matrix block using Level 2 BLAS and overwrites a real m-by-nrhs matrix B with Q**T * B.
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download DLAQP2RK + dependencies
+*>
+*> [TGZ]
+*>
+*> [ZIP]
+*>
+*> [TXT]
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE DLAQP2RK( M, N, NRHS, IOFFSET, KMAX, ABSTOL, RELTOL,
+* $ KP1, MAXC2NRM, A, LDA, K, MAXC2NRMK,
+* $ RELMAXC2NRMK, JPIV, TAU, VN1, VN2, WORK,
+* $ INFO )
+* IMPLICIT NONE
+*
+* .. Scalar Arguments ..
+* INTEGER INFO, IOFFSET, KP1, K, KMAX, LDA, M, N, NRHS
+* DOUBLE PRECISION ABSTOL, MAXC2NRM, MAXC2NRMK, RELMAXC2NRMK,
+* $ RELTOL
+* ..
+* .. Array Arguments ..
+* INTEGER JPIV( * )
+* DOUBLE PRECISION A( LDA, * ), TAU( * ), VN1( * ), VN2( * ),
+* $ WORK( * )
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> DLAQP2RK computes a truncated (rank K) or full rank Householder QR
+*> factorization with column pivoting of a real matrix
+*> block A(IOFFSET+1:M,1:N) as
+*>
+*> A * P(K) = Q(K) * R(K).
+*>
+*> The routine uses Level 2 BLAS. The block A(1:IOFFSET,1:N)
+*> is accordingly pivoted, but not factorized.
+*>
+*> The routine also overwrites the right-hand-sides matrix block B
+*> stored in A(IOFFSET+1:M,N+1:N+NRHS) with Q(K)**T * B.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] M
+*> \verbatim
+*> M is INTEGER
+*> The number of rows of the matrix A. M >= 0.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> The number of columns of the matrix A. N >= 0.
+*> \endverbatim
+*>
+*> \param[in] NRHS
+*> \verbatim
+*> NRHS is INTEGER
+*> The number of right hand sides, i.e., the number of
+*> columns of the matrix B. NRHS >= 0.
+*> \endverbatim
+*>
+*> \param[in] IOFFSET
+*> \verbatim
+*> IOFFSET is INTEGER
+*> The number of rows of the matrix A that must be pivoted
+*> but not factorized. IOFFSET >= 0.
+*>
+*> IOFFSET also represents the number of columns of the whole
+*> original matrix A_orig that have been factorized
+*> in the previous steps.
+*> \endverbatim
+*>
+*> \param[in] KMAX
+*> \verbatim
+*> KMAX is INTEGER
+*>
+*> The first factorization stopping criterion. KMAX >= 0.
+*>
+*> The maximum number of columns of the matrix A to factorize,
+*> i.e. the maximum factorization rank.
+*>
+*> a) If KMAX >= min(M-IOFFSET,N), then this stopping
+*> criterion is not used, factorize columns
+*> depending on ABSTOL and RELTOL.
+*>
+*> b) If KMAX = 0, then this stopping criterion is
+*> satisfied on input and the routine exits immediately.
+*> This means that the factorization is not performed,
+*> the matrices A and B and the arrays TAU, IPIV
+*> are not modified.
+*> \endverbatim
+*>
+*> \param[in] ABSTOL
+*> \verbatim
+*> ABSTOL is DOUBLE PRECISION, cannot be NaN.
+*>
+*> The second factorization stopping criterion.
+*>
+*> The absolute tolerance (stopping threshold) for
+*> maximum column 2-norm of the residual matrix.
+*> The algorithm converges (stops the factorization) when
+*> the maximum column 2-norm of the residual matrix
+*> is less than or equal to ABSTOL.
+*>
+*> a) If ABSTOL < 0.0, then this stopping criterion is not
+*> used, the routine factorizes columns depending
+*> on KMAX and RELTOL.
+*> This includes the case ABSTOL = -Inf.
+*>
+*> b) If 0.0 <= ABSTOL then the input value
+*> of ABSTOL is used.
+*> \endverbatim
+*>
+*> \param[in] RELTOL
+*> \verbatim
+*> RELTOL is DOUBLE PRECISION, cannot be NaN.
+*>
+*> The third factorization stopping criterion.
+*>
+*> The tolerance (stopping threshold) for the ratio of the
+*> maximum column 2-norm of the residual matrix to the maximum
+*> column 2-norm of the original matrix A_orig. The algorithm
+*> converges (stops the factorization), when this ratio is
+*> less than or equal to RELTOL.
+*>
+*> a) If RELTOL < 0.0, then this stopping criterion is not
+*> used, the routine factorizes columns depending
+*> on KMAX and ABSTOL.
+*> This includes the case RELTOL = -Inf.
+*>
+*> d) If 0.0 <= RELTOL then the input value of RELTOL
+*> is used.
+*> \endverbatim
+*>
+*> \param[in] KP1
+*> \verbatim
+*> KP1 is INTEGER
+*> The index of the column with the maximum 2-norm in
+*> the whole original matrix A_orig determined in the
+*> main routine DGEQP3RK. 1 <= KP1 <= N_orig_mat.
+*> \endverbatim
+*>
+*> \param[in] MAXC2NRM
+*> \verbatim
+*> MAXC2NRM is DOUBLE PRECISION
+*> The maximum column 2-norm of the whole original
+*> matrix A_orig computed in the main routine DGEQP3RK.
+*> MAXC2NRM >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*> A is DOUBLE PRECISION array, dimension (LDA,N+NRHS)
+*> On entry:
+*> the M-by-N matrix A and M-by-NRHS matrix B, as in
+*>
+*> N NRHS
+*> array_A = M [ mat_A, mat_B ]
+*>
+*> On exit:
+*> 1. The elements in block A(IOFFSET+1:M,1:K) below
+*> the diagonal together with the array TAU represent
+*> the orthogonal matrix Q(K) as a product of elementary
+*> reflectors.
+*> 2. The upper triangular block of the matrix A stored
+*> in A(IOFFSET+1:M,1:K) is the triangular factor obtained.
+*> 3. The block of the matrix A stored in A(1:IOFFSET,1:N)
+*> has been accordingly pivoted, but not factorized.
+*> 4. The rest of the array A, block A(IOFFSET+1:M,K+1:N+NRHS).
+*> The left part A(IOFFSET+1:M,K+1:N) of this block
+*> contains the residual of the matrix A, and,
+*> if NRHS > 0, the right part of the block
+*> A(IOFFSET+1:M,N+1:N+NRHS) contains the block of
+*> the right-hand-side matrix B. Both these blocks have been
+*> updated by multiplication from the left by Q(K)**T.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*> LDA is INTEGER
+*> The leading dimension of the array A. LDA >= max(1,M).
+*> \endverbatim
+*>
+*> \param[out] K
+*> \verbatim
+*> K is INTEGER
+*> Factorization rank of the matrix A, i.e. the rank of
+*> the factor R, which is the same as the number of non-zero
+*> rows of the factor R. 0 <= K <= min(M-IOFFSET,KMAX,N).
+*>
+*> K also represents the number of non-zero Householder
+*> vectors.
+*> \endverbatim
+*>
+*> \param[out] MAXC2NRMK
+*> \verbatim
+*> MAXC2NRMK is DOUBLE PRECISION
+*> The maximum column 2-norm of the residual matrix,
+*> when the factorization stopped at rank K. MAXC2NRMK >= 0.
+*> \endverbatim
+*>
+*> \param[out] RELMAXC2NRMK
+*> \verbatim
+*> RELMAXC2NRMK is DOUBLE PRECISION
+*> The ratio MAXC2NRMK / MAXC2NRM of the maximum column
+*> 2-norm of the residual matrix (when the factorization
+*> stopped at rank K) to the maximum column 2-norm of the
+*> whole original matrix A. RELMAXC2NRMK >= 0.
+*> \endverbatim
+*>
+*> \param[out] JPIV
+*> \verbatim
+*> JPIV is INTEGER array, dimension (N)
+*> Column pivot indices, for 1 <= j <= N, column j
+*> of the matrix A was interchanged with column JPIV(j).
+*> \endverbatim
+*>
+*> \param[out] TAU
+*> \verbatim
+*> TAU is DOUBLE PRECISION array, dimension (min(M-IOFFSET,N))
+*> The scalar factors of the elementary reflectors.
+*> \endverbatim
+*>
+*> \param[in,out] VN1
+*> \verbatim
+*> VN1 is DOUBLE PRECISION array, dimension (N)
+*> The vector with the partial column norms.
+*> \endverbatim
+*>
+*> \param[in,out] VN2
+*> \verbatim
+*> VN2 is DOUBLE PRECISION array, dimension (N)
+*> The vector with the exact column norms.
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*> WORK is DOUBLE PRECISION array, dimension (N-1)
+*> Used in DLARF subroutine to apply an elementary
+*> reflector from the left.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*> INFO is INTEGER
+*> 1) INFO = 0: successful exit.
+*> 2) If INFO = j_1, where 1 <= j_1 <= N, then NaN was
+*> detected and the routine stops the computation.
+*> The j_1-th column of the matrix A or the j_1-th
+*> element of array TAU contains the first occurrence
+*> of NaN in the factorization step K+1 ( when K columns
+*> have been factorized ).
+*>
+*> On exit:
+*> K is set to the number of
+*> factorized columns without
+*> exception.
+*> MAXC2NRMK is set to NaN.
+*> RELMAXC2NRMK is set to NaN.
+*> TAU(K+1:min(M,N)) is not set and contains undefined
+*> elements. If j_1=K+1, TAU(K+1)
+*> may contain NaN.
+*> 3) If INFO = j_2, where N+1 <= j_2 <= 2*N, then no NaN
+*> was detected, but +Inf (or -Inf) was detected and
+*> the routine continues the computation until completion.
+*> The (j_2-N)-th column of the matrix A contains the first
+*> occurrence of +Inf (or -Inf) in the factorization
+*> step K+1 ( when K columns have been factorized ).
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \ingroup laqp2rk
+*
+*> \par References:
+* ================
+*> [1] A Level 3 BLAS QR factorization algorithm with column pivoting developed in 1996.
+*> G. Quintana-Orti, Depto. de Informatica, Universidad Jaime I, Spain.
+*> X. Sun, Computer Science Dept., Duke University, USA.
+*> C. H. Bischof, Math. and Comp. Sci. Div., Argonne National Lab, USA.
+*> A BLAS-3 version of the QR factorization with column pivoting.
+*> LAPACK Working Note 114
+*> \htmlonly
+*> https://www.netlib.org/lapack/lawnspdf/lawn114.pdf
+*> \endhtmlonly
+*> and in
+*> SIAM J. Sci. Comput., 19(5):1486-1494, Sept. 1998.
+*> \htmlonly
+*> https://doi.org/10.1137/S1064827595296732
+*> \endhtmlonly
+*>
+*> [2] A partial column norm updating strategy developed in 2006.
+*> Z. Drmac and Z. Bujanovic, Dept. of Math., University of Zagreb, Croatia.
+*> On the failure of rank revealing QR factorization software – a case study.
+*> LAPACK Working Note 176.
+*> \htmlonly
+*> http://www.netlib.org/lapack/lawnspdf/lawn176.pdf
+*> \endhtmlonly
+*> and in
+*> ACM Trans. Math. Softw. 35, 2, Article 12 (July 2008), 28 pages.
+*> \htmlonly
+*> https://doi.org/10.1145/1377612.1377616
+*> \endhtmlonly
+*
+*> \par Contributors:
+* ==================
+*>
+*> \verbatim
+*>
+*> November 2023, Igor Kozachenko, James Demmel,
+*> Computer Science Division,
+*> University of California, Berkeley
+*>
+*> \endverbatim
+*
+* =====================================================================
+ SUBROUTINE DLAQP2RK( M, N, NRHS, IOFFSET, KMAX, ABSTOL, RELTOL,
+ $ KP1, MAXC2NRM, A, LDA, K, MAXC2NRMK,
+ $ RELMAXC2NRMK, JPIV, TAU, VN1, VN2, WORK,
+ $ INFO )
+ IMPLICIT NONE
+*
+* -- LAPACK auxiliary routine --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*
+* .. Scalar Arguments ..
+ INTEGER INFO, IOFFSET, KP1, K, KMAX, LDA, M, N, NRHS
+ DOUBLE PRECISION ABSTOL, MAXC2NRM, MAXC2NRMK, RELMAXC2NRMK,
+ $ RELTOL
+* ..
+* .. Array Arguments ..
+ INTEGER JPIV( * )
+ DOUBLE PRECISION A( LDA, * ), TAU( * ), VN1( * ), VN2( * ),
+ $ WORK( * )
+* ..
+*
+* =====================================================================
+*
+* .. Parameters ..
+ DOUBLE PRECISION ZERO, ONE
+ PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
+* ..
+* .. Local Scalars ..
+ INTEGER I, ITEMP, J, JMAXC2NRM, KK, KP, MINMNFACT,
+ $ MINMNUPDT
+ DOUBLE PRECISION AIKK, HUGEVAL, TEMP, TEMP2, TOL3Z
+* ..
+* .. External Subroutines ..
+ EXTERNAL DLARF, DLARFG, DSWAP
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC ABS, MAX, MIN, SQRT
+* ..
+* .. External Functions ..
+ LOGICAL DISNAN
+ INTEGER IDAMAX
+ DOUBLE PRECISION DLAMCH, DNRM2
+ EXTERNAL DISNAN, DLAMCH, IDAMAX, DNRM2
+* ..
+* .. Executable Statements ..
+*
+* Initialize INFO
+*
+ INFO = 0
+*
+* MINMNFACT in the smallest dimension of the submatrix
+* A(IOFFSET+1:M,1:N) to be factorized.
+*
+* MINMNUPDT is the smallest dimension
+* of the subarray A(IOFFSET+1:M,1:N+NRHS) to be udated, which
+* contains the submatrices A(IOFFSET+1:M,1:N) and
+* B(IOFFSET+1:M,1:NRHS) as column blocks.
+*
+ MINMNFACT = MIN( M-IOFFSET, N )
+ MINMNUPDT = MIN( M-IOFFSET, N+NRHS )
+ KMAX = MIN( KMAX, MINMNFACT )
+ TOL3Z = SQRT( DLAMCH( 'Epsilon' ) )
+ HUGEVAL = DLAMCH( 'Overflow' )
+*
+* Compute the factorization, KK is the lomn loop index.
+*
+ DO KK = 1, KMAX
+*
+ I = IOFFSET + KK
+*
+ IF( I.EQ.1 ) THEN
+*
+* ============================================================
+*
+* We are at the first column of the original whole matrix A,
+* therefore we use the computed KP1 and MAXC2NRM from the
+* main routine.
+*
+
+ KP = KP1
+*
+* ============================================================
+*
+ ELSE
+*
+* ============================================================
+*
+* Determine the pivot column in KK-th step, i.e. the index
+* of the column with the maximum 2-norm in the
+* submatrix A(I:M,K:N).
+*
+ KP = ( KK-1 ) + IDAMAX( N-KK+1, VN1( KK ), 1 )
+*
+* Determine the maximum column 2-norm and the relative maximum
+* column 2-norm of the submatrix A(I:M,KK:N) in step KK.
+* RELMAXC2NRMK will be computed later, after somecondition
+* checks on MAXC2NRMK.
+*
+ MAXC2NRMK = VN1( KP )
+*
+* ============================================================
+*
+* Check if the submatrix A(I:M,KK:N) contains NaN, and set
+* INFO parameter to the column number, where the first NaN
+* is found and return from the routine.
+* We need to check the condition only if the
+* column index (same as row index) of the original whole
+* matrix is larger than 1, since the condition for whole
+* original matrix is checked in the main routine.
+*
+ IF( DISNAN( MAXC2NRMK ) ) THEN
+*
+* Set K, the number of factorized columns.
+* that are not zero.
+*
+ K = KK - 1
+ INFO = K + KP
+*
+* Set RELMAXC2NRMK to NaN.
+*
+ RELMAXC2NRMK = MAXC2NRMK
+*
+* Array TAU(K+1:MINMNFACT) is not set and contains
+* undefined elements.
+*
+ RETURN
+ END IF
+*
+* ============================================================
+*
+* Quick return, if the submatrix A(I:M,KK:N) is
+* a zero matrix.
+* We need to check the condition only if the
+* column index (same as row index) of the original whole
+* matrix is larger than 1, since the condition for whole
+* original matrix is checked in the main routine.
+*
+ IF( MAXC2NRMK.EQ.ZERO ) THEN
+*
+* Set K, the number of factorized columns.
+* that are not zero.
+*
+ K = KK - 1
+ RELMAXC2NRMK = ZERO
+*
+* Set TAUs corresponding to the columns that were not
+* factorized to ZERO, i.e. set TAU(KK:MINMNFACT) to ZERO.
+*
+ DO J = KK, MINMNFACT
+ TAU( J ) = ZERO
+ END DO
+*
+* Return from the routine.
+*
+ RETURN
+*
+ END IF
+*
+* ============================================================
+*
+* Check if the submatrix A(I:M,KK:N) contains Inf,
+* set INFO parameter to the column number, where
+* the first Inf is found plus N, and continue
+* the computation.
+* We need to check the condition only if the
+* column index (same as row index) of the original whole
+* matrix is larger than 1, since the condition for whole
+* original matrix is checked in the main routine.
+*
+ IF( INFO.EQ.0 .AND. MAXC2NRMK.GT.HUGEVAL ) THEN
+ INFO = N + KK - 1 + KP
+ END IF
+*
+* ============================================================
+*
+* Test for the second and third stopping criteria.
+* NOTE: There is no need to test for ABSTOL >= ZERO, since
+* MAXC2NRMK is non-negative. Similarly, there is no need
+* to test for RELTOL >= ZERO, since RELMAXC2NRMK is
+* non-negative.
+* We need to check the condition only if the
+* column index (same as row index) of the original whole
+* matrix is larger than 1, since the condition for whole
+* original matrix is checked in the main routine.
+
+ RELMAXC2NRMK = MAXC2NRMK / MAXC2NRM
+*
+ IF( MAXC2NRMK.LE.ABSTOL .OR. RELMAXC2NRMK.LE.RELTOL ) THEN
+*
+* Set K, the number of factorized columns.
+*
+ K = KK - 1
+*
+* Set TAUs corresponding to the columns that were not
+* factorized to ZERO, i.e. set TAU(KK:MINMNFACT) to ZERO.
+*
+ DO J = KK, MINMNFACT
+ TAU( J ) = ZERO
+ END DO
+*
+* Return from the routine.
+*
+ RETURN
+*
+ END IF
+*
+* ============================================================
+*
+* End ELSE of IF(I.EQ.1)
+*
+ END IF
+*
+* ===============================================================
+*
+* If the pivot column is not the first column of the
+* subblock A(1:M,KK:N):
+* 1) swap the KK-th column and the KP-th pivot column
+* in A(1:M,1:N);
+* 2) copy the KK-th element into the KP-th element of the partial
+* and exact 2-norm vectors VN1 and VN2. ( Swap is not needed
+* for VN1 and VN2 since we use the element with the index
+* larger than KK in the next loop step.)
+* 3) Save the pivot interchange with the indices relative to the
+* the original matrix A, not the block A(1:M,1:N).
+*
+ IF( KP.NE.KK ) THEN
+ CALL DSWAP( M, A( 1, KP ), 1, A( 1, KK ), 1 )
+ VN1( KP ) = VN1( KK )
+ VN2( KP ) = VN2( KK )
+ ITEMP = JPIV( KP )
+ JPIV( KP ) = JPIV( KK )
+ JPIV( KK ) = ITEMP
+ END IF
+*
+* Generate elementary reflector H(KK) using the column A(I:M,KK),
+* if the column has more than one element, otherwise
+* the elementary reflector would be an identity matrix,
+* and TAU(KK) = ZERO.
+*
+ IF( I.LT.M ) THEN
+ CALL DLARFG( M-I+1, A( I, KK ), A( I+1, KK ), 1,
+ $ TAU( KK ) )
+ ELSE
+ TAU( KK ) = ZERO
+ END IF
+*
+* Check if TAU(KK) contains NaN, set INFO parameter
+* to the column number where NaN is found and return from
+* the routine.
+* NOTE: There is no need to check TAU(KK) for Inf,
+* since DLARFG cannot produce TAU(KK) or Householder vector
+* below the diagonal containing Inf. Only BETA on the diagonal,
+* returned by DLARFG can contain Inf, which requires
+* TAU(KK) to contain NaN. Therefore, this case of generating Inf
+* by DLARFG is covered by checking TAU(KK) for NaN.
+*
+ IF( DISNAN( TAU(KK) ) ) THEN
+ K = KK - 1
+ INFO = KK
+*
+* Set MAXC2NRMK and RELMAXC2NRMK to NaN.
+*
+ MAXC2NRMK = TAU( KK )
+ RELMAXC2NRMK = TAU( KK )
+*
+* Array TAU(KK:MINMNFACT) is not set and contains
+* undefined elements, except the first element TAU(KK) = NaN.
+*
+ RETURN
+ END IF
+*
+* Apply H(KK)**T to A(I:M,KK+1:N+NRHS) from the left.
+* ( If M >= N, then at KK = N there is no residual matrix,
+* i.e. no columns of A to update, only columns of B.
+* If M < N, then at KK = M-IOFFSET, I = M and we have a
+* one-row residual matrix in A and the elementary
+* reflector is a unit matrix, TAU(KK) = ZERO, i.e. no update
+* is needed for the residual matrix in A and the
+* right-hand-side-matrix in B.
+* Therefore, we update only if
+* KK < MINMNUPDT = min(M-IOFFSET, N+NRHS)
+* condition is satisfied, not only KK < N+NRHS )
+*
+ IF( KK.LT.MINMNUPDT ) THEN
+ AIKK = A( I, KK )
+ A( I, KK ) = ONE
+ CALL DLARF( 'Left', M-I+1, N+NRHS-KK, A( I, KK ), 1,
+ $ TAU( KK ), A( I, KK+1 ), LDA, WORK( 1 ) )
+ A( I, KK ) = AIKK
+ END IF
+*
+ IF( KK.LT.MINMNFACT ) THEN
+*
+* Update the partial column 2-norms for the residual matrix,
+* only if the residual matrix A(I+1:M,KK+1:N) exists, i.e.
+* when KK < min(M-IOFFSET, N).
+*
+ DO J = KK + 1, N
+ IF( VN1( J ).NE.ZERO ) THEN
+*
+* NOTE: The following lines follow from the analysis in
+* Lapack Working Note 176.
+*
+ TEMP = ONE - ( ABS( A( I, J ) ) / VN1( J ) )**2
+ TEMP = MAX( TEMP, ZERO )
+ TEMP2 = TEMP*( VN1( J ) / VN2( J ) )**2
+ IF( TEMP2 .LE. TOL3Z ) THEN
+*
+* Compute the column 2-norm for the partial
+* column A(I+1:M,J) by explicitly computing it,
+* and store it in both partial 2-norm vector VN1
+* and exact column 2-norm vector VN2.
+*
+ VN1( J ) = DNRM2( M-I, A( I+1, J ), 1 )
+ VN2( J ) = VN1( J )
+*
+ ELSE
+*
+* Update the column 2-norm for the partial
+* column A(I+1:M,J) by removing one
+* element A(I,J) and store it in partial
+* 2-norm vector VN1.
+*
+ VN1( J ) = VN1( J )*SQRT( TEMP )
+*
+ END IF
+ END IF
+ END DO
+*
+ END IF
+*
+* End factorization loop
+*
+ END DO
+*
+* If we reached this point, all colunms have been factorized,
+* i.e. no condition was triggered to exit the routine.
+* Set the number of factorized columns.
+*
+ K = KMAX
+*
+* We reached the end of the loop, i.e. all KMAX columns were
+* factorized, we need to set MAXC2NRMK and RELMAXC2NRMK before
+* we return.
+*
+ IF( K.LT.MINMNFACT ) THEN
+*
+ JMAXC2NRM = K + IDAMAX( N-K, VN1( K+1 ), 1 )
+ MAXC2NRMK = VN1( JMAXC2NRM )
+*
+ IF( K.EQ.0 ) THEN
+ RELMAXC2NRMK = ONE
+ ELSE
+ RELMAXC2NRMK = MAXC2NRMK / MAXC2NRM
+ END IF
+*
+ ELSE
+ MAXC2NRMK = ZERO
+ RELMAXC2NRMK = ZERO
+ END IF
+*
+* We reached the end of the loop, i.e. all KMAX columns were
+* factorized, set TAUs corresponding to the columns that were
+* not factorized to ZERO, i.e. TAU(K+1:MINMNFACT) set to ZERO.
+*
+ DO J = K + 1, MINMNFACT
+ TAU( J ) = ZERO
+ END DO
+*
+ RETURN
+*
+* End of DLAQP2RK
+*
+ END
diff --git a/lapack-netlib/SRC/dlaqp3rk.f b/lapack-netlib/SRC/dlaqp3rk.f
new file mode 100644
index 000000000..39e617d0e
--- /dev/null
+++ b/lapack-netlib/SRC/dlaqp3rk.f
@@ -0,0 +1,935 @@
+*> \brief \b DLAQP3RK computes a step of truncated QR factorization with column pivoting of a real m-by-n matrix A using Level 3 BLAS and overwrites a real m-by-nrhs matrix B with Q**T * B.
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download DLAQP3RK + dependencies
+*>
+*> [TGZ]
+*>
+*> [ZIP]
+*>
+*> [TXT]
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE DLAQP3RK( M, N, NRHS, IOFFSET, NB, ABSTOL,
+* $ RELTOL, KP1, MAXC2NRM, A, LDA, DONE, KB,
+* $ MAXC2NRMK, RELMAXC2NRMK, JPIV, TAU,
+* $ VN1, VN2, AUXV, F, LDF, IWORK, INFO )
+* IMPLICIT NONE
+* LOGICAL DONE
+* INTEGER INFO, IOFFSET, KB, KP1, LDA, LDF, M, N,
+* $ NB, NRHS
+* DOUBLE PRECISION ABSTOL, MAXC2NRM, MAXC2NRMK, RELMAXC2NRMK,
+* $ RELTOL
+*
+* .. Scalar Arguments ..
+* LOGICAL DONE
+* INTEGER KB, LDA, LDF, M, N, NB, NRHS, IOFFSET
+* DOUBLE PRECISION ABSTOL, MAXC2NRM, MAXC2NRMK, RELMAXC2NRMK,
+* $ RELTOL
+* ..
+* .. Array Arguments ..
+* INTEGER IWORK( * ), JPIV( * )
+* DOUBLE PRECISION A( LDA, * ), AUXV( * ), F( LDF, * ), TAU( * ),
+* $ VN1( * ), VN2( * )
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> DLAQP3RK computes a step of truncated QR factorization with column
+*> pivoting of a real M-by-N matrix A block A(IOFFSET+1:M,1:N)
+*> by using Level 3 BLAS as
+*>
+*> A * P(KB) = Q(KB) * R(KB).
+*>
+*> The routine tries to factorize NB columns from A starting from
+*> the row IOFFSET+1 and updates the residual matrix with BLAS 3
+*> xGEMM. The number of actually factorized columns is returned
+*> is smaller than NB.
+*>
+*> Block A(1:IOFFSET,1:N) is accordingly pivoted, but not factorized.
+*>
+*> The routine also overwrites the right-hand-sides B matrix stored
+*> in A(IOFFSET+1:M,1:N+1:N+NRHS) with Q(KB)**T * B.
+*>
+*> Cases when the number of factorized columns KB < NB:
+*>
+*> (1) In some cases, due to catastrophic cancellations, it cannot
+*> factorize all NB columns and need to update the residual matrix.
+*> Hence, the actual number of factorized columns in the block returned
+*> in KB is smaller than NB. The logical DONE is returned as FALSE.
+*> The factorization of the whole original matrix A_orig must proceed
+*> with the next block.
+*>
+*> (2) Whenever the stopping criterion ABSTOL or RELTOL is satisfied,
+*> the factorization of the whole original matrix A_orig is stopped,
+*> the logical DONE is returned as TRUE. The number of factorized
+*> columns which is smaller than NB is returned in KB.
+*>
+*> (3) In case both stopping criteria ABSTOL or RELTOL are not used,
+*> and when the residual matrix is a zero matrix in some factorization
+*> step KB, the factorization of the whole original matrix A_orig is
+*> stopped, the logical DONE is returned as TRUE. The number of
+*> factorized columns which is smaller than NB is returned in KB.
+*>
+*> (4) Whenever NaN is detected in the matrix A or in the array TAU,
+*> the factorization of the whole original matrix A_orig is stopped,
+*> the logical DONE is returned as TRUE. The number of factorized
+*> columns which is smaller than NB is returned in KB. The INFO
+*> parameter is set to the column index of the first NaN occurrence.
+*>
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] M
+*> \verbatim
+*> M is INTEGER
+*> The number of rows of the matrix A. M >= 0.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> The number of columns of the matrix A. N >= 0
+*> \endverbatim
+*>
+*> \param[in] NRHS
+*> \verbatim
+*> NRHS is INTEGER
+*> The number of right hand sides, i.e., the number of
+*> columns of the matrix B. NRHS >= 0.
+*> \endverbatim
+*>
+*> \param[in] IOFFSET
+*> \verbatim
+*> IOFFSET is INTEGER
+*> The number of rows of the matrix A that must be pivoted
+*> but not factorized. IOFFSET >= 0.
+*>
+*> IOFFSET also represents the number of columns of the whole
+*> original matrix A_orig that have been factorized
+*> in the previous steps.
+*> \endverbatim
+*>
+*> \param[in] NB
+*> \verbatim
+*> NB is INTEGER
+*> Factorization block size, i.e the number of columns
+*> to factorize in the matrix A. 0 <= NB
+*>
+*> If NB = 0, then the routine exits immediately.
+*> This means that the factorization is not performed,
+*> the matrices A and B and the arrays TAU, IPIV
+*> are not modified.
+*> \endverbatim
+*>
+*> \param[in] ABSTOL
+*> \verbatim
+*> ABSTOL is DOUBLE PRECISION, cannot be NaN.
+*>
+*> The absolute tolerance (stopping threshold) for
+*> maximum column 2-norm of the residual matrix.
+*> The algorithm converges (stops the factorization) when
+*> the maximum column 2-norm of the residual matrix
+*> is less than or equal to ABSTOL.
+*>
+*> a) If ABSTOL < 0.0, then this stopping criterion is not
+*> used, the routine factorizes columns depending
+*> on NB and RELTOL.
+*> This includes the case ABSTOL = -Inf.
+*>
+*> b) If 0.0 <= ABSTOL then the input value
+*> of ABSTOL is used.
+*> \endverbatim
+*>
+*> \param[in] RELTOL
+*> \verbatim
+*> RELTOL is DOUBLE PRECISION, cannot be NaN.
+*>
+*> The tolerance (stopping threshold) for the ratio of the
+*> maximum column 2-norm of the residual matrix to the maximum
+*> column 2-norm of the original matrix A_orig. The algorithm
+*> converges (stops the factorization), when this ratio is
+*> less than or equal to RELTOL.
+*>
+*> a) If RELTOL < 0.0, then this stopping criterion is not
+*> used, the routine factorizes columns depending
+*> on NB and ABSTOL.
+*> This includes the case RELTOL = -Inf.
+*>
+*> d) If 0.0 <= RELTOL then the input value of RELTOL
+*> is used.
+*> \endverbatim
+*>
+*> \param[in] KP1
+*> \verbatim
+*> KP1 is INTEGER
+*> The index of the column with the maximum 2-norm in
+*> the whole original matrix A_orig determined in the
+*> main routine DGEQP3RK. 1 <= KP1 <= N_orig.
+*> \endverbatim
+*>
+*> \param[in] MAXC2NRM
+*> \verbatim
+*> MAXC2NRM is DOUBLE PRECISION
+*> The maximum column 2-norm of the whole original
+*> matrix A_orig computed in the main routine DGEQP3RK.
+*> MAXC2NRM >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*> A is DOUBLE PRECISION array, dimension (LDA,N+NRHS)
+*> On entry:
+*> the M-by-N matrix A and M-by-NRHS matrix B, as in
+*>
+*> N NRHS
+*> array_A = M [ mat_A, mat_B ]
+*>
+*> On exit:
+*> 1. The elements in block A(IOFFSET+1:M,1:KB) below
+*> the diagonal together with the array TAU represent
+*> the orthogonal matrix Q(KB) as a product of elementary
+*> reflectors.
+*> 2. The upper triangular block of the matrix A stored
+*> in A(IOFFSET+1:M,1:KB) is the triangular factor obtained.
+*> 3. The block of the matrix A stored in A(1:IOFFSET,1:N)
+*> has been accordingly pivoted, but not factorized.
+*> 4. The rest of the array A, block A(IOFFSET+1:M,KB+1:N+NRHS).
+*> The left part A(IOFFSET+1:M,KB+1:N) of this block
+*> contains the residual of the matrix A, and,
+*> if NRHS > 0, the right part of the block
+*> A(IOFFSET+1:M,N+1:N+NRHS) contains the block of
+*> the right-hand-side matrix B. Both these blocks have been
+*> updated by multiplication from the left by Q(KB)**T.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*> LDA is INTEGER
+*> The leading dimension of the array A. LDA >= max(1,M).
+*> \endverbatim
+*>
+*> \param[out]
+*> \verbatim
+*> DONE is LOGICAL
+*> TRUE: a) if the factorization completed before processing
+*> all min(M-IOFFSET,NB,N) columns due to ABSTOL
+*> or RELTOL criterion,
+*> b) if the factorization completed before processing
+*> all min(M-IOFFSET,NB,N) columns due to the
+*> residual matrix being a ZERO matrix.
+*> c) when NaN was detected in the matrix A
+*> or in the array TAU.
+*> FALSE: otherwise.
+*> \endverbatim
+*>
+*> \param[out] KB
+*> \verbatim
+*> KB is INTEGER
+*> Factorization rank of the matrix A, i.e. the rank of
+*> the factor R, which is the same as the number of non-zero
+*> rows of the factor R. 0 <= KB <= min(M-IOFFSET,NB,N).
+*>
+*> KB also represents the number of non-zero Householder
+*> vectors.
+*> \endverbatim
+*>
+*> \param[out] MAXC2NRMK
+*> \verbatim
+*> MAXC2NRMK is DOUBLE PRECISION
+*> The maximum column 2-norm of the residual matrix,
+*> when the factorization stopped at rank KB. MAXC2NRMK >= 0.
+*> \endverbatim
+*>
+*> \param[out] RELMAXC2NRMK
+*> \verbatim
+*> RELMAXC2NRMK is DOUBLE PRECISION
+*> The ratio MAXC2NRMK / MAXC2NRM of the maximum column
+*> 2-norm of the residual matrix (when the factorization
+*> stopped at rank KB) to the maximum column 2-norm of the
+*> original matrix A_orig. RELMAXC2NRMK >= 0.
+*> \endverbatim
+*>
+*> \param[out] JPIV
+*> \verbatim
+*> JPIV is INTEGER array, dimension (N)
+*> Column pivot indices, for 1 <= j <= N, column j
+*> of the matrix A was interchanged with column JPIV(j).
+*> \endverbatim
+*>
+*> \param[out] TAU
+*> \verbatim
+*> TAU is DOUBLE PRECISION array, dimension (min(M-IOFFSET,N))
+*> The scalar factors of the elementary reflectors.
+*> \endverbatim
+*>
+*> \param[in,out] VN1
+*> \verbatim
+*> VN1 is DOUBLE PRECISION array, dimension (N)
+*> The vector with the partial column norms.
+*> \endverbatim
+*>
+*> \param[in,out] VN2
+*> \verbatim
+*> VN2 is DOUBLE PRECISION array, dimension (N)
+*> The vector with the exact column norms.
+*> \endverbatim
+*>
+*> \param[out] AUXV
+*> \verbatim
+*> AUXV is DOUBLE PRECISION array, dimension (NB)
+*> Auxiliary vector.
+*> \endverbatim
+*>
+*> \param[out] F
+*> \verbatim
+*> F is DOUBLE PRECISION array, dimension (LDF,NB)
+*> Matrix F**T = L*(Y**T)*A.
+*> \endverbatim
+*>
+*> \param[in] LDF
+*> \verbatim
+*> LDF is INTEGER
+*> The leading dimension of the array F. LDF >= max(1,N+NRHS).
+*> \endverbatim
+*>
+*> \param[out] IWORK
+*> \verbatim
+*> IWORK is INTEGER array, dimension (N-1).
+*> Is a work array. ( IWORK is used to store indices
+*> of "bad" columns for norm downdating in the residual
+*> matrix ).
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*> INFO is INTEGER
+*> 1) INFO = 0: successful exit.
+*> 2) If INFO = j_1, where 1 <= j_1 <= N, then NaN was
+*> detected and the routine stops the computation.
+*> The j_1-th column of the matrix A or the j_1-th
+*> element of array TAU contains the first occurrence
+*> of NaN in the factorization step KB+1 ( when KB columns
+*> have been factorized ).
+*>
+*> On exit:
+*> KB is set to the number of
+*> factorized columns without
+*> exception.
+*> MAXC2NRMK is set to NaN.
+*> RELMAXC2NRMK is set to NaN.
+*> TAU(KB+1:min(M,N)) is not set and contains undefined
+*> elements. If j_1=KB+1, TAU(KB+1)
+*> may contain NaN.
+*> 3) If INFO = j_2, where N+1 <= j_2 <= 2*N, then no NaN
+*> was detected, but +Inf (or -Inf) was detected and
+*> the routine continues the computation until completion.
+*> The (j_2-N)-th column of the matrix A contains the first
+*> occurrence of +Inf (or -Inf) in the actorization
+*> step KB+1 ( when KB columns have been factorized ).
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \ingroup laqp3rk
+*
+*> \par References:
+* ================
+*> [1] A Level 3 BLAS QR factorization algorithm with column pivoting developed in 1996.
+*> G. Quintana-Orti, Depto. de Informatica, Universidad Jaime I, Spain.
+*> X. Sun, Computer Science Dept., Duke University, USA.
+*> C. H. Bischof, Math. and Comp. Sci. Div., Argonne National Lab, USA.
+*> A BLAS-3 version of the QR factorization with column pivoting.
+*> LAPACK Working Note 114
+*> \htmlonly
+*> https://www.netlib.org/lapack/lawnspdf/lawn114.pdf
+*> \endhtmlonly
+*> and in
+*> SIAM J. Sci. Comput., 19(5):1486-1494, Sept. 1998.
+*> \htmlonly
+*> https://doi.org/10.1137/S1064827595296732
+*> \endhtmlonly
+*>
+*> [2] A partial column norm updating strategy developed in 2006.
+*> Z. Drmac and Z. Bujanovic, Dept. of Math., University of Zagreb, Croatia.
+*> On the failure of rank revealing QR factorization software – a case study.
+*> LAPACK Working Note 176.
+*> \htmlonly
+*> http://www.netlib.org/lapack/lawnspdf/lawn176.pdf
+*> \endhtmlonly
+*> and in
+*> ACM Trans. Math. Softw. 35, 2, Article 12 (July 2008), 28 pages.
+*> \htmlonly
+*> https://doi.org/10.1145/1377612.1377616
+*> \endhtmlonly
+*
+*> \par Contributors:
+* ==================
+*>
+*> \verbatim
+*>
+*> November 2023, Igor Kozachenko, James Demmel,
+*> Computer Science Division,
+*> University of California, Berkeley
+*>
+*> \endverbatim
+*
+* =====================================================================
+ SUBROUTINE DLAQP3RK( M, N, NRHS, IOFFSET, NB, ABSTOL,
+ $ RELTOL, KP1, MAXC2NRM, A, LDA, DONE, KB,
+ $ MAXC2NRMK, RELMAXC2NRMK, JPIV, TAU,
+ $ VN1, VN2, AUXV, F, LDF, IWORK, INFO )
+ IMPLICIT NONE
+*
+* -- LAPACK auxiliary routine --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*
+* .. Scalar Arguments ..
+ LOGICAL DONE
+ INTEGER INFO, IOFFSET, KB, KP1, LDA, LDF, M, N,
+ $ NB, NRHS
+ DOUBLE PRECISION ABSTOL, MAXC2NRM, MAXC2NRMK, RELMAXC2NRMK,
+ $ RELTOL
+* ..
+* .. Array Arguments ..
+ INTEGER IWORK( * ), JPIV( * )
+ DOUBLE PRECISION A( LDA, * ), AUXV( * ), F( LDF, * ), TAU( * ),
+ $ VN1( * ), VN2( * )
+* ..
+*
+* =====================================================================
+*
+* .. Parameters ..
+ DOUBLE PRECISION ZERO, ONE
+ PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
+* ..
+* .. Local Scalars ..
+ INTEGER ITEMP, J, K, MINMNFACT, MINMNUPDT,
+ $ LSTICC, KP, I, IF
+ DOUBLE PRECISION AIK, HUGEVAL, TEMP, TEMP2, TOL3Z
+* ..
+* .. External Subroutines ..
+ EXTERNAL DGEMM, DGEMV, DLARFG, DSWAP
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC ABS, MAX, MIN, SQRT
+* ..
+* .. External Functions ..
+ LOGICAL DISNAN
+ INTEGER IDAMAX
+ DOUBLE PRECISION DLAMCH, DNRM2
+ EXTERNAL DISNAN, DLAMCH, IDAMAX, DNRM2
+* ..
+* .. Executable Statements ..
+*
+* Initialize INFO
+*
+ INFO = 0
+*
+* MINMNFACT in the smallest dimension of the submatrix
+* A(IOFFSET+1:M,1:N) to be factorized.
+*
+ MINMNFACT = MIN( M-IOFFSET, N )
+ MINMNUPDT = MIN( M-IOFFSET, N+NRHS )
+ NB = MIN( NB, MINMNFACT )
+ TOL3Z = SQRT( DLAMCH( 'Epsilon' ) )
+ HUGEVAL = DLAMCH( 'Overflow' )
+*
+* Compute factorization in a while loop over NB columns,
+* K is the column index in the block A(1:M,1:N).
+*
+ K = 0
+ LSTICC = 0
+ DONE = .FALSE.
+*
+ DO WHILE ( K.LT.NB .AND. LSTICC.EQ.0 )
+ K = K + 1
+ I = IOFFSET + K
+*
+ IF( I.EQ.1 ) THEN
+*
+* We are at the first column of the original whole matrix A_orig,
+* therefore we use the computed KP1 and MAXC2NRM from the
+* main routine.
+*
+ KP = KP1
+*
+ ELSE
+*
+* Determine the pivot column in K-th step, i.e. the index
+* of the column with the maximum 2-norm in the
+* submatrix A(I:M,K:N).
+*
+ KP = ( K-1 ) + IDAMAX( N-K+1, VN1( K ), 1 )
+*
+* Determine the maximum column 2-norm and the relative maximum
+* column 2-norm of the submatrix A(I:M,K:N) in step K.
+*
+ MAXC2NRMK = VN1( KP )
+*
+* ============================================================
+*
+* Check if the submatrix A(I:M,K:N) contains NaN, set
+* INFO parameter to the column number, where the first NaN
+* is found and return from the routine.
+* We need to check the condition only if the
+* column index (same as row index) of the original whole
+* matrix is larger than 1, since the condition for whole
+* original matrix is checked in the main routine.
+*
+ IF( DISNAN( MAXC2NRMK ) ) THEN
+*
+ DONE = .TRUE.
+*
+* Set KB, the number of factorized partial columns
+* that are non-zero in each step in the block,
+* i.e. the rank of the factor R.
+* Set IF, the number of processed rows in the block, which
+* is the same as the number of processed rows in
+* the original whole matrix A_orig.
+*
+ KB = K - 1
+ IF = I - 1
+ INFO = KB + KP
+*
+* Set RELMAXC2NRMK to NaN.
+*
+ RELMAXC2NRMK = MAXC2NRMK
+*
+* There is no need to apply the block reflector to the
+* residual of the matrix A stored in A(KB+1:M,KB+1:N),
+* since the submatrix contains NaN and we stop
+* the computation.
+* But, we need to apply the block reflector to the residual
+* right hand sides stored in A(KB+1:M,N+1:N+NRHS), if the
+* residual right hand sides exist. This occurs
+* when ( NRHS != 0 AND KB <= (M-IOFFSET) ):
+*
+* A(I+1:M,N+1:N+NRHS) := A(I+1:M,N+1:N+NRHS) -
+* A(I+1:M,1:KB) * F(N+1:N+NRHS,1:KB)**T.
+
+ IF( NRHS.GT.0 .AND. KB.LT.(M-IOFFSET) ) THEN
+ CALL DGEMM( 'No transpose', 'Transpose',
+ $ M-IF, NRHS, KB, -ONE, A( IF+1, 1 ), LDA,
+ $ F( N+1, 1 ), LDF, ONE, A( IF+1, N+1 ), LDA )
+ END IF
+*
+* There is no need to recompute the 2-norm of the
+* difficult columns, since we stop the factorization.
+*
+* Array TAU(KF+1:MINMNFACT) is not set and contains
+* undefined elements.
+*
+* Return from the routine.
+*
+ RETURN
+ END IF
+*
+* Quick return, if the submatrix A(I:M,K:N) is
+* a zero matrix. We need to check it only if the column index
+* (same as row index) is larger than 1, since the condition
+* for the whole original matrix A_orig is checked in the main
+* routine.
+*
+ IF( MAXC2NRMK.EQ.ZERO ) THEN
+*
+ DONE = .TRUE.
+*
+* Set KB, the number of factorized partial columns
+* that are non-zero in each step in the block,
+* i.e. the rank of the factor R.
+* Set IF, the number of processed rows in the block, which
+* is the same as the number of processed rows in
+* the original whole matrix A_orig.
+*
+ KB = K - 1
+ IF = I - 1
+ RELMAXC2NRMK = ZERO
+*
+* There is no need to apply the block reflector to the
+* residual of the matrix A stored in A(KB+1:M,KB+1:N),
+* since the submatrix is zero and we stop the computation.
+* But, we need to apply the block reflector to the residual
+* right hand sides stored in A(KB+1:M,N+1:N+NRHS), if the
+* residual right hand sides exist. This occurs
+* when ( NRHS != 0 AND KB <= (M-IOFFSET) ):
+*
+* A(I+1:M,N+1:N+NRHS) := A(I+1:M,N+1:N+NRHS) -
+* A(I+1:M,1:KB) * F(N+1:N+NRHS,1:KB)**T.
+*
+ IF( NRHS.GT.0 .AND. KB.LT.(M-IOFFSET) ) THEN
+ CALL DGEMM( 'No transpose', 'Transpose',
+ $ M-IF, NRHS, KB, -ONE, A( IF+1, 1 ), LDA,
+ $ F( N+1, 1 ), LDF, ONE, A( IF+1, N+1 ), LDA )
+ END IF
+*
+* There is no need to recompute the 2-norm of the
+* difficult columns, since we stop the factorization.
+*
+* Set TAUs corresponding to the columns that were not
+* factorized to ZERO, i.e. set TAU(KB+1:MINMNFACT) = ZERO,
+* which is equivalent to seting TAU(K:MINMNFACT) = ZERO.
+*
+ DO J = K, MINMNFACT
+ TAU( J ) = ZERO
+ END DO
+*
+* Return from the routine.
+*
+ RETURN
+*
+ END IF
+*
+* ============================================================
+*
+* Check if the submatrix A(I:M,K:N) contains Inf,
+* set INFO parameter to the column number, where
+* the first Inf is found plus N, and continue
+* the computation.
+* We need to check the condition only if the
+* column index (same as row index) of the original whole
+* matrix is larger than 1, since the condition for whole
+* original matrix is checked in the main routine.
+*
+ IF( INFO.EQ.0 .AND. MAXC2NRMK.GT.HUGEVAL ) THEN
+ INFO = N + K - 1 + KP
+ END IF
+*
+* ============================================================
+*
+* Test for the second and third tolerance stopping criteria.
+* NOTE: There is no need to test for ABSTOL.GE.ZERO, since
+* MAXC2NRMK is non-negative. Similarly, there is no need
+* to test for RELTOL.GE.ZERO, since RELMAXC2NRMK is
+* non-negative.
+* We need to check the condition only if the
+* column index (same as row index) of the original whole
+* matrix is larger than 1, since the condition for whole
+* original matrix is checked in the main routine.
+*
+ RELMAXC2NRMK = MAXC2NRMK / MAXC2NRM
+*
+ IF( MAXC2NRMK.LE.ABSTOL .OR. RELMAXC2NRMK.LE.RELTOL ) THEN
+*
+ DONE = .TRUE.
+*
+* Set KB, the number of factorized partial columns
+* that are non-zero in each step in the block,
+* i.e. the rank of the factor R.
+* Set IF, the number of processed rows in the block, which
+* is the same as the number of processed rows in
+* the original whole matrix A_orig;
+*
+ KB = K - 1
+ IF = I - 1
+*
+* Apply the block reflector to the residual of the
+* matrix A and the residual of the right hand sides B, if
+* the residual matrix and and/or the residual of the right
+* hand sides exist, i.e. if the submatrix
+* A(I+1:M,KB+1:N+NRHS) exists. This occurs when
+* KB < MINMNUPDT = min( M-IOFFSET, N+NRHS ):
+*
+* A(IF+1:M,K+1:N+NRHS) := A(IF+1:M,KB+1:N+NRHS) -
+* A(IF+1:M,1:KB) * F(KB+1:N+NRHS,1:KB)**T.
+*
+ IF( KB.LT.MINMNUPDT ) THEN
+ CALL DGEMM( 'No transpose', 'Transpose',
+ $ M-IF, N+NRHS-KB, KB,-ONE, A( IF+1, 1 ), LDA,
+ $ F( KB+1, 1 ), LDF, ONE, A( IF+1, KB+1 ), LDA )
+ END IF
+*
+* There is no need to recompute the 2-norm of the
+* difficult columns, since we stop the factorization.
+*
+* Set TAUs corresponding to the columns that were not
+* factorized to ZERO, i.e. set TAU(KB+1:MINMNFACT) = ZERO,
+* which is equivalent to seting TAU(K:MINMNFACT) = ZERO.
+*
+ DO J = K, MINMNFACT
+ TAU( J ) = ZERO
+ END DO
+*
+* Return from the routine.
+*
+ RETURN
+*
+ END IF
+*
+* ============================================================
+*
+* End ELSE of IF(I.EQ.1)
+*
+ END IF
+*
+* ===============================================================
+*
+* If the pivot column is not the first column of the
+* subblock A(1:M,K:N):
+* 1) swap the K-th column and the KP-th pivot column
+* in A(1:M,1:N);
+* 2) swap the K-th row and the KP-th row in F(1:N,1:K-1)
+* 3) copy the K-th element into the KP-th element of the partial
+* and exact 2-norm vectors VN1 and VN2. (Swap is not needed
+* for VN1 and VN2 since we use the element with the index
+* larger than K in the next loop step.)
+* 4) Save the pivot interchange with the indices relative to the
+* the original matrix A_orig, not the block A(1:M,1:N).
+*
+ IF( KP.NE.K ) THEN
+ CALL DSWAP( M, A( 1, KP ), 1, A( 1, K ), 1 )
+ CALL DSWAP( K-1, F( KP, 1 ), LDF, F( K, 1 ), LDF )
+ VN1( KP ) = VN1( K )
+ VN2( KP ) = VN2( K )
+ ITEMP = JPIV( KP )
+ JPIV( KP ) = JPIV( K )
+ JPIV( K ) = ITEMP
+ END IF
+*
+* Apply previous Householder reflectors to column K:
+* A(I:M,K) := A(I:M,K) - A(I:M,1:K-1)*F(K,1:K-1)**T.
+*
+ IF( K.GT.1 ) THEN
+ CALL DGEMV( 'No transpose', M-I+1, K-1, -ONE, A( I, 1 ),
+ $ LDA, F( K, 1 ), LDF, ONE, A( I, K ), 1 )
+ END IF
+*
+* Generate elementary reflector H(k) using the column A(I:M,K).
+*
+ IF( I.LT.M ) THEN
+ CALL DLARFG( M-I+1, A( I, K ), A( I+1, K ), 1, TAU( K ) )
+ ELSE
+ TAU( K ) = ZERO
+ END IF
+*
+* Check if TAU(K) contains NaN, set INFO parameter
+* to the column number where NaN is found and return from
+* the routine.
+* NOTE: There is no need to check TAU(K) for Inf,
+* since DLARFG cannot produce TAU(K) or Householder vector
+* below the diagonal containing Inf. Only BETA on the diagonal,
+* returned by DLARFG can contain Inf, which requires
+* TAU(K) to contain NaN. Therefore, this case of generating Inf
+* by DLARFG is covered by checking TAU(K) for NaN.
+*
+ IF( DISNAN( TAU(K) ) ) THEN
+*
+ DONE = .TRUE.
+*
+* Set KB, the number of factorized partial columns
+* that are non-zero in each step in the block,
+* i.e. the rank of the factor R.
+* Set IF, the number of processed rows in the block, which
+* is the same as the number of processed rows in
+* the original whole matrix A_orig.
+*
+ KB = K - 1
+ IF = I - 1
+ INFO = K
+*
+* Set MAXC2NRMK and RELMAXC2NRMK to NaN.
+*
+ MAXC2NRMK = TAU( K )
+ RELMAXC2NRMK = TAU( K )
+*
+* There is no need to apply the block reflector to the
+* residual of the matrix A stored in A(KB+1:M,KB+1:N),
+* since the submatrix contains NaN and we stop
+* the computation.
+* But, we need to apply the block reflector to the residual
+* right hand sides stored in A(KB+1:M,N+1:N+NRHS), if the
+* residual right hand sides exist. This occurs
+* when ( NRHS != 0 AND KB <= (M-IOFFSET) ):
+*
+* A(I+1:M,N+1:N+NRHS) := A(I+1:M,N+1:N+NRHS) -
+* A(I+1:M,1:KB) * F(N+1:N+NRHS,1:KB)**T.
+*
+ IF( NRHS.GT.0 .AND. KB.LT.(M-IOFFSET) ) THEN
+ CALL DGEMM( 'No transpose', 'Transpose',
+ $ M-IF, NRHS, KB, -ONE, A( IF+1, 1 ), LDA,
+ $ F( N+1, 1 ), LDF, ONE, A( IF+1, N+1 ), LDA )
+ END IF
+*
+* There is no need to recompute the 2-norm of the
+* difficult columns, since we stop the factorization.
+*
+* Array TAU(KF+1:MINMNFACT) is not set and contains
+* undefined elements.
+*
+* Return from the routine.
+*
+ RETURN
+ END IF
+*
+* ===============================================================
+*
+ AIK = A( I, K )
+ A( I, K ) = ONE
+*
+* ===============================================================
+*
+* Compute the current K-th column of F:
+* 1) F(K+1:N,K) := tau(K) * A(I:M,K+1:N)**T * A(I:M,K).
+*
+ IF( K.LT.N+NRHS ) THEN
+ CALL DGEMV( 'Transpose', M-I+1, N+NRHS-K,
+ $ TAU( K ), A( I, K+1 ), LDA, A( I, K ), 1,
+ $ ZERO, F( K+1, K ), 1 )
+ END IF
+*
+* 2) Zero out elements above and on the diagonal of the
+* column K in matrix F, i.e elements F(1:K,K).
+*
+ DO J = 1, K
+ F( J, K ) = ZERO
+ END DO
+*
+* 3) Incremental updating of the K-th column of F:
+* F(1:N,K) := F(1:N,K) - tau(K) * F(1:N,1:K-1) * A(I:M,1:K-1)**T
+* * A(I:M,K).
+*
+ IF( K.GT.1 ) THEN
+ CALL DGEMV( 'Transpose', M-I+1, K-1, -TAU( K ),
+ $ A( I, 1 ), LDA, A( I, K ), 1, ZERO,
+ $ AUXV( 1 ), 1 )
+*
+ CALL DGEMV( 'No transpose', N+NRHS, K-1, ONE,
+ $ F( 1, 1 ), LDF, AUXV( 1 ), 1, ONE,
+ $ F( 1, K ), 1 )
+ END IF
+*
+* ===============================================================
+*
+* Update the current I-th row of A:
+* A(I,K+1:N+NRHS) := A(I,K+1:N+NRHS)
+* - A(I,1:K)*F(K+1:N+NRHS,1:K)**T.
+*
+ IF( K.LT.N+NRHS ) THEN
+ CALL DGEMV( 'No transpose', N+NRHS-K, K, -ONE,
+ $ F( K+1, 1 ), LDF, A( I, 1 ), LDA, ONE,
+ $ A( I, K+1 ), LDA )
+ END IF
+*
+ A( I, K ) = AIK
+*
+* Update the partial column 2-norms for the residual matrix,
+* only if the residual matrix A(I+1:M,K+1:N) exists, i.e.
+* when K < MINMNFACT = min( M-IOFFSET, N ).
+*
+ IF( K.LT.MINMNFACT ) THEN
+*
+ DO J = K + 1, N
+ IF( VN1( J ).NE.ZERO ) THEN
+*
+* NOTE: The following lines follow from the analysis in
+* Lapack Working Note 176.
+*
+ TEMP = ABS( A( I, J ) ) / VN1( J )
+ TEMP = MAX( ZERO, ( ONE+TEMP )*( ONE-TEMP ) )
+ TEMP2 = TEMP*( VN1( J ) / VN2( J ) )**2
+ IF( TEMP2.LE.TOL3Z ) THEN
+*
+* At J-index, we have a difficult column for the
+* update of the 2-norm. Save the index of the previous
+* difficult column in IWORK(J-1).
+* NOTE: ILSTCC > 1, threfore we can use IWORK only
+* with N-1 elements, where the elements are
+* shifted by 1 to the left.
+*
+ IWORK( J-1 ) = LSTICC
+*
+* Set the index of the last difficult column LSTICC.
+*
+ LSTICC = J
+*
+ ELSE
+ VN1( J ) = VN1( J )*SQRT( TEMP )
+ END IF
+ END IF
+ END DO
+*
+ END IF
+*
+* End of while loop.
+*
+ END DO
+*
+* Now, afler the loop:
+* Set KB, the number of factorized columns in the block;
+* Set IF, the number of processed rows in the block, which
+* is the same as the number of processed rows in
+* the original whole matrix A_orig, IF = IOFFSET + KB.
+*
+ KB = K
+ IF = I
+*
+* Apply the block reflector to the residual of the matrix A
+* and the residual of the right hand sides B, if the residual
+* matrix and and/or the residual of the right hand sides
+* exist, i.e. if the submatrix A(I+1:M,KB+1:N+NRHS) exists.
+* This occurs when KB < MINMNUPDT = min( M-IOFFSET, N+NRHS ):
+*
+* A(IF+1:M,K+1:N+NRHS) := A(IF+1:M,KB+1:N+NRHS) -
+* A(IF+1:M,1:KB) * F(KB+1:N+NRHS,1:KB)**T.
+*
+ IF( KB.LT.MINMNUPDT ) THEN
+ CALL DGEMM( 'No transpose', 'Transpose',
+ $ M-IF, N+NRHS-KB, KB, -ONE, A( IF+1, 1 ), LDA,
+ $ F( KB+1, 1 ), LDF, ONE, A( IF+1, KB+1 ), LDA )
+ END IF
+*
+* Recompute the 2-norm of the difficult columns.
+* Loop over the index of the difficult columns from the largest
+* to the smallest index.
+*
+ DO WHILE( LSTICC.GT.0 )
+*
+* LSTICC is the index of the last difficult column is greater
+* than 1.
+* ITEMP is the index of the previous difficult column.
+*
+ ITEMP = IWORK( LSTICC-1 )
+*
+* Compute the 2-norm explicilty for the last difficult column and
+* save it in the partial and exact 2-norm vectors VN1 and VN2.
+*
+* NOTE: The computation of VN1( LSTICC ) relies on the fact that
+* DNRM2 does not fail on vectors with norm below the value of
+* SQRT(DLAMCH('S'))
+*
+ VN1( LSTICC ) = DNRM2( M-IF, A( IF+1, LSTICC ), 1 )
+ VN2( LSTICC ) = VN1( LSTICC )
+*
+* Downdate the index of the last difficult column to
+* the index of the previous difficult column.
+*
+ LSTICC = ITEMP
+*
+ END DO
+*
+ RETURN
+*
+* End of DLAQP3RK
+*
+ END
diff --git a/lapack-netlib/SRC/ilaenv.f b/lapack-netlib/SRC/ilaenv.f
index a639e0375..e74a2b35e 100644
--- a/lapack-netlib/SRC/ilaenv.f
+++ b/lapack-netlib/SRC/ilaenv.f
@@ -132,7 +132,7 @@
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
-*> \ingroup OTHERauxiliary
+*> \ingroup ilaenv
*
*> \par Further Details:
* =====================
@@ -355,6 +355,12 @@
ELSE
NB = 64
END IF
+ ELSE IF( SUBNAM( 4: 7 ).EQ.'QP3RK' ) THEN
+ IF( SNAME ) THEN
+ NB = 32
+ ELSE
+ NB = 32
+ END IF
END IF
ELSE IF( C2.EQ.'PO' ) THEN
IF( C3.EQ.'TRF' ) THEN
@@ -541,7 +547,14 @@
ELSE
NBMIN = 2
END IF
+ ELSE IF( SUBNAM( 4: 7 ).EQ.'QP3RK' ) THEN
+ IF( SNAME ) THEN
+ NBMIN = 2
+ ELSE
+ NBMIN = 2
+ END IF
END IF
+
ELSE IF( C2.EQ.'SY' ) THEN
IF( C3.EQ.'TRF' ) THEN
IF( SNAME ) THEN
@@ -618,6 +631,12 @@
ELSE
NX = 128
END IF
+ ELSE IF( SUBNAM( 4: 7 ).EQ.'QP3RK' ) THEN
+ IF( SNAME ) THEN
+ NX = 128
+ ELSE
+ NX = 128
+ END IF
END IF
ELSE IF( C2.EQ.'SY' ) THEN
IF( SNAME .AND. C3.EQ.'TRD' ) THEN
diff --git a/lapack-netlib/SRC/sgeqp3rk.f b/lapack-netlib/SRC/sgeqp3rk.f
new file mode 100644
index 000000000..17559c7f4
--- /dev/null
+++ b/lapack-netlib/SRC/sgeqp3rk.f
@@ -0,0 +1,1081 @@
+*> \brief \b SGEQP3RK computes a truncated Householder QR factorization with column pivoting of a real m-by-n matrix A by using Level 3 BLAS and overwrites a real m-by-nrhs matrix B with Q**T * B.
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download SGEQP3RK + dependencies
+*>
+*> [TGZ]
+*>
+*> [ZIP]
+*>
+*> [TXT]
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE SGEQP3RK( M, N, NRHS, KMAX, ABSTOL, RELTOL, A, LDA,
+* $ K, MAXC2NRMK, RELMAXC2NRMK, JPIV, TAU,
+* $ WORK, LWORK, IWORK, INFO )
+* IMPLICIT NONE
+*
+* .. Scalar Arguments ..
+* INTEGER INFO, K, KMAX, LDA, LWORK, M, N, NRHS
+* REAL ABSTOL, MAXC2NRMK, RELMAXC2NRMK, RELTOL
+* ..
+* .. Array Arguments ..
+* INTEGER IWORK( * ), JPIV( * )
+* REAL A( LDA, * ), TAU( * ), WORK( * )
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> SGEQP3RK performs two tasks simultaneously:
+*>
+*> Task 1: The routine computes a truncated (rank K) or full rank
+*> Householder QR factorization with column pivoting of a real
+*> M-by-N matrix A using Level 3 BLAS. K is the number of columns
+*> that were factorized, i.e. factorization rank of the
+*> factor R, K <= min(M,N).
+*>
+*> A * P(K) = Q(K) * R(K) =
+*>
+*> = Q(K) * ( R11(K) R12(K) ) = Q(K) * ( R(K)_approx )
+*> ( 0 R22(K) ) ( 0 R(K)_residual ),
+*>
+*> where:
+*>
+*> P(K) is an N-by-N permutation matrix;
+*> Q(K) is an M-by-M orthogonal matrix;
+*> R(K)_approx = ( R11(K), R12(K) ) is a rank K approximation of the
+*> full rank factor R with K-by-K upper-triangular
+*> R11(K) and K-by-N rectangular R12(K). The diagonal
+*> entries of R11(K) appear in non-increasing order
+*> of absolute value, and absolute values of all of
+*> them exceed the maximum column 2-norm of R22(K)
+*> up to roundoff error.
+*> R(K)_residual = R22(K) is the residual of a rank K approximation
+*> of the full rank factor R. It is a
+*> an (M-K)-by-(N-K) rectangular matrix;
+*> 0 is a an (M-K)-by-K zero matrix.
+*>
+*> Task 2: At the same time, the routine overwrites a real M-by-NRHS
+*> matrix B with Q(K)**T * B using Level 3 BLAS.
+*>
+*> =====================================================================
+*>
+*> The matrices A and B are stored on input in the array A as
+*> the left and right blocks A(1:M,1:N) and A(1:M, N+1:N+NRHS)
+*> respectively.
+*>
+*> N NRHS
+*> array_A = M [ mat_A, mat_B ]
+*>
+*> The truncation criteria (i.e. when to stop the factorization)
+*> can be any of the following:
+*>
+*> 1) The input parameter KMAX, the maximum number of columns
+*> KMAX to factorize, i.e. the factorization rank is limited
+*> to KMAX. If KMAX >= min(M,N), the criterion is not used.
+*>
+*> 2) The input parameter ABSTOL, the absolute tolerance for
+*> the maximum column 2-norm of the residual matrix R22(K). This
+*> means that the factorization stops if this norm is less or
+*> equal to ABSTOL. If ABSTOL < 0.0, the criterion is not used.
+*>
+*> 3) The input parameter RELTOL, the tolerance for the maximum
+*> column 2-norm matrix of the residual matrix R22(K) divided
+*> by the maximum column 2-norm of the original matrix A, which
+*> is equal to abs(R(1,1)). This means that the factorization stops
+*> when the ratio of the maximum column 2-norm of R22(K) to
+*> the maximum column 2-norm of A is less than or equal to RELTOL.
+*> If RELTOL < 0.0, the criterion is not used.
+*>
+*> 4) In case both stopping criteria ABSTOL or RELTOL are not used,
+*> and when the residual matrix R22(K) is a zero matrix in some
+*> factorization step K. ( This stopping criterion is implicit. )
+*>
+*> The algorithm stops when any of these conditions is first
+*> satisfied, otherwise the whole matrix A is factorized.
+*>
+*> To factorize the whole matrix A, use the values
+*> KMAX >= min(M,N), ABSTOL < 0.0 and RELTOL < 0.0.
+*>
+*> The routine returns:
+*> a) Q(K), R(K)_approx = ( R11(K), R12(K) ),
+*> R(K)_residual = R22(K), P(K), i.e. the resulting matrices
+*> of the factorization; P(K) is represented by JPIV,
+*> ( if K = min(M,N), R(K)_approx is the full factor R,
+*> and there is no residual matrix R(K)_residual);
+*> b) K, the number of columns that were factorized,
+*> i.e. factorization rank;
+*> c) MAXC2NRMK, the maximum column 2-norm of the residual
+*> matrix R(K)_residual = R22(K),
+*> ( if K = min(M,N), MAXC2NRMK = 0.0 );
+*> d) RELMAXC2NRMK equals MAXC2NRMK divided by MAXC2NRM, the maximum
+*> column 2-norm of the original matrix A, which is equal
+*> to abs(R(1,1)), ( if K = min(M,N), RELMAXC2NRMK = 0.0 );
+*> e) Q(K)**T * B, the matrix B with the orthogonal
+*> transformation Q(K)**T applied on the left.
+*>
+*> The N-by-N permutation matrix P(K) is stored in a compact form in
+*> the integer array JPIV. For 1 <= j <= N, column j
+*> of the matrix A was interchanged with column JPIV(j).
+*>
+*> The M-by-M orthogonal matrix Q is represented as a product
+*> of elementary Householder reflectors
+*>
+*> Q(K) = H(1) * H(2) * . . . * H(K),
+*>
+*> where K is the number of columns that were factorized.
+*>
+*> Each H(j) has the form
+*>
+*> H(j) = I - tau * v * v**T,
+*>
+*> where 1 <= j <= K and
+*> I is an M-by-M identity matrix,
+*> tau is a real scalar,
+*> v is a real vector with v(1:j-1) = 0 and v(j) = 1.
+*>
+*> v(j+1:M) is stored on exit in A(j+1:M,j) and tau in TAU(j).
+*>
+*> See the Further Details section for more information.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] M
+*> \verbatim
+*> M is INTEGER
+*> The number of rows of the matrix A. M >= 0.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> The number of columns of the matrix A. N >= 0.
+*> \endverbatim
+*>
+*> \param[in] NRHS
+*> \verbatim
+*> NRHS is INTEGER
+*> The number of right hand sides, i.e. the number of
+*> columns of the matrix B. NRHS >= 0.
+*> \endverbatim
+*>
+*> \param[in] KMAX
+*> \verbatim
+*> KMAX is INTEGER
+*>
+*> The first factorization stopping criterion. KMAX >= 0.
+*>
+*> The maximum number of columns of the matrix A to factorize,
+*> i.e. the maximum factorization rank.
+*>
+*> a) If KMAX >= min(M,N), then this stopping criterion
+*> is not used, the routine factorizes columns
+*> depending on ABSTOL and RELTOL.
+*>
+*> b) If KMAX = 0, then this stopping criterion is
+*> satisfied on input and the routine exits immediately.
+*> This means that the factorization is not performed,
+*> the matrices A and B are not modified, and
+*> the matrix A is itself the residual.
+*> \endverbatim
+*>
+*> \param[in] ABSTOL
+*> \verbatim
+*> ABSTOL is REAL
+*>
+*> The second factorization stopping criterion, cannot be NaN.
+*>
+*> The absolute tolerance (stopping threshold) for
+*> maximum column 2-norm of the residual matrix R22(K).
+*> The algorithm converges (stops the factorization) when
+*> the maximum column 2-norm of the residual matrix R22(K)
+*> is less than or equal to ABSTOL. Let SAFMIN = SLAMCH('S').
+*>
+*> a) If ABSTOL is NaN, then no computation is performed
+*> and an error message ( INFO = -5 ) is issued
+*> by XERBLA.
+*>
+*> b) If ABSTOL < 0.0, then this stopping criterion is not
+*> used, the routine factorizes columns depending
+*> on KMAX and RELTOL.
+*> This includes the case ABSTOL = -Inf.
+*>
+*> c) If 0.0 <= ABSTOL < 2*SAFMIN, then ABSTOL = 2*SAFMIN
+*> is used. This includes the case ABSTOL = -0.0.
+*>
+*> d) If 2*SAFMIN <= ABSTOL then the input value
+*> of ABSTOL is used.
+*>
+*> Let MAXC2NRM be the maximum column 2-norm of the
+*> whole original matrix A.
+*> If ABSTOL chosen above is >= MAXC2NRM, then this
+*> stopping criterion is satisfied on input and routine exits
+*> immediately after MAXC2NRM is computed. The routine
+*> returns MAXC2NRM in MAXC2NORMK,
+*> and 1.0 in RELMAXC2NORMK.
+*> This includes the case ABSTOL = +Inf. This means that the
+*> factorization is not performed, the matrices A and B are not
+*> modified, and the matrix A is itself the residual.
+*> \endverbatim
+*>
+*> \param[in] RELTOL
+*> \verbatim
+*> RELTOL is REAL
+*>
+*> The third factorization stopping criterion, cannot be NaN.
+*>
+*> The tolerance (stopping threshold) for the ratio
+*> abs(R(K+1,K+1))/abs(R(1,1)) of the maximum column 2-norm of
+*> the residual matrix R22(K) to the maximum column 2-norm of
+*> the original matrix A. The algorithm converges (stops the
+*> factorization), when abs(R(K+1,K+1))/abs(R(1,1)) A is less
+*> than or equal to RELTOL. Let EPS = SLAMCH('E').
+*>
+*> a) If RELTOL is NaN, then no computation is performed
+*> and an error message ( INFO = -6 ) is issued
+*> by XERBLA.
+*>
+*> b) If RELTOL < 0.0, then this stopping criterion is not
+*> used, the routine factorizes columns depending
+*> on KMAX and ABSTOL.
+*> This includes the case RELTOL = -Inf.
+*>
+*> c) If 0.0 <= RELTOL < EPS, then RELTOL = EPS is used.
+*> This includes the case RELTOL = -0.0.
+*>
+*> d) If EPS <= RELTOL then the input value of RELTOL
+*> is used.
+*>
+*> Let MAXC2NRM be the maximum column 2-norm of the
+*> whole original matrix A.
+*> If RELTOL chosen above is >= 1.0, then this stopping
+*> criterion is satisfied on input and routine exits
+*> immediately after MAXC2NRM is computed.
+*> The routine returns MAXC2NRM in MAXC2NORMK,
+*> and 1.0 in RELMAXC2NORMK.
+*> This includes the case RELTOL = +Inf. This means that the
+*> factorization is not performed, the matrices A and B are not
+*> modified, and the matrix A is itself the residual.
+*>
+*> NOTE: We recommend that RELTOL satisfy
+*> min( max(M,N)*EPS, sqrt(EPS) ) <= RELTOL
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*> A is REAL array, dimension (LDA,N+NRHS)
+*>
+*> On entry:
+*>
+*> a) The subarray A(1:M,1:N) contains the M-by-N matrix A.
+*> b) The subarray A(1:M,N+1:N+NRHS) contains the M-by-NRHS
+*> matrix B.
+*>
+*> N NRHS
+*> array_A = M [ mat_A, mat_B ]
+*>
+*> On exit:
+*>
+*> a) The subarray A(1:M,1:N) contains parts of the factors
+*> of the matrix A:
+*>
+*> 1) If K = 0, A(1:M,1:N) contains the original matrix A.
+*> 2) If K > 0, A(1:M,1:N) contains parts of the
+*> factors:
+*>
+*> 1. The elements below the diagonal of the subarray
+*> A(1:M,1:K) together with TAU(1:K) represent the
+*> orthogonal matrix Q(K) as a product of K Householder
+*> elementary reflectors.
+*>
+*> 2. The elements on and above the diagonal of
+*> the subarray A(1:K,1:N) contain K-by-N
+*> upper-trapezoidal matrix
+*> R(K)_approx = ( R11(K), R12(K) ).
+*> NOTE: If K=min(M,N), i.e. full rank factorization,
+*> then R_approx(K) is the full factor R which
+*> is upper-trapezoidal. If, in addition, M>=N,
+*> then R is upper-triangular.
+*>
+*> 3. The subarray A(K+1:M,K+1:N) contains (M-K)-by-(N-K)
+*> rectangular matrix R(K)_residual = R22(K).
+*>
+*> b) If NRHS > 0, the subarray A(1:M,N+1:N+NRHS) contains
+*> the M-by-NRHS product Q(K)**T * B.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*> LDA is INTEGER
+*> The leading dimension of the array A. LDA >= max(1,M).
+*> This is the leading dimension for both matrices, A and B.
+*> \endverbatim
+*>
+*> \param[out] K
+*> \verbatim
+*> K is INTEGER
+*> Factorization rank of the matrix A, i.e. the rank of
+*> the factor R, which is the same as the number of non-zero
+*> rows of the factor R. 0 <= K <= min(M,KMAX,N).
+*>
+*> K also represents the number of non-zero Householder
+*> vectors.
+*>
+*> NOTE: If K = 0, a) the arrays A and B are not modified;
+*> b) the array TAU(1:min(M,N)) is set to ZERO,
+*> if the matrix A does not contain NaN,
+*> otherwise the elements TAU(1:min(M,N))
+*> are undefined;
+*> c) the elements of the array JPIV are set
+*> as follows: for j = 1:N, JPIV(j) = j.
+*> \endverbatim
+*>
+*> \param[out] MAXC2NRMK
+*> \verbatim
+*> MAXC2NRMK is REAL
+*> The maximum column 2-norm of the residual matrix R22(K),
+*> when the factorization stopped at rank K. MAXC2NRMK >= 0.
+*>
+*> a) If K = 0, i.e. the factorization was not performed,
+*> the matrix A was not modified and is itself a residual
+*> matrix, then MAXC2NRMK equals the maximum column 2-norm
+*> of the original matrix A.
+*>
+*> b) If 0 < K < min(M,N), then MAXC2NRMK is returned.
+*>
+*> c) If K = min(M,N), i.e. the whole matrix A was
+*> factorized and there is no residual matrix,
+*> then MAXC2NRMK = 0.0.
+*>
+*> NOTE: MAXC2NRMK in the factorization step K would equal
+*> R(K+1,K+1) in the next factorization step K+1.
+*> \endverbatim
+*>
+*> \param[out] RELMAXC2NRMK
+*> \verbatim
+*> RELMAXC2NRMK is REAL
+*> The ratio MAXC2NRMK / MAXC2NRM of the maximum column
+*> 2-norm of the residual matrix R22(K) (when the factorization
+*> stopped at rank K) to the maximum column 2-norm of the
+*> whole original matrix A. RELMAXC2NRMK >= 0.
+*>
+*> a) If K = 0, i.e. the factorization was not performed,
+*> the matrix A was not modified and is itself a residual
+*> matrix, then RELMAXC2NRMK = 1.0.
+*>
+*> b) If 0 < K < min(M,N), then
+*> RELMAXC2NRMK = MAXC2NRMK / MAXC2NRM is returned.
+*>
+*> c) If K = min(M,N), i.e. the whole matrix A was
+*> factorized and there is no residual matrix,
+*> then RELMAXC2NRMK = 0.0.
+*>
+*> NOTE: RELMAXC2NRMK in the factorization step K would equal
+*> abs(R(K+1,K+1))/abs(R(1,1)) in the next factorization
+*> step K+1.
+*> \endverbatim
+*>
+*> \param[out] JPIV
+*> \verbatim
+*> JPIV is INTEGER array, dimension (N)
+*> Column pivot indices. For 1 <= j <= N, column j
+*> of the matrix A was interchanged with column JPIV(j).
+*>
+*> The elements of the array JPIV(1:N) are always set
+*> by the routine, for example, even when no columns
+*> were factorized, i.e. when K = 0, the elements are
+*> set as JPIV(j) = j for j = 1:N.
+*> \endverbatim
+*>
+*> \param[out] TAU
+*> \verbatim
+*> TAU is REAL array, dimension (min(M,N))
+*> The scalar factors of the elementary reflectors.
+*>
+*> If 0 < K <= min(M,N), only the elements TAU(1:K) of
+*> the array TAU are modified by the factorization.
+*> After the factorization computed, if no NaN was found
+*> during the factorization, the remaining elements
+*> TAU(K+1:min(M,N)) are set to zero, otherwise the
+*> elements TAU(K+1:min(M,N)) are not set and therefore
+*> undefined.
+*> ( If K = 0, all elements of TAU are set to zero, if
+*> the matrix A does not contain NaN. )
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*> WORK is REAL array, dimension (MAX(1,LWORK))
+*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*> LWORK is INTEGER
+*> The dimension of the array WORK.
+*. LWORK >= (3*N + NRHS - 1)
+*> For optimal performance LWORK >= (2*N + NB*( N+NRHS+1 )),
+*> where NB is the optimal block size for SGEQP3RK returned
+*> by ILAENV. Minimal block size MINNB=2.
+*>
+*> NOTE: The decision, whether to use unblocked BLAS 2
+*> or blocked BLAS 3 code is based not only on the dimension
+*> LWORK of the availbale workspace WORK, but also also on the
+*> matrix A dimension N via crossover point NX returned
+*> by ILAENV. (For N less than NX, unblocked code should be
+*> used.)
+*>
+*> If LWORK = -1, then a workspace query is assumed;
+*> the routine only calculates the optimal size of the WORK
+*> array, returns this value as the first entry of the WORK
+*> array, and no error message related to LWORK is issued
+*> by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] IWORK
+*> \verbatim
+*> IWORK is INTEGER array, dimension (N-1).
+*> Is a work array. ( IWORK is used to store indices
+*> of "bad" columns for norm downdating in the residual
+*> matrix in the blocked step auxiliary subroutine SLAQP3RK ).
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*> INFO is INTEGER
+*> 1) INFO = 0: successful exit.
+*> 2) INFO < 0: if INFO = -i, the i-th argument had an
+*> illegal value.
+*> 3) If INFO = j_1, where 1 <= j_1 <= N, then NaN was
+*> detected and the routine stops the computation.
+*> The j_1-th column of the matrix A or the j_1-th
+*> element of array TAU contains the first occurrence
+*> of NaN in the factorization step K+1 ( when K columns
+*> have been factorized ).
+*>
+*> On exit:
+*> K is set to the number of
+*> factorized columns without
+*> exception.
+*> MAXC2NRMK is set to NaN.
+*> RELMAXC2NRMK is set to NaN.
+*> TAU(K+1:min(M,N)) is not set and contains undefined
+*> elements. If j_1=K+1, TAU(K+1)
+*> may contain NaN.
+*> 4) If INFO = j_2, where N+1 <= j_2 <= 2*N, then no NaN
+*> was detected, but +Inf (or -Inf) was detected and
+*> the routine continues the computation until completion.
+*> The (j_2-N)-th column of the matrix A contains the first
+*> occurrence of +Inf (or -Inf) in the factorization
+*> step K+1 ( when K columns have been factorized ).
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \ingroup geqp3rk
+*
+*> \par Further Details:
+* =====================
+*
+*> \verbatim
+*> SGEQP3RK is based on the same BLAS3 Householder QR factorization
+*> algorithm with column pivoting as in SGEQP3 routine which uses
+*> SLARFG routine to generate Householder reflectors
+*> for QR factorization.
+*>
+*> We can also write:
+*>
+*> A = A_approx(K) + A_residual(K)
+*>
+*> The low rank approximation matrix A(K)_approx from
+*> the truncated QR factorization of rank K of the matrix A is:
+*>
+*> A(K)_approx = Q(K) * ( R(K)_approx ) * P(K)**T
+*> ( 0 0 )
+*>
+*> = Q(K) * ( R11(K) R12(K) ) * P(K)**T
+*> ( 0 0 )
+*>
+*> The residual A_residual(K) of the matrix A is:
+*>
+*> A_residual(K) = Q(K) * ( 0 0 ) * P(K)**T =
+*> ( 0 R(K)_residual )
+*>
+*> = Q(K) * ( 0 0 ) * P(K)**T
+*> ( 0 R22(K) )
+*>
+*> The truncated (rank K) factorization guarantees that
+*> the maximum column 2-norm of A_residual(K) is less than
+*> or equal to MAXC2NRMK up to roundoff error.
+*>
+*> NOTE: An approximation of the null vectors
+*> of A can be easily computed from R11(K)
+*> and R12(K):
+*>
+*> Null( A(K) )_approx = P * ( inv(R11(K)) * R12(K) )
+*> ( -I )
+*>
+*> \endverbatim
+*
+*> \par References:
+* ================
+*> [1] A Level 3 BLAS QR factorization algorithm with column pivoting developed in 1996.
+*> G. Quintana-Orti, Depto. de Informatica, Universidad Jaime I, Spain.
+*> X. Sun, Computer Science Dept., Duke University, USA.
+*> C. H. Bischof, Math. and Comp. Sci. Div., Argonne National Lab, USA.
+*> A BLAS-3 version of the QR factorization with column pivoting.
+*> LAPACK Working Note 114
+*> \htmlonly
+*> https://www.netlib.org/lapack/lawnspdf/lawn114.pdf
+*> \endhtmlonly
+*> and in
+*> SIAM J. Sci. Comput., 19(5):1486-1494, Sept. 1998.
+*> \htmlonly
+*> https://doi.org/10.1137/S1064827595296732
+*> \endhtmlonly
+*>
+*> [2] A partial column norm updating strategy developed in 2006.
+*> Z. Drmac and Z. Bujanovic, Dept. of Math., University of Zagreb, Croatia.
+*> On the failure of rank revealing QR factorization software – a case study.
+*> LAPACK Working Note 176.
+*> \htmlonly
+*> http://www.netlib.org/lapack/lawnspdf/lawn176.pdf
+*> \endhtmlonly
+*> and in
+*> ACM Trans. Math. Softw. 35, 2, Article 12 (July 2008), 28 pages.
+*> \htmlonly
+*> https://doi.org/10.1145/1377612.1377616
+*> \endhtmlonly
+*
+*> \par Contributors:
+* ==================
+*>
+*> \verbatim
+*>
+*> November 2023, Igor Kozachenko, James Demmel,
+*> Computer Science Division,
+*> University of California, Berkeley
+*>
+*> \endverbatim
+*
+* =====================================================================
+ SUBROUTINE SGEQP3RK( M, N, NRHS, KMAX, ABSTOL, RELTOL, A, LDA,
+ $ K, MAXC2NRMK, RELMAXC2NRMK, JPIV, TAU,
+ $ WORK, LWORK, IWORK, INFO )
+ IMPLICIT NONE
+*
+* -- LAPACK computational routine --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*
+* .. Scalar Arguments ..
+ INTEGER INFO, K, KF, KMAX, LDA, LWORK, M, N, NRHS
+ REAL ABSTOL, MAXC2NRMK, RELMAXC2NRMK, RELTOL
+* ..
+* .. Array Arguments ..
+ INTEGER IWORK( * ), JPIV( * )
+ REAL A( LDA, * ), TAU( * ), WORK( * )
+* ..
+*
+* =====================================================================
+*
+* .. Parameters ..
+ INTEGER INB, INBMIN, IXOVER
+ PARAMETER ( INB = 1, INBMIN = 2, IXOVER = 3 )
+ REAL ZERO, ONE, TWO
+ PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0, TWO = 2.0E+0 )
+* ..
+* .. Local Scalars ..
+ LOGICAL LQUERY, DONE
+ INTEGER IINFO, IOFFSET, IWS, J, JB, JBF, JMAXB, JMAX,
+ $ JMAXC2NRM, KP1, LWKOPT, MINMN, N_SUB, NB,
+ $ NBMIN, NX
+ REAL EPS, HUGEVAL, MAXC2NRM, SAFMIN
+* ..
+* .. External Subroutines ..
+ EXTERNAL SLAQP2RK, SLAQP3RK, XERBLA
+* ..
+* .. External Functions ..
+ LOGICAL SISNAN
+ INTEGER ISAMAX, ILAENV
+ REAL SLAMCH, SNRM2
+ EXTERNAL SISNAN, SLAMCH, SNRM2, ISAMAX, ILAENV
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC REAL, MAX, MIN
+* ..
+* .. Executable Statements ..
+*
+* Test input arguments
+* ====================
+*
+ INFO = 0
+ LQUERY = ( LWORK.EQ.-1 )
+ IF( M.LT.0 ) THEN
+ INFO = -1
+ ELSE IF( N.LT.0 ) THEN
+ INFO = -2
+ ELSE IF( NRHS.LT.0 ) THEN
+ INFO = -3
+ ELSE IF( KMAX.LT.0 ) THEN
+ INFO = -4
+ ELSE IF( SISNAN( ABSTOL ) ) THEN
+ INFO = -5
+ ELSE IF( SISNAN( RELTOL ) ) THEN
+ INFO = -6
+ ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
+ INFO = -8
+ END IF
+*
+* If the input parameters M, N, NRHS, KMAX, LDA are valid:
+* a) Test the input workspace size LWORK for the minimum
+* size requirement IWS.
+* b) Determine the optimal block size NB and optimal
+* workspace size LWKOPT to be returned in WORK(1)
+* in case of (1) LWORK < IWS, (2) LQUERY = .TRUE.,
+* (3) when routine exits.
+* Here, IWS is the miminum workspace required for unblocked
+* code.
+*
+ IF( INFO.EQ.0 ) THEN
+ MINMN = MIN( M, N )
+ IF( MINMN.EQ.0 ) THEN
+ IWS = 1
+ LWKOPT = 1
+ ELSE
+*
+* Minimal workspace size in case of using only unblocked
+* BLAS 2 code in SLAQP2RK.
+* 1) SGEQP3RK and SLAQP2RK: 2*N to store full and partial
+* column 2-norms.
+* 2) SLAQP2RK: N+NRHS-1 to use in WORK array that is used
+* in SLARF subroutine inside SLAQP2RK to apply an
+* elementary reflector from the left.
+* TOTAL_WORK_SIZE = 3*N + NRHS - 1
+*
+ IWS = 3*N + NRHS - 1
+*
+* Assign to NB optimal block size.
+*
+ NB = ILAENV( INB, 'SGEQP3RK', ' ', M, N, -1, -1 )
+*
+* A formula for the optimal workspace size in case of using
+* both unblocked BLAS 2 in SLAQP2RK and blocked BLAS 3 code
+* in SLAQP3RK.
+* 1) SGEQP3RK, SLAQP2RK, SLAQP3RK: 2*N to store full and
+* partial column 2-norms.
+* 2) SLAQP2RK: N+NRHS-1 to use in WORK array that is used
+* in SLARF subroutine to apply an elementary reflector
+* from the left.
+* 3) SLAQP3RK: NB*(N+NRHS) to use in the work array F that
+* is used to apply a block reflector from
+* the left.
+* 4) SLAQP3RK: NB to use in the auxilixary array AUX.
+* Sizes (2) and ((3) + (4)) should intersect, therefore
+* TOTAL_WORK_SIZE = 2*N + NB*( N+NRHS+1 ), given NBMIN=2.
+*
+ LWKOPT = 2*N + NB*( N+NRHS+1 )
+ END IF
+ WORK( 1 ) = REAL( LWKOPT )
+*
+ IF( ( LWORK.LT.IWS ) .AND. .NOT.LQUERY ) THEN
+ INFO = -15
+ END IF
+ END IF
+*
+* NOTE: The optimal workspace size is returned in WORK(1), if
+* the input parameters M, N, NRHS, KMAX, LDA are valid.
+*
+ IF( INFO.NE.0 ) THEN
+ CALL XERBLA( 'SGEQP3RK', -INFO )
+ RETURN
+ ELSE IF( LQUERY ) THEN
+ RETURN
+ END IF
+*
+* Quick return if possible for M=0 or N=0.
+*
+ IF( MINMN.EQ.0 ) THEN
+ K = 0
+ MAXC2NRMK = ZERO
+ RELMAXC2NRMK = ZERO
+ WORK( 1 ) = REAL( LWKOPT )
+ RETURN
+ END IF
+*
+* ==================================================================
+*
+* Initialize column pivot array JPIV.
+*
+ DO J = 1, N
+ JPIV( J ) = J
+ END DO
+*
+* ==================================================================
+*
+* Initialize storage for partial and exact column 2-norms.
+* a) The elements WORK(1:N) are used to store partial column
+* 2-norms of the matrix A, and may decrease in each computation
+* step; initialize to the values of complete columns 2-norms.
+* b) The elements WORK(N+1:2*N) are used to store complete column
+* 2-norms of the matrix A, they are not changed during the
+* computation; initialize the values of complete columns 2-norms.
+*
+ DO J = 1, N
+ WORK( J ) = SNRM2( M, A( 1, J ), 1 )
+ WORK( N+J ) = WORK( J )
+ END DO
+*
+* ==================================================================
+*
+* Compute the pivot column index and the maximum column 2-norm
+* for the whole original matrix stored in A(1:M,1:N).
+*
+ KP1 = ISAMAX( N, WORK( 1 ), 1 )
+ MAXC2NRM = WORK( KP1 )
+*
+* ==================================================================.
+*
+ IF( SISNAN( MAXC2NRM ) ) THEN
+*
+* Check if the matrix A contains NaN, set INFO parameter
+* to the column number where the first NaN is found and return
+* from the routine.
+*
+ K = 0
+ INFO = KP1
+*
+* Set MAXC2NRMK and RELMAXC2NRMK to NaN.
+*
+ MAXC2NRMK = MAXC2NRM
+ RELMAXC2NRMK = MAXC2NRM
+*
+* Array TAU is not set and contains undefined elements.
+*
+ WORK( 1 ) = REAL( LWKOPT )
+ RETURN
+ END IF
+*
+* ===================================================================
+*
+ IF( MAXC2NRM.EQ.ZERO ) THEN
+*
+* Check is the matrix A is a zero matrix, set array TAU and
+* return from the routine.
+*
+ K = 0
+ MAXC2NRMK = ZERO
+ RELMAXC2NRMK = ZERO
+*
+ DO J = 1, MINMN
+ TAU( J ) = ZERO
+ END DO
+*
+ WORK( 1 ) = REAL( LWKOPT )
+ RETURN
+*
+ END IF
+*
+* ===================================================================
+*
+ HUGEVAL = SLAMCH( 'Overflow' )
+*
+ IF( MAXC2NRM.GT.HUGEVAL ) THEN
+*
+* Check if the matrix A contains +Inf or -Inf, set INFO parameter
+* to the column number, where the first +/-Inf is found plus N,
+* and continue the computation.
+*
+ INFO = N + KP1
+*
+ END IF
+*
+* ==================================================================
+*
+* Quick return if possible for the case when the first
+* stopping criterion is satisfied, i.e. KMAX = 0.
+*
+ IF( KMAX.EQ.0 ) THEN
+ K = 0
+ MAXC2NRMK = MAXC2NRM
+ RELMAXC2NRMK = ONE
+ DO J = 1, MINMN
+ TAU( J ) = ZERO
+ END DO
+ WORK( 1 ) = REAL( LWKOPT )
+ RETURN
+ END IF
+*
+* ==================================================================
+*
+ EPS = SLAMCH('Epsilon')
+*
+* Adjust ABSTOL
+*
+ IF( ABSTOL.GE.ZERO ) THEN
+ SAFMIN = SLAMCH('Safe minimum')
+ ABSTOL = MAX( ABSTOL, TWO*SAFMIN )
+ END IF
+*
+* Adjust RELTOL
+*
+ IF( RELTOL.GE.ZERO ) THEN
+ RELTOL = MAX( RELTOL, EPS )
+ END IF
+*
+* ===================================================================
+*
+* JMAX is the maximum index of the column to be factorized,
+* which is also limited by the first stopping criterion KMAX.
+*
+ JMAX = MIN( KMAX, MINMN )
+*
+* ===================================================================
+*
+* Quick return if possible for the case when the second or third
+* stopping criterion for the whole original matrix is satified,
+* i.e. MAXC2NRM <= ABSTOL or RELMAXC2NRM <= RELTOL
+* (which is ONE <= RELTOL).
+*
+ IF( MAXC2NRM.LE.ABSTOL .OR. ONE.LE.RELTOL ) THEN
+*
+ K = 0
+ MAXC2NRMK = MAXC2NRM
+ RELMAXC2NRMK = ONE
+*
+ DO J = 1, MINMN
+ TAU( J ) = ZERO
+ END DO
+*
+ WORK( 1 ) = REAL( LWKOPT )
+ RETURN
+ END IF
+*
+* ==================================================================
+* Factorize columns
+* ==================================================================
+*
+* Determine the block size.
+*
+ NBMIN = 2
+ NX = 0
+*
+ IF( ( NB.GT.1 ) .AND. ( NB.LT.MINMN ) ) THEN
+*
+* Determine when to cross over from blocked to unblocked code.
+* (for N less than NX, unblocked code should be used).
+*
+ NX = MAX( 0, ILAENV( IXOVER, 'SGEQP3RK', ' ', M, N, -1, -1 ))
+*
+ IF( NX.LT.MINMN ) THEN
+*
+* Determine if workspace is large enough for blocked code.
+*
+ IF( LWORK.LT.LWKOPT ) THEN
+*
+* Not enough workspace to use optimal block size that
+* is currently stored in NB.
+* Reduce NB and determine the minimum value of NB.
+*
+ NB = ( LWORK-2*N ) / ( N+1 )
+ NBMIN = MAX( 2, ILAENV( INBMIN, 'SGEQP3RK', ' ', M, N,
+ $ -1, -1 ) )
+*
+ END IF
+ END IF
+ END IF
+*
+* ==================================================================
+*
+* DONE is the boolean flag to rerpresent the case when the
+* factorization completed in the block factorization routine,
+* before the end of the block.
+*
+ DONE = .FALSE.
+*
+* J is the column index.
+*
+ J = 1
+*
+* (1) Use blocked code initially.
+*
+* JMAXB is the maximum column index of the block, when the
+* blocked code is used, is also limited by the first stopping
+* criterion KMAX.
+*
+ JMAXB = MIN( KMAX, MINMN - NX )
+*
+ IF( NB.GE.NBMIN .AND. NB.LT.JMAX .AND. JMAXB.GT.0 ) THEN
+*
+* Loop over the column blocks of the matrix A(1:M,1:JMAXB). Here:
+* J is the column index of a column block;
+* JB is the column block size to pass to block factorization
+* routine in a loop step;
+* JBF is the number of columns that were actually factorized
+* that was returned by the block factorization routine
+* in a loop step, JBF <= JB;
+* N_SUB is the number of columns in the submatrix;
+* IOFFSET is the number of rows that should not be factorized.
+*
+ DO WHILE( J.LE.JMAXB )
+*
+ JB = MIN( NB, JMAXB-J+1 )
+ N_SUB = N-J+1
+ IOFFSET = J-1
+*
+* Factorize JB columns among the columns A(J:N).
+*
+ CALL SLAQP3RK( M, N_SUB, NRHS, IOFFSET, JB, ABSTOL,
+ $ RELTOL, KP1, MAXC2NRM, A( 1, J ), LDA,
+ $ DONE, JBF, MAXC2NRMK, RELMAXC2NRMK,
+ $ JPIV( J ), TAU( J ),
+ $ WORK( J ), WORK( N+J ),
+ $ WORK( 2*N+1 ), WORK( 2*N+JB+1 ),
+ $ N+NRHS-J+1, IWORK, IINFO )
+*
+* Set INFO on the first occurence of Inf.
+*
+ IF( IINFO.GT.N_SUB .AND. INFO.EQ.0 ) THEN
+ INFO = 2*IOFFSET + IINFO
+ END IF
+*
+ IF( DONE ) THEN
+*
+* Either the submatrix is zero before the end of the
+* column block, or ABSTOL or RELTOL criterion is
+* satisfied before the end of the column block, we can
+* return from the routine. Perform the following before
+* returning:
+* a) Set the number of factorized columns K,
+* K = IOFFSET + JBF from the last call of blocked
+* routine.
+* NOTE: 1) MAXC2NRMK and RELMAXC2NRMK are returned
+* by the block factorization routine;
+* 2) The remaining TAUs are set to ZERO by the
+* block factorization routine.
+*
+ K = IOFFSET + JBF
+*
+* Set INFO on the first occurrence of NaN, NaN takes
+* prcedence over Inf.
+*
+ IF( IINFO.LE.N_SUB .AND. IINFO.GT.0 ) THEN
+ INFO = IOFFSET + IINFO
+ END IF
+*
+* Return from the routine.
+*
+ WORK( 1 ) = REAL( LWKOPT )
+*
+ RETURN
+*
+ END IF
+*
+ J = J + JBF
+*
+ END DO
+*
+ END IF
+*
+* Use unblocked code to factor the last or only block.
+* J = JMAX+1 means we factorized the maximum possible number of
+* columns, that is in ELSE clause we need to compute
+* the MAXC2NORM and RELMAXC2NORM to return after we processed
+* the blocks.
+*
+ IF( J.LE.JMAX ) THEN
+*
+* N_SUB is the number of columns in the submatrix;
+* IOFFSET is the number of rows that should not be factorized.
+*
+ N_SUB = N-J+1
+ IOFFSET = J-1
+*
+ CALL SLAQP2RK( M, N_SUB, NRHS, IOFFSET, JMAX-J+1,
+ $ ABSTOL, RELTOL, KP1, MAXC2NRM, A( 1, J ), LDA,
+ $ KF, MAXC2NRMK, RELMAXC2NRMK, JPIV( J ),
+ $ TAU( J ), WORK( J ), WORK( N+J ),
+ $ WORK( 2*N+1 ), IINFO )
+*
+* ABSTOL or RELTOL criterion is satisfied when the number of
+* the factorized columns KF is smaller then the number
+* of columns JMAX-J+1 supplied to be factorized by the
+* unblocked routine, we can return from
+* the routine. Perform the following before returning:
+* a) Set the number of factorized columns K,
+* b) MAXC2NRMK and RELMAXC2NRMK are returned by the
+* unblocked factorization routine above.
+*
+ K = J - 1 + KF
+*
+* Set INFO on the first exception occurence.
+*
+* Set INFO on the first exception occurence of Inf or NaN,
+* (NaN takes precedence over Inf).
+*
+ IF( IINFO.GT.N_SUB .AND. INFO.EQ.0 ) THEN
+ INFO = 2*IOFFSET + IINFO
+ ELSE IF( IINFO.LE.N_SUB .AND. IINFO.GT.0 ) THEN
+ INFO = IOFFSET + IINFO
+ END IF
+*
+ ELSE
+*
+* Compute the return values for blocked code.
+*
+* Set the number of factorized columns if the unblocked routine
+* was not called.
+*
+ K = JMAX
+*
+* If there exits a residual matrix after the blocked code:
+* 1) compute the values of MAXC2NRMK, RELMAXC2NRMK of the
+* residual matrix, otherwise set them to ZERO;
+* 2) Set TAU(K+1:MINMN) to ZERO.
+*
+ IF( K.LT.MINMN ) THEN
+ JMAXC2NRM = K + ISAMAX( N-K, WORK( K+1 ), 1 )
+ MAXC2NRMK = WORK( JMAXC2NRM )
+ IF( K.EQ.0 ) THEN
+ RELMAXC2NRMK = ONE
+ ELSE
+ RELMAXC2NRMK = MAXC2NRMK / MAXC2NRM
+ END IF
+*
+ DO J = K + 1, MINMN
+ TAU( J ) = ZERO
+ END DO
+*
+ END IF
+*
+* END IF( J.LE.JMAX ) THEN
+*
+ END IF
+*
+ WORK( 1 ) = REAL( LWKOPT )
+*
+ RETURN
+*
+* End of SGEQP3RK
+*
+ END
diff --git a/lapack-netlib/SRC/slaqp2rk.f b/lapack-netlib/SRC/slaqp2rk.f
new file mode 100644
index 000000000..d3dbb3d7c
--- /dev/null
+++ b/lapack-netlib/SRC/slaqp2rk.f
@@ -0,0 +1,713 @@
+*> \brief \b SLAQP2RK computes truncated QR factorization with column pivoting of a real matrix block using Level 2 BLAS and overwrites a real m-by-nrhs matrix B with Q**T * B.
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download SLAQP2RK + dependencies
+*>
+*> [TGZ]
+*>
+*> [ZIP]
+*>
+*> [TXT]
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE SLAQP2RK( M, N, NRHS, IOFFSET, KMAX, ABSTOL, RELTOL,
+* $ KP1, MAXC2NRM, A, LDA, K, MAXC2NRMK,
+* $ RELMAXC2NRMK, JPIV, TAU, VN1, VN2, WORK,
+* $ INFO )
+* IMPLICIT NONE
+*
+* .. Scalar Arguments ..
+* INTEGER INFO, IOFFSET, KP1, K, KMAX, LDA, M, N, NRHS
+* REAL ABSTOL, MAXC2NRM, MAXC2NRMK, RELMAXC2NRMK,
+* $ RELTOL
+* ..
+* .. Array Arguments ..
+* INTEGER JPIV( * )
+* REAL A( LDA, * ), TAU( * ), VN1( * ), VN2( * ),
+* $ WORK( * )
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> SLAQP2RK computes a truncated (rank K) or full rank Householder QR
+*> factorization with column pivoting of a real matrix
+*> block A(IOFFSET+1:M,1:N) as
+*>
+*> A * P(K) = Q(K) * R(K).
+*>
+*> The routine uses Level 2 BLAS. The block A(1:IOFFSET,1:N)
+*> is accordingly pivoted, but not factorized.
+*>
+*> The routine also overwrites the right-hand-sides matrix block B
+*> stored in A(IOFFSET+1:M,N+1:N+NRHS) with Q(K)**T * B.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] M
+*> \verbatim
+*> M is INTEGER
+*> The number of rows of the matrix A. M >= 0.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> The number of columns of the matrix A. N >= 0.
+*> \endverbatim
+*>
+*> \param[in] NRHS
+*> \verbatim
+*> NRHS is INTEGER
+*> The number of right hand sides, i.e., the number of
+*> columns of the matrix B. NRHS >= 0.
+*> \endverbatim
+*>
+*> \param[in] IOFFSET
+*> \verbatim
+*> IOFFSET is INTEGER
+*> The number of rows of the matrix A that must be pivoted
+*> but not factorized. IOFFSET >= 0.
+*>
+*> IOFFSET also represents the number of columns of the whole
+*> original matrix A_orig that have been factorized
+*> in the previous steps.
+*> \endverbatim
+*>
+*> \param[in] KMAX
+*> \verbatim
+*> KMAX is INTEGER
+*>
+*> The first factorization stopping criterion. KMAX >= 0.
+*>
+*> The maximum number of columns of the matrix A to factorize,
+*> i.e. the maximum factorization rank.
+*>
+*> a) If KMAX >= min(M-IOFFSET,N), then this stopping
+*> criterion is not used, factorize columns
+*> depending on ABSTOL and RELTOL.
+*>
+*> b) If KMAX = 0, then this stopping criterion is
+*> satisfied on input and the routine exits immediately.
+*> This means that the factorization is not performed,
+*> the matrices A and B and the arrays TAU, IPIV
+*> are not modified.
+*> \endverbatim
+*>
+*> \param[in] ABSTOL
+*> \verbatim
+*> ABSTOL is DOUBLE PRECISION, cannot be NaN.
+*>
+*> The second factorization stopping criterion.
+*>
+*> The absolute tolerance (stopping threshold) for
+*> maximum column 2-norm of the residual matrix.
+*> The algorithm converges (stops the factorization) when
+*> the maximum column 2-norm of the residual matrix
+*> is less than or equal to ABSTOL.
+*>
+*> a) If ABSTOL < 0.0, then this stopping criterion is not
+*> used, the routine factorizes columns depending
+*> on KMAX and RELTOL.
+*> This includes the case ABSTOL = -Inf.
+*>
+*> b) If 0.0 <= ABSTOL then the input value
+*> of ABSTOL is used.
+*> \endverbatim
+*>
+*> \param[in] RELTOL
+*> \verbatim
+*> RELTOL is DOUBLE PRECISION, cannot be NaN.
+*>
+*> The third factorization stopping criterion.
+*>
+*> The tolerance (stopping threshold) for the ratio of the
+*> maximum column 2-norm of the residual matrix to the maximum
+*> column 2-norm of the original matrix A_orig. The algorithm
+*> converges (stops the factorization), when this ratio is
+*> less than or equal to RELTOL.
+*>
+*> a) If RELTOL < 0.0, then this stopping criterion is not
+*> used, the routine factorizes columns depending
+*> on KMAX and ABSTOL.
+*> This includes the case RELTOL = -Inf.
+*>
+*> d) If 0.0 <= RELTOL then the input value of RELTOL
+*> is used.
+*> \endverbatim
+*>
+*> \param[in] KP1
+*> \verbatim
+*> KP1 is INTEGER
+*> The index of the column with the maximum 2-norm in
+*> the whole original matrix A_orig determined in the
+*> main routine SGEQP3RK. 1 <= KP1 <= N_orig_mat.
+*> \endverbatim
+*>
+*> \param[in] MAXC2NRM
+*> \verbatim
+*> MAXC2NRM is DOUBLE PRECISION
+*> The maximum column 2-norm of the whole original
+*> matrix A_orig computed in the main routine SGEQP3RK.
+*> MAXC2NRM >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*> A is REAL array, dimension (LDA,N+NRHS)
+*> On entry:
+*> the M-by-N matrix A and M-by-NRHS matrix B, as in
+*>
+*> N NRHS
+*> array_A = M [ mat_A, mat_B ]
+*>
+*> On exit:
+*> 1. The elements in block A(IOFFSET+1:M,1:K) below
+*> the diagonal together with the array TAU represent
+*> the orthogonal matrix Q(K) as a product of elementary
+*> reflectors.
+*> 2. The upper triangular block of the matrix A stored
+*> in A(IOFFSET+1:M,1:K) is the triangular factor obtained.
+*> 3. The block of the matrix A stored in A(1:IOFFSET,1:N)
+*> has been accordingly pivoted, but not factorized.
+*> 4. The rest of the array A, block A(IOFFSET+1:M,K+1:N+NRHS).
+*> The left part A(IOFFSET+1:M,K+1:N) of this block
+*> contains the residual of the matrix A, and,
+*> if NRHS > 0, the right part of the block
+*> A(IOFFSET+1:M,N+1:N+NRHS) contains the block of
+*> the right-hand-side matrix B. Both these blocks have been
+*> updated by multiplication from the left by Q(K)**T.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*> LDA is INTEGER
+*> The leading dimension of the array A. LDA >= max(1,M).
+*> \endverbatim
+*>
+*> \param[out] K
+*> \verbatim
+*> K is INTEGER
+*> Factorization rank of the matrix A, i.e. the rank of
+*> the factor R, which is the same as the number of non-zero
+*> rows of the factor R. 0 <= K <= min(M-IOFFSET,KMAX,N).
+*>
+*> K also represents the number of non-zero Householder
+*> vectors.
+*> \endverbatim
+*>
+*> \param[out] MAXC2NRMK
+*> \verbatim
+*> MAXC2NRMK is DOUBLE PRECISION
+*> The maximum column 2-norm of the residual matrix,
+*> when the factorization stopped at rank K. MAXC2NRMK >= 0.
+*> \endverbatim
+*>
+*> \param[out] RELMAXC2NRMK
+*> \verbatim
+*> RELMAXC2NRMK is DOUBLE PRECISION
+*> The ratio MAXC2NRMK / MAXC2NRM of the maximum column
+*> 2-norm of the residual matrix (when the factorization
+*> stopped at rank K) to the maximum column 2-norm of the
+*> whole original matrix A. RELMAXC2NRMK >= 0.
+*> \endverbatim
+*>
+*> \param[out] JPIV
+*> \verbatim
+*> JPIV is INTEGER array, dimension (N)
+*> Column pivot indices, for 1 <= j <= N, column j
+*> of the matrix A was interchanged with column JPIV(j).
+*> \endverbatim
+*>
+*> \param[out] TAU
+*> \verbatim
+*> TAU is REAL array, dimension (min(M-IOFFSET,N))
+*> The scalar factors of the elementary reflectors.
+*> \endverbatim
+*>
+*> \param[in,out] VN1
+*> \verbatim
+*> VN1 is REAL array, dimension (N)
+*> The vector with the partial column norms.
+*> \endverbatim
+*>
+*> \param[in,out] VN2
+*> \verbatim
+*> VN2 is REAL array, dimension (N)
+*> The vector with the exact column norms.
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*> WORK is REAL array, dimension (N-1)
+*> Used in SLARF subroutine to apply an elementary
+*> reflector from the left.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*> INFO is INTEGER
+*> 1) INFO = 0: successful exit.
+*> 2) If INFO = j_1, where 1 <= j_1 <= N, then NaN was
+*> detected and the routine stops the computation.
+*> The j_1-th column of the matrix A or the j_1-th
+*> element of array TAU contains the first occurrence
+*> of NaN in the factorization step K+1 ( when K columns
+*> have been factorized ).
+*>
+*> On exit:
+*> K is set to the number of
+*> factorized columns without
+*> exception.
+*> MAXC2NRMK is set to NaN.
+*> RELMAXC2NRMK is set to NaN.
+*> TAU(K+1:min(M,N)) is not set and contains undefined
+*> elements. If j_1=K+1, TAU(K+1)
+*> may contain NaN.
+*> 3) If INFO = j_2, where N+1 <= j_2 <= 2*N, then no NaN
+*> was detected, but +Inf (or -Inf) was detected and
+*> the routine continues the computation until completion.
+*> The (j_2-N)-th column of the matrix A contains the first
+*> occurrence of +Inf (or -Inf) in the factorization
+*> step K+1 ( when K columns have been factorized ).
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \ingroup laqp2rk
+*
+*> \par References:
+* ================
+*> [1] A Level 3 BLAS QR factorization algorithm with column pivoting developed in 1996.
+*> G. Quintana-Orti, Depto. de Informatica, Universidad Jaime I, Spain.
+*> X. Sun, Computer Science Dept., Duke University, USA.
+*> C. H. Bischof, Math. and Comp. Sci. Div., Argonne National Lab, USA.
+*> A BLAS-3 version of the QR factorization with column pivoting.
+*> LAPACK Working Note 114
+*> \htmlonly
+*> https://www.netlib.org/lapack/lawnspdf/lawn114.pdf
+*> \endhtmlonly
+*> and in
+*> SIAM J. Sci. Comput., 19(5):1486-1494, Sept. 1998.
+*> \htmlonly
+*> https://doi.org/10.1137/S1064827595296732
+*> \endhtmlonly
+*>
+*> [2] A partial column norm updating strategy developed in 2006.
+*> Z. Drmac and Z. Bujanovic, Dept. of Math., University of Zagreb, Croatia.
+*> On the failure of rank revealing QR factorization software – a case study.
+*> LAPACK Working Note 176.
+*> \htmlonly
+*> http://www.netlib.org/lapack/lawnspdf/lawn176.pdf
+*> \endhtmlonly
+*> and in
+*> ACM Trans. Math. Softw. 35, 2, Article 12 (July 2008), 28 pages.
+*> \htmlonly
+*> https://doi.org/10.1145/1377612.1377616
+*> \endhtmlonly
+*
+*> \par Contributors:
+* ==================
+*>
+*> \verbatim
+*>
+*> November 2023, Igor Kozachenko, James Demmel,
+*> Computer Science Division,
+*> University of California, Berkeley
+*>
+*> \endverbatim
+*
+* =====================================================================
+ SUBROUTINE SLAQP2RK( M, N, NRHS, IOFFSET, KMAX, ABSTOL, RELTOL,
+ $ KP1, MAXC2NRM, A, LDA, K, MAXC2NRMK,
+ $ RELMAXC2NRMK, JPIV, TAU, VN1, VN2, WORK,
+ $ INFO )
+ IMPLICIT NONE
+*
+* -- LAPACK auxiliary routine --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*
+* .. Scalar Arguments ..
+ INTEGER INFO, IOFFSET, KP1, K, KMAX, LDA, M, N, NRHS
+ REAL ABSTOL, MAXC2NRM, MAXC2NRMK, RELMAXC2NRMK,
+ $ RELTOL
+* ..
+* .. Array Arguments ..
+ INTEGER JPIV( * )
+ REAL A( LDA, * ), TAU( * ), VN1( * ), VN2( * ),
+ $ WORK( * )
+* ..
+*
+* =====================================================================
+*
+* .. Parameters ..
+ REAL ZERO, ONE
+ PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
+* ..
+* .. Local Scalars ..
+ INTEGER I, ITEMP, J, JMAXC2NRM, KK, KP, MINMNFACT,
+ $ MINMNUPDT
+ REAL AIKK, HUGEVAL, TEMP, TEMP2, TOL3Z
+* ..
+* .. External Subroutines ..
+ EXTERNAL SLARF, SLARFG, SSWAP
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC ABS, MAX, MIN, SQRT
+* ..
+* .. External Functions ..
+ LOGICAL SISNAN
+ INTEGER ISAMAX
+ REAL SLAMCH, SNRM2
+ EXTERNAL SISNAN, SLAMCH, ISAMAX, SNRM2
+* ..
+* .. Executable Statements ..
+*
+* Initialize INFO
+*
+ INFO = 0
+*
+* MINMNFACT in the smallest dimension of the submatrix
+* A(IOFFSET+1:M,1:N) to be factorized.
+*
+* MINMNUPDT is the smallest dimension
+* of the subarray A(IOFFSET+1:M,1:N+NRHS) to be udated, which
+* contains the submatrices A(IOFFSET+1:M,1:N) and
+* B(IOFFSET+1:M,1:NRHS) as column blocks.
+*
+ MINMNFACT = MIN( M-IOFFSET, N )
+ MINMNUPDT = MIN( M-IOFFSET, N+NRHS )
+ KMAX = MIN( KMAX, MINMNFACT )
+ TOL3Z = SQRT( SLAMCH( 'Epsilon' ) )
+ HUGEVAL = SLAMCH( 'Overflow' )
+*
+* Compute the factorization, KK is the lomn loop index.
+*
+ DO KK = 1, KMAX
+*
+ I = IOFFSET + KK
+*
+ IF( I.EQ.1 ) THEN
+*
+* ============================================================
+*
+* We are at the first column of the original whole matrix A,
+* therefore we use the computed KP1 and MAXC2NRM from the
+* main routine.
+*
+
+ KP = KP1
+*
+* ============================================================
+*
+ ELSE
+*
+* ============================================================
+*
+* Determine the pivot column in KK-th step, i.e. the index
+* of the column with the maximum 2-norm in the
+* submatrix A(I:M,K:N).
+*
+ KP = ( KK-1 ) + ISAMAX( N-KK+1, VN1( KK ), 1 )
+*
+* Determine the maximum column 2-norm and the relative maximum
+* column 2-norm of the submatrix A(I:M,KK:N) in step KK.
+* RELMAXC2NRMK will be computed later, after somecondition
+* checks on MAXC2NRMK.
+*
+ MAXC2NRMK = VN1( KP )
+*
+* ============================================================
+*
+* Check if the submatrix A(I:M,KK:N) contains NaN, and set
+* INFO parameter to the column number, where the first NaN
+* is found and return from the routine.
+* We need to check the condition only if the
+* column index (same as row index) of the original whole
+* matrix is larger than 1, since the condition for whole
+* original matrix is checked in the main routine.
+*
+ IF( SISNAN( MAXC2NRMK ) ) THEN
+*
+* Set K, the number of factorized columns.
+* that are not zero.
+*
+ K = KK - 1
+ INFO = K + KP
+*
+* Set RELMAXC2NRMK to NaN.
+*
+ RELMAXC2NRMK = MAXC2NRMK
+*
+* Array TAU(K+1:MINMNFACT) is not set and contains
+* undefined elements.
+*
+ RETURN
+ END IF
+*
+* ============================================================
+*
+* Quick return, if the submatrix A(I:M,KK:N) is
+* a zero matrix.
+* We need to check the condition only if the
+* column index (same as row index) of the original whole
+* matrix is larger than 1, since the condition for whole
+* original matrix is checked in the main routine.
+*
+ IF( MAXC2NRMK.EQ.ZERO ) THEN
+*
+* Set K, the number of factorized columns.
+* that are not zero.
+*
+ K = KK - 1
+ RELMAXC2NRMK = ZERO
+*
+* Set TAUs corresponding to the columns that were not
+* factorized to ZERO, i.e. set TAU(KK:MINMNFACT) to ZERO.
+*
+ DO J = KK, MINMNFACT
+ TAU( J ) = ZERO
+ END DO
+*
+* Return from the routine.
+*
+ RETURN
+*
+ END IF
+*
+* ============================================================
+*
+* Check if the submatrix A(I:M,KK:N) contains Inf,
+* set INFO parameter to the column number, where
+* the first Inf is found plus N, and continue
+* the computation.
+* We need to check the condition only if the
+* column index (same as row index) of the original whole
+* matrix is larger than 1, since the condition for whole
+* original matrix is checked in the main routine.
+*
+ IF( INFO.EQ.0 .AND. MAXC2NRMK.GT.HUGEVAL ) THEN
+ INFO = N + KK - 1 + KP
+ END IF
+*
+* ============================================================
+*
+* Test for the second and third stopping criteria.
+* NOTE: There is no need to test for ABSTOL >= ZERO, since
+* MAXC2NRMK is non-negative. Similarly, there is no need
+* to test for RELTOL >= ZERO, since RELMAXC2NRMK is
+* non-negative.
+* We need to check the condition only if the
+* column index (same as row index) of the original whole
+* matrix is larger than 1, since the condition for whole
+* original matrix is checked in the main routine.
+
+ RELMAXC2NRMK = MAXC2NRMK / MAXC2NRM
+*
+ IF( MAXC2NRMK.LE.ABSTOL .OR. RELMAXC2NRMK.LE.RELTOL ) THEN
+*
+* Set K, the number of factorized columns.
+*
+ K = KK - 1
+*
+* Set TAUs corresponding to the columns that were not
+* factorized to ZERO, i.e. set TAU(KK:MINMNFACT) to ZERO.
+*
+ DO J = KK, MINMNFACT
+ TAU( J ) = ZERO
+ END DO
+*
+* Return from the routine.
+*
+ RETURN
+*
+ END IF
+*
+* ============================================================
+*
+* End ELSE of IF(I.EQ.1)
+*
+ END IF
+*
+* ===============================================================
+*
+* If the pivot column is not the first column of the
+* subblock A(1:M,KK:N):
+* 1) swap the KK-th column and the KP-th pivot column
+* in A(1:M,1:N);
+* 2) copy the KK-th element into the KP-th element of the partial
+* and exact 2-norm vectors VN1 and VN2. ( Swap is not needed
+* for VN1 and VN2 since we use the element with the index
+* larger than KK in the next loop step.)
+* 3) Save the pivot interchange with the indices relative to the
+* the original matrix A, not the block A(1:M,1:N).
+*
+ IF( KP.NE.KK ) THEN
+ CALL SSWAP( M, A( 1, KP ), 1, A( 1, KK ), 1 )
+ VN1( KP ) = VN1( KK )
+ VN2( KP ) = VN2( KK )
+ ITEMP = JPIV( KP )
+ JPIV( KP ) = JPIV( KK )
+ JPIV( KK ) = ITEMP
+ END IF
+*
+* Generate elementary reflector H(KK) using the column A(I:M,KK),
+* if the column has more than one element, otherwise
+* the elementary reflector would be an identity matrix,
+* and TAU(KK) = ZERO.
+*
+ IF( I.LT.M ) THEN
+ CALL SLARFG( M-I+1, A( I, KK ), A( I+1, KK ), 1,
+ $ TAU( KK ) )
+ ELSE
+ TAU( KK ) = ZERO
+ END IF
+*
+* Check if TAU(KK) contains NaN, set INFO parameter
+* to the column number where NaN is found and return from
+* the routine.
+* NOTE: There is no need to check TAU(KK) for Inf,
+* since SLARFG cannot produce TAU(KK) or Householder vector
+* below the diagonal containing Inf. Only BETA on the diagonal,
+* returned by SLARFG can contain Inf, which requires
+* TAU(KK) to contain NaN. Therefore, this case of generating Inf
+* by SLARFG is covered by checking TAU(KK) for NaN.
+*
+ IF( SISNAN( TAU(KK) ) ) THEN
+ K = KK - 1
+ INFO = KK
+*
+* Set MAXC2NRMK and RELMAXC2NRMK to NaN.
+*
+ MAXC2NRMK = TAU( KK )
+ RELMAXC2NRMK = TAU( KK )
+*
+* Array TAU(KK:MINMNFACT) is not set and contains
+* undefined elements, except the first element TAU(KK) = NaN.
+*
+ RETURN
+ END IF
+*
+* Apply H(KK)**T to A(I:M,KK+1:N+NRHS) from the left.
+* ( If M >= N, then at KK = N there is no residual matrix,
+* i.e. no columns of A to update, only columns of B.
+* If M < N, then at KK = M-IOFFSET, I = M and we have a
+* one-row residual matrix in A and the elementary
+* reflector is a unit matrix, TAU(KK) = ZERO, i.e. no update
+* is needed for the residual matrix in A and the
+* right-hand-side-matrix in B.
+* Therefore, we update only if
+* KK < MINMNUPDT = min(M-IOFFSET, N+NRHS)
+* condition is satisfied, not only KK < N+NRHS )
+*
+ IF( KK.LT.MINMNUPDT ) THEN
+ AIKK = A( I, KK )
+ A( I, KK ) = ONE
+ CALL SLARF( 'Left', M-I+1, N+NRHS-KK, A( I, KK ), 1,
+ $ TAU( KK ), A( I, KK+1 ), LDA, WORK( 1 ) )
+ A( I, KK ) = AIKK
+ END IF
+*
+ IF( KK.LT.MINMNFACT ) THEN
+*
+* Update the partial column 2-norms for the residual matrix,
+* only if the residual matrix A(I+1:M,KK+1:N) exists, i.e.
+* when KK < min(M-IOFFSET, N).
+*
+ DO J = KK + 1, N
+ IF( VN1( J ).NE.ZERO ) THEN
+*
+* NOTE: The following lines follow from the analysis in
+* Lapack Working Note 176.
+*
+ TEMP = ONE - ( ABS( A( I, J ) ) / VN1( J ) )**2
+ TEMP = MAX( TEMP, ZERO )
+ TEMP2 = TEMP*( VN1( J ) / VN2( J ) )**2
+ IF( TEMP2 .LE. TOL3Z ) THEN
+*
+* Compute the column 2-norm for the partial
+* column A(I+1:M,J) by explicitly computing it,
+* and store it in both partial 2-norm vector VN1
+* and exact column 2-norm vector VN2.
+*
+ VN1( J ) = SNRM2( M-I, A( I+1, J ), 1 )
+ VN2( J ) = VN1( J )
+*
+ ELSE
+*
+* Update the column 2-norm for the partial
+* column A(I+1:M,J) by removing one
+* element A(I,J) and store it in partial
+* 2-norm vector VN1.
+*
+ VN1( J ) = VN1( J )*SQRT( TEMP )
+*
+ END IF
+ END IF
+ END DO
+*
+ END IF
+*
+* End factorization loop
+*
+ END DO
+*
+* If we reached this point, all colunms have been factorized,
+* i.e. no condition was triggered to exit the routine.
+* Set the number of factorized columns.
+*
+ K = KMAX
+*
+* We reached the end of the loop, i.e. all KMAX columns were
+* factorized, we need to set MAXC2NRMK and RELMAXC2NRMK before
+* we return.
+*
+ IF( K.LT.MINMNFACT ) THEN
+*
+ JMAXC2NRM = K + ISAMAX( N-K, VN1( K+1 ), 1 )
+ MAXC2NRMK = VN1( JMAXC2NRM )
+*
+ IF( K.EQ.0 ) THEN
+ RELMAXC2NRMK = ONE
+ ELSE
+ RELMAXC2NRMK = MAXC2NRMK / MAXC2NRM
+ END IF
+*
+ ELSE
+ MAXC2NRMK = ZERO
+ RELMAXC2NRMK = ZERO
+ END IF
+*
+* We reached the end of the loop, i.e. all KMAX columns were
+* factorized, set TAUs corresponding to the columns that were
+* not factorized to ZERO, i.e. TAU(K+1:MINMNFACT) set to ZERO.
+*
+ DO J = K + 1, MINMNFACT
+ TAU( J ) = ZERO
+ END DO
+*
+ RETURN
+*
+* End of SLAQP2RK
+*
+ END
diff --git a/lapack-netlib/SRC/slaqp3rk.f b/lapack-netlib/SRC/slaqp3rk.f
new file mode 100644
index 000000000..fa735bb9d
--- /dev/null
+++ b/lapack-netlib/SRC/slaqp3rk.f
@@ -0,0 +1,935 @@
+*> \brief \b SLAQP3RK computes a step of truncated QR factorization with column pivoting of a real m-by-n matrix A using Level 3 BLAS and overwrites a real m-by-nrhs matrix B with Q**T * B.
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download SLAQP3RK + dependencies
+*>
+*> [TGZ]
+*>
+*> [ZIP]
+*>
+*> [TXT]
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE SLAQP3RK( M, N, NRHS, IOFFSET, NB, ABSTOL,
+* $ RELTOL, KP1, MAXC2NRM, A, LDA, DONE, KB,
+* $ MAXC2NRMK, RELMAXC2NRMK, JPIV, TAU,
+* $ VN1, VN2, AUXV, F, LDF, IWORK, INFO )
+* IMPLICIT NONE
+* LOGICAL DONE
+* INTEGER INFO, IOFFSET, KB, KP1, LDA, LDF, M, N,
+* $ NB, NRHS
+* REAL ABSTOL, MAXC2NRM, MAXC2NRMK, RELMAXC2NRMK,
+* $ RELTOL
+*
+* .. Scalar Arguments ..
+* LOGICAL DONE
+* INTEGER KB, LDA, LDF, M, N, NB, NRHS, IOFFSET
+* REAL ABSTOL, MAXC2NRM, MAXC2NRMK, RELMAXC2NRMK,
+* $ RELTOL
+* ..
+* .. Array Arguments ..
+* INTEGER IWORK( * ), JPIV( * )
+* REAL A( LDA, * ), AUXV( * ), F( LDF, * ), TAU( * ),
+* $ VN1( * ), VN2( * )
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> SLAQP3RK computes a step of truncated QR factorization with column
+*> pivoting of a real M-by-N matrix A block A(IOFFSET+1:M,1:N)
+*> by using Level 3 BLAS as
+*>
+*> A * P(KB) = Q(KB) * R(KB).
+*>
+*> The routine tries to factorize NB columns from A starting from
+*> the row IOFFSET+1 and updates the residual matrix with BLAS 3
+*> xGEMM. The number of actually factorized columns is returned
+*> is smaller than NB.
+*>
+*> Block A(1:IOFFSET,1:N) is accordingly pivoted, but not factorized.
+*>
+*> The routine also overwrites the right-hand-sides B matrix stored
+*> in A(IOFFSET+1:M,1:N+1:N+NRHS) with Q(KB)**T * B.
+*>
+*> Cases when the number of factorized columns KB < NB:
+*>
+*> (1) In some cases, due to catastrophic cancellations, it cannot
+*> factorize all NB columns and need to update the residual matrix.
+*> Hence, the actual number of factorized columns in the block returned
+*> in KB is smaller than NB. The logical DONE is returned as FALSE.
+*> The factorization of the whole original matrix A_orig must proceed
+*> with the next block.
+*>
+*> (2) Whenever the stopping criterion ABSTOL or RELTOL is satisfied,
+*> the factorization of the whole original matrix A_orig is stopped,
+*> the logical DONE is returned as TRUE. The number of factorized
+*> columns which is smaller than NB is returned in KB.
+*>
+*> (3) In case both stopping criteria ABSTOL or RELTOL are not used,
+*> and when the residual matrix is a zero matrix in some factorization
+*> step KB, the factorization of the whole original matrix A_orig is
+*> stopped, the logical DONE is returned as TRUE. The number of
+*> factorized columns which is smaller than NB is returned in KB.
+*>
+*> (4) Whenever NaN is detected in the matrix A or in the array TAU,
+*> the factorization of the whole original matrix A_orig is stopped,
+*> the logical DONE is returned as TRUE. The number of factorized
+*> columns which is smaller than NB is returned in KB. The INFO
+*> parameter is set to the column index of the first NaN occurrence.
+*>
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] M
+*> \verbatim
+*> M is INTEGER
+*> The number of rows of the matrix A. M >= 0.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> The number of columns of the matrix A. N >= 0
+*> \endverbatim
+*>
+*> \param[in] NRHS
+*> \verbatim
+*> NRHS is INTEGER
+*> The number of right hand sides, i.e., the number of
+*> columns of the matrix B. NRHS >= 0.
+*> \endverbatim
+*>
+*> \param[in] IOFFSET
+*> \verbatim
+*> IOFFSET is INTEGER
+*> The number of rows of the matrix A that must be pivoted
+*> but not factorized. IOFFSET >= 0.
+*>
+*> IOFFSET also represents the number of columns of the whole
+*> original matrix A_orig that have been factorized
+*> in the previous steps.
+*> \endverbatim
+*>
+*> \param[in] NB
+*> \verbatim
+*> NB is INTEGER
+*> Factorization block size, i.e the number of columns
+*> to factorize in the matrix A. 0 <= NB
+*>
+*> If NB = 0, then the routine exits immediately.
+*> This means that the factorization is not performed,
+*> the matrices A and B and the arrays TAU, IPIV
+*> are not modified.
+*> \endverbatim
+*>
+*> \param[in] ABSTOL
+*> \verbatim
+*> ABSTOL is REAL, cannot be NaN.
+*>
+*> The absolute tolerance (stopping threshold) for
+*> maximum column 2-norm of the residual matrix.
+*> The algorithm converges (stops the factorization) when
+*> the maximum column 2-norm of the residual matrix
+*> is less than or equal to ABSTOL.
+*>
+*> a) If ABSTOL < 0.0, then this stopping criterion is not
+*> used, the routine factorizes columns depending
+*> on NB and RELTOL.
+*> This includes the case ABSTOL = -Inf.
+*>
+*> b) If 0.0 <= ABSTOL then the input value
+*> of ABSTOL is used.
+*> \endverbatim
+*>
+*> \param[in] RELTOL
+*> \verbatim
+*> RELTOL is REAL, cannot be NaN.
+*>
+*> The tolerance (stopping threshold) for the ratio of the
+*> maximum column 2-norm of the residual matrix to the maximum
+*> column 2-norm of the original matrix A_orig. The algorithm
+*> converges (stops the factorization), when this ratio is
+*> less than or equal to RELTOL.
+*>
+*> a) If RELTOL < 0.0, then this stopping criterion is not
+*> used, the routine factorizes columns depending
+*> on NB and ABSTOL.
+*> This includes the case RELTOL = -Inf.
+*>
+*> d) If 0.0 <= RELTOL then the input value of RELTOL
+*> is used.
+*> \endverbatim
+*>
+*> \param[in] KP1
+*> \verbatim
+*> KP1 is INTEGER
+*> The index of the column with the maximum 2-norm in
+*> the whole original matrix A_orig determined in the
+*> main routine SGEQP3RK. 1 <= KP1 <= N_orig.
+*> \endverbatim
+*>
+*> \param[in] MAXC2NRM
+*> \verbatim
+*> MAXC2NRM is REAL
+*> The maximum column 2-norm of the whole original
+*> matrix A_orig computed in the main routine SGEQP3RK.
+*> MAXC2NRM >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*> A is REAL array, dimension (LDA,N+NRHS)
+*> On entry:
+*> the M-by-N matrix A and M-by-NRHS matrix B, as in
+*>
+*> N NRHS
+*> array_A = M [ mat_A, mat_B ]
+*>
+*> On exit:
+*> 1. The elements in block A(IOFFSET+1:M,1:KB) below
+*> the diagonal together with the array TAU represent
+*> the orthogonal matrix Q(KB) as a product of elementary
+*> reflectors.
+*> 2. The upper triangular block of the matrix A stored
+*> in A(IOFFSET+1:M,1:KB) is the triangular factor obtained.
+*> 3. The block of the matrix A stored in A(1:IOFFSET,1:N)
+*> has been accordingly pivoted, but not factorized.
+*> 4. The rest of the array A, block A(IOFFSET+1:M,KB+1:N+NRHS).
+*> The left part A(IOFFSET+1:M,KB+1:N) of this block
+*> contains the residual of the matrix A, and,
+*> if NRHS > 0, the right part of the block
+*> A(IOFFSET+1:M,N+1:N+NRHS) contains the block of
+*> the right-hand-side matrix B. Both these blocks have been
+*> updated by multiplication from the left by Q(KB)**T.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*> LDA is INTEGER
+*> The leading dimension of the array A. LDA >= max(1,M).
+*> \endverbatim
+*>
+*> \param[out]
+*> \verbatim
+*> DONE is LOGICAL
+*> TRUE: a) if the factorization completed before processing
+*> all min(M-IOFFSET,NB,N) columns due to ABSTOL
+*> or RELTOL criterion,
+*> b) if the factorization completed before processing
+*> all min(M-IOFFSET,NB,N) columns due to the
+*> residual matrix being a ZERO matrix.
+*> c) when NaN was detected in the matrix A
+*> or in the array TAU.
+*> FALSE: otherwise.
+*> \endverbatim
+*>
+*> \param[out] KB
+*> \verbatim
+*> KB is INTEGER
+*> Factorization rank of the matrix A, i.e. the rank of
+*> the factor R, which is the same as the number of non-zero
+*> rows of the factor R. 0 <= KB <= min(M-IOFFSET,NB,N).
+*>
+*> KB also represents the number of non-zero Householder
+*> vectors.
+*> \endverbatim
+*>
+*> \param[out] MAXC2NRMK
+*> \verbatim
+*> MAXC2NRMK is REAL
+*> The maximum column 2-norm of the residual matrix,
+*> when the factorization stopped at rank KB. MAXC2NRMK >= 0.
+*> \endverbatim
+*>
+*> \param[out] RELMAXC2NRMK
+*> \verbatim
+*> RELMAXC2NRMK is REAL
+*> The ratio MAXC2NRMK / MAXC2NRM of the maximum column
+*> 2-norm of the residual matrix (when the factorization
+*> stopped at rank KB) to the maximum column 2-norm of the
+*> original matrix A_orig. RELMAXC2NRMK >= 0.
+*> \endverbatim
+*>
+*> \param[out] JPIV
+*> \verbatim
+*> JPIV is INTEGER array, dimension (N)
+*> Column pivot indices, for 1 <= j <= N, column j
+*> of the matrix A was interchanged with column JPIV(j).
+*> \endverbatim
+*>
+*> \param[out] TAU
+*> \verbatim
+*> TAU is REAL array, dimension (min(M-IOFFSET,N))
+*> The scalar factors of the elementary reflectors.
+*> \endverbatim
+*>
+*> \param[in,out] VN1
+*> \verbatim
+*> VN1 is REAL array, dimension (N)
+*> The vector with the partial column norms.
+*> \endverbatim
+*>
+*> \param[in,out] VN2
+*> \verbatim
+*> VN2 is REAL array, dimension (N)
+*> The vector with the exact column norms.
+*> \endverbatim
+*>
+*> \param[out] AUXV
+*> \verbatim
+*> AUXV is REAL array, dimension (NB)
+*> Auxiliary vector.
+*> \endverbatim
+*>
+*> \param[out] F
+*> \verbatim
+*> F is REAL array, dimension (LDF,NB)
+*> Matrix F**T = L*(Y**T)*A.
+*> \endverbatim
+*>
+*> \param[in] LDF
+*> \verbatim
+*> LDF is INTEGER
+*> The leading dimension of the array F. LDF >= max(1,N+NRHS).
+*> \endverbatim
+*>
+*> \param[out] IWORK
+*> \verbatim
+*> IWORK is INTEGER array, dimension (N-1).
+*> Is a work array. ( IWORK is used to store indices
+*> of "bad" columns for norm downdating in the residual
+*> matrix ).
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*> INFO is INTEGER
+*> 1) INFO = 0: successful exit.
+*> 2) If INFO = j_1, where 1 <= j_1 <= N, then NaN was
+*> detected and the routine stops the computation.
+*> The j_1-th column of the matrix A or the j_1-th
+*> element of array TAU contains the first occurrence
+*> of NaN in the factorization step KB+1 ( when KB columns
+*> have been factorized ).
+*>
+*> On exit:
+*> KB is set to the number of
+*> factorized columns without
+*> exception.
+*> MAXC2NRMK is set to NaN.
+*> RELMAXC2NRMK is set to NaN.
+*> TAU(KB+1:min(M,N)) is not set and contains undefined
+*> elements. If j_1=KB+1, TAU(KB+1)
+*> may contain NaN.
+*> 3) If INFO = j_2, where N+1 <= j_2 <= 2*N, then no NaN
+*> was detected, but +Inf (or -Inf) was detected and
+*> the routine continues the computation until completion.
+*> The (j_2-N)-th column of the matrix A contains the first
+*> occurrence of +Inf (or -Inf) in the actorization
+*> step KB+1 ( when KB columns have been factorized ).
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \ingroup laqp3rk
+*
+*> \par References:
+* ================
+*> [1] A Level 3 BLAS QR factorization algorithm with column pivoting developed in 1996.
+*> G. Quintana-Orti, Depto. de Informatica, Universidad Jaime I, Spain.
+*> X. Sun, Computer Science Dept., Duke University, USA.
+*> C. H. Bischof, Math. and Comp. Sci. Div., Argonne National Lab, USA.
+*> A BLAS-3 version of the QR factorization with column pivoting.
+*> LAPACK Working Note 114
+*> \htmlonly
+*> https://www.netlib.org/lapack/lawnspdf/lawn114.pdf
+*> \endhtmlonly
+*> and in
+*> SIAM J. Sci. Comput., 19(5):1486-1494, Sept. 1998.
+*> \htmlonly
+*> https://doi.org/10.1137/S1064827595296732
+*> \endhtmlonly
+*>
+*> [2] A partial column norm updating strategy developed in 2006.
+*> Z. Drmac and Z. Bujanovic, Dept. of Math., University of Zagreb, Croatia.
+*> On the failure of rank revealing QR factorization software – a case study.
+*> LAPACK Working Note 176.
+*> \htmlonly
+*> http://www.netlib.org/lapack/lawnspdf/lawn176.pdf
+*> \endhtmlonly
+*> and in
+*> ACM Trans. Math. Softw. 35, 2, Article 12 (July 2008), 28 pages.
+*> \htmlonly
+*> https://doi.org/10.1145/1377612.1377616
+*> \endhtmlonly
+*
+*> \par Contributors:
+* ==================
+*>
+*> \verbatim
+*>
+*> November 2023, Igor Kozachenko, James Demmel,
+*> Computer Science Division,
+*> University of California, Berkeley
+*>
+*> \endverbatim
+*
+* =====================================================================
+ SUBROUTINE SLAQP3RK( M, N, NRHS, IOFFSET, NB, ABSTOL,
+ $ RELTOL, KP1, MAXC2NRM, A, LDA, DONE, KB,
+ $ MAXC2NRMK, RELMAXC2NRMK, JPIV, TAU,
+ $ VN1, VN2, AUXV, F, LDF, IWORK, INFO )
+ IMPLICIT NONE
+*
+* -- LAPACK auxiliary routine --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*
+* .. Scalar Arguments ..
+ LOGICAL DONE
+ INTEGER INFO, IOFFSET, KB, KP1, LDA, LDF, M, N,
+ $ NB, NRHS
+ REAL ABSTOL, MAXC2NRM, MAXC2NRMK, RELMAXC2NRMK,
+ $ RELTOL
+* ..
+* .. Array Arguments ..
+ INTEGER IWORK( * ), JPIV( * )
+ REAL A( LDA, * ), AUXV( * ), F( LDF, * ), TAU( * ),
+ $ VN1( * ), VN2( * )
+* ..
+*
+* =====================================================================
+*
+* .. Parameters ..
+ REAL ZERO, ONE
+ PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
+* ..
+* .. Local Scalars ..
+ INTEGER ITEMP, J, K, MINMNFACT, MINMNUPDT,
+ $ LSTICC, KP, I, IF
+ REAL AIK, HUGEVAL, TEMP, TEMP2, TOL3Z
+* ..
+* .. External Subroutines ..
+ EXTERNAL SGEMM, SGEMV, SLARFG, SSWAP
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC ABS, MAX, MIN, SQRT
+* ..
+* .. External Functions ..
+ LOGICAL SISNAN
+ INTEGER ISAMAX
+ REAL SLAMCH, SNRM2
+ EXTERNAL SISNAN, SLAMCH, ISAMAX, SNRM2
+* ..
+* .. Executable Statements ..
+*
+* Initialize INFO
+*
+ INFO = 0
+*
+* MINMNFACT in the smallest dimension of the submatrix
+* A(IOFFSET+1:M,1:N) to be factorized.
+*
+ MINMNFACT = MIN( M-IOFFSET, N )
+ MINMNUPDT = MIN( M-IOFFSET, N+NRHS )
+ NB = MIN( NB, MINMNFACT )
+ TOL3Z = SQRT( SLAMCH( 'Epsilon' ) )
+ HUGEVAL = SLAMCH( 'Overflow' )
+*
+* Compute factorization in a while loop over NB columns,
+* K is the column index in the block A(1:M,1:N).
+*
+ K = 0
+ LSTICC = 0
+ DONE = .FALSE.
+*
+ DO WHILE ( K.LT.NB .AND. LSTICC.EQ.0 )
+ K = K + 1
+ I = IOFFSET + K
+*
+ IF( I.EQ.1 ) THEN
+*
+* We are at the first column of the original whole matrix A_orig,
+* therefore we use the computed KP1 and MAXC2NRM from the
+* main routine.
+*
+ KP = KP1
+*
+ ELSE
+*
+* Determine the pivot column in K-th step, i.e. the index
+* of the column with the maximum 2-norm in the
+* submatrix A(I:M,K:N).
+*
+ KP = ( K-1 ) + ISAMAX( N-K+1, VN1( K ), 1 )
+*
+* Determine the maximum column 2-norm and the relative maximum
+* column 2-norm of the submatrix A(I:M,K:N) in step K.
+*
+ MAXC2NRMK = VN1( KP )
+*
+* ============================================================
+*
+* Check if the submatrix A(I:M,K:N) contains NaN, set
+* INFO parameter to the column number, where the first NaN
+* is found and return from the routine.
+* We need to check the condition only if the
+* column index (same as row index) of the original whole
+* matrix is larger than 1, since the condition for whole
+* original matrix is checked in the main routine.
+*
+ IF( SISNAN( MAXC2NRMK ) ) THEN
+*
+ DONE = .TRUE.
+*
+* Set KB, the number of factorized partial columns
+* that are non-zero in each step in the block,
+* i.e. the rank of the factor R.
+* Set IF, the number of processed rows in the block, which
+* is the same as the number of processed rows in
+* the original whole matrix A_orig.
+*
+ KB = K - 1
+ IF = I - 1
+ INFO = KB + KP
+*
+* Set RELMAXC2NRMK to NaN.
+*
+ RELMAXC2NRMK = MAXC2NRMK
+*
+* There is no need to apply the block reflector to the
+* residual of the matrix A stored in A(KB+1:M,KB+1:N),
+* since the submatrix contains NaN and we stop
+* the computation.
+* But, we need to apply the block reflector to the residual
+* right hand sides stored in A(KB+1:M,N+1:N+NRHS), if the
+* residual right hand sides exist. This occurs
+* when ( NRHS != 0 AND KB <= (M-IOFFSET) ):
+*
+* A(I+1:M,N+1:N+NRHS) := A(I+1:M,N+1:N+NRHS) -
+* A(I+1:M,1:KB) * F(N+1:N+NRHS,1:KB)**T.
+
+ IF( NRHS.GT.0 .AND. KB.LT.(M-IOFFSET) ) THEN
+ CALL SGEMM( 'No transpose', 'Transpose',
+ $ M-IF, NRHS, KB, -ONE, A( IF+1, 1 ), LDA,
+ $ F( N+1, 1 ), LDF, ONE, A( IF+1, N+1 ), LDA )
+ END IF
+*
+* There is no need to recompute the 2-norm of the
+* difficult columns, since we stop the factorization.
+*
+* Array TAU(KF+1:MINMNFACT) is not set and contains
+* undefined elements.
+*
+* Return from the routine.
+*
+ RETURN
+ END IF
+*
+* Quick return, if the submatrix A(I:M,K:N) is
+* a zero matrix. We need to check it only if the column index
+* (same as row index) is larger than 1, since the condition
+* for the whole original matrix A_orig is checked in the main
+* routine.
+*
+ IF( MAXC2NRMK.EQ.ZERO ) THEN
+*
+ DONE = .TRUE.
+*
+* Set KB, the number of factorized partial columns
+* that are non-zero in each step in the block,
+* i.e. the rank of the factor R.
+* Set IF, the number of processed rows in the block, which
+* is the same as the number of processed rows in
+* the original whole matrix A_orig.
+*
+ KB = K - 1
+ IF = I - 1
+ RELMAXC2NRMK = ZERO
+*
+* There is no need to apply the block reflector to the
+* residual of the matrix A stored in A(KB+1:M,KB+1:N),
+* since the submatrix is zero and we stop the computation.
+* But, we need to apply the block reflector to the residual
+* right hand sides stored in A(KB+1:M,N+1:N+NRHS), if the
+* residual right hand sides exist. This occurs
+* when ( NRHS != 0 AND KB <= (M-IOFFSET) ):
+*
+* A(I+1:M,N+1:N+NRHS) := A(I+1:M,N+1:N+NRHS) -
+* A(I+1:M,1:KB) * F(N+1:N+NRHS,1:KB)**T.
+*
+ IF( NRHS.GT.0 .AND. KB.LT.(M-IOFFSET) ) THEN
+ CALL SGEMM( 'No transpose', 'Transpose',
+ $ M-IF, NRHS, KB, -ONE, A( IF+1, 1 ), LDA,
+ $ F( N+1, 1 ), LDF, ONE, A( IF+1, N+1 ), LDA )
+ END IF
+*
+* There is no need to recompute the 2-norm of the
+* difficult columns, since we stop the factorization.
+*
+* Set TAUs corresponding to the columns that were not
+* factorized to ZERO, i.e. set TAU(KB+1:MINMNFACT) = ZERO,
+* which is equivalent to seting TAU(K:MINMNFACT) = ZERO.
+*
+ DO J = K, MINMNFACT
+ TAU( J ) = ZERO
+ END DO
+*
+* Return from the routine.
+*
+ RETURN
+*
+ END IF
+*
+* ============================================================
+*
+* Check if the submatrix A(I:M,K:N) contains Inf,
+* set INFO parameter to the column number, where
+* the first Inf is found plus N, and continue
+* the computation.
+* We need to check the condition only if the
+* column index (same as row index) of the original whole
+* matrix is larger than 1, since the condition for whole
+* original matrix is checked in the main routine.
+*
+ IF( INFO.EQ.0 .AND. MAXC2NRMK.GT.HUGEVAL ) THEN
+ INFO = N + K - 1 + KP
+ END IF
+*
+* ============================================================
+*
+* Test for the second and third tolerance stopping criteria.
+* NOTE: There is no need to test for ABSTOL.GE.ZERO, since
+* MAXC2NRMK is non-negative. Similarly, there is no need
+* to test for RELTOL.GE.ZERO, since RELMAXC2NRMK is
+* non-negative.
+* We need to check the condition only if the
+* column index (same as row index) of the original whole
+* matrix is larger than 1, since the condition for whole
+* original matrix is checked in the main routine.
+*
+ RELMAXC2NRMK = MAXC2NRMK / MAXC2NRM
+*
+ IF( MAXC2NRMK.LE.ABSTOL .OR. RELMAXC2NRMK.LE.RELTOL ) THEN
+*
+ DONE = .TRUE.
+*
+* Set KB, the number of factorized partial columns
+* that are non-zero in each step in the block,
+* i.e. the rank of the factor R.
+* Set IF, the number of processed rows in the block, which
+* is the same as the number of processed rows in
+* the original whole matrix A_orig;
+*
+ KB = K - 1
+ IF = I - 1
+*
+* Apply the block reflector to the residual of the
+* matrix A and the residual of the right hand sides B, if
+* the residual matrix and and/or the residual of the right
+* hand sides exist, i.e. if the submatrix
+* A(I+1:M,KB+1:N+NRHS) exists. This occurs when
+* KB < MINMNUPDT = min( M-IOFFSET, N+NRHS ):
+*
+* A(IF+1:M,K+1:N+NRHS) := A(IF+1:M,KB+1:N+NRHS) -
+* A(IF+1:M,1:KB) * F(KB+1:N+NRHS,1:KB)**T.
+*
+ IF( KB.LT.MINMNUPDT ) THEN
+ CALL SGEMM( 'No transpose', 'Transpose',
+ $ M-IF, N+NRHS-KB, KB,-ONE, A( IF+1, 1 ), LDA,
+ $ F( KB+1, 1 ), LDF, ONE, A( IF+1, KB+1 ), LDA )
+ END IF
+*
+* There is no need to recompute the 2-norm of the
+* difficult columns, since we stop the factorization.
+*
+* Set TAUs corresponding to the columns that were not
+* factorized to ZERO, i.e. set TAU(KB+1:MINMNFACT) = ZERO,
+* which is equivalent to seting TAU(K:MINMNFACT) = ZERO.
+*
+ DO J = K, MINMNFACT
+ TAU( J ) = ZERO
+ END DO
+*
+* Return from the routine.
+*
+ RETURN
+*
+ END IF
+*
+* ============================================================
+*
+* End ELSE of IF(I.EQ.1)
+*
+ END IF
+*
+* ===============================================================
+*
+* If the pivot column is not the first column of the
+* subblock A(1:M,K:N):
+* 1) swap the K-th column and the KP-th pivot column
+* in A(1:M,1:N);
+* 2) swap the K-th row and the KP-th row in F(1:N,1:K-1)
+* 3) copy the K-th element into the KP-th element of the partial
+* and exact 2-norm vectors VN1 and VN2. (Swap is not needed
+* for VN1 and VN2 since we use the element with the index
+* larger than K in the next loop step.)
+* 4) Save the pivot interchange with the indices relative to the
+* the original matrix A_orig, not the block A(1:M,1:N).
+*
+ IF( KP.NE.K ) THEN
+ CALL SSWAP( M, A( 1, KP ), 1, A( 1, K ), 1 )
+ CALL SSWAP( K-1, F( KP, 1 ), LDF, F( K, 1 ), LDF )
+ VN1( KP ) = VN1( K )
+ VN2( KP ) = VN2( K )
+ ITEMP = JPIV( KP )
+ JPIV( KP ) = JPIV( K )
+ JPIV( K ) = ITEMP
+ END IF
+*
+* Apply previous Householder reflectors to column K:
+* A(I:M,K) := A(I:M,K) - A(I:M,1:K-1)*F(K,1:K-1)**T.
+*
+ IF( K.GT.1 ) THEN
+ CALL SGEMV( 'No transpose', M-I+1, K-1, -ONE, A( I, 1 ),
+ $ LDA, F( K, 1 ), LDF, ONE, A( I, K ), 1 )
+ END IF
+*
+* Generate elementary reflector H(k) using the column A(I:M,K).
+*
+ IF( I.LT.M ) THEN
+ CALL SLARFG( M-I+1, A( I, K ), A( I+1, K ), 1, TAU( K ) )
+ ELSE
+ TAU( K ) = ZERO
+ END IF
+*
+* Check if TAU(K) contains NaN, set INFO parameter
+* to the column number where NaN is found and return from
+* the routine.
+* NOTE: There is no need to check TAU(K) for Inf,
+* since SLARFG cannot produce TAU(K) or Householder vector
+* below the diagonal containing Inf. Only BETA on the diagonal,
+* returned by SLARFG can contain Inf, which requires
+* TAU(K) to contain NaN. Therefore, this case of generating Inf
+* by SLARFG is covered by checking TAU(K) for NaN.
+*
+ IF( SISNAN( TAU(K) ) ) THEN
+*
+ DONE = .TRUE.
+*
+* Set KB, the number of factorized partial columns
+* that are non-zero in each step in the block,
+* i.e. the rank of the factor R.
+* Set IF, the number of processed rows in the block, which
+* is the same as the number of processed rows in
+* the original whole matrix A_orig.
+*
+ KB = K - 1
+ IF = I - 1
+ INFO = K
+*
+* Set MAXC2NRMK and RELMAXC2NRMK to NaN.
+*
+ MAXC2NRMK = TAU( K )
+ RELMAXC2NRMK = TAU( K )
+*
+* There is no need to apply the block reflector to the
+* residual of the matrix A stored in A(KB+1:M,KB+1:N),
+* since the submatrix contains NaN and we stop
+* the computation.
+* But, we need to apply the block reflector to the residual
+* right hand sides stored in A(KB+1:M,N+1:N+NRHS), if the
+* residual right hand sides exist. This occurs
+* when ( NRHS != 0 AND KB <= (M-IOFFSET) ):
+*
+* A(I+1:M,N+1:N+NRHS) := A(I+1:M,N+1:N+NRHS) -
+* A(I+1:M,1:KB) * F(N+1:N+NRHS,1:KB)**T.
+*
+ IF( NRHS.GT.0 .AND. KB.LT.(M-IOFFSET) ) THEN
+ CALL SGEMM( 'No transpose', 'Transpose',
+ $ M-IF, NRHS, KB, -ONE, A( IF+1, 1 ), LDA,
+ $ F( N+1, 1 ), LDF, ONE, A( IF+1, N+1 ), LDA )
+ END IF
+*
+* There is no need to recompute the 2-norm of the
+* difficult columns, since we stop the factorization.
+*
+* Array TAU(KF+1:MINMNFACT) is not set and contains
+* undefined elements.
+*
+* Return from the routine.
+*
+ RETURN
+ END IF
+*
+* ===============================================================
+*
+ AIK = A( I, K )
+ A( I, K ) = ONE
+*
+* ===============================================================
+*
+* Compute the current K-th column of F:
+* 1) F(K+1:N,K) := tau(K) * A(I:M,K+1:N)**T * A(I:M,K).
+*
+ IF( K.LT.N+NRHS ) THEN
+ CALL SGEMV( 'Transpose', M-I+1, N+NRHS-K,
+ $ TAU( K ), A( I, K+1 ), LDA, A( I, K ), 1,
+ $ ZERO, F( K+1, K ), 1 )
+ END IF
+*
+* 2) Zero out elements above and on the diagonal of the
+* column K in matrix F, i.e elements F(1:K,K).
+*
+ DO J = 1, K
+ F( J, K ) = ZERO
+ END DO
+*
+* 3) Incremental updating of the K-th column of F:
+* F(1:N,K) := F(1:N,K) - tau(K) * F(1:N,1:K-1) * A(I:M,1:K-1)**T
+* * A(I:M,K).
+*
+ IF( K.GT.1 ) THEN
+ CALL SGEMV( 'Transpose', M-I+1, K-1, -TAU( K ),
+ $ A( I, 1 ), LDA, A( I, K ), 1, ZERO,
+ $ AUXV( 1 ), 1 )
+*
+ CALL SGEMV( 'No transpose', N+NRHS, K-1, ONE,
+ $ F( 1, 1 ), LDF, AUXV( 1 ), 1, ONE,
+ $ F( 1, K ), 1 )
+ END IF
+*
+* ===============================================================
+*
+* Update the current I-th row of A:
+* A(I,K+1:N+NRHS) := A(I,K+1:N+NRHS)
+* - A(I,1:K)*F(K+1:N+NRHS,1:K)**T.
+*
+ IF( K.LT.N+NRHS ) THEN
+ CALL SGEMV( 'No transpose', N+NRHS-K, K, -ONE,
+ $ F( K+1, 1 ), LDF, A( I, 1 ), LDA, ONE,
+ $ A( I, K+1 ), LDA )
+ END IF
+*
+ A( I, K ) = AIK
+*
+* Update the partial column 2-norms for the residual matrix,
+* only if the residual matrix A(I+1:M,K+1:N) exists, i.e.
+* when K < MINMNFACT = min( M-IOFFSET, N ).
+*
+ IF( K.LT.MINMNFACT ) THEN
+*
+ DO J = K + 1, N
+ IF( VN1( J ).NE.ZERO ) THEN
+*
+* NOTE: The following lines follow from the analysis in
+* Lapack Working Note 176.
+*
+ TEMP = ABS( A( I, J ) ) / VN1( J )
+ TEMP = MAX( ZERO, ( ONE+TEMP )*( ONE-TEMP ) )
+ TEMP2 = TEMP*( VN1( J ) / VN2( J ) )**2
+ IF( TEMP2.LE.TOL3Z ) THEN
+*
+* At J-index, we have a difficult column for the
+* update of the 2-norm. Save the index of the previous
+* difficult column in IWORK(J-1).
+* NOTE: ILSTCC > 1, threfore we can use IWORK only
+* with N-1 elements, where the elements are
+* shifted by 1 to the left.
+*
+ IWORK( J-1 ) = LSTICC
+*
+* Set the index of the last difficult column LSTICC.
+*
+ LSTICC = J
+*
+ ELSE
+ VN1( J ) = VN1( J )*SQRT( TEMP )
+ END IF
+ END IF
+ END DO
+*
+ END IF
+*
+* End of while loop.
+*
+ END DO
+*
+* Now, afler the loop:
+* Set KB, the number of factorized columns in the block;
+* Set IF, the number of processed rows in the block, which
+* is the same as the number of processed rows in
+* the original whole matrix A_orig, IF = IOFFSET + KB.
+*
+ KB = K
+ IF = I
+*
+* Apply the block reflector to the residual of the matrix A
+* and the residual of the right hand sides B, if the residual
+* matrix and and/or the residual of the right hand sides
+* exist, i.e. if the submatrix A(I+1:M,KB+1:N+NRHS) exists.
+* This occurs when KB < MINMNUPDT = min( M-IOFFSET, N+NRHS ):
+*
+* A(IF+1:M,K+1:N+NRHS) := A(IF+1:M,KB+1:N+NRHS) -
+* A(IF+1:M,1:KB) * F(KB+1:N+NRHS,1:KB)**T.
+*
+ IF( KB.LT.MINMNUPDT ) THEN
+ CALL SGEMM( 'No transpose', 'Transpose',
+ $ M-IF, N+NRHS-KB, KB, -ONE, A( IF+1, 1 ), LDA,
+ $ F( KB+1, 1 ), LDF, ONE, A( IF+1, KB+1 ), LDA )
+ END IF
+*
+* Recompute the 2-norm of the difficult columns.
+* Loop over the index of the difficult columns from the largest
+* to the smallest index.
+*
+ DO WHILE( LSTICC.GT.0 )
+*
+* LSTICC is the index of the last difficult column is greater
+* than 1.
+* ITEMP is the index of the previous difficult column.
+*
+ ITEMP = IWORK( LSTICC-1 )
+*
+* Compute the 2-norm explicilty for the last difficult column and
+* save it in the partial and exact 2-norm vectors VN1 and VN2.
+*
+* NOTE: The computation of VN1( LSTICC ) relies on the fact that
+* SNRM2 does not fail on vectors with norm below the value of
+* SQRT(SLAMCH('S'))
+*
+ VN1( LSTICC ) = SNRM2( M-IF, A( IF+1, LSTICC ), 1 )
+ VN2( LSTICC ) = VN1( LSTICC )
+*
+* Downdate the index of the last difficult column to
+* the index of the previous difficult column.
+*
+ LSTICC = ITEMP
+*
+ END DO
+*
+ RETURN
+*
+* End of SLAQP3RK
+*
+ END
diff --git a/lapack-netlib/SRC/zgeqp3rk.f b/lapack-netlib/SRC/zgeqp3rk.f
new file mode 100644
index 000000000..f8ef986c7
--- /dev/null
+++ b/lapack-netlib/SRC/zgeqp3rk.f
@@ -0,0 +1,1091 @@
+*> \brief \b ZGEQP3RK computes a truncated Householder QR factorization with column pivoting of a complex m-by-n matrix A by using Level 3 BLAS and overwrites m-by-nrhs matrix B with Q**H * B.
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ZGEQP3RK + dependencies
+*>
+*> [TGZ]
+*>
+*> [ZIP]
+*>
+*> [TXT]
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE ZGEQP3RK( M, N, NRHS, KMAX, ABSTOL, RELTOL, A, LDA,
+* $ K, MAXC2NRMK, RELMAXC2NRMK, JPIV, TAU,
+* $ WORK, LWORK, RWORK, IWORK, INFO )
+* IMPLICIT NONE
+*
+* .. Scalar Arguments ..
+* INTEGER INFO, K, KMAX, LDA, LWORK, M, N, NRHS
+* DOUBLE PRECISION ABSTOL, MAXC2NRMK, RELMAXC2NRMK, RELTOL
+* ..
+* .. Array Arguments ..
+* INTEGER IWORK( * ), JPIV( * )
+* DOUBLE PRECISION RWORK( * )
+* COMPLEX*16 A( LDA, * ), TAU( * ), WORK( * )
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> ZGEQP3RK performs two tasks simultaneously:
+*>
+*> Task 1: The routine computes a truncated (rank K) or full rank
+*> Householder QR factorization with column pivoting of a complex
+*> M-by-N matrix A using Level 3 BLAS. K is the number of columns
+*> that were factorized, i.e. factorization rank of the
+*> factor R, K <= min(M,N).
+*>
+*> A * P(K) = Q(K) * R(K) =
+*>
+*> = Q(K) * ( R11(K) R12(K) ) = Q(K) * ( R(K)_approx )
+*> ( 0 R22(K) ) ( 0 R(K)_residual ),
+*>
+*> where:
+*>
+*> P(K) is an N-by-N permutation matrix;
+*> Q(K) is an M-by-M orthogonal matrix;
+*> R(K)_approx = ( R11(K), R12(K) ) is a rank K approximation of the
+*> full rank factor R with K-by-K upper-triangular
+*> R11(K) and K-by-N rectangular R12(K). The diagonal
+*> entries of R11(K) appear in non-increasing order
+*> of absolute value, and absolute values of all of
+*> them exceed the maximum column 2-norm of R22(K)
+*> up to roundoff error.
+*> R(K)_residual = R22(K) is the residual of a rank K approximation
+*> of the full rank factor R. It is a
+*> an (M-K)-by-(N-K) rectangular matrix;
+*> 0 is a an (M-K)-by-K zero matrix.
+*>
+*> Task 2: At the same time, the routine overwrites a complex M-by-NRHS
+*> matrix B with Q(K)**H * B using Level 3 BLAS.
+*>
+*> =====================================================================
+*>
+*> The matrices A and B are stored on input in the array A as
+*> the left and right blocks A(1:M,1:N) and A(1:M, N+1:N+NRHS)
+*> respectively.
+*>
+*> N NRHS
+*> array_A = M [ mat_A, mat_B ]
+*>
+*> The truncation criteria (i.e. when to stop the factorization)
+*> can be any of the following:
+*>
+*> 1) The input parameter KMAX, the maximum number of columns
+*> KMAX to factorize, i.e. the factorization rank is limited
+*> to KMAX. If KMAX >= min(M,N), the criterion is not used.
+*>
+*> 2) The input parameter ABSTOL, the absolute tolerance for
+*> the maximum column 2-norm of the residual matrix R22(K). This
+*> means that the factorization stops if this norm is less or
+*> equal to ABSTOL. If ABSTOL < 0.0, the criterion is not used.
+*>
+*> 3) The input parameter RELTOL, the tolerance for the maximum
+*> column 2-norm matrix of the residual matrix R22(K) divided
+*> by the maximum column 2-norm of the original matrix A, which
+*> is equal to abs(R(1,1)). This means that the factorization stops
+*> when the ratio of the maximum column 2-norm of R22(K) to
+*> the maximum column 2-norm of A is less than or equal to RELTOL.
+*> If RELTOL < 0.0, the criterion is not used.
+*>
+*> 4) In case both stopping criteria ABSTOL or RELTOL are not used,
+*> and when the residual matrix R22(K) is a zero matrix in some
+*> factorization step K. ( This stopping criterion is implicit. )
+*>
+*> The algorithm stops when any of these conditions is first
+*> satisfied, otherwise the whole matrix A is factorized.
+*>
+*> To factorize the whole matrix A, use the values
+*> KMAX >= min(M,N), ABSTOL < 0.0 and RELTOL < 0.0.
+*>
+*> The routine returns:
+*> a) Q(K), R(K)_approx = ( R11(K), R12(K) ),
+*> R(K)_residual = R22(K), P(K), i.e. the resulting matrices
+*> of the factorization; P(K) is represented by JPIV,
+*> ( if K = min(M,N), R(K)_approx is the full factor R,
+*> and there is no residual matrix R(K)_residual);
+*> b) K, the number of columns that were factorized,
+*> i.e. factorization rank;
+*> c) MAXC2NRMK, the maximum column 2-norm of the residual
+*> matrix R(K)_residual = R22(K),
+*> ( if K = min(M,N), MAXC2NRMK = 0.0 );
+*> d) RELMAXC2NRMK equals MAXC2NRMK divided by MAXC2NRM, the maximum
+*> column 2-norm of the original matrix A, which is equal
+*> to abs(R(1,1)), ( if K = min(M,N), RELMAXC2NRMK = 0.0 );
+*> e) Q(K)**H * B, the matrix B with the orthogonal
+*> transformation Q(K)**H applied on the left.
+*>
+*> The N-by-N permutation matrix P(K) is stored in a compact form in
+*> the integer array JPIV. For 1 <= j <= N, column j
+*> of the matrix A was interchanged with column JPIV(j).
+*>
+*> The M-by-M orthogonal matrix Q is represented as a product
+*> of elementary Householder reflectors
+*>
+*> Q(K) = H(1) * H(2) * . . . * H(K),
+*>
+*> where K is the number of columns that were factorized.
+*>
+*> Each H(j) has the form
+*>
+*> H(j) = I - tau * v * v**H,
+*>
+*> where 1 <= j <= K and
+*> I is an M-by-M identity matrix,
+*> tau is a complex scalar,
+*> v is a complex vector with v(1:j-1) = 0 and v(j) = 1.
+*>
+*> v(j+1:M) is stored on exit in A(j+1:M,j) and tau in TAU(j).
+*>
+*> See the Further Details section for more information.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] M
+*> \verbatim
+*> M is INTEGER
+*> The number of rows of the matrix A. M >= 0.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> The number of columns of the matrix A. N >= 0.
+*> \endverbatim
+*>
+*> \param[in] NRHS
+*> \verbatim
+*> NRHS is INTEGER
+*> The number of right hand sides, i.e. the number of
+*> columns of the matrix B. NRHS >= 0.
+*> \endverbatim
+*>
+*> \param[in] KMAX
+*> \verbatim
+*> KMAX is INTEGER
+*>
+*> The first factorization stopping criterion. KMAX >= 0.
+*>
+*> The maximum number of columns of the matrix A to factorize,
+*> i.e. the maximum factorization rank.
+*>
+*> a) If KMAX >= min(M,N), then this stopping criterion
+*> is not used, the routine factorizes columns
+*> depending on ABSTOL and RELTOL.
+*>
+*> b) If KMAX = 0, then this stopping criterion is
+*> satisfied on input and the routine exits immediately.
+*> This means that the factorization is not performed,
+*> the matrices A and B are not modified, and
+*> the matrix A is itself the residual.
+*> \endverbatim
+*>
+*> \param[in] ABSTOL
+*> \verbatim
+*> ABSTOL is DOUBLE PRECISION
+*>
+*> The second factorization stopping criterion, cannot be NaN.
+*>
+*> The absolute tolerance (stopping threshold) for
+*> maximum column 2-norm of the residual matrix R22(K).
+*> The algorithm converges (stops the factorization) when
+*> the maximum column 2-norm of the residual matrix R22(K)
+*> is less than or equal to ABSTOL. Let SAFMIN = DLAMCH('S').
+*>
+*> a) If ABSTOL is NaN, then no computation is performed
+*> and an error message ( INFO = -5 ) is issued
+*> by XERBLA.
+*>
+*> b) If ABSTOL < 0.0, then this stopping criterion is not
+*> used, the routine factorizes columns depending
+*> on KMAX and RELTOL.
+*> This includes the case ABSTOL = -Inf.
+*>
+*> c) If 0.0 <= ABSTOL < 2*SAFMIN, then ABSTOL = 2*SAFMIN
+*> is used. This includes the case ABSTOL = -0.0.
+*>
+*> d) If 2*SAFMIN <= ABSTOL then the input value
+*> of ABSTOL is used.
+*>
+*> Let MAXC2NRM be the maximum column 2-norm of the
+*> whole original matrix A.
+*> If ABSTOL chosen above is >= MAXC2NRM, then this
+*> stopping criterion is satisfied on input and routine exits
+*> immediately after MAXC2NRM is computed. The routine
+*> returns MAXC2NRM in MAXC2NORMK,
+*> and 1.0 in RELMAXC2NORMK.
+*> This includes the case ABSTOL = +Inf. This means that the
+*> factorization is not performed, the matrices A and B are not
+*> modified, and the matrix A is itself the residual.
+*> \endverbatim
+*>
+*> \param[in] RELTOL
+*> \verbatim
+*> RELTOL is DOUBLE PRECISION
+*>
+*> The third factorization stopping criterion, cannot be NaN.
+*>
+*> The tolerance (stopping threshold) for the ratio
+*> abs(R(K+1,K+1))/abs(R(1,1)) of the maximum column 2-norm of
+*> the residual matrix R22(K) to the maximum column 2-norm of
+*> the original matrix A. The algorithm converges (stops the
+*> factorization), when abs(R(K+1,K+1))/abs(R(1,1)) A is less
+*> than or equal to RELTOL. Let EPS = DLAMCH('E').
+*>
+*> a) If RELTOL is NaN, then no computation is performed
+*> and an error message ( INFO = -6 ) is issued
+*> by XERBLA.
+*>
+*> b) If RELTOL < 0.0, then this stopping criterion is not
+*> used, the routine factorizes columns depending
+*> on KMAX and ABSTOL.
+*> This includes the case RELTOL = -Inf.
+*>
+*> c) If 0.0 <= RELTOL < EPS, then RELTOL = EPS is used.
+*> This includes the case RELTOL = -0.0.
+*>
+*> d) If EPS <= RELTOL then the input value of RELTOL
+*> is used.
+*>
+*> Let MAXC2NRM be the maximum column 2-norm of the
+*> whole original matrix A.
+*> If RELTOL chosen above is >= 1.0, then this stopping
+*> criterion is satisfied on input and routine exits
+*> immediately after MAXC2NRM is computed.
+*> The routine returns MAXC2NRM in MAXC2NORMK,
+*> and 1.0 in RELMAXC2NORMK.
+*> This includes the case RELTOL = +Inf. This means that the
+*> factorization is not performed, the matrices A and B are not
+*> modified, and the matrix A is itself the residual.
+*>
+*> NOTE: We recommend that RELTOL satisfy
+*> min( 10*max(M,N)*EPS, sqrt(EPS) ) <= RELTOL
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*> A is COMPLEX*16 array, dimension (LDA,N+NRHS)
+*>
+*> On entry:
+*>
+*> a) The subarray A(1:M,1:N) contains the M-by-N matrix A.
+*> b) The subarray A(1:M,N+1:N+NRHS) contains the M-by-NRHS
+*> matrix B.
+*>
+*> N NRHS
+*> array_A = M [ mat_A, mat_B ]
+*>
+*> On exit:
+*>
+*> a) The subarray A(1:M,1:N) contains parts of the factors
+*> of the matrix A:
+*>
+*> 1) If K = 0, A(1:M,1:N) contains the original matrix A.
+*> 2) If K > 0, A(1:M,1:N) contains parts of the
+*> factors:
+*>
+*> 1. The elements below the diagonal of the subarray
+*> A(1:M,1:K) together with TAU(1:K) represent the
+*> orthogonal matrix Q(K) as a product of K Householder
+*> elementary reflectors.
+*>
+*> 2. The elements on and above the diagonal of
+*> the subarray A(1:K,1:N) contain K-by-N
+*> upper-trapezoidal matrix
+*> R(K)_approx = ( R11(K), R12(K) ).
+*> NOTE: If K=min(M,N), i.e. full rank factorization,
+*> then R_approx(K) is the full factor R which
+*> is upper-trapezoidal. If, in addition, M>=N,
+*> then R is upper-triangular.
+*>
+*> 3. The subarray A(K+1:M,K+1:N) contains (M-K)-by-(N-K)
+*> rectangular matrix R(K)_residual = R22(K).
+*>
+*> b) If NRHS > 0, the subarray A(1:M,N+1:N+NRHS) contains
+*> the M-by-NRHS product Q(K)**H * B.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*> LDA is INTEGER
+*> The leading dimension of the array A. LDA >= max(1,M).
+*> This is the leading dimension for both matrices, A and B.
+*> \endverbatim
+*>
+*> \param[out] K
+*> \verbatim
+*> K is INTEGER
+*> Factorization rank of the matrix A, i.e. the rank of
+*> the factor R, which is the same as the number of non-zero
+*> rows of the factor R. 0 <= K <= min(M,KMAX,N).
+*>
+*> K also represents the number of non-zero Householder
+*> vectors.
+*>
+*> NOTE: If K = 0, a) the arrays A and B are not modified;
+*> b) the array TAU(1:min(M,N)) is set to ZERO,
+*> if the matrix A does not contain NaN,
+*> otherwise the elements TAU(1:min(M,N))
+*> are undefined;
+*> c) the elements of the array JPIV are set
+*> as follows: for j = 1:N, JPIV(j) = j.
+*> \endverbatim
+*>
+*> \param[out] MAXC2NRMK
+*> \verbatim
+*> MAXC2NRMK is DOUBLE PRECISION
+*> The maximum column 2-norm of the residual matrix R22(K),
+*> when the factorization stopped at rank K. MAXC2NRMK >= 0.
+*>
+*> a) If K = 0, i.e. the factorization was not performed,
+*> the matrix A was not modified and is itself a residual
+*> matrix, then MAXC2NRMK equals the maximum column 2-norm
+*> of the original matrix A.
+*>
+*> b) If 0 < K < min(M,N), then MAXC2NRMK is returned.
+*>
+*> c) If K = min(M,N), i.e. the whole matrix A was
+*> factorized and there is no residual matrix,
+*> then MAXC2NRMK = 0.0.
+*>
+*> NOTE: MAXC2NRMK in the factorization step K would equal
+*> R(K+1,K+1) in the next factorization step K+1.
+*> \endverbatim
+*>
+*> \param[out] RELMAXC2NRMK
+*> \verbatim
+*> RELMAXC2NRMK is DOUBLE PRECISION
+*> The ratio MAXC2NRMK / MAXC2NRM of the maximum column
+*> 2-norm of the residual matrix R22(K) (when the factorization
+*> stopped at rank K) to the maximum column 2-norm of the
+*> whole original matrix A. RELMAXC2NRMK >= 0.
+*>
+*> a) If K = 0, i.e. the factorization was not performed,
+*> the matrix A was not modified and is itself a residual
+*> matrix, then RELMAXC2NRMK = 1.0.
+*>
+*> b) If 0 < K < min(M,N), then
+*> RELMAXC2NRMK = MAXC2NRMK / MAXC2NRM is returned.
+*>
+*> c) If K = min(M,N), i.e. the whole matrix A was
+*> factorized and there is no residual matrix,
+*> then RELMAXC2NRMK = 0.0.
+*>
+*> NOTE: RELMAXC2NRMK in the factorization step K would equal
+*> abs(R(K+1,K+1))/abs(R(1,1)) in the next factorization
+*> step K+1.
+*> \endverbatim
+*>
+*> \param[out] JPIV
+*> \verbatim
+*> JPIV is INTEGER array, dimension (N)
+*> Column pivot indices. For 1 <= j <= N, column j
+*> of the matrix A was interchanged with column JPIV(j).
+*>
+*> The elements of the array JPIV(1:N) are always set
+*> by the routine, for example, even when no columns
+*> were factorized, i.e. when K = 0, the elements are
+*> set as JPIV(j) = j for j = 1:N.
+*> \endverbatim
+*>
+*> \param[out] TAU
+*> \verbatim
+*> TAU is COMPLEX*16 array, dimension (min(M,N))
+*> The scalar factors of the elementary reflectors.
+*>
+*> If 0 < K <= min(M,N), only the elements TAU(1:K) of
+*> the array TAU are modified by the factorization.
+*> After the factorization computed, if no NaN was found
+*> during the factorization, the remaining elements
+*> TAU(K+1:min(M,N)) are set to zero, otherwise the
+*> elements TAU(K+1:min(M,N)) are not set and therefore
+*> undefined.
+*> ( If K = 0, all elements of TAU are set to zero, if
+*> the matrix A does not contain NaN. )
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*> WORK is COMPLEX*16 array, dimension (MAX(1,LWORK))
+*> On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*> LWORK is INTEGER
+*> The dimension of the array WORK.
+*. LWORK >= N+NRHS-1
+*> For optimal performance LWORK >= NB*( N+NRHS+1 ),
+*> where NB is the optimal block size for ZGEQP3RK returned
+*> by ILAENV. Minimal block size MINNB=2.
+*>
+*> NOTE: The decision, whether to use unblocked BLAS 2
+*> or blocked BLAS 3 code is based not only on the dimension
+*> LWORK of the availbale workspace WORK, but also also on the
+*> matrix A dimension N via crossover point NX returned
+*> by ILAENV. (For N less than NX, unblocked code should be
+*> used.)
+*>
+*> If LWORK = -1, then a workspace query is assumed;
+*> the routine only calculates the optimal size of the WORK
+*> array, returns this value as the first entry of the WORK
+*> array, and no error message related to LWORK is issued
+*> by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] RWORK
+*> \verbatim
+*> RWORK is DOUBLE PRECISION array, dimension (2*N)
+*> \endverbatim
+*>
+*> \param[out] IWORK
+*> \verbatim
+*> IWORK is INTEGER array, dimension (N-1).
+*> Is a work array. ( IWORK is used to store indices
+*> of "bad" columns for norm downdating in the residual
+*> matrix in the blocked step auxiliary subroutine ZLAQP3RK ).
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*> INFO is INTEGER
+*> 1) INFO = 0: successful exit.
+*> 2) INFO < 0: if INFO = -i, the i-th argument had an
+*> illegal value.
+*> 3) If INFO = j_1, where 1 <= j_1 <= N, then NaN was
+*> detected and the routine stops the computation.
+*> The j_1-th column of the matrix A or the j_1-th
+*> element of array TAU contains the first occurrence
+*> of NaN in the factorization step K+1 ( when K columns
+*> have been factorized ).
+*>
+*> On exit:
+*> K is set to the number of
+*> factorized columns without
+*> exception.
+*> MAXC2NRMK is set to NaN.
+*> RELMAXC2NRMK is set to NaN.
+*> TAU(K+1:min(M,N)) is not set and contains undefined
+*> elements. If j_1=K+1, TAU(K+1)
+*> may contain NaN.
+*> 4) If INFO = j_2, where N+1 <= j_2 <= 2*N, then no NaN
+*> was detected, but +Inf (or -Inf) was detected and
+*> the routine continues the computation until completion.
+*> The (j_2-N)-th column of the matrix A contains the first
+*> occurrence of +Inf (or -Inf) in the factorization
+*> step K+1 ( when K columns have been factorized ).
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \ingroup geqp3rk
+*
+*> \par Further Details:
+* =====================
+*
+*> \verbatim
+*> ZGEQP3RK is based on the same BLAS3 Householder QR factorization
+*> algorithm with column pivoting as in ZGEQP3 routine which uses
+*> ZLARFG routine to generate Householder reflectors
+*> for QR factorization.
+*>
+*> We can also write:
+*>
+*> A = A_approx(K) + A_residual(K)
+*>
+*> The low rank approximation matrix A(K)_approx from
+*> the truncated QR factorization of rank K of the matrix A is:
+*>
+*> A(K)_approx = Q(K) * ( R(K)_approx ) * P(K)**T
+*> ( 0 0 )
+*>
+*> = Q(K) * ( R11(K) R12(K) ) * P(K)**T
+*> ( 0 0 )
+*>
+*> The residual A_residual(K) of the matrix A is:
+*>
+*> A_residual(K) = Q(K) * ( 0 0 ) * P(K)**T =
+*> ( 0 R(K)_residual )
+*>
+*> = Q(K) * ( 0 0 ) * P(K)**T
+*> ( 0 R22(K) )
+*>
+*> The truncated (rank K) factorization guarantees that
+*> the maximum column 2-norm of A_residual(K) is less than
+*> or equal to MAXC2NRMK up to roundoff error.
+*>
+*> NOTE: An approximation of the null vectors
+*> of A can be easily computed from R11(K)
+*> and R12(K):
+*>
+*> Null( A(K) )_approx = P * ( inv(R11(K)) * R12(K) )
+*> ( -I )
+*>
+*> \endverbatim
+*
+*> \par References:
+* ================
+*> [1] A Level 3 BLAS QR factorization algorithm with column pivoting developed in 1996.
+*> G. Quintana-Orti, Depto. de Informatica, Universidad Jaime I, Spain.
+*> X. Sun, Computer Science Dept., Duke University, USA.
+*> C. H. Bischof, Math. and Comp. Sci. Div., Argonne National Lab, USA.
+*> A BLAS-3 version of the QR factorization with column pivoting.
+*> LAPACK Working Note 114
+*> \htmlonly
+*> https://www.netlib.org/lapack/lawnspdf/lawn114.pdf
+*> \endhtmlonly
+*> and in
+*> SIAM J. Sci. Comput., 19(5):1486-1494, Sept. 1998.
+*> \htmlonly
+*> https://doi.org/10.1137/S1064827595296732
+*> \endhtmlonly
+*>
+*> [2] A partial column norm updating strategy developed in 2006.
+*> Z. Drmac and Z. Bujanovic, Dept. of Math., University of Zagreb, Croatia.
+*> On the failure of rank revealing QR factorization software – a case study.
+*> LAPACK Working Note 176.
+*> \htmlonly
+*> http://www.netlib.org/lapack/lawnspdf/lawn176.pdf
+*> \endhtmlonly
+*> and in
+*> ACM Trans. Math. Softw. 35, 2, Article 12 (July 2008), 28 pages.
+*> \htmlonly
+*> https://doi.org/10.1145/1377612.1377616
+*> \endhtmlonly
+*
+*> \par Contributors:
+* ==================
+*>
+*> \verbatim
+*>
+*> November 2023, Igor Kozachenko, James Demmel,
+*> Computer Science Division,
+*> University of California, Berkeley
+*>
+*> \endverbatim
+*
+* =====================================================================
+ SUBROUTINE ZGEQP3RK( M, N, NRHS, KMAX, ABSTOL, RELTOL, A, LDA,
+ $ K, MAXC2NRMK, RELMAXC2NRMK, JPIV, TAU,
+ $ WORK, LWORK, RWORK, IWORK, INFO )
+ IMPLICIT NONE
+*
+* -- LAPACK computational routine --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*
+* .. Scalar Arguments ..
+ INTEGER INFO, K, KF, KMAX, LDA, LWORK, M, N, NRHS
+ DOUBLE PRECISION ABSTOL, MAXC2NRMK, RELMAXC2NRMK, RELTOL
+* ..
+* .. Array Arguments ..
+ INTEGER IWORK( * ), JPIV( * )
+ DOUBLE PRECISION RWORK( * )
+ COMPLEX*16 A( LDA, * ), TAU( * ), WORK( * )
+* ..
+*
+* =====================================================================
+*
+* .. Parameters ..
+ INTEGER INB, INBMIN, IXOVER
+ PARAMETER ( INB = 1, INBMIN = 2, IXOVER = 3 )
+ DOUBLE PRECISION ZERO, ONE, TWO
+ PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0, TWO = 2.0D+0 )
+ COMPLEX*16 CZERO
+ PARAMETER ( CZERO = ( 0.0D+0, 0.0D+0 ) )
+* ..
+* .. Local Scalars ..
+ LOGICAL LQUERY, DONE
+ INTEGER IINFO, IOFFSET, IWS, J, JB, JBF, JMAXB, JMAX,
+ $ JMAXC2NRM, KP1, LWKOPT, MINMN, N_SUB, NB,
+ $ NBMIN, NX
+ DOUBLE PRECISION EPS, HUGEVAL, MAXC2NRM, SAFMIN
+* ..
+* .. External Subroutines ..
+ EXTERNAL ZLAQP2RK, ZLAQP3RK, XERBLA
+* ..
+* .. External Functions ..
+ LOGICAL DISNAN
+ INTEGER IDAMAX, ILAENV
+ DOUBLE PRECISION DLAMCH, DZNRM2
+ EXTERNAL DISNAN, DLAMCH, DZNRM2, IDAMAX, ILAENV
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC DCMPLX, MAX, MIN
+* ..
+* .. Executable Statements ..
+*
+* Test input arguments
+* ====================
+*
+ INFO = 0
+ LQUERY = ( LWORK.EQ.-1 )
+ IF( M.LT.0 ) THEN
+ INFO = -1
+ ELSE IF( N.LT.0 ) THEN
+ INFO = -2
+ ELSE IF( NRHS.LT.0 ) THEN
+ INFO = -3
+ ELSE IF( KMAX.LT.0 ) THEN
+ INFO = -4
+ ELSE IF( DISNAN( ABSTOL ) ) THEN
+ INFO = -5
+ ELSE IF( DISNAN( RELTOL ) ) THEN
+ INFO = -6
+ ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
+ INFO = -8
+ END IF
+*
+* If the input parameters M, N, NRHS, KMAX, LDA are valid:
+* a) Test the input workspace size LWORK for the minimum
+* size requirement IWS.
+* b) Determine the optimal block size NB and optimal
+* workspace size LWKOPT to be returned in WORK(1)
+* in case of (1) LWORK < IWS, (2) LQUERY = .TRUE.,
+* (3) when routine exits.
+* Here, IWS is the miminum workspace required for unblocked
+* code.
+*
+ IF( INFO.EQ.0 ) THEN
+ MINMN = MIN( M, N )
+ IF( MINMN.EQ.0 ) THEN
+ IWS = 1
+ LWKOPT = 1
+ ELSE
+*
+* Minimal workspace size in case of using only unblocked
+* BLAS 2 code in ZLAQP2RK.
+* 1) ZLAQP2RK: N+NRHS-1 to use in WORK array that is used
+* in ZLARF subroutine inside ZLAQP2RK to apply an
+* elementary reflector from the left.
+* TOTAL_WORK_SIZE = 3*N + NRHS - 1
+*
+ IWS = N + NRHS - 1
+*
+* Assign to NB optimal block size.
+*
+ NB = ILAENV( INB, 'ZGEQP3RK', ' ', M, N, -1, -1 )
+*
+* A formula for the optimal workspace size in case of using
+* both unblocked BLAS 2 in ZLAQP2RK and blocked BLAS 3 code
+* in ZLAQP3RK.
+* 1) ZGEQP3RK, ZLAQP2RK, ZLAQP3RK: 2*N to store full and
+* partial column 2-norms.
+* 2) ZLAQP2RK: N+NRHS-1 to use in WORK array that is used
+* in ZLARF subroutine to apply an elementary reflector
+* from the left.
+* 3) ZLAQP3RK: NB*(N+NRHS) to use in the work array F that
+* is used to apply a block reflector from
+* the left.
+* 4) ZLAQP3RK: NB to use in the auxilixary array AUX.
+* Sizes (2) and ((3) + (4)) should intersect, therefore
+* TOTAL_WORK_SIZE = 2*N + NB*( N+NRHS+1 ), given NBMIN=2.
+*
+ LWKOPT = 2*N + NB*( N+NRHS+1 )
+ END IF
+ WORK( 1 ) = DCMPLX( LWKOPT )
+*
+ IF( ( LWORK.LT.IWS ) .AND. .NOT.LQUERY ) THEN
+ INFO = -15
+ END IF
+ END IF
+*
+* NOTE: The optimal workspace size is returned in WORK(1), if
+* the input parameters M, N, NRHS, KMAX, LDA are valid.
+*
+ IF( INFO.NE.0 ) THEN
+ CALL XERBLA( 'ZGEQP3RK', -INFO )
+ RETURN
+ ELSE IF( LQUERY ) THEN
+ RETURN
+ END IF
+*
+* Quick return if possible for M=0 or N=0.
+*
+ IF( MINMN.EQ.0 ) THEN
+ K = 0
+ MAXC2NRMK = ZERO
+ RELMAXC2NRMK = ZERO
+ WORK( 1 ) = DCMPLX( LWKOPT )
+ RETURN
+ END IF
+*
+* ==================================================================
+*
+* Initialize column pivot array JPIV.
+*
+ DO J = 1, N
+ JPIV( J ) = J
+ END DO
+*
+* ==================================================================
+*
+* Initialize storage for partial and exact column 2-norms.
+* a) The elements WORK(1:N) are used to store partial column
+* 2-norms of the matrix A, and may decrease in each computation
+* step; initialize to the values of complete columns 2-norms.
+* b) The elements WORK(N+1:2*N) are used to store complete column
+* 2-norms of the matrix A, they are not changed during the
+* computation; initialize the values of complete columns 2-norms.
+*
+ DO J = 1, N
+ RWORK( J ) = DZNRM2( M, A( 1, J ), 1 )
+ RWORK( N+J ) = RWORK( J )
+ END DO
+*
+* ==================================================================
+*
+* Compute the pivot column index and the maximum column 2-norm
+* for the whole original matrix stored in A(1:M,1:N).
+*
+ KP1 = IDAMAX( N, RWORK( 1 ), 1 )
+*
+* ==================================================================.
+*
+ IF( DISNAN( MAXC2NRM ) ) THEN
+*
+* Check if the matrix A contains NaN, set INFO parameter
+* to the column number where the first NaN is found and return
+* from the routine.
+*
+ K = 0
+ INFO = KP1
+*
+* Set MAXC2NRMK and RELMAXC2NRMK to NaN.
+*
+ MAXC2NRMK = MAXC2NRM
+ RELMAXC2NRMK = MAXC2NRM
+*
+* Array TAU is not set and contains undefined elements.
+*
+ WORK( 1 ) = DCMPLX( LWKOPT )
+ RETURN
+ END IF
+*
+* ===================================================================
+*
+ IF( MAXC2NRM.EQ.ZERO ) THEN
+*
+* Check is the matrix A is a zero matrix, set array TAU and
+* return from the routine.
+*
+ K = 0
+ MAXC2NRMK = ZERO
+ RELMAXC2NRMK = ZERO
+*
+ DO J = 1, MINMN
+ TAU( J ) = CZERO
+ END DO
+*
+ WORK( 1 ) = DCMPLX( LWKOPT )
+ RETURN
+*
+ END IF
+*
+* ===================================================================
+*
+ HUGEVAL = DLAMCH( 'Overflow' )
+*
+ IF( MAXC2NRM.GT.HUGEVAL ) THEN
+*
+* Check if the matrix A contains +Inf or -Inf, set INFO parameter
+* to the column number, where the first +/-Inf is found plus N,
+* and continue the computation.
+*
+ INFO = N + KP1
+*
+ END IF
+*
+* ==================================================================
+*
+* Quick return if possible for the case when the first
+* stopping criterion is satisfied, i.e. KMAX = 0.
+*
+ IF( KMAX.EQ.0 ) THEN
+ K = 0
+ MAXC2NRMK = MAXC2NRM
+ RELMAXC2NRMK = ONE
+ DO J = 1, MINMN
+ TAU( J ) = CZERO
+ END DO
+ WORK( 1 ) = DCMPLX( LWKOPT )
+ RETURN
+ END IF
+*
+* ==================================================================
+*
+ EPS = DLAMCH('Epsilon')
+*
+* Adjust ABSTOL
+*
+ IF( ABSTOL.GE.ZERO ) THEN
+ SAFMIN = DLAMCH('Safe minimum')
+ ABSTOL = MAX( ABSTOL, TWO*SAFMIN )
+ END IF
+*
+* Adjust RELTOL
+*
+ IF( RELTOL.GE.ZERO ) THEN
+ RELTOL = MAX( RELTOL, EPS )
+ END IF
+*
+* ===================================================================
+*
+* JMAX is the maximum index of the column to be factorized,
+* which is also limited by the first stopping criterion KMAX.
+*
+ JMAX = MIN( KMAX, MINMN )
+*
+* ===================================================================
+*
+* Quick return if possible for the case when the second or third
+* stopping criterion for the whole original matrix is satified,
+* i.e. MAXC2NRM <= ABSTOL or RELMAXC2NRM <= RELTOL
+* (which is ONE <= RELTOL).
+*
+ IF( MAXC2NRM.LE.ABSTOL .OR. ONE.LE.RELTOL ) THEN
+*
+ K = 0
+ MAXC2NRMK = MAXC2NRM
+ RELMAXC2NRMK = ONE
+*
+ DO J = 1, MINMN
+ TAU( J ) = CZERO
+ END DO
+*
+ WORK( 1 ) = DCMPLX( LWKOPT )
+ RETURN
+ END IF
+*
+* ==================================================================
+* Factorize columns
+* ==================================================================
+*
+* Determine the block size.
+*
+ NBMIN = 2
+ NX = 0
+*
+ IF( ( NB.GT.1 ) .AND. ( NB.LT.MINMN ) ) THEN
+*
+* Determine when to cross over from blocked to unblocked code.
+* (for N less than NX, unblocked code should be used).
+*
+ NX = MAX( 0, ILAENV( IXOVER, 'ZGEQP3RK', ' ', M, N, -1, -1 ) )
+*
+ IF( NX.LT.MINMN ) THEN
+*
+* Determine if workspace is large enough for blocked code.
+*
+ IF( LWORK.LT.LWKOPT ) THEN
+*
+* Not enough workspace to use optimal block size that
+* is currently stored in NB.
+* Reduce NB and determine the minimum value of NB.
+*
+ NB = ( LWORK-2*N ) / ( N+1 )
+ NBMIN = MAX( 2, ILAENV( INBMIN, 'ZGEQP3RK', ' ', M, N,
+ $ -1, -1 ) )
+*
+ END IF
+ END IF
+ END IF
+*
+* ==================================================================
+*
+* DONE is the boolean flag to rerpresent the case when the
+* factorization completed in the block factorization routine,
+* before the end of the block.
+*
+ DONE = .FALSE.
+*
+* J is the column index.
+*
+ J = 1
+*
+* (1) Use blocked code initially.
+*
+* JMAXB is the maximum column index of the block, when the
+* blocked code is used, is also limited by the first stopping
+* criterion KMAX.
+*
+ JMAXB = MIN( KMAX, MINMN - NX )
+*
+ IF( NB.GE.NBMIN .AND. NB.LT.JMAX .AND. JMAXB.GT.0 ) THEN
+*
+* Loop over the column blocks of the matrix A(1:M,1:JMAXB). Here:
+* J is the column index of a column block;
+* JB is the column block size to pass to block factorization
+* routine in a loop step;
+* JBF is the number of columns that were actually factorized
+* that was returned by the block factorization routine
+* in a loop step, JBF <= JB;
+* N_SUB is the number of columns in the submatrix;
+* IOFFSET is the number of rows that should not be factorized.
+*
+ DO WHILE( J.LE.JMAXB )
+*
+ JB = MIN( NB, JMAXB-J+1 )
+ N_SUB = N-J+1
+ IOFFSET = J-1
+*
+* Factorize JB columns among the columns A(J:N).
+*
+ CALL ZLAQP3RK( M, N_SUB, NRHS, IOFFSET, JB, ABSTOL,
+ $ RELTOL, KP1, MAXC2NRM, A( 1, J ), LDA,
+ $ DONE, JBF, MAXC2NRMK, RELMAXC2NRMK,
+ $ JPIV( J ), TAU( J ),
+ $ RWORK( J ), RWORK( N+J ),
+ $ WORK( 1 ), WORK( JB+1 ),
+ $ N+NRHS-J+1, IWORK, IINFO )
+*
+* Set INFO on the first occurence of Inf.
+*
+ IF( IINFO.GT.N_SUB .AND. INFO.EQ.0 ) THEN
+ INFO = 2*IOFFSET + IINFO
+ END IF
+*
+ IF( DONE ) THEN
+*
+* Either the submatrix is zero before the end of the
+* column block, or ABSTOL or RELTOL criterion is
+* satisfied before the end of the column block, we can
+* return from the routine. Perform the following before
+* returning:
+* a) Set the number of factorized columns K,
+* K = IOFFSET + JBF from the last call of blocked
+* routine.
+* NOTE: 1) MAXC2NRMK and RELMAXC2NRMK are returned
+* by the block factorization routine;
+* 2) The remaining TAUs are set to ZERO by the
+* block factorization routine.
+*
+ K = IOFFSET + JBF
+*
+* Set INFO on the first occurrence of NaN, NaN takes
+* prcedence over Inf.
+*
+ IF( IINFO.LE.N_SUB .AND. IINFO.GT.0 ) THEN
+ INFO = IOFFSET + IINFO
+ END IF
+*
+* Return from the routine.
+*
+ WORK( 1 ) = DCMPLX( LWKOPT )
+*
+ RETURN
+*
+ END IF
+*
+ J = J + JBF
+*
+ END DO
+*
+ END IF
+*
+* Use unblocked code to factor the last or only block.
+* J = JMAX+1 means we factorized the maximum possible number of
+* columns, that is in ELSE clause we need to compute
+* the MAXC2NORM and RELMAXC2NORM to return after we processed
+* the blocks.
+*
+ IF( J.LE.JMAX ) THEN
+*
+* N_SUB is the number of columns in the submatrix;
+* IOFFSET is the number of rows that should not be factorized.
+*
+ N_SUB = N-J+1
+ IOFFSET = J-1
+*
+ CALL ZLAQP2RK( M, N_SUB, NRHS, IOFFSET, JMAX-J+1,
+ $ ABSTOL, RELTOL, KP1, MAXC2NRM, A( 1, J ), LDA,
+ $ KF, MAXC2NRMK, RELMAXC2NRMK, JPIV( J ),
+ $ TAU( J ), RWORK( J ), RWORK( N+J ),
+ $ WORK( 1 ), IINFO )
+*
+* ABSTOL or RELTOL criterion is satisfied when the number of
+* the factorized columns KF is smaller then the number
+* of columns JMAX-J+1 supplied to be factorized by the
+* unblocked routine, we can return from
+* the routine. Perform the following before returning:
+* a) Set the number of factorized columns K,
+* b) MAXC2NRMK and RELMAXC2NRMK are returned by the
+* unblocked factorization routine above.
+*
+ K = J - 1 + KF
+*
+* Set INFO on the first exception occurence.
+*
+* Set INFO on the first exception occurence of Inf or NaN,
+* (NaN takes precedence over Inf).
+*
+ IF( IINFO.GT.N_SUB .AND. INFO.EQ.0 ) THEN
+ INFO = 2*IOFFSET + IINFO
+ ELSE IF( IINFO.LE.N_SUB .AND. IINFO.GT.0 ) THEN
+ INFO = IOFFSET + IINFO
+ END IF
+*
+ ELSE
+*
+* Compute the return values for blocked code.
+*
+* Set the number of factorized columns if the unblocked routine
+* was not called.
+*
+ K = JMAX
+*
+* If there exits a residual matrix after the blocked code:
+* 1) compute the values of MAXC2NRMK, RELMAXC2NRMK of the
+* residual matrix, otherwise set them to ZERO;
+* 2) Set TAU(K+1:MINMN) to ZERO.
+*
+ IF( K.LT.MINMN ) THEN
+ JMAXC2NRM = K + IDAMAX( N-K, RWORK( K+1 ), 1 )
+ MAXC2NRMK = RWORK( JMAXC2NRM )
+ IF( K.EQ.0 ) THEN
+ RELMAXC2NRMK = ONE
+ ELSE
+ RELMAXC2NRMK = MAXC2NRMK / MAXC2NRM
+ END IF
+*
+ DO J = K + 1, MINMN
+ TAU( J ) = CZERO
+ END DO
+*
+ ELSE
+ MAXC2NRMK = ZERO
+ RELMAXC2NRMK = ZERO
+*
+ END IF
+*
+* END IF( J.LE.JMAX ) THEN
+*
+ END IF
+*
+ WORK( 1 ) = DCMPLX( LWKOPT )
+*
+ RETURN
+*
+* End of ZGEQP3RK
+*
+ END
diff --git a/lapack-netlib/SRC/zlaqp2rk.f b/lapack-netlib/SRC/zlaqp2rk.f
new file mode 100644
index 000000000..f1e9f4899
--- /dev/null
+++ b/lapack-netlib/SRC/zlaqp2rk.f
@@ -0,0 +1,726 @@
+*> \brief \b ZLAQP2RK computes truncated QR factorization with column pivoting of a complex matrix block using Level 2 BLAS and overwrites a complex m-by-nrhs matrix B with Q**H * B.
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ZLAQP2RK + dependencies
+*>
+*> [TGZ]
+*>
+*> [ZIP]
+*>
+*> [TXT]
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE ZLAQP2RK( M, N, NRHS, IOFFSET, KMAX, ABSTOL, RELTOL,
+* $ KP1, MAXC2NRM, A, LDA, K, MAXC2NRMK,
+* $ RELMAXC2NRMK, JPIV, TAU, VN1, VN2, WORK,
+* $ INFO )
+* IMPLICIT NONE
+*
+* .. Scalar Arguments ..
+* INTEGER INFO, IOFFSET, KP1, K, KMAX, LDA, M, N, NRHS
+* DOUBLE PRECISION ABSTOL, MAXC2NRM, MAXC2NRMK, RELMAXC2NRMK,
+* $ RELTOL
+* ..
+* .. Array Arguments ..
+* INTEGER JPIV( * )
+* DOUBLE PRECISION VN1( * ), VN2( * )
+* COMPLEX*16 A( LDA, * ), TAU( * ), WORK( * )
+* $
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> ZLAQP2RK computes a truncated (rank K) or full rank Householder QR
+*> factorization with column pivoting of the complex matrix
+*> block A(IOFFSET+1:M,1:N) as
+*>
+*> A * P(K) = Q(K) * R(K).
+*>
+*> The routine uses Level 2 BLAS. The block A(1:IOFFSET,1:N)
+*> is accordingly pivoted, but not factorized.
+*>
+*> The routine also overwrites the right-hand-sides matrix block B
+*> stored in A(IOFFSET+1:M,N+1:N+NRHS) with Q(K)**H * B.
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] M
+*> \verbatim
+*> M is INTEGER
+*> The number of rows of the matrix A. M >= 0.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> The number of columns of the matrix A. N >= 0.
+*> \endverbatim
+*>
+*> \param[in] NRHS
+*> \verbatim
+*> NRHS is INTEGER
+*> The number of right hand sides, i.e., the number of
+*> columns of the matrix B. NRHS >= 0.
+*> \endverbatim
+*>
+*> \param[in] IOFFSET
+*> \verbatim
+*> IOFFSET is INTEGER
+*> The number of rows of the matrix A that must be pivoted
+*> but not factorized. IOFFSET >= 0.
+*>
+*> IOFFSET also represents the number of columns of the whole
+*> original matrix A_orig that have been factorized
+*> in the previous steps.
+*> \endverbatim
+*>
+*> \param[in] KMAX
+*> \verbatim
+*> KMAX is INTEGER
+*>
+*> The first factorization stopping criterion. KMAX >= 0.
+*>
+*> The maximum number of columns of the matrix A to factorize,
+*> i.e. the maximum factorization rank.
+*>
+*> a) If KMAX >= min(M-IOFFSET,N), then this stopping
+*> criterion is not used, factorize columns
+*> depending on ABSTOL and RELTOL.
+*>
+*> b) If KMAX = 0, then this stopping criterion is
+*> satisfied on input and the routine exits immediately.
+*> This means that the factorization is not performed,
+*> the matrices A and B and the arrays TAU, IPIV
+*> are not modified.
+*> \endverbatim
+*>
+*> \param[in] ABSTOL
+*> \verbatim
+*> ABSTOL is DOUBLE PRECISION, cannot be NaN.
+*>
+*> The second factorization stopping criterion.
+*>
+*> The absolute tolerance (stopping threshold) for
+*> maximum column 2-norm of the residual matrix.
+*> The algorithm converges (stops the factorization) when
+*> the maximum column 2-norm of the residual matrix
+*> is less than or equal to ABSTOL.
+*>
+*> a) If ABSTOL < 0.0, then this stopping criterion is not
+*> used, the routine factorizes columns depending
+*> on KMAX and RELTOL.
+*> This includes the case ABSTOL = -Inf.
+*>
+*> b) If 0.0 <= ABSTOL then the input value
+*> of ABSTOL is used.
+*> \endverbatim
+*>
+*> \param[in] RELTOL
+*> \verbatim
+*> RELTOL is DOUBLE PRECISION, cannot be NaN.
+*>
+*> The third factorization stopping criterion.
+*>
+*> The tolerance (stopping threshold) for the ratio of the
+*> maximum column 2-norm of the residual matrix to the maximum
+*> column 2-norm of the original matrix A_orig. The algorithm
+*> converges (stops the factorization), when this ratio is
+*> less than or equal to RELTOL.
+*>
+*> a) If RELTOL < 0.0, then this stopping criterion is not
+*> used, the routine factorizes columns depending
+*> on KMAX and ABSTOL.
+*> This includes the case RELTOL = -Inf.
+*>
+*> d) If 0.0 <= RELTOL then the input value of RELTOL
+*> is used.
+*> \endverbatim
+*>
+*> \param[in] KP1
+*> \verbatim
+*> KP1 is INTEGER
+*> The index of the column with the maximum 2-norm in
+*> the whole original matrix A_orig determined in the
+*> main routine ZGEQP3RK. 1 <= KP1 <= N_orig_mat.
+*> \endverbatim
+*>
+*> \param[in] MAXC2NRM
+*> \verbatim
+*> MAXC2NRM is DOUBLE PRECISION
+*> The maximum column 2-norm of the whole original
+*> matrix A_orig computed in the main routine ZGEQP3RK.
+*> MAXC2NRM >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*> A is COMPLEX*16 array, dimension (LDA,N+NRHS)
+*> On entry:
+*> the M-by-N matrix A and M-by-NRHS matrix B, as in
+*>
+*> N NRHS
+*> array_A = M [ mat_A, mat_B ]
+*>
+*> On exit:
+*> 1. The elements in block A(IOFFSET+1:M,1:K) below
+*> the diagonal together with the array TAU represent
+*> the orthogonal matrix Q(K) as a product of elementary
+*> reflectors.
+*> 2. The upper triangular block of the matrix A stored
+*> in A(IOFFSET+1:M,1:K) is the triangular factor obtained.
+*> 3. The block of the matrix A stored in A(1:IOFFSET,1:N)
+*> has been accordingly pivoted, but not factorized.
+*> 4. The rest of the array A, block A(IOFFSET+1:M,K+1:N+NRHS).
+*> The left part A(IOFFSET+1:M,K+1:N) of this block
+*> contains the residual of the matrix A, and,
+*> if NRHS > 0, the right part of the block
+*> A(IOFFSET+1:M,N+1:N+NRHS) contains the block of
+*> the right-hand-side matrix B. Both these blocks have been
+*> updated by multiplication from the left by Q(K)**H.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*> LDA is INTEGER
+*> The leading dimension of the array A. LDA >= max(1,M).
+*> \endverbatim
+*>
+*> \param[out] K
+*> \verbatim
+*> K is INTEGER
+*> Factorization rank of the matrix A, i.e. the rank of
+*> the factor R, which is the same as the number of non-zero
+*> rows of the factor R. 0 <= K <= min(M-IOFFSET,KMAX,N).
+*>
+*> K also represents the number of non-zero Householder
+*> vectors.
+*> \endverbatim
+*>
+*> \param[out] MAXC2NRMK
+*> \verbatim
+*> MAXC2NRMK is DOUBLE PRECISION
+*> The maximum column 2-norm of the residual matrix,
+*> when the factorization stopped at rank K. MAXC2NRMK >= 0.
+*> \endverbatim
+*>
+*> \param[out] RELMAXC2NRMK
+*> \verbatim
+*> RELMAXC2NRMK is DOUBLE PRECISION
+*> The ratio MAXC2NRMK / MAXC2NRM of the maximum column
+*> 2-norm of the residual matrix (when the factorization
+*> stopped at rank K) to the maximum column 2-norm of the
+*> whole original matrix A. RELMAXC2NRMK >= 0.
+*> \endverbatim
+*>
+*> \param[out] JPIV
+*> \verbatim
+*> JPIV is INTEGER array, dimension (N)
+*> Column pivot indices, for 1 <= j <= N, column j
+*> of the matrix A was interchanged with column JPIV(j).
+*> \endverbatim
+*>
+*> \param[out] TAU
+*> \verbatim
+*> TAU is COMPLEX*16 array, dimension (min(M-IOFFSET,N))
+*> The scalar factors of the elementary reflectors.
+*> \endverbatim
+*>
+*> \param[in,out] VN1
+*> \verbatim
+*> VN1 is DOUBLE PRECISION array, dimension (N)
+*> The vector with the partial column norms.
+*> \endverbatim
+*>
+*> \param[in,out] VN2
+*> \verbatim
+*> VN2 is DOUBLE PRECISION array, dimension (N)
+*> The vector with the exact column norms.
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*> WORK is COMPLEX*16 array, dimension (N-1)
+*> Used in ZLARF subroutine to apply an elementary
+*> reflector from the left.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*> INFO is INTEGER
+*> 1) INFO = 0: successful exit.
+*> 2) If INFO = j_1, where 1 <= j_1 <= N, then NaN was
+*> detected and the routine stops the computation.
+*> The j_1-th column of the matrix A or the j_1-th
+*> element of array TAU contains the first occurrence
+*> of NaN in the factorization step K+1 ( when K columns
+*> have been factorized ).
+*>
+*> On exit:
+*> K is set to the number of
+*> factorized columns without
+*> exception.
+*> MAXC2NRMK is set to NaN.
+*> RELMAXC2NRMK is set to NaN.
+*> TAU(K+1:min(M,N)) is not set and contains undefined
+*> elements. If j_1=K+1, TAU(K+1)
+*> may contain NaN.
+*> 3) If INFO = j_2, where N+1 <= j_2 <= 2*N, then no NaN
+*> was detected, but +Inf (or -Inf) was detected and
+*> the routine continues the computation until completion.
+*> The (j_2-N)-th column of the matrix A contains the first
+*> occurrence of +Inf (or -Inf) in the factorization
+*> step K+1 ( when K columns have been factorized ).
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \ingroup laqp2rk
+*
+*> \par References:
+* ================
+*> [1] A Level 3 BLAS QR factorization algorithm with column pivoting developed in 1996.
+*> G. Quintana-Orti, Depto. de Informatica, Universidad Jaime I, Spain.
+*> X. Sun, Computer Science Dept., Duke University, USA.
+*> C. H. Bischof, Math. and Comp. Sci. Div., Argonne National Lab, USA.
+*> A BLAS-3 version of the QR factorization with column pivoting.
+*> LAPACK Working Note 114
+*> \htmlonly
+*> https://www.netlib.org/lapack/lawnspdf/lawn114.pdf
+*> \endhtmlonly
+*> and in
+*> SIAM J. Sci. Comput., 19(5):1486-1494, Sept. 1998.
+*> \htmlonly
+*> https://doi.org/10.1137/S1064827595296732
+*> \endhtmlonly
+*>
+*> [2] A partial column norm updating strategy developed in 2006.
+*> Z. Drmac and Z. Bujanovic, Dept. of Math., University of Zagreb, Croatia.
+*> On the failure of rank revealing QR factorization software – a case study.
+*> LAPACK Working Note 176.
+*> \htmlonly
+*> http://www.netlib.org/lapack/lawnspdf/lawn176.pdf
+*> \endhtmlonly
+*> and in
+*> ACM Trans. Math. Softw. 35, 2, Article 12 (July 2008), 28 pages.
+*> \htmlonly
+*> https://doi.org/10.1145/1377612.1377616
+*> \endhtmlonly
+*
+*> \par Contributors:
+* ==================
+*>
+*> \verbatim
+*>
+*> November 2023, Igor Kozachenko, James Demmel,
+*> Computer Science Division,
+*> University of California, Berkeley
+*>
+*> \endverbatim
+*
+* =====================================================================
+ SUBROUTINE ZLAQP2RK( M, N, NRHS, IOFFSET, KMAX, ABSTOL, RELTOL,
+ $ KP1, MAXC2NRM, A, LDA, K, MAXC2NRMK,
+ $ RELMAXC2NRMK, JPIV, TAU, VN1, VN2, WORK,
+ $ INFO )
+ IMPLICIT NONE
+*
+* -- LAPACK auxiliary routine --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*
+* .. Scalar Arguments ..
+ INTEGER INFO, IOFFSET, KP1, K, KMAX, LDA, M, N, NRHS
+ DOUBLE PRECISION ABSTOL, MAXC2NRM, MAXC2NRMK, RELMAXC2NRMK,
+ $ RELTOL
+* ..
+* .. Array Arguments ..
+ INTEGER JPIV( * )
+ DOUBLE PRECISION VN1( * ), VN2( * )
+ COMPLEX*16 A( LDA, * ), TAU( * ), WORK( * )
+* ..
+*
+* =====================================================================
+*
+* .. Parameters ..
+ DOUBLE PRECISION ZERO, ONE
+ PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
+ COMPLEX*16 CZERO, CONE
+ PARAMETER ( CZERO = ( 0.0D+0, 0.0D+0 ),
+ $ CONE = ( 1.0D+0, 0.0D+0 ) )
+* ..
+* .. Local Scalars ..
+ INTEGER I, ITEMP, J, JMAXC2NRM, KK, KP, MINMNFACT,
+ $ MINMNUPDT
+ DOUBLE PRECISION HUGEVAL, TAUNAN, TEMP, TEMP2, TOL3Z
+ COMPLEX*16 AIKK
+* ..
+* .. External Subroutines ..
+ EXTERNAL ZLARF, ZLARFG, ZSWAP
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC ABS, DBLE, DCONJG, DIMAG, MAX, MIN, SQRT
+* ..
+* .. External Functions ..
+ LOGICAL DISNAN
+ INTEGER IDAMAX
+ DOUBLE PRECISION DLAMCH, DZNRM2
+ EXTERNAL DISNAN, DLAMCH, IDAMAX, DZNRM2
+* ..
+* .. Executable Statements ..
+*
+* Initialize INFO
+*
+ INFO = 0
+*
+* MINMNFACT in the smallest dimension of the submatrix
+* A(IOFFSET+1:M,1:N) to be factorized.
+*
+* MINMNUPDT is the smallest dimension
+* of the subarray A(IOFFSET+1:M,1:N+NRHS) to be udated, which
+* contains the submatrices A(IOFFSET+1:M,1:N) and
+* B(IOFFSET+1:M,1:NRHS) as column blocks.
+*
+ MINMNFACT = MIN( M-IOFFSET, N )
+ MINMNUPDT = MIN( M-IOFFSET, N+NRHS )
+ KMAX = MIN( KMAX, MINMNFACT )
+ TOL3Z = SQRT( DLAMCH( 'Epsilon' ) )
+ HUGEVAL = DLAMCH( 'Overflow' )
+*
+* Compute the factorization, KK is the lomn loop index.
+*
+ DO KK = 1, KMAX
+*
+ I = IOFFSET + KK
+*
+ IF( I.EQ.1 ) THEN
+*
+* ============================================================
+*
+* We are at the first column of the original whole matrix A,
+* therefore we use the computed KP1 and MAXC2NRM from the
+* main routine.
+*
+ KP = KP1
+*
+* ============================================================
+*
+ ELSE
+*
+* ============================================================
+*
+* Determine the pivot column in KK-th step, i.e. the index
+* of the column with the maximum 2-norm in the
+* submatrix A(I:M,K:N).
+*
+ KP = ( KK-1 ) + IDAMAX( N-KK+1, VN1( KK ), 1 )
+*
+* Determine the maximum column 2-norm and the relative maximum
+* column 2-norm of the submatrix A(I:M,KK:N) in step KK.
+* RELMAXC2NRMK will be computed later, after somecondition
+* checks on MAXC2NRMK.
+*
+ MAXC2NRMK = VN1( KP )
+*
+* ============================================================
+*
+* Check if the submatrix A(I:M,KK:N) contains NaN, and set
+* INFO parameter to the column number, where the first NaN
+* is found and return from the routine.
+* We need to check the condition only if the
+* column index (same as row index) of the original whole
+* matrix is larger than 1, since the condition for whole
+* original matrix is checked in the main routine.
+*
+ IF( DISNAN( MAXC2NRMK ) ) THEN
+*
+* Set K, the number of factorized columns.
+* that are not zero.
+*
+ K = KK - 1
+ INFO = K + KP
+*
+* Set RELMAXC2NRMK to NaN.
+*
+ RELMAXC2NRMK = MAXC2NRMK
+*
+* Array TAU(K+1:MINMNFACT) is not set and contains
+* undefined elements.
+*
+ RETURN
+ END IF
+*
+* ============================================================
+*
+* Quick return, if the submatrix A(I:M,KK:N) is
+* a zero matrix.
+* We need to check the condition only if the
+* column index (same as row index) of the original whole
+* matrix is larger than 1, since the condition for whole
+* original matrix is checked in the main routine.
+*
+ IF( MAXC2NRMK.EQ.ZERO ) THEN
+*
+* Set K, the number of factorized columns.
+* that are not zero.
+*
+ K = KK - 1
+ RELMAXC2NRMK = ZERO
+*
+* Set TAUs corresponding to the columns that were not
+* factorized to ZERO, i.e. set TAU(KK:MINMNFACT) to CZERO.
+*
+ DO J = KK, MINMNFACT
+ TAU( J ) = CZERO
+ END DO
+*
+* Return from the routine.
+*
+ RETURN
+*
+ END IF
+*
+* ============================================================
+*
+* Check if the submatrix A(I:M,KK:N) contains Inf,
+* set INFO parameter to the column number, where
+* the first Inf is found plus N, and continue
+* the computation.
+* We need to check the condition only if the
+* column index (same as row index) of the original whole
+* matrix is larger than 1, since the condition for whole
+* original matrix is checked in the main routine.
+*
+ IF( INFO.EQ.0 .AND. MAXC2NRMK.GT.HUGEVAL ) THEN
+ INFO = N + KK - 1 + KP
+ END IF
+*
+* ============================================================
+*
+* Test for the second and third stopping criteria.
+* NOTE: There is no need to test for ABSTOL >= ZERO, since
+* MAXC2NRMK is non-negative. Similarly, there is no need
+* to test for RELTOL >= ZERO, since RELMAXC2NRMK is
+* non-negative.
+* We need to check the condition only if the
+* column index (same as row index) of the original whole
+* matrix is larger than 1, since the condition for whole
+* original matrix is checked in the main routine.
+
+ RELMAXC2NRMK = MAXC2NRMK / MAXC2NRM
+*
+ IF( MAXC2NRMK.LE.ABSTOL .OR. RELMAXC2NRMK.LE.RELTOL ) THEN
+*
+* Set K, the number of factorized columns.
+*
+ K = KK - 1
+*
+* Set TAUs corresponding to the columns that were not
+* factorized to ZERO, i.e. set TAU(KK:MINMNFACT) to CZERO.
+*
+ DO J = KK, MINMNFACT
+ TAU( J ) = CZERO
+ END DO
+*
+* Return from the routine.
+*
+ RETURN
+*
+ END IF
+*
+* ============================================================
+*
+* End ELSE of IF(I.EQ.1)
+*
+ END IF
+*
+* ===============================================================
+*
+* If the pivot column is not the first column of the
+* subblock A(1:M,KK:N):
+* 1) swap the KK-th column and the KP-th pivot column
+* in A(1:M,1:N);
+* 2) copy the KK-th element into the KP-th element of the partial
+* and exact 2-norm vectors VN1 and VN2. ( Swap is not needed
+* for VN1 and VN2 since we use the element with the index
+* larger than KK in the next loop step.)
+* 3) Save the pivot interchange with the indices relative to the
+* the original matrix A, not the block A(1:M,1:N).
+*
+ IF( KP.NE.KK ) THEN
+ CALL ZSWAP( M, A( 1, KP ), 1, A( 1, KK ), 1 )
+ VN1( KP ) = VN1( KK )
+ VN2( KP ) = VN2( KK )
+ ITEMP = JPIV( KP )
+ JPIV( KP ) = JPIV( KK )
+ JPIV( KK ) = ITEMP
+ END IF
+*
+* Generate elementary reflector H(KK) using the column A(I:M,KK),
+* if the column has more than one element, otherwise
+* the elementary reflector would be an identity matrix,
+* and TAU(KK) = CZERO.
+*
+ IF( I.LT.M ) THEN
+ CALL ZLARFG( M-I+1, A( I, KK ), A( I+1, KK ), 1,
+ $ TAU( KK ) )
+ ELSE
+ TAU( KK ) = CZERO
+ END IF
+*
+* Check if TAU(KK) contains NaN, set INFO parameter
+* to the column number where NaN is found and return from
+* the routine.
+* NOTE: There is no need to check TAU(KK) for Inf,
+* since ZLARFG cannot produce TAU(KK) or Householder vector
+* below the diagonal containing Inf. Only BETA on the diagonal,
+* returned by ZLARFG can contain Inf, which requires
+* TAU(KK) to contain NaN. Therefore, this case of generating Inf
+* by ZLARFG is covered by checking TAU(KK) for NaN.
+*
+ IF( DISNAN( DBLE( TAU(KK) ) ) ) THEN
+ TAUNAN = DBLE( TAU(KK) )
+ ELSE IF( DISNAN( DIMAG( TAU(KK) ) ) ) THEN
+ TAUNAN = DIMAG( TAU(KK) )
+ ELSE
+ TAUNAN = ZERO
+ END IF
+*
+ IF( DISNAN( TAUNAN ) ) THEN
+ K = KK - 1
+ INFO = KK
+*
+* Set MAXC2NRMK and RELMAXC2NRMK to NaN.
+*
+ MAXC2NRMK = TAUNAN
+ RELMAXC2NRMK = TAUNAN
+*
+* Array TAU(KK:MINMNFACT) is not set and contains
+* undefined elements, except the first element TAU(KK) = NaN.
+*
+ RETURN
+ END IF
+*
+* Apply H(KK)**H to A(I:M,KK+1:N+NRHS) from the left.
+* ( If M >= N, then at KK = N there is no residual matrix,
+* i.e. no columns of A to update, only columns of B.
+* If M < N, then at KK = M-IOFFSET, I = M and we have a
+* one-row residual matrix in A and the elementary
+* reflector is a unit matrix, TAU(KK) = CZERO, i.e. no update
+* is needed for the residual matrix in A and the
+* right-hand-side-matrix in B.
+* Therefore, we update only if
+* KK < MINMNUPDT = min(M-IOFFSET, N+NRHS)
+* condition is satisfied, not only KK < N+NRHS )
+*
+ IF( KK.LT.MINMNUPDT ) THEN
+ AIKK = A( I, KK )
+ A( I, KK ) = CONE
+ CALL ZLARF( 'Left', M-I+1, N+NRHS-KK, A( I, KK ), 1,
+ $ DCONJG( TAU( KK ) ), A( I, KK+1 ), LDA,
+ $ WORK( 1 ) )
+ A( I, KK ) = AIKK
+ END IF
+*
+ IF( KK.LT.MINMNFACT ) THEN
+*
+* Update the partial column 2-norms for the residual matrix,
+* only if the residual matrix A(I+1:M,KK+1:N) exists, i.e.
+* when KK < min(M-IOFFSET, N).
+*
+ DO J = KK + 1, N
+ IF( VN1( J ).NE.ZERO ) THEN
+*
+* NOTE: The following lines follow from the analysis in
+* Lapack Working Note 176.
+*
+ TEMP = ONE - ( ABS( A( I, J ) ) / VN1( J ) )**2
+ TEMP = MAX( TEMP, ZERO )
+ TEMP2 = TEMP*( VN1( J ) / VN2( J ) )**2
+ IF( TEMP2 .LE. TOL3Z ) THEN
+*
+* Compute the column 2-norm for the partial
+* column A(I+1:M,J) by explicitly computing it,
+* and store it in both partial 2-norm vector VN1
+* and exact column 2-norm vector VN2.
+*
+ VN1( J ) = DZNRM2( M-I, A( I+1, J ), 1 )
+ VN2( J ) = VN1( J )
+*
+ ELSE
+*
+* Update the column 2-norm for the partial
+* column A(I+1:M,J) by removing one
+* element A(I,J) and store it in partial
+* 2-norm vector VN1.
+*
+ VN1( J ) = VN1( J )*SQRT( TEMP )
+*
+ END IF
+ END IF
+ END DO
+*
+ END IF
+*
+* End factorization loop
+*
+ END DO
+*
+* If we reached this point, all colunms have been factorized,
+* i.e. no condition was triggered to exit the routine.
+* Set the number of factorized columns.
+*
+ K = KMAX
+*
+* We reached the end of the loop, i.e. all KMAX columns were
+* factorized, we need to set MAXC2NRMK and RELMAXC2NRMK before
+* we return.
+*
+ IF( K.LT.MINMNFACT ) THEN
+*
+ JMAXC2NRM = K + IDAMAX( N-K, VN1( K+1 ), 1 )
+ MAXC2NRMK = VN1( JMAXC2NRM )
+*
+ IF( K.EQ.0 ) THEN
+ RELMAXC2NRMK = ONE
+ ELSE
+ RELMAXC2NRMK = MAXC2NRMK / MAXC2NRM
+ END IF
+*
+ ELSE
+ MAXC2NRMK = ZERO
+ RELMAXC2NRMK = ZERO
+ END IF
+*
+* We reached the end of the loop, i.e. all KMAX columns were
+* factorized, set TAUs corresponding to the columns that were
+* not factorized to ZERO, i.e. TAU(K+1:MINMNFACT) set to CZERO.
+*
+ DO J = K + 1, MINMNFACT
+ TAU( J ) = CZERO
+ END DO
+*
+ RETURN
+*
+* End of ZLAQP2RK
+*
+ END
diff --git a/lapack-netlib/SRC/zlaqp3rk.f b/lapack-netlib/SRC/zlaqp3rk.f
new file mode 100644
index 000000000..7a9fdfd95
--- /dev/null
+++ b/lapack-netlib/SRC/zlaqp3rk.f
@@ -0,0 +1,947 @@
+*> \brief \b ZLAQP3RK computes a step of truncated QR factorization with column pivoting of a complex m-by-n matrix A using Level 3 BLAS and overwrites a complex m-by-nrhs matrix B with Q**H * B.
+*
+* =========== DOCUMENTATION ===========
+*
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
+*
+*> \htmlonly
+*> Download ZLAQP3RK + dependencies
+*>
+*> [TGZ]
+*>
+*> [ZIP]
+*>
+*> [TXT]
+*> \endhtmlonly
+*
+* Definition:
+* ===========
+*
+* SUBROUTINE ZLAQP3RK( M, N, NRHS, IOFFSET, NB, ABSTOL,
+* $ RELTOL, KP1, MAXC2NRM, A, LDA, DONE, KB,
+* $ MAXC2NRMK, RELMAXC2NRMK, JPIV, TAU,
+* $ VN1, VN2, AUXV, F, LDF, IWORK, INFO )
+* IMPLICIT NONE
+* LOGICAL DONE
+* INTEGER INFO, IOFFSET, KB, KP1, LDA, LDF, M, N,
+* $ NB, NRHS
+* DOUBLE PRECISION ABSTOL, MAXC2NRM, MAXC2NRMK, RELMAXC2NRMK,
+* $ RELTOL
+* ..
+* .. Array Arguments ..
+* INTEGER IWORK( * ), JPIV( * )
+* DOUBLE PRECISION VN1( * ), VN2( * )
+* COMPLEX*16 A( LDA, * ), AUXV( * ), F( LDF, * ), TAU( * )
+* ..
+*
+*
+*> \par Purpose:
+* =============
+*>
+*> \verbatim
+*>
+*> ZLAQP3RK computes a step of truncated QR factorization with column
+*> pivoting of a complex M-by-N matrix A block A(IOFFSET+1:M,1:N)
+*> by using Level 3 BLAS as
+*>
+*> A * P(KB) = Q(KB) * R(KB).
+*>
+*> The routine tries to factorize NB columns from A starting from
+*> the row IOFFSET+1 and updates the residual matrix with BLAS 3
+*> xGEMM. The number of actually factorized columns is returned
+*> is smaller than NB.
+*>
+*> Block A(1:IOFFSET,1:N) is accordingly pivoted, but not factorized.
+*>
+*> The routine also overwrites the right-hand-sides B matrix stored
+*> in A(IOFFSET+1:M,1:N+1:N+NRHS) with Q(KB)**H * B.
+*>
+*> Cases when the number of factorized columns KB < NB:
+*>
+*> (1) In some cases, due to catastrophic cancellations, it cannot
+*> factorize all NB columns and need to update the residual matrix.
+*> Hence, the actual number of factorized columns in the block returned
+*> in KB is smaller than NB. The logical DONE is returned as FALSE.
+*> The factorization of the whole original matrix A_orig must proceed
+*> with the next block.
+*>
+*> (2) Whenever the stopping criterion ABSTOL or RELTOL is satisfied,
+*> the factorization of the whole original matrix A_orig is stopped,
+*> the logical DONE is returned as TRUE. The number of factorized
+*> columns which is smaller than NB is returned in KB.
+*>
+*> (3) In case both stopping criteria ABSTOL or RELTOL are not used,
+*> and when the residual matrix is a zero matrix in some factorization
+*> step KB, the factorization of the whole original matrix A_orig is
+*> stopped, the logical DONE is returned as TRUE. The number of
+*> factorized columns which is smaller than NB is returned in KB.
+*>
+*> (4) Whenever NaN is detected in the matrix A or in the array TAU,
+*> the factorization of the whole original matrix A_orig is stopped,
+*> the logical DONE is returned as TRUE. The number of factorized
+*> columns which is smaller than NB is returned in KB. The INFO
+*> parameter is set to the column index of the first NaN occurrence.
+*>
+*> \endverbatim
+*
+* Arguments:
+* ==========
+*
+*> \param[in] M
+*> \verbatim
+*> M is INTEGER
+*> The number of rows of the matrix A. M >= 0.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*> N is INTEGER
+*> The number of columns of the matrix A. N >= 0
+*> \endverbatim
+*>
+*> \param[in] NRHS
+*> \verbatim
+*> NRHS is INTEGER
+*> The number of right hand sides, i.e., the number of
+*> columns of the matrix B. NRHS >= 0.
+*> \endverbatim
+*>
+*> \param[in] IOFFSET
+*> \verbatim
+*> IOFFSET is INTEGER
+*> The number of rows of the matrix A that must be pivoted
+*> but not factorized. IOFFSET >= 0.
+*>
+*> IOFFSET also represents the number of columns of the whole
+*> original matrix A_orig that have been factorized
+*> in the previous steps.
+*> \endverbatim
+*>
+*> \param[in] NB
+*> \verbatim
+*> NB is INTEGER
+*> Factorization block size, i.e the number of columns
+*> to factorize in the matrix A. 0 <= NB
+*>
+*> If NB = 0, then the routine exits immediately.
+*> This means that the factorization is not performed,
+*> the matrices A and B and the arrays TAU, IPIV
+*> are not modified.
+*> \endverbatim
+*>
+*> \param[in] ABSTOL
+*> \verbatim
+*> ABSTOL is DOUBLE PRECISION, cannot be NaN.
+*>
+*> The absolute tolerance (stopping threshold) for
+*> maximum column 2-norm of the residual matrix.
+*> The algorithm converges (stops the factorization) when
+*> the maximum column 2-norm of the residual matrix
+*> is less than or equal to ABSTOL.
+*>
+*> a) If ABSTOL < 0.0, then this stopping criterion is not
+*> used, the routine factorizes columns depending
+*> on NB and RELTOL.
+*> This includes the case ABSTOL = -Inf.
+*>
+*> b) If 0.0 <= ABSTOL then the input value
+*> of ABSTOL is used.
+*> \endverbatim
+*>
+*> \param[in] RELTOL
+*> \verbatim
+*> RELTOL is DOUBLE PRECISION, cannot be NaN.
+*>
+*> The tolerance (stopping threshold) for the ratio of the
+*> maximum column 2-norm of the residual matrix to the maximum
+*> column 2-norm of the original matrix A_orig. The algorithm
+*> converges (stops the factorization), when this ratio is
+*> less than or equal to RELTOL.
+*>
+*> a) If RELTOL < 0.0, then this stopping criterion is not
+*> used, the routine factorizes columns depending
+*> on NB and ABSTOL.
+*> This includes the case RELTOL = -Inf.
+*>
+*> d) If 0.0 <= RELTOL then the input value of RELTOL
+*> is used.
+*> \endverbatim
+*>
+*> \param[in] KP1
+*> \verbatim
+*> KP1 is INTEGER
+*> The index of the column with the maximum 2-norm in
+*> the whole original matrix A_orig determined in the
+*> main routine ZGEQP3RK. 1 <= KP1 <= N_orig.
+*> \endverbatim
+*>
+*> \param[in] MAXC2NRM
+*> \verbatim
+*> MAXC2NRM is DOUBLE PRECISION
+*> The maximum column 2-norm of the whole original
+*> matrix A_orig computed in the main routine ZGEQP3RK.
+*> MAXC2NRM >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*> A is COMPLEX*16 array, dimension (LDA,N+NRHS)
+*> On entry:
+*> the M-by-N matrix A and M-by-NRHS matrix B, as in
+*>
+*> N NRHS
+*> array_A = M [ mat_A, mat_B ]
+*>
+*> On exit:
+*> 1. The elements in block A(IOFFSET+1:M,1:KB) below
+*> the diagonal together with the array TAU represent
+*> the orthogonal matrix Q(KB) as a product of elementary
+*> reflectors.
+*> 2. The upper triangular block of the matrix A stored
+*> in A(IOFFSET+1:M,1:KB) is the triangular factor obtained.
+*> 3. The block of the matrix A stored in A(1:IOFFSET,1:N)
+*> has been accordingly pivoted, but not factorized.
+*> 4. The rest of the array A, block A(IOFFSET+1:M,KB+1:N+NRHS).
+*> The left part A(IOFFSET+1:M,KB+1:N) of this block
+*> contains the residual of the matrix A, and,
+*> if NRHS > 0, the right part of the block
+*> A(IOFFSET+1:M,N+1:N+NRHS) contains the block of
+*> the right-hand-side matrix B. Both these blocks have been
+*> updated by multiplication from the left by Q(KB)**H.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*> LDA is INTEGER
+*> The leading dimension of the array A. LDA >= max(1,M).
+*> \endverbatim
+*>
+*> \param[out]
+*> \verbatim
+*> DONE is LOGICAL
+*> TRUE: a) if the factorization completed before processing
+*> all min(M-IOFFSET,NB,N) columns due to ABSTOL
+*> or RELTOL criterion,
+*> b) if the factorization completed before processing
+*> all min(M-IOFFSET,NB,N) columns due to the
+*> residual matrix being a ZERO matrix.
+*> c) when NaN was detected in the matrix A
+*> or in the array TAU.
+*> FALSE: otherwise.
+*> \endverbatim
+*>
+*> \param[out] KB
+*> \verbatim
+*> KB is INTEGER
+*> Factorization rank of the matrix A, i.e. the rank of
+*> the factor R, which is the same as the number of non-zero
+*> rows of the factor R. 0 <= KB <= min(M-IOFFSET,NB,N).
+*>
+*> KB also represents the number of non-zero Householder
+*> vectors.
+*> \endverbatim
+*>
+*> \param[out] MAXC2NRMK
+*> \verbatim
+*> MAXC2NRMK is DOUBLE PRECISION
+*> The maximum column 2-norm of the residual matrix,
+*> when the factorization stopped at rank KB. MAXC2NRMK >= 0.
+*> \endverbatim
+*>
+*> \param[out] RELMAXC2NRMK
+*> \verbatim
+*> RELMAXC2NRMK is DOUBLE PRECISION
+*> The ratio MAXC2NRMK / MAXC2NRM of the maximum column
+*> 2-norm of the residual matrix (when the factorization
+*> stopped at rank KB) to the maximum column 2-norm of the
+*> original matrix A_orig. RELMAXC2NRMK >= 0.
+*> \endverbatim
+*>
+*> \param[out] JPIV
+*> \verbatim
+*> JPIV is INTEGER array, dimension (N)
+*> Column pivot indices, for 1 <= j <= N, column j
+*> of the matrix A was interchanged with column JPIV(j).
+*> \endverbatim
+*>
+*> \param[out] TAU
+*> \verbatim
+*> TAU is COMPLEX*16 array, dimension (min(M-IOFFSET,N))
+*> The scalar factors of the elementary reflectors.
+*> \endverbatim
+*>
+*> \param[in,out] VN1
+*> \verbatim
+*> VN1 is DOUBLE PRECISION array, dimension (N)
+*> The vector with the partial column norms.
+*> \endverbatim
+*>
+*> \param[in,out] VN2
+*> \verbatim
+*> VN2 is DOUBLE PRECISION array, dimension (N)
+*> The vector with the exact column norms.
+*> \endverbatim
+*>
+*> \param[out] AUXV
+*> \verbatim
+*> AUXV is COMPLEX*16 array, dimension (NB)
+*> Auxiliary vector.
+*> \endverbatim
+*>
+*> \param[out] F
+*> \verbatim
+*> F is COMPLEX*16 array, dimension (LDF,NB)
+*> Matrix F**H = L*(Y**H)*A.
+*> \endverbatim
+*>
+*> \param[in] LDF
+*> \verbatim
+*> LDF is INTEGER
+*> The leading dimension of the array F. LDF >= max(1,N+NRHS).
+*> \endverbatim
+*>
+*> \param[out] IWORK
+*> \verbatim
+*> IWORK is INTEGER array, dimension (N-1).
+*> Is a work array. ( IWORK is used to store indices
+*> of "bad" columns for norm downdating in the residual
+*> matrix ).
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*> INFO is INTEGER
+*> 1) INFO = 0: successful exit.
+*> 2) If INFO = j_1, where 1 <= j_1 <= N, then NaN was
+*> detected and the routine stops the computation.
+*> The j_1-th column of the matrix A or the j_1-th
+*> element of array TAU contains the first occurrence
+*> of NaN in the factorization step KB+1 ( when KB columns
+*> have been factorized ).
+*>
+*> On exit:
+*> KB is set to the number of
+*> factorized columns without
+*> exception.
+*> MAXC2NRMK is set to NaN.
+*> RELMAXC2NRMK is set to NaN.
+*> TAU(KB+1:min(M,N)) is not set and contains undefined
+*> elements. If j_1=KB+1, TAU(KB+1)
+*> may contain NaN.
+*> 3) If INFO = j_2, where N+1 <= j_2 <= 2*N, then no NaN
+*> was detected, but +Inf (or -Inf) was detected and
+*> the routine continues the computation until completion.
+*> The (j_2-N)-th column of the matrix A contains the first
+*> occurrence of +Inf (or -Inf) in the actorization
+*> step KB+1 ( when KB columns have been factorized ).
+*> \endverbatim
+*
+* Authors:
+* ========
+*
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
+*> \ingroup laqp3rk
+*
+*> \par References:
+* ================
+*> [1] A Level 3 BLAS QR factorization algorithm with column pivoting developed in 1996.
+*> G. Quintana-Orti, Depto. de Informatica, Universidad Jaime I, Spain.
+*> X. Sun, Computer Science Dept., Duke University, USA.
+*> C. H. Bischof, Math. and Comp. Sci. Div., Argonne National Lab, USA.
+*> A BLAS-3 version of the QR factorization with column pivoting.
+*> LAPACK Working Note 114
+*> \htmlonly
+*> https://www.netlib.org/lapack/lawnspdf/lawn114.pdf
+*> \endhtmlonly
+*> and in
+*> SIAM J. Sci. Comput., 19(5):1486-1494, Sept. 1998.
+*> \htmlonly
+*> https://doi.org/10.1137/S1064827595296732
+*> \endhtmlonly
+*>
+*> [2] A partial column norm updating strategy developed in 2006.
+*> Z. Drmac and Z. Bujanovic, Dept. of Math., University of Zagreb, Croatia.
+*> On the failure of rank revealing QR factorization software – a case study.
+*> LAPACK Working Note 176.
+*> \htmlonly
+*> http://www.netlib.org/lapack/lawnspdf/lawn176.pdf
+*> \endhtmlonly
+*> and in
+*> ACM Trans. Math. Softw. 35, 2, Article 12 (July 2008), 28 pages.
+*> \htmlonly
+*> https://doi.org/10.1145/1377612.1377616
+*> \endhtmlonly
+*
+*> \par Contributors:
+* ==================
+*>
+*> \verbatim
+*>
+*> November 2023, Igor Kozachenko, James Demmel,
+*> Computer Science Division,
+*> University of California, Berkeley
+*>
+*> \endverbatim
+*
+* =====================================================================
+ SUBROUTINE ZLAQP3RK( M, N, NRHS, IOFFSET, NB, ABSTOL,
+ $ RELTOL, KP1, MAXC2NRM, A, LDA, DONE, KB,
+ $ MAXC2NRMK, RELMAXC2NRMK, JPIV, TAU,
+ $ VN1, VN2, AUXV, F, LDF, IWORK, INFO )
+ IMPLICIT NONE
+*
+* -- LAPACK auxiliary routine --
+* -- LAPACK is a software package provided by Univ. of Tennessee, --
+* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*
+* .. Scalar Arguments ..
+ LOGICAL DONE
+ INTEGER INFO, IOFFSET, KB, KP1, LDA, LDF, M, N,
+ $ NB, NRHS
+ DOUBLE PRECISION ABSTOL, MAXC2NRM, MAXC2NRMK, RELMAXC2NRMK,
+ $ RELTOL
+* ..
+* .. Array Arguments ..
+ INTEGER IWORK( * ), JPIV( * )
+ DOUBLE PRECISION VN1( * ), VN2( * )
+ COMPLEX*16 A( LDA, * ), AUXV( * ), F( LDF, * ), TAU( * )
+* ..
+*
+* =====================================================================
+*
+* .. Parameters ..
+ DOUBLE PRECISION ZERO, ONE
+ PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
+ COMPLEX*16 CZERO, CONE
+ PARAMETER ( CZERO = ( 0.0D+0, 0.0D+0 ),
+ $ CONE = ( 1.0D+0, 0.0D+0 ) )
+* ..
+* .. Local Scalars ..
+ INTEGER ITEMP, J, K, MINMNFACT, MINMNUPDT,
+ $ LSTICC, KP, I, IF
+ DOUBLE PRECISION HUGEVAL, TAUNAN, TEMP, TEMP2, TOL3Z
+ COMPLEX*16 AIK
+* ..
+* .. External Subroutines ..
+ EXTERNAL ZGEMM, ZGEMV, ZLARFG, ZSWAP
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC ABS, DBLE, DCONJG, DIMAG, MAX, MIN, SQRT
+* ..
+* .. External Functions ..
+ LOGICAL DISNAN
+ INTEGER IDAMAX
+ DOUBLE PRECISION DLAMCH, DZNRM2
+ EXTERNAL DISNAN, DLAMCH, IDAMAX, DZNRM2
+* ..
+* .. Executable Statements ..
+*
+* Initialize INFO
+*
+ INFO = 0
+*
+* MINMNFACT in the smallest dimension of the submatrix
+* A(IOFFSET+1:M,1:N) to be factorized.
+*
+ MINMNFACT = MIN( M-IOFFSET, N )
+ MINMNUPDT = MIN( M-IOFFSET, N+NRHS )
+ NB = MIN( NB, MINMNFACT )
+ TOL3Z = SQRT( DLAMCH( 'Epsilon' ) )
+ HUGEVAL = DLAMCH( 'Overflow' )
+*
+* Compute factorization in a while loop over NB columns,
+* K is the column index in the block A(1:M,1:N).
+*
+ K = 0
+ LSTICC = 0
+ DONE = .FALSE.
+*
+ DO WHILE ( K.LT.NB .AND. LSTICC.EQ.0 )
+ K = K + 1
+ I = IOFFSET + K
+*
+ IF( I.EQ.1 ) THEN
+*
+* We are at the first column of the original whole matrix A_orig,
+* therefore we use the computed KP1 and MAXC2NRM from the
+* main routine.
+*
+ KP = KP1
+*
+ ELSE
+*
+* Determine the pivot column in K-th step, i.e. the index
+* of the column with the maximum 2-norm in the
+* submatrix A(I:M,K:N).
+*
+ KP = ( K-1 ) + IDAMAX( N-K+1, VN1( K ), 1 )
+*
+* Determine the maximum column 2-norm and the relative maximum
+* column 2-norm of the submatrix A(I:M,K:N) in step K.
+*
+ MAXC2NRMK = VN1( KP )
+*
+* ============================================================
+*
+* Check if the submatrix A(I:M,K:N) contains NaN, set
+* INFO parameter to the column number, where the first NaN
+* is found and return from the routine.
+* We need to check the condition only if the
+* column index (same as row index) of the original whole
+* matrix is larger than 1, since the condition for whole
+* original matrix is checked in the main routine.
+*
+ IF( DISNAN( MAXC2NRMK ) ) THEN
+*
+ DONE = .TRUE.
+*
+* Set KB, the number of factorized partial columns
+* that are non-zero in each step in the block,
+* i.e. the rank of the factor R.
+* Set IF, the number of processed rows in the block, which
+* is the same as the number of processed rows in
+* the original whole matrix A_orig.
+*
+ KB = K - 1
+ IF = I - 1
+ INFO = KB + KP
+*
+* Set RELMAXC2NRMK to NaN.
+*
+ RELMAXC2NRMK = MAXC2NRMK
+*
+* There is no need to apply the block reflector to the
+* residual of the matrix A stored in A(KB+1:M,KB+1:N),
+* since the submatrix contains NaN and we stop
+* the computation.
+* But, we need to apply the block reflector to the residual
+* right hand sides stored in A(KB+1:M,N+1:N+NRHS), if the
+* residual right hand sides exist. This occurs
+* when ( NRHS != 0 AND KB <= (M-IOFFSET) ):
+*
+* A(I+1:M,N+1:N+NRHS) := A(I+1:M,N+1:N+NRHS) -
+* A(I+1:M,1:KB) * F(N+1:N+NRHS,1:KB)**H.
+
+ IF( NRHS.GT.0 .AND. KB.LT.(M-IOFFSET) ) THEN
+ CALL ZGEMM( 'No transpose', 'Conjugate transpose',
+ $ M-IF, NRHS, KB, -CONE, A( IF+1, 1 ), LDA,
+ $ F( N+1, 1 ), LDF, CONE, A( IF+1, N+1 ), LDA )
+ END IF
+*
+* There is no need to recompute the 2-norm of the
+* difficult columns, since we stop the factorization.
+*
+* Array TAU(KF+1:MINMNFACT) is not set and contains
+* undefined elements.
+*
+* Return from the routine.
+*
+ RETURN
+ END IF
+*
+* Quick return, if the submatrix A(I:M,K:N) is
+* a zero matrix. We need to check it only if the column index
+* (same as row index) is larger than 1, since the condition
+* for the whole original matrix A_orig is checked in the main
+* routine.
+*
+ IF( MAXC2NRMK.EQ.ZERO ) THEN
+*
+ DONE = .TRUE.
+*
+* Set KB, the number of factorized partial columns
+* that are non-zero in each step in the block,
+* i.e. the rank of the factor R.
+* Set IF, the number of processed rows in the block, which
+* is the same as the number of processed rows in
+* the original whole matrix A_orig.
+*
+ KB = K - 1
+ IF = I - 1
+ RELMAXC2NRMK = ZERO
+*
+* There is no need to apply the block reflector to the
+* residual of the matrix A stored in A(KB+1:M,KB+1:N),
+* since the submatrix is zero and we stop the computation.
+* But, we need to apply the block reflector to the residual
+* right hand sides stored in A(KB+1:M,N+1:N+NRHS), if the
+* residual right hand sides exist. This occurs
+* when ( NRHS != 0 AND KB <= (M-IOFFSET) ):
+*
+* A(I+1:M,N+1:N+NRHS) := A(I+1:M,N+1:N+NRHS) -
+* A(I+1:M,1:KB) * F(N+1:N+NRHS,1:KB)**H.
+*
+ IF( NRHS.GT.0 .AND. KB.LT.(M-IOFFSET) ) THEN
+ CALL ZGEMM( 'No transpose', 'Conjugate transpose',
+ $ M-IF, NRHS, KB, -CONE, A( IF+1, 1 ), LDA,
+ $ F( N+1, 1 ), LDF, CONE, A( IF+1, N+1 ), LDA )
+ END IF
+*
+* There is no need to recompute the 2-norm of the
+* difficult columns, since we stop the factorization.
+*
+* Set TAUs corresponding to the columns that were not
+* factorized to ZERO, i.e. set TAU(KB+1:MINMNFACT) = CZERO,
+* which is equivalent to seting TAU(K:MINMNFACT) = CZERO.
+*
+ DO J = K, MINMNFACT
+ TAU( J ) = CZERO
+ END DO
+*
+* Return from the routine.
+*
+ RETURN
+*
+ END IF
+*
+* ============================================================
+*
+* Check if the submatrix A(I:M,K:N) contains Inf,
+* set INFO parameter to the column number, where
+* the first Inf is found plus N, and continue
+* the computation.
+* We need to check the condition only if the
+* column index (same as row index) of the original whole
+* matrix is larger than 1, since the condition for whole
+* original matrix is checked in the main routine.
+*
+ IF( INFO.EQ.0 .AND. MAXC2NRMK.GT.HUGEVAL ) THEN
+ INFO = N + K - 1 + KP
+ END IF
+*
+* ============================================================
+*
+* Test for the second and third tolerance stopping criteria.
+* NOTE: There is no need to test for ABSTOL.GE.ZERO, since
+* MAXC2NRMK is non-negative. Similarly, there is no need
+* to test for RELTOL.GE.ZERO, since RELMAXC2NRMK is
+* non-negative.
+* We need to check the condition only if the
+* column index (same as row index) of the original whole
+* matrix is larger than 1, since the condition for whole
+* original matrix is checked in the main routine.
+*
+ RELMAXC2NRMK = MAXC2NRMK / MAXC2NRM
+*
+ IF( MAXC2NRMK.LE.ABSTOL .OR. RELMAXC2NRMK.LE.RELTOL ) THEN
+*
+ DONE = .TRUE.
+*
+* Set KB, the number of factorized partial columns
+* that are non-zero in each step in the block,
+* i.e. the rank of the factor R.
+* Set IF, the number of processed rows in the block, which
+* is the same as the number of processed rows in
+* the original whole matrix A_orig;
+*
+ KB = K - 1
+ IF = I - 1
+*
+* Apply the block reflector to the residual of the
+* matrix A and the residual of the right hand sides B, if
+* the residual matrix and and/or the residual of the right
+* hand sides exist, i.e. if the submatrix
+* A(I+1:M,KB+1:N+NRHS) exists. This occurs when
+* KB < MINMNUPDT = min( M-IOFFSET, N+NRHS ):
+*
+* A(IF+1:M,K+1:N+NRHS) := A(IF+1:M,KB+1:N+NRHS) -
+* A(IF+1:M,1:KB) * F(KB+1:N+NRHS,1:KB)**H.
+*
+ IF( KB.LT.MINMNUPDT ) THEN
+ CALL ZGEMM( 'No transpose', 'Conjugate transpose',
+ $ M-IF, N+NRHS-KB, KB,-CONE, A( IF+1, 1 ), LDA,
+ $ F( KB+1, 1 ), LDF, CONE, A( IF+1, KB+1 ), LDA )
+ END IF
+*
+* There is no need to recompute the 2-norm of the
+* difficult columns, since we stop the factorization.
+*
+* Set TAUs corresponding to the columns that were not
+* factorized to ZERO, i.e. set TAU(KB+1:MINMNFACT) = CZERO,
+* which is equivalent to seting TAU(K:MINMNFACT) = CZERO.
+*
+ DO J = K, MINMNFACT
+ TAU( J ) = CZERO
+ END DO
+*
+* Return from the routine.
+*
+ RETURN
+*
+ END IF
+*
+* ============================================================
+*
+* End ELSE of IF(I.EQ.1)
+*
+ END IF
+*
+* ===============================================================
+*
+* If the pivot column is not the first column of the
+* subblock A(1:M,K:N):
+* 1) swap the K-th column and the KP-th pivot column
+* in A(1:M,1:N);
+* 2) swap the K-th row and the KP-th row in F(1:N,1:K-1)
+* 3) copy the K-th element into the KP-th element of the partial
+* and exact 2-norm vectors VN1 and VN2. (Swap is not needed
+* for VN1 and VN2 since we use the element with the index
+* larger than K in the next loop step.)
+* 4) Save the pivot interchange with the indices relative to the
+* the original matrix A_orig, not the block A(1:M,1:N).
+*
+ IF( KP.NE.K ) THEN
+ CALL ZSWAP( M, A( 1, KP ), 1, A( 1, K ), 1 )
+ CALL ZSWAP( K-1, F( KP, 1 ), LDF, F( K, 1 ), LDF )
+ VN1( KP ) = VN1( K )
+ VN2( KP ) = VN2( K )
+ ITEMP = JPIV( KP )
+ JPIV( KP ) = JPIV( K )
+ JPIV( K ) = ITEMP
+ END IF
+*
+* Apply previous Householder reflectors to column K:
+* A(I:M,K) := A(I:M,K) - A(I:M,1:K-1)*F(K,1:K-1)**H.
+*
+ IF( K.GT.1 ) THEN
+ DO J = 1, K - 1
+ F( K, J ) = DCONJG( F( K, J ) )
+ END DO
+ CALL ZGEMV( 'No transpose', M-I+1, K-1, -CONE, A( I, 1 ),
+ $ LDA, F( K, 1 ), LDF, CONE, A( I, K ), 1 )
+ DO J = 1, K - 1
+ F( K, J ) = DCONJG( F( K, J ) )
+ END DO
+ END IF
+*
+* Generate elementary reflector H(k) using the column A(I:M,K).
+*
+ IF( I.LT.M ) THEN
+ CALL ZLARFG( M-I+1, A( I, K ), A( I+1, K ), 1, TAU( K ) )
+ ELSE
+ TAU( K ) = CZERO
+ END IF
+*
+* Check if TAU(K) contains NaN, set INFO parameter
+* to the column number where NaN is found and return from
+* the routine.
+* NOTE: There is no need to check TAU(K) for Inf,
+* since ZLARFG cannot produce TAU(KK) or Householder vector
+* below the diagonal containing Inf. Only BETA on the diagonal,
+* returned by ZLARFG can contain Inf, which requires
+* TAU(K) to contain NaN. Therefore, this case of generating Inf
+* by ZLARFG is covered by checking TAU(K) for NaN.
+*
+ IF( DISNAN( DBLE( TAU(K) ) ) ) THEN
+ TAUNAN = DBLE( TAU(K) )
+ ELSE IF( DISNAN( DIMAG( TAU(K) ) ) ) THEN
+ TAUNAN = DIMAG( TAU(K) )
+ ELSE
+ TAUNAN = ZERO
+ END IF
+*
+ IF( DISNAN( TAUNAN ) ) THEN
+*
+ DONE = .TRUE.
+*
+* Set KB, the number of factorized partial columns
+* that are non-zero in each step in the block,
+* i.e. the rank of the factor R.
+* Set IF, the number of processed rows in the block, which
+* is the same as the number of processed rows in
+* the original whole matrix A_orig.
+*
+ KB = K - 1
+ IF = I - 1
+ INFO = K
+*
+* Set MAXC2NRMK and RELMAXC2NRMK to NaN.
+*
+ MAXC2NRMK = TAUNAN
+ RELMAXC2NRMK = TAUNAN
+*
+* There is no need to apply the block reflector to the
+* residual of the matrix A stored in A(KB+1:M,KB+1:N),
+* since the submatrix contains NaN and we stop
+* the computation.
+* But, we need to apply the block reflector to the residual
+* right hand sides stored in A(KB+1:M,N+1:N+NRHS), if the
+* residual right hand sides exist. This occurs
+* when ( NRHS != 0 AND KB <= (M-IOFFSET) ):
+*
+* A(I+1:M,N+1:N+NRHS) := A(I+1:M,N+1:N+NRHS) -
+* A(I+1:M,1:KB) * F(N+1:N+NRHS,1:KB)**H.
+*
+ IF( NRHS.GT.0 .AND. KB.LT.(M-IOFFSET) ) THEN
+ CALL ZGEMM( 'No transpose', 'Conjugate transpose',
+ $ M-IF, NRHS, KB, -CONE, A( IF+1, 1 ), LDA,
+ $ F( N+1, 1 ), LDF, CONE, A( IF+1, N+1 ), LDA )
+ END IF
+*
+* There is no need to recompute the 2-norm of the
+* difficult columns, since we stop the factorization.
+*
+* Array TAU(KF+1:MINMNFACT) is not set and contains
+* undefined elements.
+*
+* Return from the routine.
+*
+ RETURN
+ END IF
+*
+* ===============================================================
+*
+ AIK = A( I, K )
+ A( I, K ) = CONE
+*
+* ===============================================================
+*
+* Compute the current K-th column of F:
+* 1) F(K+1:N,K) := tau(K) * A(I:M,K+1:N)**H * A(I:M,K).
+*
+ IF( K.LT.N+NRHS ) THEN
+ CALL ZGEMV( 'Conjugate transpose', M-I+1, N+NRHS-K,
+ $ TAU( K ), A( I, K+1 ), LDA, A( I, K ), 1,
+ $ CZERO, F( K+1, K ), 1 )
+ END IF
+*
+* 2) Zero out elements above and on the diagonal of the
+* column K in matrix F, i.e elements F(1:K,K).
+*
+ DO J = 1, K
+ F( J, K ) = CZERO
+ END DO
+*
+* 3) Incremental updating of the K-th column of F:
+* F(1:N,K) := F(1:N,K) - tau(K) * F(1:N,1:K-1) * A(I:M,1:K-1)**H
+* * A(I:M,K).
+*
+ IF( K.GT.1 ) THEN
+ CALL ZGEMV( 'Conjugate Transpose', M-I+1, K-1, -TAU( K ),
+ $ A( I, 1 ), LDA, A( I, K ), 1, CZERO,
+ $ AUXV( 1 ), 1 )
+*
+ CALL ZGEMV( 'No transpose', N+NRHS, K-1, CONE,
+ $ F( 1, 1 ), LDF, AUXV( 1 ), 1, CONE,
+ $ F( 1, K ), 1 )
+ END IF
+*
+* ===============================================================
+*
+* Update the current I-th row of A:
+* A(I,K+1:N+NRHS) := A(I,K+1:N+NRHS)
+* - A(I,1:K)*F(K+1:N+NRHS,1:K)**H.
+*
+ IF( K.LT.N+NRHS ) THEN
+ CALL ZGEMM( 'No transpose', 'Conjugate transpose',
+ $ 1, N+NRHS-K, K, -CONE, A( I, 1 ), LDA,
+ $ F( K+1, 1 ), LDF, CONE, A( I, K+1 ), LDA )
+ END IF
+*
+ A( I, K ) = AIK
+*
+* Update the partial column 2-norms for the residual matrix,
+* only if the residual matrix A(I+1:M,K+1:N) exists, i.e.
+* when K < MINMNFACT = min( M-IOFFSET, N ).
+*
+ IF( K.LT.MINMNFACT ) THEN
+*
+ DO J = K + 1, N
+ IF( VN1( J ).NE.ZERO ) THEN
+*
+* NOTE: The following lines follow from the analysis in
+* Lapack Working Note 176.
+*
+ TEMP = ABS( A( I, J ) ) / VN1( J )
+ TEMP = MAX( ZERO, ( ONE+TEMP )*( ONE-TEMP ) )
+ TEMP2 = TEMP*( VN1( J ) / VN2( J ) )**2
+ IF( TEMP2.LE.TOL3Z ) THEN
+*
+* At J-index, we have a difficult column for the
+* update of the 2-norm. Save the index of the previous
+* difficult column in IWORK(J-1).
+* NOTE: ILSTCC > 1, threfore we can use IWORK only
+* with N-1 elements, where the elements are
+* shifted by 1 to the left.
+*
+ IWORK( J-1 ) = LSTICC
+*
+* Set the index of the last difficult column LSTICC.
+*
+ LSTICC = J
+*
+ ELSE
+ VN1( J ) = VN1( J )*SQRT( TEMP )
+ END IF
+ END IF
+ END DO
+*
+ END IF
+*
+* End of while loop.
+*
+ END DO
+*
+* Now, afler the loop:
+* Set KB, the number of factorized columns in the block;
+* Set IF, the number of processed rows in the block, which
+* is the same as the number of processed rows in
+* the original whole matrix A_orig, IF = IOFFSET + KB.
+*
+ KB = K
+ IF = I
+*
+* Apply the block reflector to the residual of the matrix A
+* and the residual of the right hand sides B, if the residual
+* matrix and and/or the residual of the right hand sides
+* exist, i.e. if the submatrix A(I+1:M,KB+1:N+NRHS) exists.
+* This occurs when KB < MINMNUPDT = min( M-IOFFSET, N+NRHS ):
+*
+* A(IF+1:M,K+1:N+NRHS) := A(IF+1:M,KB+1:N+NRHS) -
+* A(IF+1:M,1:KB) * F(KB+1:N+NRHS,1:KB)**H.
+*
+ IF( KB.LT.MINMNUPDT ) THEN
+ CALL ZGEMM( 'No transpose', 'Conjugate transpose',
+ $ M-IF, N+NRHS-KB, KB, -CONE, A( IF+1, 1 ), LDA,
+ $ F( KB+1, 1 ), LDF, CONE, A( IF+1, KB+1 ), LDA )
+ END IF
+*
+* Recompute the 2-norm of the difficult columns.
+* Loop over the index of the difficult columns from the largest
+* to the smallest index.
+*
+ DO WHILE( LSTICC.GT.0 )
+*
+* LSTICC is the index of the last difficult column is greater
+* than 1.
+* ITEMP is the index of the previous difficult column.
+*
+ ITEMP = IWORK( LSTICC-1 )
+*
+* Compute the 2-norm explicilty for the last difficult column and
+* save it in the partial and exact 2-norm vectors VN1 and VN2.
+*
+* NOTE: The computation of VN1( LSTICC ) relies on the fact that
+* DZNRM2 does not fail on vectors with norm below the value of
+* SQRT(DLAMCH('S'))
+*
+ VN1( LSTICC ) = DZNRM2( M-IF, A( IF+1, LSTICC ), 1 )
+ VN2( LSTICC ) = VN1( LSTICC )
+*
+* Downdate the index of the last difficult column to
+* the index of the previous difficult column.
+*
+ LSTICC = ITEMP
+*
+ END DO
+*
+ RETURN
+*
+* End of ZLAQP3RK
+*
+ END