Fix some minors issue: extra space, variable names.
* ===========
*
* RECURSIVE SUBROUTINE CGELQT3( M, N, A, LDA, T, LDT, INFO )
-*
+*
* .. Scalar Arguments ..
* INTEGER INFO, LDA, M, N, LDT
* ..
* .. Array Arguments ..
* COMPLEX A( LDA, * ), T( LDT, * )
* ..
-*
+*
*
*> \par Purpose:
* =============
*>
*> \verbatim
*>
-*> CGELQT3 recursively computes a LQ factorization of a complex M-by-N
-*> matrix A, using the compact WY representation of Q.
+*> CGELQT3 recursively computes a LQ factorization of a complex M-by-N
+*> matrix A, using the compact WY representation of Q.
*>
-*> Based on the algorithm of Elmroth and Gustavson,
+*> Based on the algorithm of Elmroth and Gustavson,
*> IBM J. Res. Develop. Vol 44 No. 4 July 2000.
*> \endverbatim
*
* Authors:
* ========
*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
*
*> \date September 2012
*
*> V = ( 1 v1 v1 v1 v1 )
*> ( 1 v2 v2 v2 )
*> ( 1 v3 v3 v3 )
-*>
+*>
*>
*> where the vi's represent the vectors which define H(i), which are returned
*> in the matrix A. The 1's along the diagonal of V are not stored in A. The
PARAMETER ( ZERO = (0.0E+00,0.0E+00))
* ..
* .. Local Scalars ..
- INTEGER I, I1, J, J1, N1, N2, IINFO
+ INTEGER I, I1, J, J1, M1, M2, N1, N2, IINFO
* ..
* .. External Subroutines ..
EXTERNAL CLARFG, CTRMM, CGEMM, XERBLA
*
CALL CLARFG( N, A, A( 1, MIN( 2, N ) ), LDA, T )
T(1,1)=CONJG(T(1,1))
-*
+*
ELSE
*
* Otherwise, split A into blocks...
T( I+M1, J ) = A( I+M1, J )
END DO
END DO
- CALL CTRMM( 'R', 'U', 'C', 'U', M2, M1, ONE,
+ CALL CTRMM( 'R', 'U', 'C', 'U', M2, M1, ONE,
& A, LDA, T( I1, 1 ), LDT )
*
CALL CGEMM( 'N', 'C', M2, M1, N-M1, ONE, A( I1, I1 ), LDA,
CALL CTRMM( 'R', 'U', 'N', 'N', M2, M1, ONE,
& T, LDT, T( I1, 1 ), LDT )
*
- CALL CGEMM( 'N', 'N', M2, N-M1, M1, -ONE, T( I1, 1 ), LDT,
+ CALL CGEMM( 'N', 'N', M2, N-M1, M1, -ONE, T( I1, 1 ), LDT,
& A( 1, I1 ), LDA, ONE, A( I1, I1 ), LDA )
*
CALL CTRMM( 'R', 'U', 'N', 'U', M2, M1 , ONE,
*
* Compute A(J1:M,J1:N) <- (Y2,R2,T2) where Q2 = I - Y2 T2 Y2^H
*
- CALL CGELQT3( M2, N-M1, A( I1, I1 ), LDA,
+ CALL CGELQT3( M2, N-M1, A( I1, I1 ), LDA,
& T( I1, I1 ), LDT, IINFO )
*
* Compute T3 = T(J1:N1,1:N) = -T1 Y1^H Y2 T2
CALL CGEMM( 'N', 'C', M1, M2, N-M, ONE, A( 1, J1 ), LDA,
& A( I1, J1 ), LDA, ONE, T( 1, I1 ), LDT )
*
- CALL CTRMM( 'L', 'U', 'N', 'N', M1, M2, -ONE, T, LDT,
+ CALL CTRMM( 'L', 'U', 'N', 'N', M1, M2, -ONE, T, LDT,
& T( 1, I1 ), LDT )
*
- CALL CTRMM( 'R', 'U', 'N', 'N', M1, M2, ONE,
+ CALL CTRMM( 'R', 'U', 'N', 'N', M1, M2, ONE,
& T( I1, I1 ), LDT, T( 1, I1 ), LDT )
*
-*
+*
*
* Y = (Y1,Y2); L = [ L1 0 ]; T = [T1 T3]
* [ A(1:N1,J1:N) L2 ] [ 0 T2]
* SUBROUTINE CGETSLS( TRANS, M, N, NRHS, A, LDA, B, LDB
* $ , WORK, LWORK, INFO )
-*
+*
* .. Scalar Arguments ..
* CHARACTER TRANS
* INTEGER INFO, LDA, LDB, LWORK, M, N, NRHS
* .. Array Arguments ..
* COMPLEX A( LDA, * ), B( LDB, * ), WORK( * )
* ..
-*
+*
*
*> \par Purpose:
* =============
*> \verbatim
*>
*> CGETSLS solves overdetermined or underdetermined real linear systems
-*> involving an M-by-N matrix A, or its transpose, using a tall skinny
-*> QR or short wide LQfactorization of A. It is assumed that A has
+*> involving an M-by-N matrix A, or its transpose, using a tall skinny
+*> QR or short wide LQfactorization of A. It is assumed that A has
*> full rank.
*>
*> The following options are provided:
* Authors:
* ========
*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
*
*> \date November 2011
*
* .. Local Scalars ..
LOGICAL LQUERY, TRAN
INTEGER I, IASCL, IBSCL, J, MINMN, MAXMN, BROW, LW,
- $ SCLLEN, MNK, WSIZEO, WSIZEM, LW1, LW2, INFO2
+ $ SCLLEN, MNK, WSIZEO, WSIZEM, LW1, LW2,
+ $ INFO2, NB
REAL ANRM, BIGNUM, BNRM, SMLNUM
* ..
* .. External Functions ..
EXTERNAL LSAME, ILAENV, SLABAD, SLAMCH, CLANGE
* ..
* .. External Subroutines ..
- EXTERNAL CGEQR, CGEMQR, CLASCL, CLASET,
+ EXTERNAL CGEQR, CGEMQR, CLASCL, CLASET,
$ CTRTRS, XERBLA, CGELQ, CGEMLQ
* ..
* .. Intrinsic Functions ..
TRAN = LSAME( TRANS, 'C' )
*
LQUERY = ( LWORK.EQ.-1 )
- IF( .NOT.( LSAME( TRANS, 'N' ) .OR.
+ IF( .NOT.( LSAME( TRANS, 'N' ) .OR.
$ LSAME( TRANS, 'C' ) ) ) THEN
INFO = -1
ELSE IF( M.LT.0 ) THEN
IF( INFO.EQ.0) THEN
*
* Determine the block size and minimum LWORK
-*
+*
IF ( M.GE.N ) THEN
- CALL CGEQR( M, N, A, LDA, WORK(1), -1, WORK(6), -1,
+ CALL CGEQR( M, N, A, LDA, WORK(1), -1, WORK(6), -1,
$ INFO2)
MB = INT(WORK(4))
NB = INT(WORK(5))
$ INT(WORK(2)), B, LDB, WORK(6), -1 , INFO2 )
WSIZEO = INT(WORK(2))+MAX(LW,INT(WORK(6)))
WSIZEM = INT(WORK(3))+MAX(LW,INT(WORK(6)))
- ELSE
- CALL CGELQ( M, N, A, LDA, WORK(1), -1, WORK(6), -1,
+ ELSE
+ CALL CGELQ( M, N, A, LDA, WORK(1), -1, WORK(6), -1,
$ INFO2)
MB = INT(WORK(4))
NB = INT(WORK(5))
* Quick return if possible
*
IF( MIN( M, N, NRHS ).EQ.0 ) THEN
- CALL CLASET( 'FULL', MAX( M, N ), NRHS, CZERO, CZERO,
+ CALL CLASET( 'FULL', MAX( M, N ), NRHS, CZERO, CZERO,
$ B, LDB )
RETURN
END IF
*
* Scale A, B if max element outside range [SMLNUM,BIGNUM]
*
- ANRM = CLANGE( 'M', M, N, A, LDA, RWORK )
+ ANRM = CLANGE( 'M', M, N, A, LDA, WORK )
IASCL = 0
IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN
*
IF ( TRAN ) THEN
BROW = N
END IF
- BNRM = CLANGE( 'M', BROW, NRHS, B, LDB, RWORK )
+ BNRM = CLANGE( 'M', BROW, NRHS, B, LDB, WORK )
IBSCL = 0
IF( BNRM.GT.ZERO .AND. BNRM.LT.SMLNUM ) THEN
*
*
* B(1:M,1:NRHS) := Q**T * B(1:M,1:NRHS)
*
- CALL CGEMQR( 'L' , 'C', M, NRHS, N, A, LDA,
+ CALL CGEMQR( 'L' , 'C', M, NRHS, N, A, LDA,
$ WORK(LW2+1), LW1, B, LDB, WORK(1), LW2, INFO )
*
* B(1:N,1:NRHS) := inv(R) * B(1:N,1:NRHS)
*
CALL CGEMQR( 'L', 'N', M, NRHS, N, A, LDA,
$ WORK( LW2+1), LW1, B, LDB, WORK( 1 ), LW2,
- $ INFO )
+ $ INFO )
*
SCLLEN = M
*
*
* =========== DOCUMENTATION ===========
*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
-*> Download DGEQRT3 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgelqt3.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgelqt3.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgelqt3.f">
+*> Download DGEQRT3 + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgelqt3.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgelqt3.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgelqt3.f">
*> [TXT]</a>
-*> \endhtmlonly
+*> \endhtmlonly
*
* Definition:
* ===========
*
* RECURSIVE SUBROUTINE DGELQT3( M, N, A, LDA, T, LDT, INFO )
-*
+*
* .. Scalar Arguments ..
* INTEGER INFO, LDA, M, N, LDT
* ..
* .. Array Arguments ..
* DOUBLE PRECISION A( LDA, * ), T( LDT, * )
* ..
-*
+*
*
*> \par Purpose:
* =============
*>
*> \verbatim
*>
-*> DGELQT3 recursively computes a LQ factorization of a real M-by-N
-*> matrix A, using the compact WY representation of Q.
+*> DGELQT3 recursively computes a LQ factorization of a real M-by-N
+*> matrix A, using the compact WY representation of Q.
*>
-*> Based on the algorithm of Elmroth and Gustavson,
+*> Based on the algorithm of Elmroth and Gustavson,
*> IBM J. Res. Develop. Vol 44 No. 4 July 2000.
*> \endverbatim
*
* Authors:
* ========
*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
*
*> \date September 2012
*
*> V = ( 1 v1 v1 v1 v1 )
*> ( 1 v2 v2 v2 )
*> ( 1 v3 v3 v3 )
-*>
+*>
*>
*> where the vi's represent the vectors which define H(i), which are returned
*> in the matrix A. The 1's along the diagonal of V are not stored in A. The
PARAMETER ( ONE = 1.0D+00 )
* ..
* .. Local Scalars ..
- INTEGER I, I1, J, J1, N1, N2, IINFO
+ INTEGER I, I1, J, J1, M1, M2, N1, N2, IINFO
* ..
* .. External Subroutines ..
EXTERNAL DLARFG, DTRMM, DGEMM, XERBLA
* Compute Householder transform when N=1
*
CALL DLARFG( N, A, A( 1, MIN( 2, N ) ), LDA, T )
-*
+*
ELSE
*
* Otherwise, split A into blocks...
T( I+M1, J ) = A( I+M1, J )
END DO
END DO
- CALL DTRMM( 'R', 'U', 'T', 'U', M2, M1, ONE,
+ CALL DTRMM( 'R', 'U', 'T', 'U', M2, M1, ONE,
& A, LDA, T( I1, 1 ), LDT )
*
CALL DGEMM( 'N', 'T', M2, M1, N-M1, ONE, A( I1, I1 ), LDA,
CALL DTRMM( 'R', 'U', 'N', 'N', M2, M1, ONE,
& T, LDT, T( I1, 1 ), LDT )
*
- CALL DGEMM( 'N', 'N', M2, N-M1, M1, -ONE, T( I1, 1 ), LDT,
+ CALL DGEMM( 'N', 'N', M2, N-M1, M1, -ONE, T( I1, 1 ), LDT,
& A( 1, I1 ), LDA, ONE, A( I1, I1 ), LDA )
*
CALL DTRMM( 'R', 'U', 'N', 'U', M2, M1 , ONE,
*
* Compute A(J1:M,J1:N) <- (Y2,R2,T2) where Q2 = I - Y2 T2 Y2^H
*
- CALL DGELQT3( M2, N-M1, A( I1, I1 ), LDA,
+ CALL DGELQT3( M2, N-M1, A( I1, I1 ), LDA,
& T( I1, I1 ), LDT, IINFO )
*
* Compute T3 = T(J1:N1,1:N) = -T1 Y1^H Y2 T2
CALL DGEMM( 'N', 'T', M1, M2, N-M, ONE, A( 1, J1 ), LDA,
& A( I1, J1 ), LDA, ONE, T( 1, I1 ), LDT )
*
- CALL DTRMM( 'L', 'U', 'N', 'N', M1, M2, -ONE, T, LDT,
+ CALL DTRMM( 'L', 'U', 'N', 'N', M1, M2, -ONE, T, LDT,
& T( 1, I1 ), LDT )
*
- CALL DTRMM( 'R', 'U', 'N', 'N', M1, M2, ONE,
+ CALL DTRMM( 'R', 'U', 'N', 'N', M1, M2, ONE,
& T( I1, I1 ), LDT, T( 1, I1 ), LDT )
*
-*
+*
*
* Y = (Y1,Y2); L = [ L1 0 ]; T = [T1 T3]
* [ A(1:N1,J1:N) L2 ] [ 0 T2]
*
* SUBROUTINE DGETSLS( TRANS, M, N, NRHS, A, LDA, B, LDB
* $ , WORK, LWORK, INFO )
-
-*
+*
* .. Scalar Arguments ..
* CHARACTER TRANS
* INTEGER INFO, LDA, LDB, LWORK, M, N, NRHS
* .. Array Arguments ..
* DOUBLE PRECISION A( LDA, * ), B( LDB, * ), WORK( * )
* ..
-*
+*
*
*> \par Purpose:
* =============
*> \verbatim
*>
*> DGETSLS solves overdetermined or underdetermined real linear systems
-*> involving an M-by-N matrix A, using a tall skinny QR or short wide LQ
+*> involving an M-by-N matrix A, using a tall skinny QR or short wide LQ
*> factorization of A. It is assumed that A has full rank.
*>
-*>
+*>
*>
*> The following options are provided:
*>
*> \verbatim
*> LWORK is INTEGER
*> The dimension of the array WORK.
-*> IF LWORK=-1, workspace query is assumed, and
+*> IF LWORK=-1, workspace query is assumed, and
*> WORK(1) returns the optimal LWORK,
*> and WORK(2) returns the minimum LWORK.
*> \endverbatim
* Authors:
* ========
*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
*
*> \date November 2011
*
* .. Local Scalars ..
LOGICAL LQUERY, TRAN
INTEGER I, IASCL, IBSCL, J, MINMN, MAXMN, BROW, LW,
- $ SCLLEN, MNK, WSIZEO, WSIZEM, LW1, LW2, INFO2
+ $ SCLLEN, MNK, WSIZEO, WSIZEM, LW1, LW2,
+ $ INFO2, NB
DOUBLE PRECISION ANRM, BIGNUM, BNRM, SMLNUM
* ..
* .. External Functions ..
EXTERNAL LSAME, ILAENV, DLABAD, DLAMCH, DLANGE
* ..
* .. External Subroutines ..
- EXTERNAL DGEQR, DGEMQR, DLASCL, DLASET,
+ EXTERNAL DGEQR, DGEMQR, DLASCL, DLASET,
$ DTRTRS, XERBLA, DGELQ, DGEMLQ
* ..
* .. Intrinsic Functions ..
TRAN = LSAME( TRANS, 'T' )
*
LQUERY = ( LWORK.EQ.-1 )
- IF( .NOT.( LSAME( TRANS, 'N' ) .OR.
+ IF( .NOT.( LSAME( TRANS, 'N' ) .OR.
$ LSAME( TRANS, 'T' ) ) ) THEN
INFO = -1
ELSE IF( M.LT.0 ) THEN
IF( INFO.EQ.0) THEN
*
* Determine the block size and minimum LWORK
-*
+*
IF ( M.GE.N ) THEN
- CALL DGEQR( M, N, A, LDA, WORK(1), -1, WORK(6), -1,
+ CALL DGEQR( M, N, A, LDA, WORK(1), -1, WORK(6), -1,
$ INFO2)
MB = INT(WORK(4))
NB = INT(WORK(5))
$ INT(WORK(2)), B, LDB, WORK(6), -1 , INFO2 )
WSIZEO = INT(WORK(2))+MAX(LW,INT(WORK(6)))
WSIZEM = INT(WORK(3))+MAX(LW,INT(WORK(6)))
- ELSE
- CALL DGELQ( M, N, A, LDA, WORK(1), -1, WORK(6), -1,
+ ELSE
+ CALL DGELQ( M, N, A, LDA, WORK(1), -1, WORK(6), -1,
$ INFO2)
MB = INT(WORK(4))
NB = INT(WORK(5))
* Quick return if possible
*
IF( MIN( M, N, NRHS ).EQ.0 ) THEN
- CALL DLASET( 'FULL', MAX( M, N ), NRHS, ZERO, ZERO,
+ CALL DLASET( 'FULL', MAX( M, N ), NRHS, ZERO, ZERO,
$ B, LDB )
RETURN
END IF
*
* Scale A, B if max element outside range [SMLNUM,BIGNUM]
*
- ANRM = DLANGE( 'M', M, N, A, LDA, RWORK )
+ ANRM = DLANGE( 'M', M, N, A, LDA, WORK )
IASCL = 0
IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN
*
IF ( TRAN ) THEN
BROW = N
END IF
- BNRM = DLANGE( 'M', BROW, NRHS, B, LDB, RWORK )
+ BNRM = DLANGE( 'M', BROW, NRHS, B, LDB, WORK )
IBSCL = 0
IF( BNRM.GT.ZERO .AND. BNRM.LT.SMLNUM ) THEN
*
*
* B(1:M,1:NRHS) := Q**T * B(1:M,1:NRHS)
*
- CALL DGEMQR( 'L' , 'T', M, NRHS, N, A, LDA,
+ CALL DGEMQR( 'L' , 'T', M, NRHS, N, A, LDA,
$ WORK(LW2+1), LW1, B, LDB, WORK(1), LW2, INFO )
*
* B(1:N,1:NRHS) := inv(R) * B(1:N,1:NRHS)
*
CALL DGEMQR( 'L', 'N', M, NRHS, N, A, LDA,
$ WORK( LW2+1), LW1, B, LDB, WORK( 1 ), LW2,
- $ INFO )
+ $ INFO )
*
SCLLEN = M
*
ELSE IF( C3.EQ.'QR ') THEN
IF( N3 .EQ. 1) THEN
IF( SNAME ) THEN
- IF ((M*N.LE.131072).OR.(M.LE.8192)) THEN
+* M*N
+ IF ((N1*N2.LE.131072).OR.(N1.LE.8192)) THEN
NB = N1
ELSE
NB = 32768/N2
END IF
ELSE
- IF ((M*N.LE.131072).OR.(M.LE.8192)) THEN
+ IF ((N1*N2.LE.131072).OR.(N1.LE.8192)) THEN
NB = N1
ELSE
NB = 32768/N2
ELSE IF( C3.EQ.'LQ ') THEN
IF( N3 .EQ. 2) THEN
IF( SNAME ) THEN
- IF ((M*N.LE.131072).OR.(M.LE.8192)) THEN
+* M*N
+ IF ((N1*N2.LE.131072).OR.(N1.LE.8192)) THEN
NB = N1
ELSE
NB = 32768/N2
END IF
ELSE
- IF ((M*N.LE.131072).OR.(M.LE.8192)) THEN
+ IF ((N1*N2.LE.131072).OR.(N1.LE.8192)) THEN
NB = N1
ELSE
NB = 32768/N2
PARAMETER ( ONE = 1.0D+00 )
* ..
* .. Local Scalars ..
- INTEGER I, I1, J, J1, N1, N2, IINFO
+ INTEGER I, I1, J, J1, M1, M2, N1, N2, IINFO
* ..
* .. External Subroutines ..
EXTERNAL DLARFG, DTRMM, DGEMM, XERBLA
* .. Local Scalars ..
LOGICAL LQUERY, TRAN
INTEGER I, IASCL, IBSCL, J, MINMN, MAXMN, BROW, LW,
- $ SCLLEN, MNK, WSIZEO, WSIZEM, LW1, LW2, INFO2
+ $ SCLLEN, MNK, WSIZEO, WSIZEM, LW1, LW2, INFO2,
+ $ NB
REAL ANRM, BIGNUM, BNRM, SMLNUM
* ..
* .. External Functions ..
*
* Scale A, B if max element outside range [SMLNUM,BIGNUM]
*
- ANRM = SLANGE( 'M', M, N, A, LDA, RWORK )
+ ANRM = SLANGE( 'M', M, N, A, LDA, WORK )
IASCL = 0
IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN
*
IF ( TRAN ) THEN
BROW = N
END IF
- BNRM = SLANGE( 'M', BROW, NRHS, B, LDB, RWORK )
+ BNRM = SLANGE( 'M', BROW, NRHS, B, LDB, WORK )
IBSCL = 0
IF( BNRM.GT.ZERO .AND. BNRM.LT.SMLNUM ) THEN
*
*
* =========== DOCUMENTATION ===========
*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
-*> Download DGEQRT3 + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zgelqt3.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zgelqt3.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zgelqt3.f">
+*> Download DGEQRT3 + dependencies
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zgelqt3.f">
+*> [TGZ]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zgelqt3.f">
+*> [ZIP]</a>
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zgelqt3.f">
*> [TXT]</a>
-*> \endhtmlonly
+*> \endhtmlonly
*
* Definition:
* ===========
*
* RECURSIVE SUBROUTINE ZGELQT3( M, N, A, LDA, T, LDT, INFO )
-*
+*
* .. Scalar Arguments ..
* INTEGER INFO, LDA, M, N, LDT
* ..
* .. Array Arguments ..
* COMPLEX*16 A( LDA, * ), T( LDT, * )
* ..
-*
+*
*
*> \par Purpose:
* =============
*>
*> \verbatim
*>
-*> DGELQT3 recursively computes a LQ factorization of a complex M-by-N
-*> matrix A, using the compact WY representation of Q.
+*> DGELQT3 recursively computes a LQ factorization of a complex M-by-N
+*> matrix A, using the compact WY representation of Q.
*>
-*> Based on the algorithm of Elmroth and Gustavson,
+*> Based on the algorithm of Elmroth and Gustavson,
*> IBM J. Res. Develop. Vol 44 No. 4 July 2000.
*> \endverbatim
*
* Authors:
* ========
*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
*
*> \date September 2012
*
*> V = ( 1 v1 v1 v1 v1 )
*> ( 1 v2 v2 v2 )
*> ( 1 v3 v3 v3 )
-*>
+*>
*>
*> where the vi's represent the vectors which define H(i), which are returned
*> in the matrix A. The 1's along the diagonal of V are not stored in A. The
PARAMETER ( ZERO = (0.0D+00,0.0D+00))
* ..
* .. Local Scalars ..
- INTEGER I, I1, J, J1, N1, N2, IINFO
+ INTEGER I, I1, J, J1, M1, M2, N1, N2, IINFO
* ..
* .. External Subroutines ..
EXTERNAL ZLARFG, ZTRMM, ZGEMM, XERBLA
*
CALL ZLARFG( N, A, A( 1, MIN( 2, N ) ), LDA, T )
T(1,1)=CONJG(T(1,1))
-*
+*
ELSE
*
* Otherwise, split A into blocks...
T( I+M1, J ) = A( I+M1, J )
END DO
END DO
- CALL ZTRMM( 'R', 'U', 'C', 'U', M2, M1, ONE,
+ CALL ZTRMM( 'R', 'U', 'C', 'U', M2, M1, ONE,
& A, LDA, T( I1, 1 ), LDT )
*
CALL ZGEMM( 'N', 'C', M2, M1, N-M1, ONE, A( I1, I1 ), LDA,
CALL ZTRMM( 'R', 'U', 'N', 'N', M2, M1, ONE,
& T, LDT, T( I1, 1 ), LDT )
*
- CALL ZGEMM( 'N', 'N', M2, N-M1, M1, -ONE, T( I1, 1 ), LDT,
+ CALL ZGEMM( 'N', 'N', M2, N-M1, M1, -ONE, T( I1, 1 ), LDT,
& A( 1, I1 ), LDA, ONE, A( I1, I1 ), LDA )
*
CALL ZTRMM( 'R', 'U', 'N', 'U', M2, M1 , ONE,
*
* Compute A(J1:M,J1:N) <- (Y2,R2,T2) where Q2 = I - Y2 T2 Y2^H
*
- CALL ZGELQT3( M2, N-M1, A( I1, I1 ), LDA,
+ CALL ZGELQT3( M2, N-M1, A( I1, I1 ), LDA,
& T( I1, I1 ), LDT, IINFO )
*
* Compute T3 = T(J1:N1,1:N) = -T1 Y1^H Y2 T2
CALL ZGEMM( 'N', 'C', M1, M2, N-M, ONE, A( 1, J1 ), LDA,
& A( I1, J1 ), LDA, ONE, T( 1, I1 ), LDT )
*
- CALL ZTRMM( 'L', 'U', 'N', 'N', M1, M2, -ONE, T, LDT,
+ CALL ZTRMM( 'L', 'U', 'N', 'N', M1, M2, -ONE, T, LDT,
& T( 1, I1 ), LDT )
*
- CALL ZTRMM( 'R', 'U', 'N', 'N', M1, M2, ONE,
+ CALL ZTRMM( 'R', 'U', 'N', 'N', M1, M2, ONE,
& T( I1, I1 ), LDT, T( 1, I1 ), LDT )
*
-*
+*
*
* Y = (Y1,Y2); L = [ L1 0 ]; T = [T1 T3]
* [ A(1:N1,J1:N) L2 ] [ 0 T2]
* SUBROUTINE ZGETSLS( TRANS, M, N, NRHS, A, LDA, B, LDB
* $ , WORK, LWORK, INFO )
-*
+*
* .. Scalar Arguments ..
* CHARACTER TRANS
* INTEGER INFO, LDA, LDB, LWORK, M, N, NRHS
* .. Array Arguments ..
* COMPLEX*16 A( LDA, * ), B( LDB, * ), WORK( * )
* ..
-*
+*
*
*> \par Purpose:
* =============
*> \verbatim
*>
*> ZGETSLS solves overdetermined or underdetermined real linear systems
-*> involving an M-by-N matrix A, or its transpose, using a tall skinny
-*> QR or short wide LQfactorization of A. It is assumed that A has
+*> involving an M-by-N matrix A, or its transpose, using a tall skinny
+*> QR or short wide LQfactorization of A. It is assumed that A has
*> full rank.
*>
*> The following options are provided:
* Authors:
* ========
*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
*
*> \date November 2011
*
*
* .. Scalar Arguments ..
CHARACTER TRANS
- INTEGER INFO, LDA, LDB, LWORK, M, N, NRHS, MB
+ INTEGER INFO, LDA, LDB, LWORK, M, N, NRHS, MB, NB
* ..
* .. Array Arguments ..
COMPLEX*16 A( LDA, * ), B( LDB, * ), WORK( * )
EXTERNAL LSAME, ILAENV, DLABAD, DLAMCH, DLANGE
* ..
* .. External Subroutines ..
- EXTERNAL ZGEQR, ZGEMQR, ZLASCL, ZLASET,
+ EXTERNAL ZGEQR, ZGEMQR, ZLASCL, ZLASET,
$ ZTRTRS, XERBLA, ZGELQ, ZGEMLQ
* ..
* .. Intrinsic Functions ..
TRAN = LSAME( TRANS, 'C' )
*
LQUERY = ( LWORK.EQ.-1 )
- IF( .NOT.( LSAME( TRANS, 'N' ) .OR.
+ IF( .NOT.( LSAME( TRANS, 'N' ) .OR.
$ LSAME( TRANS, 'C' ) ) ) THEN
INFO = -1
ELSE IF( M.LT.0 ) THEN
IF( INFO.EQ.0) THEN
*
* Determine the block size and minimum LWORK
-*
+*
IF ( M.GE.N ) THEN
- CALL ZGEQR( M, N, A, LDA, WORK(1), -1, WORK(6), -1,
+ CALL ZGEQR( M, N, A, LDA, WORK(1), -1, WORK(6), -1,
$ INFO2)
MB = INT(WORK(4))
NB = INT(WORK(5))
$ INT(WORK(2)), B, LDB, WORK(6), -1 , INFO2 )
WSIZEO = INT(WORK(2))+MAX(LW,INT(WORK(6)))
WSIZEM = INT(WORK(3))+MAX(LW,INT(WORK(6)))
- ELSE
- CALL ZGELQ( M, N, A, LDA, WORK(1), -1, WORK(6), -1,
+ ELSE
+ CALL ZGELQ( M, N, A, LDA, WORK(1), -1, WORK(6), -1,
$ INFO2)
MB = INT(WORK(4))
NB = INT(WORK(5))
* Quick return if possible
*
IF( MIN( M, N, NRHS ).EQ.0 ) THEN
- CALL ZLASET( 'FULL', MAX( M, N ), NRHS, CZERO, CZERO,
+ CALL ZLASET( 'FULL', MAX( M, N ), NRHS, CZERO, CZERO,
$ B, LDB )
RETURN
END IF
*
* Scale A, B if max element outside range [SMLNUM,BIGNUM]
*
- ANRM = ZLANGE( 'M', M, N, A, LDA, RWORK )
+ ANRM = ZLANGE( 'M', M, N, A, LDA, WORK )
IASCL = 0
IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN
*
IF ( TRAN ) THEN
BROW = N
END IF
- BNRM = ZLANGE( 'M', BROW, NRHS, B, LDB, RWORK )
+ BNRM = ZLANGE( 'M', BROW, NRHS, B, LDB, WORK )
IBSCL = 0
IF( BNRM.GT.ZERO .AND. BNRM.LT.SMLNUM ) THEN
*
*
* B(1:M,1:NRHS) := Q**T * B(1:M,1:NRHS)
*
- CALL ZGEMQR( 'L' , 'C', M, NRHS, N, A, LDA,
+ CALL ZGEMQR( 'L' , 'C', M, NRHS, N, A, LDA,
$ WORK(LW2+1), LW1, B, LDB, WORK(1), LW2, INFO )
*
* B(1:N,1:NRHS) := inv(R) * B(1:N,1:NRHS)
*
CALL ZGEMQR( 'L', 'N', M, NRHS, N, A, LDA,
$ WORK( LW2+1), LW1, B, LDB, WORK( 1 ), LW2,
- $ INFO )
+ $ INFO )
*
SCLLEN = M
*
* .. Local Scalars ..
CHARACTER TRANS
CHARACTER*3 PATH
- INTEGER CRANK, I, IM, IN, INB, INFO, INS, IRANK,
+ INTEGER CRANK, I, IM, IMB, IN, INB, INFO, INS, IRANK,
$ ISCALE, ITRAN, ITYPE, J, K, LDA, LDB, LDWORK,
$ LWLSY, LWORK, M, MNMIN, N, NB, NCOLS, NERRS,
$ NFAIL, NRHS, NROWS, NRUN, RANK, MB, LWTS
MNMIN = MAX(MIN( M, N ),1)
LDB = MAX( 1, M, N )
MB = (MNMIN+1)
- IF(MINMN.NE.MB) THEN
+ IF(MNMIN.NE.MB) THEN
LWTS = (((LDB-MB)/(MB-MNMIN))*MNMIN+MNMIN*2)*MB+5
ELSE
- LWTS = 2*MINMN+5
+ LWTS = 2*MNMIN+5
END IF
*
DO 120 INS = 1, NNS
* .. Local Scalars ..
CHARACTER TRANS
CHARACTER*3 PATH
- INTEGER CRANK, I, IM, IN, INB, INFO, INS, IRANK,
+ INTEGER CRANK, I, IM, IMB, IN, INB, INFO, INS, IRANK,
$ ISCALE, ITRAN, ITYPE, J, K, LDA, LDB, LDWORK,
$ LWLSY, LWORK, M, MNMIN, N, NB, NCOLS, NERRS,
$ NFAIL, NLVL, NRHS, NROWS, NRUN, RANK, MB, LWTS
MNMIN = MAX(MIN( M, N ),1)
LDB = MAX( 1, M, N )
MB = (MNMIN+1)
- IF(MINMN.NE.MB) THEN
+ IF(MNMIN.NE.MB) THEN
LWTS = (((LDB-MB)/(MB-MNMIN))*MNMIN+MNMIN*2)*MB+5
ELSE
- LWTS = 2*MINMN+5
+ LWTS = 2*MNMIN+5
END IF
*
DO 130 INS = 1, NNS
* .. Local Scalars ..
CHARACTER TRANS
CHARACTER*3 PATH
- INTEGER CRANK, I, IM, IN, INB, INFO, INS, IRANK,
+ INTEGER CRANK, I, IM, IMB, IN, INB, INFO, INS, IRANK,
$ ISCALE, ITRAN, ITYPE, J, K, LDA, LDB, LDWORK,
$ LWLSY, LWORK, M, MNMIN, N, NB, NCOLS, NERRS,
$ NFAIL, NLVL, NRHS, NROWS, NRUN, RANK, MB, LWTS
MNMIN = MAX(MIN( M, N ),1)
LDB = MAX( 1, M, N )
MB = (MNMIN+1)
- IF(MINMN.NE.MB) THEN
+ IF(MNMIN.NE.MB) THEN
LWTS = (((LDB-MB)/(MB-MNMIN))*MNMIN+MNMIN*2)*MB+5
ELSE
- LWTS = 2*MINMN+5
+ LWTS = 2*MNMIN+5
END IF
*
DO 130 INS = 1, NNS
* .. Local Scalars ..
CHARACTER TRANS
CHARACTER*3 PATH
- INTEGER CRANK, I, IM, IN, INB, INFO, INS, IRANK,
+ INTEGER CRANK, I, IM, IMB, IN, INB, INFO, INS, IRANK,
$ ISCALE, ITRAN, ITYPE, J, K, LDA, LDB, LDWORK,
$ LWLSY, LWORK, M, MNMIN, N, NB, NCOLS, NERRS,
$ NFAIL, NRHS, NROWS, NRUN, RANK, MB, LWTS
MNMIN = MAX(MIN( M, N ),1)
LDB = MAX( 1, M, N )
MB = (MNMIN+1)
- IF(MINMN.NE.MB) THEN
+ IF(MNMIN.NE.MB) THEN
LWTS = (((LDB-MB)/(MB-MNMIN))*MNMIN+LDB*2)*MB+5
ELSE
- LWTS = 2*MINMN+5
+ LWTS = 2*MNMIN+5
END IF
*
DO 120 INS = 1, NNS
projects / platform / upstream / lapack.git / commitdiff