diff options
| author | Julien Langou <julien.langou@ucdenver.edu> | 2016-11-03 08:48:54 +0100 |
|---|---|---|
| committer | Julien Langou <julien.langou@ucdenver.edu> | 2016-11-03 08:48:54 +0100 |
| commit | bbff7393714b29a6ff70e8c1565784cb16a0e746 (patch) | |
| tree | 146d4bc89db9148abc4b19e2e453623f1a6c7bbe /SRC | |
| parent | bd47060bcb3a470520622de69ac1426ca4186f5e (diff) | |
| download | lapack-bbff7393714b29a6ff70e8c1565784cb16a0e746.tar.gz lapack-bbff7393714b29a6ff70e8c1565784cb16a0e746.tar.bz2 lapack-bbff7393714b29a6ff70e8c1565784cb16a0e746.zip | |
Lots of trailing whitespaces in the files of Syd. Cleaning this. No big deal.
Diffstat (limited to 'SRC')
79 files changed, 2029 insertions, 2029 deletions
diff --git a/SRC/CMakeLists.txt b/SRC/CMakeLists.txt index 0ceea60b..30cf7079 100644 --- a/SRC/CMakeLists.txt +++ b/SRC/CMakeLists.txt @@ -151,7 +151,7 @@ set(SLASRC sbbcsd.f slapmr.f sorbdb.f sorbdb1.f sorbdb2.f sorbdb3.f sorbdb4.f sorbdb5.f sorbdb6.f sorcsd.f sorcsd2by1.f sgeqrt.f sgeqrt2.f sgeqrt3.f sgemqrt.f - stpqrt.f stpqrt2.f stpmqrt.f stprfb.f + stpqrt.f stpqrt2.f stpmqrt.f stprfb.f sgelqt.f sgelqt3.f sgemlqt.f sgetsls.f sgeqr.f slatsqr.f slamtsqr.f sgemqr.f sgelq.f slaswlq.f slamswlq.f sgemlq.f @@ -322,7 +322,7 @@ set(DLASRC dbbcsd.f dlapmr.f dorbdb.f dorbdb1.f dorbdb2.f dorbdb3.f dorbdb4.f dorbdb5.f dorbdb6.f dorcsd.f dorcsd2by1.f dgeqrt.f dgeqrt2.f dgeqrt3.f dgemqrt.f - dtpqrt.f dtpqrt2.f dtpmqrt.f dtprfb.f + dtpqrt.f dtpqrt2.f dtpmqrt.f dtprfb.f dgelqt.f dgelqt3.f dgemlqt.f dgetsls.f dgeqr.f dlatsqr.f dlamtsqr.f dgemqr.f dgelq.f dlaswlq.f dlamswlq.f dgemlq.f diff --git a/SRC/cgelq.f b/SRC/cgelq.f index e6e2b129..c6c962d7 100644 --- a/SRC/cgelq.f +++ b/SRC/cgelq.f @@ -1,26 +1,26 @@ -* +* * Definition: * =========== * -* SUBROUTINE CGELQ( M, N, A, LDA, WORK1, LWORK1, WORK2, LWORK2, +* SUBROUTINE CGELQ( M, N, A, LDA, WORK1, LWORK1, WORK2, LWORK2, * INFO) -* +* * .. Scalar Arguments .. * INTEGER INFO, LDA, M, N, LWORK1, LWORK2 * .. * .. Array Arguments .. * COMPLEX A( LDA, * ), WORK1( * ), WORK2( * ) * .. -* +* * *> \par Purpose: * ============= *> *> \verbatim -*> -*> CGELQ computes an LQ factorization of an M-by-N matrix A, -*> using CLASWLQ when A is short and wide -*> (N sufficiently greater than M), and otherwise CGELQT: +*> +*> CGELQ computes an LQ factorization of an M-by-N matrix A, +*> using CLASWLQ when A is short and wide +*> (N sufficiently greater than M), and otherwise CGELQT: *> A = L * Q . *> \endverbatim * @@ -43,10 +43,10 @@ *> \verbatim *> A is COMPLEX array, dimension (LDA,N) *> On entry, the M-by-N matrix A. -*> On exit, the elements on and below the diagonal of the array -*> contain the M-by-min(M,N) lower trapezoidal matrix L +*> On exit, the elements on and below the diagonal of the array +*> contain the M-by-min(M,N) lower trapezoidal matrix L *> (L is lower triangular if M <= N); -*> the elements above the diagonal are the rows of +*> the elements above the diagonal are the rows of *> blocked V representing Q (see Further Details). *> \endverbatim *> @@ -60,13 +60,13 @@ *> \verbatim *> WORK1 is COMPLEX array, dimension (MAX(1,LWORK1)) *> WORK1 contains part of the data structure used to store Q. -*> WORK1(1): algorithm type = 1, to indicate output from +*> WORK1(1): algorithm type = 1, to indicate output from *> CLASWLQ or CGELQT *> WORK1(2): optimum size of WORK1 *> WORK1(3): minimum size of WORK1 *> WORK1(4): horizontal block size *> WORK1(5): vertical block size -*> WORK1(6:LWORK1): data structure needed for Q, computed by +*> WORK1(6:LWORK1): data structure needed for Q, computed by *> CLASWLQ or CGELQT *> \endverbatim *> @@ -74,25 +74,25 @@ *> \verbatim *> LWORK1 is INTEGER *> The dimension of the array WORK1. -*> If LWORK1 = -1, then a query is assumed. In this case the +*> If LWORK1 = -1, then a query is assumed. In this case the *> routine calculates the optimal size of WORK1 and -*> returns this value in WORK1(2), and calculates the minimum -*> size of WORK1 and returns this value in WORK1(3). -*> No error message related to LWORK1 is issued by XERBLA when +*> returns this value in WORK1(2), and calculates the minimum +*> size of WORK1 and returns this value in WORK1(3). +*> No error message related to LWORK1 is issued by XERBLA when *> LWORK1 = -1. *> \endverbatim *> *> \param[out] WORK2 *> \verbatim *> (workspace) COMPLEX array, dimension (MAX(1,LWORK2)) -*> +*> *> \endverbatim *> \param[in] LWORK2 *> \verbatim *> LWORK2 is INTEGER *> The dimension of the array WORK2. *> If LWORK2 = -1, then a query is assumed. In this case the -*> routine calculates the optimal size of WORK2 and +*> routine calculates the optimal size of WORK2 and *> returns this value in WORK2(1), and calculates the minimum *> size of WORK2 and returns this value in WORK2(2). *> No error message related to LWORK2 is issued by XERBLA when @@ -121,19 +121,19 @@ *> Depending on the matrix dimensions M and N, and row and column *> block sizes MB and NB returned by ILAENV, GELQ will use either *> LASWLQ(if the matrix is short-and-wide) or GELQT to compute -*> the LQ decomposition. +*> the LQ decomposition. *> The output of LASWLQ or GELQT representing Q is stored in A and in -*> array WORK1(6:LWORK1) for later use. -*> WORK1(2:5) contains the matrix dimensions M,N and block sizes MB, NB -*> which are needed to interpret A and WORK1(6:LWORK1) for later use. -*> WORK1(1)=1 indicates that the code needed to take WORK1(2:5) and +*> array WORK1(6:LWORK1) for later use. +*> WORK1(2:5) contains the matrix dimensions M,N and block sizes MB, NB +*> which are needed to interpret A and WORK1(6:LWORK1) for later use. +*> WORK1(1)=1 indicates that the code needed to take WORK1(2:5) and *> decide whether LASWLQ or GELQT was used is the same as used below in -*> GELQ. For a detailed description of A and WORK1(6:LWORK1), see +*> GELQ. For a detailed description of A and WORK1(6:LWORK1), see *> Further Details in LASWLQ or GELQT. *> \endverbatim *> * ===================================================================== - SUBROUTINE CGELQ( M, N, A, LDA, WORK1, LWORK1, WORK2, LWORK2, + SUBROUTINE CGELQ( M, N, A, LDA, WORK1, LWORK1, WORK2, LWORK2, $ INFO) * * -- LAPACK computational routine (version 3.5.0) -- @@ -175,8 +175,8 @@ * LQUERY = ( LWORK1.EQ.-1 .OR. LWORK2.EQ.-1 ) * -* Determine the block size -* +* Determine the block size +* IF ( MIN(M,N).GT.0 ) THEN MB = ILAENV( 1, 'CGELQ ', ' ', M, N, 1, -1) NB = ILAENV( 1, 'CGELQ ', ' ', M, N, 2, -1) @@ -197,18 +197,18 @@ NBLCKS = 1 END IF * Determine if the workspace size satisfies minimum size -* - LMINWS = .FALSE. +* + LMINWS = .FALSE. IF((LWORK1.LT.MAX(1,MB*M*NBLCKS+5) $ .OR.(LWORK2.LT.MB*M)).AND.(LWORK2.GE.M).AND.(LWORK1.GE.M+5) $ .AND.(.NOT.LQUERY)) THEN IF (LWORK1.LT.MAX(1,MB*M*NBLCKS+5)) THEN LMINWS = .TRUE. MB = 1 - END IF + END IF IF (LWORK1.LT.MAX(1,M*NBLCKS+5)) THEN LMINWS = .TRUE. - NB = N + NB = N END IF IF (LWORK2.LT.MB*M) THEN LMINWS = .TRUE. @@ -222,13 +222,13 @@ INFO = -2 ELSE IF( LDA.LT.MAX( 1, M ) ) THEN INFO = -4 - ELSE IF( LWORK1.LT.MAX( 1, MB*M*NBLCKS+5 ) + ELSE IF( LWORK1.LT.MAX( 1, MB*M*NBLCKS+5 ) $ .AND.(.NOT.LQUERY).AND. (.NOT.LMINWS)) THEN INFO = -6 ELSE IF( (LWORK2.LT.MAX(1,M*MB)).AND.(.NOT.LQUERY) $ .AND.(.NOT.LMINWS) ) THEN - INFO = -8 - END IF + INFO = -8 + END IF * IF( INFO.EQ.0) THEN WORK1(1) = 1 @@ -256,12 +256,12 @@ * IF((N.LE.M).OR.(NB.LE.M).OR.(NB.GE.N)) THEN CALL CGELQT( M, N, MB, A, LDA, WORK1(6), MB, WORK2, INFO) - ELSE - CALL CLASWLQ( M, N, MB, NB, A, LDA, WORK1(6), MB, WORK2, + ELSE + CALL CLASWLQ( M, N, MB, NB, A, LDA, WORK1(6), MB, WORK2, $ LWORK2, INFO) END IF RETURN -* +* * End of CGELQ * - END
\ No newline at end of file + END diff --git a/SRC/cgelqt.f b/SRC/cgelqt.f index 70abe1af..043fc9db 100644 --- a/SRC/cgelqt.f +++ b/SRC/cgelqt.f @@ -3,14 +3,14 @@ * =========== * * SUBROUTINE CGELQT( M, N, MB, A, LDA, T, LDT, WORK, INFO ) -* +* * .. Scalar Arguments .. * INTEGER INFO, LDA, LDT, M, N, MB * .. * .. Array Arguments .. * COMPLEX A( LDA, * ), T( LDT, * ), WORK( * ) * .. -* +* * *> \par Purpose: * ============= @@ -18,7 +18,7 @@ *> \verbatim *> *> CGELQT computes a blocked LQ factorization of a complex M-by-N matrix A -*> using the compact WY representation of Q. +*> using the compact WY representation of Q. *> \endverbatim * * Arguments: @@ -87,10 +87,10 @@ * 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 2013 * @@ -107,14 +107,14 @@ *> V = ( 1 v1 v1 v1 v1 ) *> ( 1 v2 v2 v2 ) *> ( 1 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. +*> in the matrix A. The 1's along the diagonal of V are not stored in A. *> Let K=MIN(M,N). The number of blocks is B = ceiling(K/NB), where each -*> block is of order NB except for the last block, which is of order +*> block is of order NB except for the last block, which is of order *> IB = K - (B-1)*NB. For each of the B blocks, a upper triangular block -*> reflector factor is computed: T1, T2, ..., TB. The NB-by-NB (and IB-by-IB +*> reflector factor is computed: T1, T2, ..., TB. The NB-by-NB (and IB-by-IB *> for the last block) T's are stored in the NB-by-N matrix T as *> *> T = (T1 T2 ... TB). @@ -174,21 +174,21 @@ * DO I = 1, K, MB IB = MIN( K-I+1, MB ) -* +* * Compute the LQ factorization of the current block A(I:M,I:I+IB-1) -* +* CALL CGELQT3( IB, N-I+1, A(I,I), LDA, T(1,I), LDT, IINFO ) IF( I+IB.LE.M ) THEN * * Update by applying H**T to A(I:M,I+IB:N) from the right * CALL CLARFB( 'R', 'N', 'F', 'R', M-I-IB+1, N-I+1, IB, - $ A( I, I ), LDA, T( 1, I ), LDT, + $ A( I, I ), LDA, T( 1, I ), LDT, $ A( I+IB, I ), LDA, WORK , M-I-IB+1 ) END IF END DO RETURN -* +* * End of CGELQT * END diff --git a/SRC/cgemlq.f b/SRC/cgemlq.f index bd7823df..1a551ca3 100644 --- a/SRC/cgemlq.f +++ b/SRC/cgemlq.f @@ -1,8 +1,8 @@ -* +* * Definition: * =========== * -* SUBROUTINE CGEMLQ( SIDE, TRANS, M, N, K, A, LDA, WORK1, +* SUBROUTINE CGEMLQ( SIDE, TRANS, M, N, K, A, LDA, WORK1, * $ LWORK1, C, LDC, WORK2, LWORK2, INFO ) * * @@ -17,15 +17,15 @@ * ============= *> *> \verbatim -*> +*> *> CGEMLQ overwrites the general real M-by-N matrix C with *> -*> +*> *> SIDE = 'L' SIDE = 'R' *> TRANS = 'N': Q * C C * Q *> TRANS = 'T': Q**T * C C * Q**T -*> where Q is a complex orthogonal matrix defined as the product -*> of blocked elementary reflectors computed by short wide LQ +*> where Q is a complex orthogonal matrix defined as the product +*> of blocked elementary reflectors computed by short wide LQ *> factorization (DGELQ) *> \endverbatim * @@ -59,7 +59,7 @@ *> The number of elementary reflectors whose product defines *> the matrix Q. *> M >= K >= 0; -*> +*> *> \endverbatim *> *> \param[in,out] A @@ -101,15 +101,15 @@ *> \param[out] WORK2 *> \verbatim *> (workspace) COMPLEX array, dimension (MAX(1,LWORK2)) -*> +*> *> \endverbatim *> \param[in] LWORK2 *> \verbatim *> LWORK2 is INTEGER -*> The dimension of the array WORK2. +*> The dimension of the array WORK2. *> If LWORK2 = -1, then a workspace query is assumed; the routine *> only calculates the optimal size of the WORK2 array, returns -*> this value as the third entry of the WORK2 array (WORK2(1)), +*> this value as the third entry of the WORK2 array (WORK2(1)), *> and no error message related to LWORK2 is issued by XERBLA. *> *> \endverbatim @@ -135,19 +135,19 @@ *> Depending on the matrix dimensions M and N, and row and column *> block sizes MB and NB returned by ILAENV, GELQ will use either *> LASWLQ(if the matrix is short-and-wide) or GELQT to compute -*> the LQ decomposition. +*> the LQ decomposition. *> The output of LASWLQ or GELQT representing Q is stored in A and in -*> array WORK1(6:LWORK1) for later use. -*> WORK1(2:5) contains the matrix dimensions M,N and block sizes MB, NB -*> which are needed to interpret A and WORK1(6:LWORK1) for later use. -*> WORK1(1)=1 indicates that the code needed to take WORK1(2:5) and +*> array WORK1(6:LWORK1) for later use. +*> WORK1(2:5) contains the matrix dimensions M,N and block sizes MB, NB +*> which are needed to interpret A and WORK1(6:LWORK1) for later use. +*> WORK1(1)=1 indicates that the code needed to take WORK1(2:5) and *> decide whether LASWLQ or GELQT was used is the same as used below in -*> GELQ. For a detailed description of A and WORK1(6:LWORK1), see +*> GELQ. For a detailed description of A and WORK1(6:LWORK1), see *> Further Details in LASWLQ or GELQT. *> \endverbatim *> * ===================================================================== - SUBROUTINE CGEMLQ( SIDE, TRANS, M, N, K, A, LDA, WORK1, LWORK1, + SUBROUTINE CGEMLQ( SIDE, TRANS, M, N, K, A, LDA, WORK1, LWORK1, $ C, LDC, WORK2, LWORK2, INFO ) * * -- LAPACK computational routine (version 3.5.0) -- @@ -242,12 +242,12 @@ * IF( MIN(M,N,K).EQ.0 ) THEN RETURN - END IF + END IF * IF((LEFT.AND.M.LE.K).OR.(RIGHT.AND.N.LE.K).OR.(NB.LE.K).OR. $ (NB.GE.MAX(M,N,K))) THEN - CALL CGEMLQT( SIDE, TRANS, M, N, K, MB, A, LDA, - $ WORK1(6), MB, C, LDC, WORK2, INFO) + CALL CGEMLQT( SIDE, TRANS, M, N, K, MB, A, LDA, + $ WORK1(6), MB, C, LDC, WORK2, INFO) ELSE CALL CLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, WORK1(6), $ MB, C, LDC, WORK2, LWORK2, INFO ) @@ -258,4 +258,4 @@ * * End of CGEMLQ * - END
\ No newline at end of file + END diff --git a/SRC/cgemlqt.f b/SRC/cgemlqt.f index 04f44e41..b34afc94 100644 --- a/SRC/cgemlqt.f +++ b/SRC/cgemlqt.f @@ -1,9 +1,9 @@ * Definition: * =========== * -* SUBROUTINE CGEMLQT( SIDE, TRANS, M, N, K, MB, V, LDV, T, LDT, +* SUBROUTINE CGEMLQT( SIDE, TRANS, M, N, K, MB, V, LDV, T, LDT, * C, LDC, WORK, INFO ) -* +* * .. Scalar Arguments .. * CHARACTER SIDE, TRANS * INTEGER INFO, K, LDV, LDC, M, N, MB, LDT @@ -11,7 +11,7 @@ * .. Array Arguments .. * COMPLEX V( LDV, * ), C( LDC, * ), T( LDT, * ), WORK( * ) * .. -* +* * *> \par Purpose: * ============= @@ -29,7 +29,7 @@ *> *> Q = H(1) H(2) . . . H(K) = I - V C V**C *> -*> generated using the compact WY representation as returned by CGELQT. +*> generated using the compact WY representation as returned by CGELQT. *> *> Q is of order M if SIDE = 'L' and of order N if SIDE = 'R'. *> \endverbatim @@ -138,17 +138,17 @@ * 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 2013 * *> \ingroup doubleGEcomputational * * ===================================================================== - SUBROUTINE CGEMLQT( SIDE, TRANS, M, N, K, MB, V, LDV, T, LDT, + SUBROUTINE CGEMLQT( SIDE, TRANS, M, N, K, MB, V, LDV, T, LDT, $ C, LDC, WORK, INFO ) * * -- LAPACK computational routine (version 3.5.0) -- @@ -190,7 +190,7 @@ RIGHT = LSAME( SIDE, 'R' ) TRAN = LSAME( TRANS, 'C' ) NOTRAN = LSAME( TRANS, 'N' ) -* +* IF( LEFT ) THEN LDWORK = MAX( 1, N ) ELSE IF ( RIGHT ) THEN @@ -229,17 +229,17 @@ * DO I = 1, K, MB IB = MIN( MB, K-I+1 ) - CALL CLARFB( 'L', 'C', 'F', 'R', M-I+1, N, IB, - $ V( I, I ), LDV, T( 1, I ), LDT, + CALL CLARFB( 'L', 'C', 'F', 'R', M-I+1, N, IB, + $ V( I, I ), LDV, T( 1, I ), LDT, $ C( I, 1 ), LDC, WORK, LDWORK ) END DO -* +* ELSE IF( RIGHT .AND. TRAN ) THEN * DO I = 1, K, MB IB = MIN( MB, K-I+1 ) - CALL CLARFB( 'R', 'N', 'F', 'R', M, N-I+1, IB, - $ V( I, I ), LDV, T( 1, I ), LDT, + CALL CLARFB( 'R', 'N', 'F', 'R', M, N-I+1, IB, + $ V( I, I ), LDV, T( 1, I ), LDT, $ C( 1, I ), LDC, WORK, LDWORK ) END DO * @@ -247,9 +247,9 @@ * KF = ((K-1)/MB)*MB+1 DO I = KF, 1, -MB - IB = MIN( MB, K-I+1 ) - CALL CLARFB( 'L', 'N', 'F', 'R', M-I+1, N, IB, - $ V( I, I ), LDV, T( 1, I ), LDT, + IB = MIN( MB, K-I+1 ) + CALL CLARFB( 'L', 'N', 'F', 'R', M-I+1, N, IB, + $ V( I, I ), LDV, T( 1, I ), LDT, $ C( I, 1 ), LDC, WORK, LDWORK ) END DO * @@ -257,9 +257,9 @@ * KF = ((K-1)/MB)*MB+1 DO I = KF, 1, -MB - IB = MIN( MB, K-I+1 ) - CALL CLARFB( 'R', 'C', 'F', 'R', M, N-I+1, IB, - $ V( I, I ), LDV, T( 1, I ), LDT, + IB = MIN( MB, K-I+1 ) + CALL CLARFB( 'R', 'C', 'F', 'R', M, N-I+1, IB, + $ V( I, I ), LDV, T( 1, I ), LDT, $ C( 1, I ), LDC, WORK, LDWORK ) END DO * diff --git a/SRC/cgemqr.f b/SRC/cgemqr.f index de2965ee..51d38b85 100644 --- a/SRC/cgemqr.f +++ b/SRC/cgemqr.f @@ -1,8 +1,8 @@ -* +* * Definition: * =========== * -* SUBROUTINE CGEMQR( SIDE, TRANS, M, N, K, A, LDA, WORK1, +* SUBROUTINE CGEMQR( SIDE, TRANS, M, N, K, A, LDA, WORK1, * $ LWORK1, C, LDC, WORK2, LWORK2, INFO ) * * @@ -17,15 +17,15 @@ * ============= *> *> \verbatim -*> +*> *> CGEMQR overwrites the general real M-by-N matrix C with *> -*> +*> *> SIDE = 'L' SIDE = 'R' *> TRANS = 'N': Q * C C * Q *> TRANS = 'T': Q**T * C C * Q**T -*> where Q is a complex orthogonal matrix defined as the product -*> of blocked elementary reflectors computed by tall skinny +*> where Q is a complex orthogonal matrix defined as the product +*> of blocked elementary reflectors computed by tall skinny *> QR factorization (CGEQR) *> \endverbatim * @@ -59,15 +59,15 @@ *> The number of elementary reflectors whose product defines *> the matrix Q. *> N >= K >= 0; -*> +*> *> \endverbatim *> *> \param[in,out] A *> \verbatim *> A is COMPLEX array, dimension (LDA,K) -*> The i-th column must contain the vector which defines the -*> blockedelementary reflector H(i), for i = 1,2,...,k, as -*> returned by DGETSQR in the first k columns of +*> The i-th column must contain the vector which defines the +*> blockedelementary reflector H(i), for i = 1,2,...,k, as +*> returned by DGETSQR in the first k columns of *> its array argument A. *> \endverbatim *> @@ -103,15 +103,15 @@ *> \param[out] WORK2 *> \verbatim *> (workspace) COMPLEX array, dimension (MAX(1,LWORK2)) -*> +*> *> \endverbatim *> \param[in] LWORK2 *> \verbatim *> LWORK2 is INTEGER -*> The dimension of the array WORK2. +*> The dimension of the array WORK2. *> If LWORK2 = -1, then a workspace query is assumed; the routine *> only calculates the optimal size of the WORK2 array, returns -*> this value as the third entry of the WORK2 array (WORK2(1)), +*> this value as the third entry of the WORK2 array (WORK2(1)), *> and no error message related to LWORK2 is issued by XERBLA. *> *> \endverbatim @@ -137,19 +137,19 @@ *> Depending on the matrix dimensions M and N, and row and column *> block sizes MB and NB returned by ILAENV, GEQR will use either *> LATSQR (if the matrix is tall-and-skinny) or GEQRT to compute -*> the QR decomposition. +*> the QR decomposition. *> The output of LATSQR or GEQRT representing Q is stored in A and in -*> array WORK1(6:LWORK1) for later use. -*> WORK1(2:5) contains the matrix dimensions M,N and block sizes MB,NB -*> which are needed to interpret A and WORK1(6:LWORK1) for later use. -*> WORK1(1)=1 indicates that the code needed to take WORK1(2:5) and -*> decide whether LATSQR or GEQRT was used is the same as used below in +*> array WORK1(6:LWORK1) for later use. +*> WORK1(2:5) contains the matrix dimensions M,N and block sizes MB,NB +*> which are needed to interpret A and WORK1(6:LWORK1) for later use. +*> WORK1(1)=1 indicates that the code needed to take WORK1(2:5) and +*> decide whether LATSQR or GEQRT was used is the same as used below in *> GEQR. For a detailed description of A and WORK1(6:LWORK1), see *> Further Details in LATSQR or GEQRT. *> \endverbatim *> * ===================================================================== - SUBROUTINE CGEMQR( SIDE, TRANS, M, N, K, A, LDA, WORK1, LWORK1, + SUBROUTINE CGEMQR( SIDE, TRANS, M, N, K, A, LDA, WORK1, LWORK1, $ C, LDC, WORK2, LWORK2, INFO ) * * -- LAPACK computational routine (version 3.5.0) -- @@ -177,7 +177,7 @@ LOGICAL LSAME EXTERNAL LSAME * .. External Subroutines .. - EXTERNAL CGEMQRT, CLAMTSQR, XERBLA + EXTERNAL CGEMQRT, CLAMTSQR, XERBLA * .. Intrinsic Functions .. INTRINSIC INT, MAX, MIN, MOD * .. @@ -199,7 +199,7 @@ ELSE IF(RIGHT) THEN LW = MB * NB MN = N - END IF + END IF * IF ((MB.GT.K).AND.(MN.GT.K)) THEN IF(MOD(MN-K, MB-K).EQ.0) THEN @@ -233,7 +233,7 @@ END IF * * Determine the block size if it is tall skinny or short and wide -* +* IF( INFO.EQ.0) THEN WORK2(1) = LW END IF @@ -253,16 +253,16 @@ * IF((LEFT.AND.M.LE.K).OR.(RIGHT.AND.N.LE.K).OR.(MB.LE.K).OR. $ (MB.GE.MAX(M,N,K))) THEN - CALL CGEMQRT( SIDE, TRANS, M, N, K, NB, A, LDA, - $ WORK1(6), NB, C, LDC, WORK2, INFO) + CALL CGEMQRT( SIDE, TRANS, M, N, K, NB, A, LDA, + $ WORK1(6), NB, C, LDC, WORK2, INFO) ELSE CALL CLAMTSQR( SIDE, TRANS, M, N, K, MB, NB, A, LDA, WORK1(6), $ NB, C, LDC, WORK2, LWORK2, INFO ) - END IF + END IF * WORK2(1) = LW RETURN * * End of CGEMQR * - END
\ No newline at end of file + END diff --git a/SRC/cgeqr.f b/SRC/cgeqr.f index c5151408..330fda5c 100644 --- a/SRC/cgeqr.f +++ b/SRC/cgeqr.f @@ -1,26 +1,26 @@ -* +* * Definition: * =========== * * SUBROUTINE CGEQR( M, N, A, LDA, WORK1, LWORK1, WORK2, LWORK2, * INFO) -* +* * .. Scalar Arguments .. * INTEGER INFO, LDA, M, N, LWORK1, LWORK2 * .. * .. Array Arguments .. * COMPLEX A( LDA, * ), WORK1( * ), WORK2( * ) * .. -* +* * *> \par Purpose: * ============= *> *> \verbatim -*> -*> CGEQR computes a QR factorization of an M-by-N matrix A, -*> using CLATSQR when A is tall and skinny -*> (M sufficiently greater than N), and otherwise CGEQRT: +*> +*> CGEQR computes a QR factorization of an M-by-N matrix A, +*> using CLATSQR when A is tall and skinny +*> (M sufficiently greater than N), and otherwise CGEQRT: *> A = Q * R . *> \endverbatim * @@ -44,7 +44,7 @@ *> A is COMPLEX array, dimension (LDA,N) *> On entry, the M-by-N matrix A. *> On exit, the elements on and above the diagonal of the array -*> contain the min(M,N)-by-N upper trapezoidal matrix R +*> contain the min(M,N)-by-N upper trapezoidal matrix R *> (R is upper triangular if M >= N); *> the elements below the diagonal represent Q (see Further Details). *> \endverbatim @@ -59,13 +59,13 @@ *> \verbatim *> WORK1 is COMPLEX array, dimension (MAX(1,LWORK1)) *> WORK1 contains part of the data structure used to store Q. -*> WORK1(1): algorithm type = 1, to indicate output from +*> WORK1(1): algorithm type = 1, to indicate output from *> CLATSQR or CGEQRT *> WORK1(2): optimum size of WORK1 *> WORK1(3): minimum size of WORK1 *> WORK1(4): row block size *> WORK1(5): column block size -*> WORK1(6:LWORK1): data structure needed for Q, computed by +*> WORK1(6:LWORK1): data structure needed for Q, computed by *> CLATSQR or CGEQRT *> \endverbatim *> @@ -73,25 +73,25 @@ *> \verbatim *> LWORK1 is INTEGER *> The dimension of the array WORK1. -*> If LWORK1 = -1, then a query is assumed. In this case the +*> If LWORK1 = -1, then a query is assumed. In this case the *> routine calculates the optimal size of WORK1 and -*> returns this value in WORK1(2), and calculates the minimum -*> size of WORK1 and returns this value in WORK1(3). -*> No error message related to LWORK1 is issued by XERBLA when +*> returns this value in WORK1(2), and calculates the minimum +*> size of WORK1 and returns this value in WORK1(3). +*> No error message related to LWORK1 is issued by XERBLA when *> LWORK1 = -1. *> \endverbatim *> *> \param[out] WORK2 *> \verbatim -*> (workspace) COMPLEX array, dimension (MAX(1,LWORK2)) +*> (workspace) COMPLEX array, dimension (MAX(1,LWORK2)) *> \endverbatim *> *> \param[in] LWORK2 *> \verbatim *> LWORK2 is INTEGER *> The dimension of the array WORK2. -*> If LWORK2 = -1, then a query is assumed. In this case the -*> routine calculates the optimal size of WORK2 and +*> If LWORK2 = -1, then a query is assumed. In this case the +*> routine calculates the optimal size of WORK2 and *> returns this value in WORK2(1), and calculates the minimum *> size of WORK2 and returns this value in WORK2(2). *> No error message related to LWORK2 is issued by XERBLA when @@ -120,19 +120,19 @@ *> Depending on the matrix dimensions M and N, and row and column *> block sizes MB and NB returned by ILAENV, GEQR will use either *> LATSQR (if the matrix is tall-and-skinny) or GEQRT to compute -*> the QR decomposition. +*> the QR decomposition. *> The output of LATSQR or GEQRT representing Q is stored in A and in -*> array WORK1(6:LWORK1) for later use. -*> WORK1(2:5) contains the matrix dimensions M,N and block sizes MB,NB -*> which are needed to interpret A and WORK1(6:LWORK1) for later use. -*> WORK1(1)=1 indicates that the code needed to take WORK1(2:5) and -*> decide whether LATSQR or GEQRT was used is the same as used below in +*> array WORK1(6:LWORK1) for later use. +*> WORK1(2:5) contains the matrix dimensions M,N and block sizes MB,NB +*> which are needed to interpret A and WORK1(6:LWORK1) for later use. +*> WORK1(1)=1 indicates that the code needed to take WORK1(2:5) and +*> decide whether LATSQR or GEQRT was used is the same as used below in *> GEQR. For a detailed description of A and WORK1(6:LWORK1), see *> Further Details in LATSQR or GEQRT. *> \endverbatim *> * ===================================================================== - SUBROUTINE CGEQR( M, N, A, LDA, WORK1, LWORK1, WORK2, LWORK2, + SUBROUTINE CGEQR( M, N, A, LDA, WORK1, LWORK1, WORK2, LWORK2, $ INFO) * * -- LAPACK computational routine (version 3.5.0) -- @@ -174,8 +174,8 @@ * LQUERY = ( LWORK1.EQ.-1 .OR. LWORK2.EQ.-1 ) * -* Determine the block size -* +* Determine the block size +* IF ( MIN(M,N).GT.0 ) THEN MB = ILAENV( 1, 'CGEQR ', ' ', M, N, 1, -1) NB = ILAENV( 1, 'CGEQR ', ' ', M, N, 2, -1) @@ -197,18 +197,18 @@ END IF * * Determine if the workspace size satisfies minimum size -* +* LMINWS = .FALSE. - IF((LWORK1.LT.MAX(1, NB*N*NBLCKS+5) - $ .OR.(LWORK2.LT.NB*N)).AND.(LWORK2.GE.N).AND.(LWORK1.GT.N+5) + IF((LWORK1.LT.MAX(1, NB*N*NBLCKS+5) + $ .OR.(LWORK2.LT.NB*N)).AND.(LWORK2.GE.N).AND.(LWORK1.GT.N+5) $ .AND.(.NOT.LQUERY)) THEN IF (LWORK1.LT.MAX(1, NB * N * NBLCKS+5)) THEN LMINWS = .TRUE. NB = 1 - END IF + END IF IF (LWORK1.LT.MAX(1, N * NBLCKS+5)) THEN LMINWS = .TRUE. - MB = M + MB = M END IF IF (LWORK2.LT.NB*N) THEN LMINWS = .TRUE. @@ -222,13 +222,13 @@ INFO = -2 ELSE IF( LDA.LT.MAX( 1, M ) ) THEN INFO = -4 - ELSE IF( LWORK1.LT.MAX( 1, NB * N * NBLCKS + 5 ) + ELSE IF( LWORK1.LT.MAX( 1, NB * N * NBLCKS + 5 ) $ .AND.(.NOT.LQUERY).AND.(.NOT.LMINWS)) THEN INFO = -6 - ELSE IF( (LWORK2.LT.MAX(1,N*NB)).AND.(.NOT.LQUERY) + ELSE IF( (LWORK2.LT.MAX(1,N*NB)).AND.(.NOT.LQUERY) $ .AND.(.NOT.LMINWS)) THEN - INFO = -8 - END IF + INFO = -8 + END IF * IF( INFO.EQ.0) THEN WORK1(1) = 1 @@ -257,12 +257,12 @@ IF((M.LE.N).OR.(MB.LE.N).OR.(MB.GE.M)) THEN CALL CGEQRT( M, N, NB, A, LDA, WORK1(6), NB, WORK2, INFO) RETURN - ELSE - CALL CLATSQR( M, N, MB, NB, A, LDA, WORK1(6), NB, WORK2, + ELSE + CALL CLATSQR( M, N, MB, NB, A, LDA, WORK1(6), NB, WORK2, $ LWORK2, INFO) END IF RETURN -* +* * End of CGEQR * - END
\ No newline at end of file + END diff --git a/SRC/cgetsls.f b/SRC/cgetsls.f index 222f0211..af5bd2cb 100644 --- a/SRC/cgetsls.f +++ b/SRC/cgetsls.f @@ -488,4 +488,4 @@ * * End of CGETSLS * - END
\ No newline at end of file + END diff --git a/SRC/cheevr.f b/SRC/cheevr.f index 31df2cb6..e3a31ca3 100644 --- a/SRC/cheevr.f +++ b/SRC/cheevr.f @@ -258,7 +258,7 @@ *> indicating the nonzero elements in Z. The i-th eigenvector *> is nonzero only in elements ISUPPZ( 2*i-1 ) through *> ISUPPZ( 2*i ). This is an output of CSTEMR (tridiagonal -*> matrix). The support of the eigenvectors of A is typically +*> matrix). The support of the eigenvectors of A is typically *> 1:N because of the unitary transformations applied by CUNMTR. *> Implemented only for RANGE = 'A' or 'I' and IU - IL = N - 1 *> \endverbatim diff --git a/SRC/chesv_aasen.f b/SRC/chesv_aasen.f index e5d1cb68..f9d188ad 100644 --- a/SRC/chesv_aasen.f +++ b/SRC/chesv_aasen.f @@ -2,25 +2,25 @@ * * =========== 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 CHESV_AASEN + dependencies -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/chesv_aasen.f"> -*> [TGZ]</a> -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/chesv_aasen.f"> -*> [ZIP]</a> -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/chesv_aasen.f"> +*> Download CHESV_AASEN + dependencies +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/chesv_aasen.f"> +*> [TGZ]</a> +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/chesv_aasen.f"> +*> [ZIP]</a> +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/chesv_aasen.f"> *> [TXT]</a> -*> \endhtmlonly +*> \endhtmlonly * * Definition: * =========== * * SUBROUTINE CHESV_AASEN( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, * LWORK, INFO ) -* +* * .. Scalar Arguments .. * CHARACTER UPLO * INTEGER INFO, LDA, LDB, LWORK, N, NRHS @@ -29,7 +29,7 @@ * INTEGER IPIV( * ) * COMPLEX A( LDA, * ), B( LDB, * ), WORK( * ) * .. -* +* * *> \par Purpose: * ============= @@ -45,7 +45,7 @@ *> A = U * T * U**H, if UPLO = 'U', or *> A = L * T * L**H, if UPLO = 'L', *> where U (or L) is a product of permutation and unit upper (lower) -*> triangular matrices, and T is Hermitian and tridiagonal. The factored form +*> triangular matrices, and T is Hermitian and tridiagonal. The factored form *> of A is then used to solve the system of equations A * X = B. *> \endverbatim * @@ -99,8 +99,8 @@ *> \param[out] IPIV *> \verbatim *> IPIV is INTEGER array, dimension (N) -*> On exit, it contains the details of the interchanges, i.e., -*> the row and column k of A were interchanged with the +*> On exit, it contains the details of the interchanges, i.e., +*> the row and column k of A were interchanged with the *> row and column IPIV(k). *> \endverbatim *> @@ -151,10 +151,10 @@ * 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 2016 * diff --git a/SRC/chetrf_aasen.f b/SRC/chetrf_aasen.f index deb0b647..8d8a08c9 100644 --- a/SRC/chetrf_aasen.f +++ b/SRC/chetrf_aasen.f @@ -2,24 +2,24 @@ * * =========== 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 CHETRF_AASEN + dependencies -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/chetrf_aasen.f"> -*> [TGZ]</a> -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/chetrf_aasen.f"> -*> [ZIP]</a> -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/chetrf_aasen.f"> +*> Download CHETRF_AASEN + dependencies +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/chetrf_aasen.f"> +*> [TGZ]</a> +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/chetrf_aasen.f"> +*> [ZIP]</a> +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/chetrf_aasen.f"> *> [TXT]</a> -*> \endhtmlonly +*> \endhtmlonly * * Definition: * =========== * * SUBROUTINE CHETRF_AASEN( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) -* +* * .. Scalar Arguments .. * CHARACTER UPLO * INTEGER N, LDA, LWORK, INFO @@ -73,7 +73,7 @@ *> triangular part of A is not referenced. *> *> On exit, the tridiagonal matrix is stored in the diagonals -*> and the subdiagonals of A just below (or above) the diagonals, +*> and the subdiagonals of A just below (or above) the diagonals, *> and L is stored below (or above) the subdiaonals, when UPLO *> is 'L' (or 'U'). *> \endverbatim @@ -87,8 +87,8 @@ *> \param[out] IPIV *> \verbatim *> IPIV is INTEGER array, dimension (N) -*> On exit, it contains the details of the interchanges, i.e., -*> the row and column k of A were interchanged with the +*> On exit, it contains the details of the interchanges, i.e., +*> the row and column k of A were interchanged with the *> row and column IPIV(k). *> \endverbatim *> @@ -124,10 +124,10 @@ * 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 2016 * @@ -245,14 +245,14 @@ * J = 0 10 CONTINUE - IF( J.GE.N ) + IF( J.GE.N ) $ GO TO 20 * * each step of the main loop * J is the last column of the previous panel * J1 is the first column of the current panel * K1 identifies if the previous column of the panel has been -* explicitly stored, e.g., K1=1 for the first panel, and +* explicitly stored, e.g., K1=1 for the first panel, and * K1=0 for the rest * J1 = J + 1 @@ -261,27 +261,27 @@ * * Panel factorization * - CALL CLAHEF_AASEN( UPLO, 2-K1, N-J, JB, + CALL CLAHEF_AASEN( UPLO, 2-K1, N-J, JB, $ A( MAX(1, J), J+1 ), LDA, - $ IPIV( J+1 ), WORK, N, WORK( N*NB+1 ), + $ IPIV( J+1 ), WORK, N, WORK( N*NB+1 ), $ IINFO ) IF( (IINFO.GT.0) .AND. (INFO.EQ.0) ) THEN INFO = IINFO+J - ENDIF + ENDIF * * Ajust IPIV and apply it back (J-th step picks (J+1)-th pivot) * DO J2 = J+2, MIN(N, J+JB+1) IPIV( J2 ) = IPIV( J2 ) + J IF( (J2.NE.IPIV(J2)) .AND. ((J1-K1).GT.2) ) THEN - CALL CSWAP( J1-K1-2, A( 1, J2 ), 1, + CALL CSWAP( J1-K1-2, A( 1, J2 ), 1, $ A( 1, IPIV(J2) ), 1 ) END IF END DO J = J + JB * * Trailing submatrix update, where -* the row A(J1-1, J2-1:N) stores U(J1, J2+1:N) and +* the row A(J1-1, J2-1:N) stores U(J1, J2+1:N) and * WORK stores the current block of the auxiriarly matrix H * IF( J.LT.N ) THEN @@ -313,7 +313,7 @@ * K2 = 0 * -* First update skips the first column +* First update skips the first column * JB = JB - 1 END IF @@ -335,7 +335,7 @@ * * Update off-diagonal block of J2-th block row with CGEMM * - CALL CGEMM( 'Conjugate transpose', 'Transpose', + CALL CGEMM( 'Conjugate transpose', 'Transpose', $ NJ, N-J3+1, JB+1, $ -ONE, A( J1-K2, J2 ), LDA, $ WORK( (J3-J1+1)+K1*N ), N, @@ -358,7 +358,7 @@ * Factorize A as L*D*L**T using the lower triangle of A * ..................................................... * -* copy first column A(1:N, 1) into H(1:N, 1) +* copy first column A(1:N, 1) into H(1:N, 1) * (stored in WORK(1:N)) * CALL CCOPY( N, A( 1, 1 ), 1, WORK( 1 ), 1 ) @@ -369,14 +369,14 @@ * J = 0 11 CONTINUE - IF( J.GE.N ) + IF( J.GE.N ) $ GO TO 20 * * each step of the main loop * J is the last column of the previous panel * J1 is the first column of the current panel * K1 identifies if the previous column of the panel has been -* explicitly stored, e.g., K1=1 for the first panel, and +* explicitly stored, e.g., K1=1 for the first panel, and * K1=0 for the rest * J1 = J+1 @@ -385,26 +385,26 @@ * * Panel factorization * - CALL CLAHEF_AASEN( UPLO, 2-K1, N-J, JB, + CALL CLAHEF_AASEN( UPLO, 2-K1, N-J, JB, $ A( J+1, MAX(1, J) ), LDA, $ IPIV( J+1 ), WORK, N, WORK( N*NB+1 ), IINFO) IF( (IINFO.GT.0) .AND. (INFO.EQ.0) ) THEN INFO = IINFO+J - ENDIF + ENDIF * * Ajust IPIV and apply it back (J-th step picks (J+1)-th pivot) * DO J2 = J+2, MIN(N, J+JB+1) IPIV( J2 ) = IPIV( J2 ) + J IF( (J2.NE.IPIV(J2)) .AND. ((J1-K1).GT.2) ) THEN - CALL CSWAP( J1-K1-2, A( J2, 1 ), LDA, + CALL CSWAP( J1-K1-2, A( J2, 1 ), LDA, $ A( IPIV(J2), 1 ), LDA ) END IF END DO J = J + JB * * Trailing submatrix update, where -* A(J2+1, J1-1) stores L(J2+1, J1) and +* A(J2+1, J1-1) stores L(J2+1, J1) and * WORK(J2+1, 1) stores H(J2+1, 1) * IF( J.LT.N ) THEN @@ -436,7 +436,7 @@ * K2 = 0 * -* First update skips the first column +* First update skips the first column * JB = JB - 1 END IF @@ -458,7 +458,7 @@ * * Update off-diagonal block of J2-th block column with CGEMM * - CALL CGEMM( 'No transpose', 'Conjugate transpose', + CALL CGEMM( 'No transpose', 'Conjugate transpose', $ N-J3+1, NJ, JB+1, $ -ONE, WORK( (J3-J1+1)+K1*N ), N, $ A( J2, J1-K2 ), LDA, diff --git a/SRC/chetrs_aasen.f b/SRC/chetrs_aasen.f index 629084eb..33f32fac 100644 --- a/SRC/chetrs_aasen.f +++ b/SRC/chetrs_aasen.f @@ -2,25 +2,25 @@ * * =========== 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 CHETRS_AASEN + dependencies *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/chetrs_aasen.f"> -*> [TGZ]</a> +*> [TGZ]</a> *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/chetrs_aasen.f"> -*> [ZIP]</a> +*> [ZIP]</a> *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/chetrs_aasen.f"> *> [TXT]</a> -*> \endhtmlonly +*> \endhtmlonly * * Definition: * =========== * * SUBROUTINE CHETRS_AASEN( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, * WORK, LWORK, INFO ) -* +* * .. Scalar Arguments .. * CHARACTER UPLO * INTEGER N, NRHS, LDA, LDB, LWORK, INFO @@ -29,7 +29,7 @@ * INTEGER IPIV( * ) * COMPLEX A( LDA, * ), B( LDB, * ), WORK( * ) * .. -* +* * *> \par Purpose: * ============= @@ -116,10 +116,10 @@ * 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 2016 * @@ -254,7 +254,7 @@ * * Compute (L \P**T * B) -> B [ (L \P**T * B) ] * - CALL CTRSM( 'L', 'L', 'N', 'U', N-1, NRHS, ONE, A( 2, 1), LDA, + CALL CTRSM( 'L', 'L', 'N', 'U', N-1, NRHS, ONE, A( 2, 1), LDA, $ B(2, 1), LDB) * * Compute T \ B -> B [ T \ (L \P**T * B) ] @@ -269,7 +269,7 @@ $ INFO) * * Compute (L**T \ B) -> B [ L**T \ (T \ (L \P**T * B) ) ] -* +* CALL CTRSM( 'L', 'L', 'C', 'U', N-1, NRHS, ONE, A( 2, 1 ), LDA, $ B( 2, 1 ), LDB) * diff --git a/SRC/clahef_aasen.f b/SRC/clahef_aasen.f index f79c8b70..73f750fe 100644 --- a/SRC/clahef_aasen.f +++ b/SRC/clahef_aasen.f @@ -2,25 +2,25 @@ * * =========== 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 CLAHEF_AASEN + dependencies -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/clahef_aasen.f"> -*> [TGZ]</a> -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/clahef_aasen.f"> -*> [ZIP]</a> -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/clahef_aasen.f"> +*> Download CLAHEF_AASEN + dependencies +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/clahef_aasen.f"> +*> [TGZ]</a> +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/clahef_aasen.f"> +*> [ZIP]</a> +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/clahef_aasen.f"> *> [TXT]</a> -*> \endhtmlonly +*> \endhtmlonly * * Definition: * =========== * -* SUBROUTINE CLAHEF_AASEN( UPLO, J1, M, NB, A, LDA, IPIV, +* SUBROUTINE CLAHEF_AASEN( UPLO, J1, M, NB, A, LDA, IPIV, * H, LDH, WORK, INFO ) -* +* * .. Scalar Arguments .. * CHARACTER UPLO * INTEGER J1, M, NB, LDA, LDH, INFO @@ -29,7 +29,7 @@ * INTEGER IPIV( * ) * COMPLEX A( LDA, * ), H( LDH, * ), WORK( * ) * .. -* +* * *> \par Purpose: * ============= @@ -44,9 +44,9 @@ *> last row, or column, of the previous panel. The first row, or column, *> of A is set to be the first row, or column, of an identity matrix, *> which is used to factorize the first panel. -*> +*> *> The resulting J-th row of U, or J-th column of L, is stored in the -*> (J-1)-th row, or column, of A (without the unit diatonals), while +*> (J-1)-th row, or column, of A (without the unit diatonals), while *> the diagonal and subdiagonal of A are overwritten by those of T. *> *> \endverbatim @@ -141,10 +141,10 @@ * 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 2016 * @@ -153,7 +153,7 @@ * @generated from zlahef_aasen.f, fortran z -> c, Sun Oct 2 22:41:33 2016 * * ===================================================================== - SUBROUTINE CLAHEF_AASEN( UPLO, J1, M, NB, A, LDA, IPIV, + SUBROUTINE CLAHEF_AASEN( UPLO, J1, M, NB, A, LDA, IPIV, $ H, LDH, WORK, INFO ) * * -- LAPACK computational routine (version 3.4.0) -- @@ -179,7 +179,7 @@ * * .. Local Scalars .. INTEGER J, K, K1, I1, I2 - COMPLEX PIV, ALPHA + COMPLEX PIV, ALPHA * .. * .. External Functions .. LOGICAL LSAME @@ -255,14 +255,14 @@ * A( K, J ) = REAL( WORK( 1 ) ) * - IF( J.LT.M ) THEN + IF( J.LT.M ) THEN * * Compute WORK(2:N) = T(J, J) L(J, (J+1):N) * where A(J, J) stores T(J, J) and A(J-1, (J+1):N) stores U(J, (J+1):N) * IF( (J1+J-1).GT.1 ) THEN - ALPHA = -A( K, J ) - CALL CAXPY( M-J, ALPHA, A( K-1, J+1 ), LDA, + ALPHA = -A( K, J ) + CALL CAXPY( M-J, ALPHA, A( K-1, J+1 ), LDA, $ WORK( 2 ), 1 ) ENDIF * @@ -285,14 +285,14 @@ * I1 = I1+J-1 I2 = I2+J-1 - CALL CSWAP( I2-I1-1, A( J1+I1-1, I1+1 ), LDA, + CALL CSWAP( I2-I1-1, A( J1+I1-1, I1+1 ), LDA, $ A( J1+I1, I2 ), 1 ) CALL CLACGV( I2-I1, A( J1+I1-1, I1+1 ), LDA ) CALL CLACGV( I2-I1-1, A( J1+I1, I2 ), 1 ) * * Swap A(I1, I2+1:N) with A(I2, I2+1:N) * - CALL CSWAP( M-I2, A( J1+I1-1, I2+1 ), LDA, + CALL CSWAP( M-I2, A( J1+I1-1, I2+1 ), LDA, $ A( J1+I2-1, I2+1 ), LDA ) * * Swap A(I1, I1) with A(I2,I2) @@ -311,17 +311,17 @@ * Swap L(1:I1-1, I1) with L(1:I1-1, I2), * skipping the first column * - CALL CSWAP( I1-K1+1, A( 1, I1 ), 1, + CALL CSWAP( I1-K1+1, A( 1, I1 ), 1, $ A( 1, I2 ), 1 ) END IF - ELSE + ELSE IPIV( J+1 ) = J+1 ENDIF * * Set A(J, J+1) = T(J, J+1) * A( K, J+1 ) = WORK( 2 ) - IF( (A( K, J ).EQ.ZERO ) .AND. + IF( (A( K, J ).EQ.ZERO ) .AND. $ ( (J.EQ.M) .OR. (A( K, J+1 ).EQ.ZERO))) THEN IF(INFO .EQ. 0) THEN INFO = J @@ -330,9 +330,9 @@ * IF( J.LT.NB ) THEN * -* Copy A(J+1:N, J+1) into H(J:N, J), +* Copy A(J+1:N, J+1) into H(J:N, J), * - CALL CCOPY( M-J, A( K+1, J+1 ), LDA, + CALL CCOPY( M-J, A( K+1, J+1 ), LDA, $ H( J+1, J+1 ), 1 ) END IF * @@ -344,7 +344,7 @@ CALL CCOPY( M-J-1, WORK( 3 ), 1, A( K, J+2 ), LDA ) CALL CSCAL( M-J-1, ALPHA, A( K, J+2 ), LDA ) ELSE - CALL CLASET( 'Full', 1, M-J-1, ZERO, ZERO, + CALL CLASET( 'Full', 1, M-J-1, ZERO, ZERO, $ A( K, J+2 ), LDA) END IF ELSE @@ -409,14 +409,14 @@ * A( J, K ) = REAL( WORK( 1 ) ) * - IF( J.LT.M ) THEN + IF( J.LT.M ) THEN * * Compute WORK(2:N) = T(J, J) L((J+1):N, J) * where A(J, J) = T(J, J) and A((J+1):N, J-1) = L((J+1):N, J) * IF( (J1+J-1).GT.1 ) THEN ALPHA = -A( J, K ) - CALL CAXPY( M-J, ALPHA, A( J+1, K-1 ), 1, + CALL CAXPY( M-J, ALPHA, A( J+1, K-1 ), 1, $ WORK( 2 ), 1 ) ENDIF * @@ -439,14 +439,14 @@ * I1 = I1+J-1 I2 = I2+J-1 - CALL CSWAP( I2-I1-1, A( I1+1, J1+I1-1 ), 1, + CALL CSWAP( I2-I1-1, A( I1+1, J1+I1-1 ), 1, $ A( I2, J1+I1 ), LDA ) CALL CLACGV( I2-I1, A( I1+1, J1+I1-1 ), 1 ) CALL CLACGV( I2-I1-1, A( I2, J1+I1 ), LDA ) * * Swap A(I2+1:N, I1) with A(I2+1:N, I2) * - CALL CSWAP( M-I2, A( I2+1, J1+I1-1 ), 1, + CALL CSWAP( M-I2, A( I2+1, J1+I1-1 ), 1, $ A( I2+1, J1+I2-1 ), 1 ) * * Swap A(I1, I1) with A(I2, I2) @@ -465,27 +465,27 @@ * Swap L(1:I1-1, I1) with L(1:I1-1, I2), * skipping the first column * - CALL CSWAP( I1-K1+1, A( I1, 1 ), LDA, + CALL CSWAP( I1-K1+1, A( I1, 1 ), LDA, $ A( I2, 1 ), LDA ) END IF - ELSE + ELSE IPIV( J+1 ) = J+1 ENDIF * * Set A(J+1, J) = T(J+1, J) * A( J+1, K ) = WORK( 2 ) - IF( (A( J, K ).EQ.ZERO) .AND. + IF( (A( J, K ).EQ.ZERO) .AND. $ ( (J.EQ.M) .OR. (A( J+1, K ).EQ.ZERO)) ) THEN - IF (INFO .EQ. 0) + IF (INFO .EQ. 0) $ INFO = J END IF * IF( J.LT.NB ) THEN * -* Copy A(J+1:N, J+1) into H(J+1:N, J), +* Copy A(J+1:N, J+1) into H(J+1:N, J), * - CALL CCOPY( M-J, A( J+1, K+1 ), 1, + CALL CCOPY( M-J, A( J+1, K+1 ), 1, $ H( J+1, J+1 ), 1 ) END IF * @@ -497,11 +497,11 @@ CALL CCOPY( M-J-1, WORK( 3 ), 1, A( J+2, K ), 1 ) CALL CSCAL( M-J-1, ALPHA, A( J+2, K ), 1 ) ELSE - CALL CLASET( 'Full', M-J-1, 1, ZERO, ZERO, + CALL CLASET( 'Full', M-J-1, 1, ZERO, ZERO, $ A( J+2, K ), LDA ) END IF ELSE - IF( (A( J, K ).EQ.ZERO) .AND. (J.EQ.M) + IF( (A( J, K ).EQ.ZERO) .AND. (J.EQ.M) $ .AND. (INFO.EQ.0) ) INFO = J END IF J = J + 1 diff --git a/SRC/clamswlq.f b/SRC/clamswlq.f index 3b640b84..9e3338e2 100644 --- a/SRC/clamswlq.f +++ b/SRC/clamswlq.f @@ -1,8 +1,8 @@ -* +* * Definition: * =========== * -* SUBROUTINE CLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, +* SUBROUTINE CLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, * $ LDT, C, LDC, WORK, LWORK, INFO ) * * @@ -17,15 +17,15 @@ * ============= *> *> \verbatim -*> +*> *> CLAMQRTS overwrites the general real M-by-N matrix C with *> -*> +*> *> SIDE = 'L' SIDE = 'R' *> TRANS = 'N': Q * C C * Q *> TRANS = 'T': Q**T * C C * Q**T *> where Q is a real orthogonal matrix defined as the product of blocked -*> elementary reflectors computed by short wide LQ +*> elementary reflectors computed by short wide LQ *> factorization (CLASWLQ) *> \endverbatim * @@ -59,28 +59,28 @@ *> The number of elementary reflectors whose product defines *> the matrix Q. *> M >= K >= 0; -*> +*> *> \endverbatim *> \param[in] MB *> \verbatim *> MB is INTEGER -*> The row block size to be used in the blocked QR. -*> M >= MB >= 1 +*> The row block size to be used in the blocked QR. +*> M >= MB >= 1 *> \endverbatim *> *> \param[in] NB *> \verbatim *> NB is INTEGER -*> The column block size to be used in the blocked QR. +*> The column block size to be used in the blocked QR. *> NB > M. *> \endverbatim *> *> \param[in] NB *> \verbatim *> NB is INTEGER -*> The block size to be used in the blocked QR. +*> The block size to be used in the blocked QR. *> MB > M. -*> +*> *> \endverbatim *> *> \param[in,out] A @@ -101,7 +101,7 @@ *> *> \param[in] T *> \verbatim -*> T is COMPLEX array, dimension +*> T is COMPLEX array, dimension *> ( M * Number of blocks(CEIL(N-K/NB-K)), *> The blocked upper triangular block reflectors stored in compact form *> as a sequence of upper triangular blocks. See below @@ -125,7 +125,7 @@ *> \param[out] WORK *> \verbatim *> (workspace) COMPLEX array, dimension (MAX(1,LWORK)) -*> +*> *> \endverbatim *> \param[in] LWORK *> \verbatim @@ -177,7 +177,7 @@ *> block reflectors, stored in array T(1:LDT,(i-1)*M+1:i*M). *> The last Q(k) may use fewer rows. *> For more information see Further Details in TPQRT. -*> +*> *> For more details of the overall algorithm, see the description of *> Sequential TSQR in Section 2.2 of [1]. *> @@ -187,7 +187,7 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE CLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, + SUBROUTINE CLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, $ LDT, C, LDC, WORK, LWORK, INFO ) * * -- LAPACK computational routine (version 3.5.0) -- @@ -266,11 +266,11 @@ * IF( MIN(M,N,K).EQ.0 ) THEN RETURN - END IF + END IF * IF((NB.LE.K).OR.(NB.GE.MAX(M,N,K))) THEN - CALL CGEMLQT( SIDE, TRANS, M, N, K, MB, A, LDA, - $ T, LDT, C, LDC, WORK, INFO) + CALL CGEMLQT( SIDE, TRANS, M, N, K, MB, A, LDA, + $ T, LDT, C, LDC, WORK, INFO) RETURN END IF * @@ -388,7 +388,7 @@ IF(II.LE.N) THEN * * Multiply Q to the last block of C -* +* CALL CTPMLQT('R','C',M , KK, K, 0,MB, A(1,II), LDA, $ T(1,CTR*K+1),LDT, C(1,1), LDC, $ C(1,II), LDC, WORK, INFO ) @@ -402,4 +402,4 @@ * * End of CLAMSWLQ * - END
\ No newline at end of file + END diff --git a/SRC/clamtsqr.f b/SRC/clamtsqr.f index 0f9ac57b..387e1fe1 100644 --- a/SRC/clamtsqr.f +++ b/SRC/clamtsqr.f @@ -1,8 +1,8 @@ -* +* * Definition: * =========== * -* SUBROUTINE CLAMTSQR( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, +* SUBROUTINE CLAMTSQR( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, * $ LDT, C, LDC, WORK, LWORK, INFO ) * * @@ -17,15 +17,15 @@ * ============= *> *> \verbatim -*> +*> *> CLAMTSQR overwrites the general complex M-by-N matrix C with *> -*> +*> *> SIDE = 'L' SIDE = 'R' *> TRANS = 'N': Q * C C * Q *> TRANS = 'C': Q**C * C C * Q**C -*> where Q is a real orthogonal matrix defined as the product -*> of blocked elementary reflectors computed by tall skinny +*> where Q is a real orthogonal matrix defined as the product +*> of blocked elementary reflectors computed by tall skinny *> QR factorization (CLATSQR) *> \endverbatim * @@ -59,29 +59,29 @@ *> The number of elementary reflectors whose product defines *> the matrix Q. *> N >= K >= 0; -*> +*> *> \endverbatim *> *> \param[in] MB *> \verbatim *> MB is INTEGER -*> The block size to be used in the blocked QR. +*> The block size to be used in the blocked QR. *> MB > N. (must be the same as DLATSQR) *> \endverbatim *> *> \param[in] NB *> \verbatim *> NB is INTEGER -*> The column block size to be used in the blocked QR. +*> The column block size to be used in the blocked QR. *> N >= NB >= 1. *> \endverbatim *> *> \param[in,out] A *> \verbatim *> A is COMPLEX array, dimension (LDA,K) -*> The i-th column must contain the vector which defines the -*> blockedelementary reflector H(i), for i = 1,2,...,k, as -*> returned by DLATSQR in the first k columns of +*> The i-th column must contain the vector which defines the +*> blockedelementary reflector H(i), for i = 1,2,...,k, as +*> returned by DLATSQR in the first k columns of *> its array argument A. *> \endverbatim *> @@ -95,7 +95,7 @@ *> *> \param[in] T *> \verbatim -*> T is COMPLEX array, dimension +*> T is COMPLEX array, dimension *> ( N * Number of blocks(CEIL(M-K/MB-K)), *> The blocked upper triangular block reflectors stored in compact form *> as a sequence of upper triangular blocks. See below @@ -119,13 +119,13 @@ *> \param[out] WORK *> \verbatim *> (workspace) COMPLEX array, dimension (MAX(1,LWORK)) -*> +*> *> \endverbatim *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER *> The dimension of the array WORK. -*> +*> *> If SIDE = 'L', LWORK >= max(1,N)*NB; *> if SIDE = 'R', LWORK >= max(1,MB)*NB. *> If LWORK = -1, then a workspace query is assumed; the routine @@ -172,7 +172,7 @@ *> block reflectors, stored in array T(1:LDT,(i-1)*N+1:i*N). *> The last Q(k) may use fewer rows. *> For more information see Further Details in TPQRT. -*> +*> *> For more details of the overall algorithm, see the description of *> Sequential TSQR in Section 2.2 of [1]. *> @@ -182,7 +182,7 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE CLAMTSQR( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, + SUBROUTINE CLAMTSQR( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, $ LDT, C, LDC, WORK, LWORK, INFO ) * * -- LAPACK computational routine (version 3.5.0) -- @@ -210,7 +210,7 @@ LOGICAL LSAME EXTERNAL LSAME * .. External Subroutines .. - EXTERNAL CGEMQRT, CTPMQRT, XERBLA + EXTERNAL CGEMQRT, CTPMQRT, XERBLA * .. * .. Executable Statements .. * @@ -250,9 +250,9 @@ IF( INFO.EQ.0) THEN * * Determine the block size if it is tall skinny or short and wide -* +* IF( INFO.EQ.0) THEN - WORK(1) = LW + WORK(1) = LW END IF END IF IF( INFO.NE.0 ) THEN @@ -269,10 +269,10 @@ END IF * IF((MB.LE.K).OR.(MB.GE.MAX(M,N,K))) THEN - CALL CGEMQRT( SIDE, TRANS, M, N, K, NB, A, LDA, - $ T, LDT, C, LDC, WORK, INFO) + CALL CGEMQRT( SIDE, TRANS, M, N, K, NB, A, LDA, + $ T, LDT, C, LDC, WORK, INFO) RETURN - END IF + END IF * IF(LEFT.AND.NOTRAN) THEN * @@ -328,7 +328,7 @@ IF(II.LE.M) THEN * * Multiply Q to the last block of C -* +* CALL CTPMQRT('L','C',KK , N, K, 0,NB, A(II,1), LDA, $ T(1,CTR*K+1), LDT, C(1,1), LDC, $ C(II,1), LDC, WORK, INFO ) @@ -401,9 +401,9 @@ WORK(1)= N * NB ELSE IF(RIGHT) THEN WORK(1)= MB * NB - END IF + END IF RETURN * * End of CLAMTSQR * - END
\ No newline at end of file + END diff --git a/SRC/claswlq.f b/SRC/claswlq.f index 91db14c9..a57771f1 100644 --- a/SRC/claswlq.f +++ b/SRC/claswlq.f @@ -1,24 +1,24 @@ -* +* * Definition: * =========== * * SUBROUTINE CLASWLQ( M, N, MB, NB, A, LDA, T, LDT, WORK, * LWORK, INFO) -* +* * .. Scalar Arguments .. * INTEGER INFO, LDA, M, N, MB, NB, LDT, LWORK * .. * .. Array Arguments .. * COMPLEX A( LDA, * ), T( LDT, * ), WORK( * ) * .. -* +* * *> \par Purpose: * ============= *> *> \verbatim -*> -*> CLASWLQ computes a blocked Short-Wide LQ factorization of a +*> +*> CLASWLQ computes a blocked Short-Wide LQ factorization of a *> M-by-N matrix A, where N >= M: *> A = L * Q *> \endverbatim @@ -41,13 +41,13 @@ *> \param[in] MB *> \verbatim *> MB is INTEGER -*> The row block size to be used in the blocked QR. -*> M >= MB >= 1 +*> The row block size to be used in the blocked QR. +*> M >= MB >= 1 *> \endverbatim *> \param[in] NB *> \verbatim *> NB is INTEGER -*> The column block size to be used in the blocked QR. +*> The column block size to be used in the blocked QR. *> NB > M. *> \endverbatim *> @@ -55,9 +55,9 @@ *> \verbatim *> A is COMPLEX array, dimension (LDA,N) *> On entry, the M-by-N matrix A. -*> On exit, the elements on and bleow the diagonal -*> of the array contain the N-by-N lower triangular matrix L; -*> the elements above the diagonal represent Q by the rows +*> On exit, the elements on and bleow the diagonal +*> of the array contain the N-by-N lower triangular matrix L; +*> the elements above the diagonal represent Q by the rows *> of blocked V (see Further Details). *> *> \endverbatim @@ -70,11 +70,11 @@ *> *> \param[out] T *> \verbatim -*> T is COMPLEX array, -*> dimension (LDT, N * Number_of_row_blocks) +*> T is COMPLEX array, +*> dimension (LDT, N * Number_of_row_blocks) *> where Number_of_row_blocks = CEIL((N-M)/(NB-M)) *> The blocked upper triangular block reflectors stored in compact form -*> as a sequence of upper triangular blocks. +*> as a sequence of upper triangular blocks. *> See Further Details below. *> \endverbatim *> @@ -88,7 +88,7 @@ *> \param[out] WORK *> \verbatim *> (workspace) COMPLEX array, dimension (MAX(1,LWORK)) -*> +*> *> \endverbatim *> \param[in] LWORK *> \verbatim @@ -137,7 +137,7 @@ *> block reflectors, stored in array T(1:LDT,(i-1)*M+1:i*M). *> The last Q(k) may use fewer rows. *> For more information see Further Details in TPQRT. -*> +*> *> For more details of the overall algorithm, see the description of *> Sequential TSQR in Section 2.2 of [1]. *> @@ -147,7 +147,7 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE CLASWLQ( M, N, MB, NB, A, LDA, T, LDT, WORK, LWORK, + SUBROUTINE CLASWLQ( M, N, MB, NB, A, LDA, T, LDT, WORK, LWORK, $ INFO) * * -- LAPACK computational routine (version 3.5.0) -- @@ -194,7 +194,7 @@ ELSE IF( N.LT.0 .OR. N.LT.M ) THEN INFO = -2 ELSE IF( MB.LT.1 .OR. ( MB.GT.M .AND. M.GT.0 )) THEN - INFO = -3 + INFO = -3 ELSE IF( NB.LE.M ) THEN INFO = -4 ELSE IF( LDA.LT.MAX( 1, M ) ) THEN @@ -202,9 +202,9 @@ ELSE IF( LDT.LT.MB ) THEN INFO = -8 ELSE IF( ( LWORK.LT.M*MB) .AND. (.NOT.LQUERY) ) THEN - INFO = -10 - END IF - IF( INFO.EQ.0) THEN + INFO = -10 + END IF + IF( INFO.EQ.0) THEN WORK(1) = MB*M END IF * @@ -226,10 +226,10 @@ IF((M.GE.N).OR.(NB.LE.M).OR.(NB.GE.N)) THEN CALL CGELQT( M, N, MB, A, LDA, T, LDT, WORK, INFO) RETURN - END IF -* + END IF +* KK = MOD((N-M),(NB-M)) - II=N-KK+1 + II=N-KK+1 * * Compute the LQ factorization of the first block A(1:M,1:NB) * @@ -237,7 +237,7 @@ CTR = 1 * DO I = NB+1, II-NB+M , (NB-M) -* +* * Compute the QR factorization of the current block A(1:M,I:I+NB-M) * CALL CTPLQT( M, NB-M, 0, MB, A(1,1), LDA, A( 1, I ), @@ -252,11 +252,11 @@ CALL CTPLQT( M, KK, 0, MB, A(1,1), LDA, A( 1, II ), $ LDA, T(1,CTR*M+1), LDT, $ WORK, INFO ) - END IF + END IF * WORK( 1 ) = M * MB RETURN -* +* * End of CLASWLQ * - END
\ No newline at end of file + END diff --git a/SRC/clatsqr.f b/SRC/clatsqr.f index e462ab77..88ec86e9 100644 --- a/SRC/clatsqr.f +++ b/SRC/clatsqr.f @@ -1,26 +1,26 @@ -* +* * Definition: * =========== * -* SUBROUTINE CLATSQR( M, N, MB, NB, A, LDA, T, LDT, WORK, +* SUBROUTINE CLATSQR( M, N, MB, NB, A, LDA, T, LDT, WORK, * LWORK, INFO) -* +* * .. Scalar Arguments .. * INTEGER INFO, LDA, M, N, MB, NB, LDT, LWORK * .. * .. Array Arguments .. * COMPLEX A( LDA, * ), T( LDT, * ), WORK( * ) * .. -* +* * *> \par Purpose: * ============= *> *> \verbatim -*> -*> SLATSQR computes a blocked Tall-Skinny QR factorization of +*> +*> SLATSQR computes a blocked Tall-Skinny QR factorization of *> an M-by-N matrix A, where M >= N: -*> A = Q * R . +*> A = Q * R . *> \endverbatim * * Arguments: @@ -41,14 +41,14 @@ *> \param[in] MB *> \verbatim *> MB is INTEGER -*> The row block size to be used in the blocked QR. +*> The row block size to be used in the blocked QR. *> MB > N. *> \endverbatim *> *> \param[in] NB *> \verbatim *> NB is INTEGER -*> The column block size to be used in the blocked QR. +*> The column block size to be used in the blocked QR. *> N >= NB >= 1. *> \endverbatim *> @@ -56,9 +56,9 @@ *> \verbatim *> A is COMPLEX array, dimension (LDA,N) *> On entry, the M-by-N matrix A. -*> On exit, the elements on and above the diagonal -*> of the array contain the N-by-N upper triangular matrix R; -*> the elements below the diagonal represent Q by the columns +*> On exit, the elements on and above the diagonal +*> of the array contain the N-by-N upper triangular matrix R; +*> the elements below the diagonal represent Q by the columns *> of blocked V (see Further Details). *> \endverbatim *> @@ -70,11 +70,11 @@ *> *> \param[out] T *> \verbatim -*> T is COMPLEX array, -*> dimension (LDT, N * Number_of_row_blocks) +*> T is COMPLEX array, +*> dimension (LDT, N * Number_of_row_blocks) *> where Number_of_row_blocks = CEIL((M-N)/(MB-N)) *> The blocked upper triangular block reflectors stored in compact form -*> as a sequence of upper triangular blocks. +*> as a sequence of upper triangular blocks. *> See Further Details below. *> \endverbatim *> @@ -86,7 +86,7 @@ *> *> \param[out] WORK *> \verbatim -*> (workspace) COMPLEX array, dimension (MAX(1,LWORK)) +*> (workspace) COMPLEX array, dimension (MAX(1,LWORK)) *> \endverbatim *> *> \param[in] LWORK @@ -136,7 +136,7 @@ *> block reflectors, stored in array T(1:LDT,(i-1)*N+1:i*N). *> The last Q(k) may use fewer rows. *> For more information see Further Details in TPQRT. -*> +*> *> For more details of the overall algorithm, see the description of *> Sequential TSQR in Section 2.2 of [1]. *> @@ -146,7 +146,7 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE CLATSQR( M, N, MB, NB, A, LDA, T, LDT, WORK, + SUBROUTINE CLATSQR( M, N, MB, NB, A, LDA, T, LDT, WORK, $ LWORK, INFO) * * -- LAPACK computational routine (version 3.5.0) -- @@ -189,7 +189,7 @@ ELSE IF( N.LT.0 .OR. M.LT.N ) THEN INFO = -2 ELSE IF( MB.LE.N ) THEN - INFO = -3 + INFO = -3 ELSE IF( NB.LT.1 .OR. ( NB.GT.N .AND. N.GT.0 )) THEN INFO = -4 ELSE IF( LDA.LT.MAX( 1, M ) ) THEN @@ -197,8 +197,8 @@ ELSE IF( LDT.LT.NB ) THEN INFO = -8 ELSE IF( LWORK.LT.(N*NB) .AND. (.NOT.LQUERY) ) THEN - INFO = -10 - END IF + INFO = -10 + END IF IF( INFO.EQ.0) THEN WORK(1) = NB*N END IF @@ -220,9 +220,9 @@ IF ((MB.LE.N).OR.(MB.GE.M)) THEN CALL CGEQRT( M, N, NB, A, LDA, T, LDT, WORK, INFO) RETURN - END IF + END IF KK = MOD((M-N),(MB-N)) - II=M-KK+1 + II=M-KK+1 * * Compute the QR factorization of the first block A(1:MB,1:N) * @@ -230,7 +230,7 @@ CTR = 1 * DO I = MB+1, II-MB+N , (MB-N) -* +* * Compute the QR factorization of the current block A(I:I+MB-N,1:N) * CALL CTPQRT( MB-N, N, 0, NB, A(1,1), LDA, A( I, 1 ), LDA, @@ -245,11 +245,11 @@ CALL CTPQRT( KK, N, 0, NB, A(1,1), LDA, A( II, 1 ), LDA, $ T(1, CTR * N + 1), LDT, $ WORK, INFO ) - END IF + END IF * work( 1 ) = N*NB RETURN -* +* * End of CLATSQR * - END
\ No newline at end of file + END diff --git a/SRC/ctplqt.f b/SRC/ctplqt.f index 4de86153..731b211a 100644 --- a/SRC/ctplqt.f +++ b/SRC/ctplqt.f @@ -3,23 +3,23 @@ * * SUBROUTINE CTPLQT( M, N, L, MB, A, LDA, B, LDB, T, LDT, WORK, * INFO ) -* +* * .. Scalar Arguments .. * INTEGER INFO, LDA, LDB, LDT, N, M, L, MB * .. * .. Array Arguments .. * COMPLEX A( LDA, * ), B( LDB, * ), T( LDT, * ), WORK( * ) * .. -* +* * *> \par Purpose: * ============= *> *> \verbatim *> -*> CTPLQT computes a blocked LQ factorization of a complex -*> "triangular-pentagonal" matrix C, which is composed of a -*> triangular block A and pentagonal block B, using the compact +*> CTPLQT computes a blocked LQ factorization of a complex +*> "triangular-pentagonal" matrix C, which is composed of a +*> triangular block A and pentagonal block B, using the compact *> WY representation for Q. *> \endverbatim * @@ -30,7 +30,7 @@ *> \verbatim *> M is INTEGER *> The number of rows of the matrix B, and the order of the -*> triangular matrix A. +*> triangular matrix A. *> M >= 0. *> \endverbatim *> @@ -71,7 +71,7 @@ *> \param[in,out] B *> \verbatim *> B is COMPLEX array, dimension (LDB,N) -*> On entry, the pentagonal M-by-N matrix B. The first N-L columns +*> On entry, the pentagonal M-by-N matrix B. The first N-L columns *> are rectangular, and the last L columns are lower trapezoidal. *> On exit, B contains the pentagonal matrix V. See Further Details. *> \endverbatim @@ -88,7 +88,7 @@ *> The lower triangular block reflectors stored in compact form *> as a sequence of upper triangular blocks. See Further Details. *> \endverbatim -*> +*> *> \param[in] LDT *> \verbatim *> LDT is INTEGER @@ -110,10 +110,10 @@ * 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 2013 * @@ -124,45 +124,45 @@ *> *> \verbatim *> -*> The input matrix C is a M-by-(M+N) matrix +*> The input matrix C is a M-by-(M+N) matrix *> *> C = [ A ] [ B ] -*> +*> *> *> where A is an lower triangular N-by-N matrix, and B is M-by-N pentagonal *> matrix consisting of a M-by-(N-L) rectangular matrix B1 on left of a M-by-L *> upper trapezoidal matrix B2: -*> [ B ] = [ B1 ] [ B2 ] +*> [ B ] = [ B1 ] [ B2 ] *> [ B1 ] <- M-by-(N-L) rectangular *> [ B2 ] <- M-by-L upper trapezoidal. *> *> The lower trapezoidal matrix B2 consists of the first L columns of a -*> N-by-N lower triangular matrix, where 0 <= L <= MIN(M,N). If L=0, -*> B is rectangular M-by-N; if M=L=N, B is lower triangular. +*> N-by-N lower triangular matrix, where 0 <= L <= MIN(M,N). If L=0, +*> B is rectangular M-by-N; if M=L=N, B is lower triangular. *> *> The matrix W stores the elementary reflectors H(i) in the i-th row *> above the diagonal (of A) in the M-by-(M+N) input matrix C -*> [ C ] = [ A ] [ B ] +*> [ C ] = [ A ] [ B ] *> [ A ] <- lower triangular N-by-N *> [ B ] <- M-by-N pentagonal *> *> so that W can be represented as -*> [ W ] = [ I ] [ V ] +*> [ W ] = [ I ] [ V ] *> [ I ] <- identity, N-by-N *> [ V ] <- M-by-N, same form as B. *> *> Thus, all of information needed for W is contained on exit in B, which -*> we call V above. Note that V has the same form as B; that is, -*> [ V ] = [ V1 ] [ V2 ] +*> we call V above. Note that V has the same form as B; that is, +*> [ V ] = [ V1 ] [ V2 ] *> [ V1 ] <- M-by-(N-L) rectangular *> [ V2 ] <- M-by-L lower trapezoidal. *> -*> The rows of V represent the vectors which define the H(i)'s. +*> The rows of V represent the vectors which define the H(i)'s. *> *> The number of blocks is B = ceiling(M/MB), where each -*> block is of order MB except for the last block, which is of order +*> block is of order MB except for the last block, which is of order *> IB = M - (M-1)*MB. For each of the B blocks, a upper triangular block -*> reflector factor is computed: T1, T2, ..., TB. The MB-by-MB (and IB-by-IB +*> reflector factor is computed: T1, T2, ..., TB. The MB-by-MB (and IB-by-IB *> for the last block) T's are stored in the MB-by-N matrix T as *> *> T = [T1 T2 ... TB]. @@ -223,7 +223,7 @@ IF( M.EQ.0 .OR. N.EQ.0 ) RETURN * DO I = 1, M, MB -* +* * Compute the QR factorization of the current block * IB = MIN( M-I+1, MB ) @@ -234,20 +234,20 @@ LB = NB-N+L-I+1 END IF * - CALL CTPLQT2( IB, NB, LB, A(I,I), LDA, B( I, 1 ), LDB, + CALL CTPLQT2( IB, NB, LB, A(I,I), LDA, B( I, 1 ), LDB, $ T(1, I ), LDT, IINFO ) * * Update by applying H**T to B(I+IB:M,:) from the right * IF( I+IB.LE.M ) THEN CALL CTPRFB( 'R', 'N', 'F', 'R', M-I-IB+1, NB, IB, LB, - $ B( I, 1 ), LDB, T( 1, I ), LDT, - $ A( I+IB, I ), LDA, B( I+IB, 1 ), LDB, + $ B( I, 1 ), LDB, T( 1, I ), LDT, + $ A( I+IB, I ), LDA, B( I+IB, 1 ), LDB, $ WORK, M-I-IB+1) END IF END DO RETURN -* +* * End of CTPLQT * END diff --git a/SRC/ctplqt2.f b/SRC/ctplqt2.f index 74979369..0981e399 100644 --- a/SRC/ctplqt2.f +++ b/SRC/ctplqt2.f @@ -2,14 +2,14 @@ * =========== * * SUBROUTINE CTPLQT2( M, N, L, A, LDA, B, LDB, T, LDT, INFO ) -* +* * .. Scalar Arguments .. * INTEGER INFO, LDA, LDB, LDT, N, M, L * .. * .. Array Arguments .. * COMPLEX A( LDA, * ), B( LDB, * ), T( LDT, * ) * .. -* +* * *> \par Purpose: * ============= @@ -17,7 +17,7 @@ *> \verbatim *> *> CTPLQT2 computes a LQ a factorization of a complex "triangular-pentagonal" -*> matrix C, which is composed of a triangular block A and pentagonal block B, +*> matrix C, which is composed of a triangular block A and pentagonal block B, *> using the compact WY representation for Q. *> \endverbatim * @@ -27,7 +27,7 @@ *> \param[in] M *> \verbatim *> M is INTEGER -*> The total number of rows of the matrix B. +*> The total number of rows of the matrix B. *> M >= 0. *> \endverbatim *> @@ -42,7 +42,7 @@ *> \param[in] L *> \verbatim *> L is INTEGER -*> The number of rows of the lower trapezoidal part of B. +*> The number of rows of the lower trapezoidal part of B. *> MIN(M,N) >= L >= 0. See Further Details. *> \endverbatim *> @@ -63,7 +63,7 @@ *> \param[in,out] B *> \verbatim *> B is COMPLEX array, dimension (LDB,N) -*> On entry, the pentagonal M-by-N matrix B. The first N-L columns +*> On entry, the pentagonal M-by-N matrix B. The first N-L columns *> are rectangular, and the last L columns are lower trapezoidal. *> On exit, B contains the pentagonal matrix V. See Further Details. *> \endverbatim @@ -97,10 +97,10 @@ * 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 * @@ -111,10 +111,10 @@ *> *> \verbatim *> -*> The input matrix C is a M-by-(M+N) matrix +*> The input matrix C is a M-by-(M+N) matrix *> *> C = [ A ][ B ] -*> +*> *> *> where A is an lower triangular N-by-N matrix, and B is M-by-N pentagonal *> matrix consisting of a M-by-(N-L) rectangular matrix B1 left of a M-by-L @@ -125,8 +125,8 @@ *> [ B2 ] <- M-by-L lower trapezoidal. *> *> The lower trapezoidal matrix B2 consists of the first L columns of a -*> N-by-N lower triangular matrix, where 0 <= L <= MIN(M,N). If L=0, -*> B is rectangular M-by-N; if M=L=N, B is lower triangular. +*> N-by-N lower triangular matrix, where 0 <= L <= MIN(M,N). If L=0, +*> B is rectangular M-by-N; if M=L=N, B is lower triangular. *> *> The matrix W stores the elementary reflectors H(i) in the i-th row *> above the diagonal (of A) in the M-by-(M+N) input matrix C @@ -137,18 +137,18 @@ *> *> so that W can be represented as *> -*> W = [ I ][ V ] +*> W = [ I ][ V ] *> [ I ] <- identity, N-by-N *> [ V ] <- M-by-N, same form as B. *> *> Thus, all of information needed for W is contained on exit in B, which -*> we call V above. Note that V has the same form as B; that is, +*> we call V above. Note that V has the same form as B; that is, *> -*> W = [ V1 ][ V2 ] +*> W = [ V1 ][ V2 ] *> [ V1 ] <- M-by-(N-L) rectangular *> [ V2 ] <- M-by-L lower trapezoidal. *> -*> The rows of V represent the vectors which define the H(i)'s. +*> The rows of V represent the vectors which define the H(i)'s. *> The (M+N)-by-(M+N) block reflector H is then given by *> *> H = I - W**T * T * W @@ -214,7 +214,7 @@ * Quick return if possible * IF( N.EQ.0 .OR. M.EQ.0 ) RETURN -* +* DO I = 1, M * * Generate elementary reflector H(I) to annihilate B(I,:) @@ -232,7 +232,7 @@ DO J = 1, M-I T( M, J ) = (A( I+J, I )) END DO - CALL CGEMV( 'N', M-I, P, ONE, B( I+1, 1 ), LDB, + CALL CGEMV( 'N', M-I, P, ONE, B( I+1, 1 ), LDB, $ B( I, 1 ), LDB, ONE, T( M, 1 ), LDT ) * * C(I+1:M,I:N) = C(I+1:M,I:N) + alpha * C(I,I:N)*W(M-1:1)^H @@ -274,16 +274,16 @@ * * Rectangular part of B2 * - CALL CGEMV( 'N', I-1-P, L, ALPHA, B( MP, NP ), LDB, + CALL CGEMV( 'N', I-1-P, L, ALPHA, B( MP, NP ), LDB, $ B( I, NP ), LDB, ZERO, T( I,MP ), LDT ) * * B1 * - CALL CGEMV( 'N', I-1, N-L, ALPHA, B, LDB, B( I, 1 ), LDB, - $ ONE, T( I, 1 ), LDT ) + CALL CGEMV( 'N', I-1, N-L, ALPHA, B, LDB, B( I, 1 ), LDB, + $ ONE, T( I, 1 ), LDT ) * - + * * T(1:I-1,I) := T(1:I-1,1:I-1) * T(I,1:I-1) * @@ -296,7 +296,7 @@ END DO DO J = 1, N-L+P B(I,J)=CONJG(B(I,J)) - END DO + END DO * * T(I,I) = tau(I) * @@ -309,7 +309,7 @@ T(J,I)=ZERO END DO END DO - + * * End of CTPLQT2 * diff --git a/SRC/ctpmlqt.f b/SRC/ctpmlqt.f index 411ef72d..f567e6d0 100644 --- a/SRC/ctpmlqt.f +++ b/SRC/ctpmlqt.f @@ -3,23 +3,23 @@ * * SUBROUTINE CTPMLQT( SIDE, TRANS, M, N, K, L, MB, V, LDV, T, LDT, * A, LDA, B, LDB, WORK, INFO ) -* +* * .. Scalar Arguments .. * CHARACTER SIDE, TRANS * INTEGER INFO, K, LDV, LDA, LDB, M, N, L, MB, LDT * .. * .. Array Arguments .. -* COMPLEX V( LDV, * ), A( LDA, * ), B( LDB, * ), +* COMPLEX V( LDV, * ), A( LDA, * ), B( LDB, * ), * $ T( LDT, * ), WORK( * ) * .. -* +* * *> \par Purpose: * ============= *> *> \verbatim *> -*> CTPMQRT applies a complex orthogonal matrix Q obtained from a +*> CTPMQRT applies a complex orthogonal matrix Q obtained from a *> "triangular-pentagonal" real block reflector H to a general *> real matrix C, which consists of two blocks A and B. *> \endverbatim @@ -52,7 +52,7 @@ *> N is INTEGER *> The number of columns of the matrix B. N >= 0. *> \endverbatim -*> +*> *> \param[in] K *> \verbatim *> K is INTEGER @@ -63,7 +63,7 @@ *> \param[in] L *> \verbatim *> L is INTEGER -*> The order of the trapezoidal part of V. +*> The order of the trapezoidal part of V. *> K >= L >= 0. See Further Details. *> \endverbatim *> @@ -107,19 +107,19 @@ *> \param[in,out] A *> \verbatim *> A is COMPLEX array, dimension -*> (LDA,N) if SIDE = 'L' or +*> (LDA,N) if SIDE = 'L' or *> (LDA,K) if SIDE = 'R' *> On entry, the K-by-N or M-by-K matrix A. -*> On exit, A is overwritten by the corresponding block of +*> On exit, A is overwritten by the corresponding block of *> Q*C or Q**C*C or C*Q or C*Q**C. See Further Details. *> \endverbatim *> *> \param[in] LDA *> \verbatim *> LDA is INTEGER -*> The leading dimension of the array A. +*> The leading dimension of the array A. *> If SIDE = 'L', LDC >= max(1,K); -*> If SIDE = 'R', LDC >= max(1,M). +*> If SIDE = 'R', LDC >= max(1,M). *> \endverbatim *> *> \param[in,out] B @@ -133,7 +133,7 @@ *> \param[in] LDB *> \verbatim *> LDB is INTEGER -*> The leading dimension of the array B. +*> The leading dimension of the array B. *> LDB >= max(1,M). *> \endverbatim *> @@ -153,10 +153,10 @@ * 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 2015 * @@ -168,20 +168,20 @@ *> \verbatim *> *> The columns of the pentagonal matrix V contain the elementary reflectors -*> H(1), H(2), ..., H(K); V is composed of a rectangular block V1 and a +*> H(1), H(2), ..., H(K); V is composed of a rectangular block V1 and a *> trapezoidal block V2: *> *> V = [V1] [V2]. -*> *> -*> The size of the trapezoidal block V2 is determined by the parameter L, +*> +*> The size of the trapezoidal block V2 is determined by the parameter L, *> where 0 <= L <= K; V2 is lower trapezoidal, consisting of the first L *> rows of a K-by-K upper triangular matrix. If L=K, V2 is lower triangular; *> if L=0, there is no trapezoidal block, hence V = V1 is rectangular. *> -*> If SIDE = 'L': C = [A] where A is K-by-N, B is M-by-N and V is K-by-M. -*> [B] -*> +*> If SIDE = 'L': C = [A] where A is K-by-N, B is M-by-N and V is K-by-M. +*> [B] +*> *> If SIDE = 'R': C = [A B] where A is M-by-K, B is M-by-N and V is K-by-N. *> *> The real orthogonal matrix Q is formed from V and T. @@ -209,7 +209,7 @@ INTEGER INFO, K, LDV, LDA, LDB, M, N, L, MB, LDT * .. * .. Array Arguments .. - COMPLEX V( LDV, * ), A( LDA, * ), B( LDB, * ), + COMPLEX V( LDV, * ), A( LDA, * ), B( LDB, * ), $ T( LDT, * ), WORK( * ) * .. * @@ -239,7 +239,7 @@ RIGHT = LSAME( SIDE, 'R' ) TRAN = LSAME( TRANS, 'C' ) NOTRAN = LSAME( TRANS, 'N' ) -* +* IF ( LEFT ) THEN LDAQ = MAX( 1, K ) ELSE IF ( RIGHT ) THEN @@ -256,7 +256,7 @@ ELSE IF( K.LT.0 ) THEN INFO = -5 ELSE IF( L.LT.0 .OR. L.GT.K ) THEN - INFO = -6 + INFO = -6 ELSE IF( MB.LT.1 .OR. (MB.GT.K .AND. K.GT.0) ) THEN INFO = -7 ELSE IF( LDV.LT.K ) THEN @@ -288,11 +288,11 @@ ELSE LB = 0 END IF - CALL CTPRFB( 'L', 'C', 'F', 'R', NB, N, IB, LB, - $ V( I, 1 ), LDV, T( 1, I ), LDT, + CALL CTPRFB( 'L', 'C', 'F', 'R', NB, N, IB, LB, + $ V( I, 1 ), LDV, T( 1, I ), LDT, $ A( I, 1 ), LDA, B, LDB, WORK, IB ) END DO -* +* ELSE IF( RIGHT .AND. TRAN ) THEN * DO I = 1, K, MB @@ -303,8 +303,8 @@ ELSE LB = NB-N+L-I+1 END IF - CALL CTPRFB( 'R', 'N', 'F', 'R', M, NB, IB, LB, - $ V( I, 1 ), LDV, T( 1, I ), LDT, + CALL CTPRFB( 'R', 'N', 'F', 'R', M, NB, IB, LB, + $ V( I, 1 ), LDV, T( 1, I ), LDT, $ A( 1, I ), LDA, B, LDB, WORK, M ) END DO * @@ -312,15 +312,15 @@ * KF = ((K-1)/MB)*MB+1 DO I = KF, 1, -MB - IB = MIN( MB, K-I+1 ) + IB = MIN( MB, K-I+1 ) NB = MIN( M-L+I+IB-1, M ) IF( I.GE.L ) THEN LB = 0 ELSE LB = 0 - END IF + END IF CALL CTPRFB( 'L', 'N', 'F', 'R', NB, N, IB, LB, - $ V( I, 1 ), LDV, T( 1, I ), LDT, + $ V( I, 1 ), LDV, T( 1, I ), LDT, $ A( I, 1 ), LDA, B, LDB, WORK, IB ) END DO * @@ -328,7 +328,7 @@ * KF = ((K-1)/MB)*MB+1 DO I = KF, 1, -MB - IB = MIN( MB, K-I+1 ) + IB = MIN( MB, K-I+1 ) NB = MIN( N-L+I+IB-1, N ) IF( I.GE.L ) THEN LB = 0 @@ -336,7 +336,7 @@ LB = NB-N+L-I+1 END IF CALL CTPRFB( 'R', 'C', 'F', 'R', M, NB, IB, LB, - $ V( I, 1 ), LDV, T( 1, I ), LDT, + $ V( I, 1 ), LDV, T( 1, I ), LDT, $ A( 1, I ), LDA, B, LDB, WORK, M ) END DO * diff --git a/SRC/dgelq.f b/SRC/dgelq.f index 4086cd36..d73f7454 100644 --- a/SRC/dgelq.f +++ b/SRC/dgelq.f @@ -1,26 +1,26 @@ -* +* * Definition: * =========== * -* SUBROUTINE DGELQ( M, N, A, LDA, WORK1, LWORK1, WORK2, LWORK2, +* SUBROUTINE DGELQ( M, N, A, LDA, WORK1, LWORK1, WORK2, LWORK2, * INFO) -* +* * .. Scalar Arguments .. * INTEGER INFO, LDA, M, N, LWORK1, LWORK2 * .. * .. Array Arguments .. * DOUBLE PRECISION A( LDA, * ), WORK1( * ), WORK2( * ) * .. -* +* * *> \par Purpose: * ============= *> *> \verbatim -*> -*> DGELQ computes an LQ factorization of an M-by-N matrix A, -*> using DLASWLQ when A is short and wide -*> (N sufficiently greater than M), and otherwise DGELQT: +*> +*> DGELQ computes an LQ factorization of an M-by-N matrix A, +*> using DLASWLQ when A is short and wide +*> (N sufficiently greater than M), and otherwise DGELQT: *> A = L * Q . *> \endverbatim * @@ -43,10 +43,10 @@ *> \verbatim *> A is DOUBLE PRECISION array, dimension (LDA,N) *> On entry, the M-by-N matrix A. -*> On exit, the elements on and below the diagonal of the array -*> contain the M-by-min(M,N) lower trapezoidal matrix L +*> On exit, the elements on and below the diagonal of the array +*> contain the M-by-min(M,N) lower trapezoidal matrix L *> (L is lower triangular if M <= N); -*> the elements above the diagonal are the rows of +*> the elements above the diagonal are the rows of *> blocked V representing Q (see Further Details). *> \endverbatim *> @@ -60,13 +60,13 @@ *> \verbatim *> WORK1 is DOUBLE PRECISION array, dimension (MAX(1,LWORK1)) *> WORK1 contains part of the data structure used to store Q. -*> WORK1(1): algorithm type = 1, to indicate output from +*> WORK1(1): algorithm type = 1, to indicate output from *> DLASWLQ or DGELQT *> WORK1(2): optimum size of WORK1 *> WORK1(3): minimum size of WORK1 *> WORK1(4): horizontal block size *> WORK1(5): vertical block size -*> WORK1(6:LWORK1): data structure needed for Q, computed by +*> WORK1(6:LWORK1): data structure needed for Q, computed by *> DLASWLQ or DGELQT *> \endverbatim *> @@ -74,25 +74,25 @@ *> \verbatim *> LWORK1 is INTEGER *> The dimension of the array WORK1. -*> If LWORK1 = -1, then a query is assumed. In this case the +*> If LWORK1 = -1, then a query is assumed. In this case the *> routine calculates the optimal size of WORK1 and -*> returns this value in WORK1(2), and calculates the minimum -*> size of WORK1 and returns this value in WORK1(3). -*> No error message related to LWORK1 is issued by XERBLA when +*> returns this value in WORK1(2), and calculates the minimum +*> size of WORK1 and returns this value in WORK1(3). +*> No error message related to LWORK1 is issued by XERBLA when *> LWORK1 = -1. *> \endverbatim *> *> \param[out] WORK2 *> \verbatim *> (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK2)) -*> +*> *> \endverbatim *> \param[in] LWORK2 *> \verbatim *> LWORK2 is INTEGER *> The dimension of the array WORK2. *> If LWORK2 = -1, then a query is assumed. In this case the -*> routine calculates the optimal size of WORK2 and +*> routine calculates the optimal size of WORK2 and *> returns this value in WORK2(1), and calculates the minimum *> size of WORK2 and returns this value in WORK2(2). *> No error message related to LWORK2 is issued by XERBLA when @@ -121,20 +121,20 @@ *> Depending on the matrix dimensions M and N, and row and column *> block sizes MB and NB returned by ILAENV, GELQ will use either *> LASWLQ(if the matrix is short-and-wide) or GELQT to compute -*> the LQ decomposition. +*> the LQ decomposition. *> The output of LASWLQ or GELQT representing Q is stored in A and in -*> array WORK1(6:LWORK1) for later use. -*> WORK1(2:5) contains the matrix dimensions M,N and block sizes MB, NB -*> which are needed to interpret A and WORK1(6:LWORK1) for later use. -*> WORK1(1)=1 indicates that the code needed to take WORK1(2:5) and +*> array WORK1(6:LWORK1) for later use. +*> WORK1(2:5) contains the matrix dimensions M,N and block sizes MB, NB +*> which are needed to interpret A and WORK1(6:LWORK1) for later use. +*> WORK1(1)=1 indicates that the code needed to take WORK1(2:5) and *> decide whether LASWLQ or GELQT was used is the same as used below in -*> GELQ. For a detailed description of A and WORK1(6:LWORK1), see +*> GELQ. For a detailed description of A and WORK1(6:LWORK1), see *> Further Details in LASWLQ or GELQT. *> \endverbatim *> *> * ===================================================================== - SUBROUTINE DGELQ( M, N, A, LDA, WORK1, LWORK1, WORK2, LWORK2, + SUBROUTINE DGELQ( M, N, A, LDA, WORK1, LWORK1, WORK2, LWORK2, $ INFO) * * -- LAPACK computational routine (version 3.5.0) -- @@ -176,8 +176,8 @@ * LQUERY = ( LWORK1.EQ.-1 .OR. LWORK2.EQ.-1 ) * -* Determine the block size -* +* Determine the block size +* IF ( MIN(M,N).GT.0 ) THEN MB = ILAENV( 1, 'DGELQ ', ' ', M, N, 1, -1) NB = ILAENV( 1, 'DGELQ ', ' ', M, N, 2, -1) @@ -199,7 +199,7 @@ END IF * * Determine if the workspace size satisfies minimum size -* +* LMINWS = .FALSE. IF((LWORK1.LT.MAX(1,MB*M*NBLCKS+5) $ .OR.(LWORK2.LT.MB*M)).AND.(LWORK2.GE.M).AND.(LWORK1.GE.M+5) @@ -207,10 +207,10 @@ IF (LWORK1.LT.MAX(1,MB*M*NBLCKS+5)) THEN LMINWS = .TRUE. MB = 1 - END IF + END IF IF (LWORK1.LT.MAX(1,M*NBLCKS+5)) THEN LMINWS = .TRUE. - NB = N + NB = N END IF IF (LWORK2.LT.MB*M) THEN LMINWS = .TRUE. @@ -224,13 +224,13 @@ INFO = -2 ELSE IF( LDA.LT.MAX( 1, M ) ) THEN INFO = -4 - ELSE IF( LWORK1.LT.MAX( 1, MB*M*NBLCKS+5 ) + ELSE IF( LWORK1.LT.MAX( 1, MB*M*NBLCKS+5 ) $ .AND.(.NOT.LQUERY).AND. (.NOT.LMINWS)) THEN INFO = -6 ELSE IF( (LWORK2.LT.MAX(1,M*MB)).AND.(.NOT.LQUERY) $ .AND.(.NOT.LMINWS) ) THEN - INFO = -8 - END IF + INFO = -8 + END IF * IF( INFO.EQ.0) THEN WORK1(1) = 1 @@ -258,12 +258,12 @@ * IF((N.LE.M).OR.(NB.LE.M).OR.(NB.GE.N)) THEN CALL DGELQT( M, N, MB, A, LDA, WORK1(6), MB, WORK2, INFO) - ELSE - CALL DLASWLQ( M, N, MB, NB, A, LDA, WORK1(6), MB, WORK2, + ELSE + CALL DLASWLQ( M, N, MB, NB, A, LDA, WORK1(6), MB, WORK2, $ LWORK2, INFO) END IF RETURN -* +* * End of DGELQ * - END
\ No newline at end of file + END diff --git a/SRC/dgelqt.f b/SRC/dgelqt.f index 0f301699..f826abdd 100644 --- a/SRC/dgelqt.f +++ b/SRC/dgelqt.f @@ -2,31 +2,31 @@ * * =========== 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 DGEQRT + dependencies -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgelqt.f"> -*> [TGZ]</a> -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgelqt.f"> -*> [ZIP]</a> -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgelqt.f"> +*> Download DGEQRT + dependencies +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgelqt.f"> +*> [TGZ]</a> +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgelqt.f"> +*> [ZIP]</a> +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgelqt.f"> *> [TXT]</a> -*> \endhtmlonly +*> \endhtmlonly * * Definition: * =========== * * SUBROUTINE DGELQT( M, N, MB, A, LDA, T, LDT, WORK, INFO ) -* +* * .. Scalar Arguments .. * INTEGER INFO, LDA, LDT, M, N, MB * .. * .. Array Arguments .. * DOUBLE PRECISION A( LDA, * ), T( LDT, * ), WORK( * ) * .. -* +* * *> \par Purpose: * ============= @@ -34,7 +34,7 @@ *> \verbatim *> *> DGELQT computes a blocked LQ factorization of a real M-by-N matrix A -*> using the compact WY representation of Q. +*> using the compact WY representation of Q. *> \endverbatim * * Arguments: @@ -103,10 +103,10 @@ * 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 2013 * @@ -123,14 +123,14 @@ *> V = ( 1 v1 v1 v1 v1 ) *> ( 1 v2 v2 v2 ) *> ( 1 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. +*> in the matrix A. The 1's along the diagonal of V are not stored in A. *> Let K=MIN(M,N). The number of blocks is B = ceiling(K/NB), where each -*> block is of order NB except for the last block, which is of order +*> block is of order NB except for the last block, which is of order *> IB = K - (B-1)*NB. For each of the B blocks, a upper triangular block -*> reflector factor is computed: T1, T2, ..., TB. The NB-by-NB (and IB-by-IB +*> reflector factor is computed: T1, T2, ..., TB. The NB-by-NB (and IB-by-IB *> for the last block) T's are stored in the NB-by-N matrix T as *> *> T = (T1 T2 ... TB). @@ -190,21 +190,21 @@ * DO I = 1, K, MB IB = MIN( K-I+1, MB ) -* +* * Compute the LQ factorization of the current block A(I:M,I:I+IB-1) -* +* CALL DGELQT3( IB, N-I+1, A(I,I), LDA, T(1,I), LDT, IINFO ) IF( I+IB.LE.M ) THEN * * Update by applying H**T to A(I:M,I+IB:N) from the right * CALL DLARFB( 'R', 'N', 'F', 'R', M-I-IB+1, N-I+1, IB, - $ A( I, I ), LDA, T( 1, I ), LDT, + $ A( I, I ), LDA, T( 1, I ), LDT, $ A( I+IB, I ), LDA, WORK , M-I-IB+1 ) END IF END DO RETURN -* +* * End of DGELQT * END diff --git a/SRC/dgemlq.f b/SRC/dgemlq.f index 8cf911b3..7bdf97a1 100644 --- a/SRC/dgemlq.f +++ b/SRC/dgemlq.f @@ -1,8 +1,8 @@ -* +* * Definition: * =========== * -* SUBROUTINE DGEMLQ( SIDE, TRANS, M, N, K, A, LDA, WORK1, +* SUBROUTINE DGEMLQ( SIDE, TRANS, M, N, K, A, LDA, WORK1, * $ LWORK1, C, LDC, WORK2, LWORK2, INFO ) * * @@ -17,15 +17,15 @@ * ============= *> *> \verbatim -*> +*> *> DGEMLQ overwrites the general real M-by-N matrix C with *> -*> +*> *> SIDE = 'L' SIDE = 'R' *> TRANS = 'N': Q * C C * Q *> TRANS = 'T': Q**T * C C * Q**T -*> where Q is a real orthogonal matrix defined as the product -*> of blocked elementary reflectors computed by short wide LQ +*> where Q is a real orthogonal matrix defined as the product +*> of blocked elementary reflectors computed by short wide LQ *> factorization (DGELQ) *> \endverbatim * @@ -59,7 +59,7 @@ *> The number of elementary reflectors whose product defines *> the matrix Q. *> M >= K >= 0; -*> +*> *> \endverbatim *> *> \param[in,out] A @@ -101,15 +101,15 @@ *> \param[out] WORK2 *> \verbatim *> (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK2)) -*> +*> *> \endverbatim *> \param[in] LWORK2 *> \verbatim *> LWORK2 is INTEGER -*> The dimension of the array WORK2. +*> The dimension of the array WORK2. *> If LWORK2 = -1, then a workspace query is assumed; the routine *> only calculates the optimal size of the WORK2 array, returns -*> this value as the third entry of the WORK2 array (WORK2(1)), +*> this value as the third entry of the WORK2 array (WORK2(1)), *> and no error message related to LWORK2 is issued by XERBLA. *> *> \endverbatim @@ -135,19 +135,19 @@ *> Depending on the matrix dimensions M and N, and row and column *> block sizes MB and NB returned by ILAENV, GELQ will use either *> LASWLQ(if the matrix is short-and-wide) or GELQT to compute -*> the LQ decomposition. +*> the LQ decomposition. *> The output of LASWLQ or GELQT representing Q is stored in A and in -*> array WORK1(6:LWORK1) for later use. -*> WORK1(2:5) contains the matrix dimensions M,N and block sizes MB, NB -*> which are needed to interpret A and WORK1(6:LWORK1) for later use. -*> WORK1(1)=1 indicates that the code needed to take WORK1(2:5) and +*> array WORK1(6:LWORK1) for later use. +*> WORK1(2:5) contains the matrix dimensions M,N and block sizes MB, NB +*> which are needed to interpret A and WORK1(6:LWORK1) for later use. +*> WORK1(1)=1 indicates that the code needed to take WORK1(2:5) and *> decide whether LASWLQ or GELQT was used is the same as used below in -*> GELQ. For a detailed description of A and WORK1(6:LWORK1), see +*> GELQ. For a detailed description of A and WORK1(6:LWORK1), see *> Further Details in LASWLQ or GELQT. *> \endverbatim *> * ===================================================================== - SUBROUTINE DGEMLQ( SIDE, TRANS, M, N, K, A, LDA, WORK1, LWORK1, + SUBROUTINE DGEMLQ( SIDE, TRANS, M, N, K, A, LDA, WORK1, LWORK1, $ C, LDC, WORK2, LWORK2, INFO ) * * -- LAPACK computational routine (version 3.5.0) -- @@ -242,12 +242,12 @@ * IF( MIN(M,N,K).EQ.0 ) THEN RETURN - END IF + END IF * IF((LEFT.AND.M.LE.K).OR.(RIGHT.AND.N.LE.K).OR.(NB.LE.K).OR. $ (NB.GE.MAX(M,N,K))) THEN - CALL DGEMLQT( SIDE, TRANS, M, N, K, MB, A, LDA, - $ WORK1(6), MB, C, LDC, WORK2, INFO) + CALL DGEMLQT( SIDE, TRANS, M, N, K, MB, A, LDA, + $ WORK1(6), MB, C, LDC, WORK2, INFO) ELSE CALL DLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, WORK1(6), $ MB, C, LDC, WORK2, LWORK2, INFO ) @@ -259,4 +259,4 @@ * * End of DGEMLQ * - END
\ No newline at end of file + END diff --git a/SRC/dgemlqt.f b/SRC/dgemlqt.f index ebf3e476..0519a4d0 100644 --- a/SRC/dgemlqt.f +++ b/SRC/dgemlqt.f @@ -2,25 +2,25 @@ * * =========== 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 DGEMQRT + dependencies -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgemlqt.f"> -*> [TGZ]</a> -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgemlqt.f"> -*> [ZIP]</a> -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgemlqt.f"> +*> Download DGEMQRT + dependencies +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgemlqt.f"> +*> [TGZ]</a> +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgemlqt.f"> +*> [ZIP]</a> +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgemlqt.f"> *> [TXT]</a> -*> \endhtmlonly +*> \endhtmlonly * * Definition: * =========== * -* SUBROUTINE DGEMLQT( SIDE, TRANS, M, N, K, MB, V, LDV, T, LDT, +* SUBROUTINE DGEMLQT( SIDE, TRANS, M, N, K, MB, V, LDV, T, LDT, * C, LDC, WORK, INFO ) -* +* * .. Scalar Arguments .. * CHARACTER SIDE, TRANS * INTEGER INFO, K, LDV, LDC, M, N, MB, LDT @@ -28,7 +28,7 @@ * .. Array Arguments .. * DOUBLE PRECISION V( LDV, * ), C( LDC, * ), T( LDT, * ), WORK( * ) * .. -* +* * *> \par Purpose: * ============= @@ -46,7 +46,7 @@ *> *> Q = H(1) H(2) . . . H(K) = I - V T V**T *> -*> generated using the compact WY representation as returned by DGELQT. +*> generated using the compact WY representation as returned by DGELQT. *> *> Q is of order M if SIDE = 'L' and of order N if SIDE = 'R'. *> \endverbatim @@ -155,17 +155,17 @@ * 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 2013 * *> \ingroup doubleGEcomputational * * ===================================================================== - SUBROUTINE DGEMLQT( SIDE, TRANS, M, N, K, MB, V, LDV, T, LDT, + SUBROUTINE DGEMLQT( SIDE, TRANS, M, N, K, MB, V, LDV, T, LDT, $ C, LDC, WORK, INFO ) * * -- LAPACK computational routine (version 3.5.0) -- @@ -207,7 +207,7 @@ RIGHT = LSAME( SIDE, 'R' ) TRAN = LSAME( TRANS, 'T' ) NOTRAN = LSAME( TRANS, 'N' ) -* +* IF( LEFT ) THEN LDWORK = MAX( 1, N ) ELSE IF ( RIGHT ) THEN @@ -246,17 +246,17 @@ * DO I = 1, K, MB IB = MIN( MB, K-I+1 ) - CALL DLARFB( 'L', 'T', 'F', 'R', M-I+1, N, IB, - $ V( I, I ), LDV, T( 1, I ), LDT, + CALL DLARFB( 'L', 'T', 'F', 'R', M-I+1, N, IB, + $ V( I, I ), LDV, T( 1, I ), LDT, $ C( I, 1 ), LDC, WORK, LDWORK ) END DO -* +* ELSE IF( RIGHT .AND. TRAN ) THEN * DO I = 1, K, MB IB = MIN( MB, K-I+1 ) - CALL DLARFB( 'R', 'N', 'F', 'R', M, N-I+1, IB, - $ V( I, I ), LDV, T( 1, I ), LDT, + CALL DLARFB( 'R', 'N', 'F', 'R', M, N-I+1, IB, + $ V( I, I ), LDV, T( 1, I ), LDT, $ C( 1, I ), LDC, WORK, LDWORK ) END DO * @@ -264,9 +264,9 @@ * KF = ((K-1)/MB)*MB+1 DO I = KF, 1, -MB - IB = MIN( MB, K-I+1 ) - CALL DLARFB( 'L', 'N', 'F', 'R', M-I+1, N, IB, - $ V( I, I ), LDV, T( 1, I ), LDT, + IB = MIN( MB, K-I+1 ) + CALL DLARFB( 'L', 'N', 'F', 'R', M-I+1, N, IB, + $ V( I, I ), LDV, T( 1, I ), LDT, $ C( I, 1 ), LDC, WORK, LDWORK ) END DO * @@ -274,9 +274,9 @@ * KF = ((K-1)/MB)*MB+1 DO I = KF, 1, -MB - IB = MIN( MB, K-I+1 ) - CALL DLARFB( 'R', 'T', 'F', 'R', M, N-I+1, IB, - $ V( I, I ), LDV, T( 1, I ), LDT, + IB = MIN( MB, K-I+1 ) + CALL DLARFB( 'R', 'T', 'F', 'R', M, N-I+1, IB, + $ V( I, I ), LDV, T( 1, I ), LDT, $ C( 1, I ), LDC, WORK, LDWORK ) END DO * diff --git a/SRC/dgemqr.f b/SRC/dgemqr.f index 73c84bf6..0ceea6fe 100644 --- a/SRC/dgemqr.f +++ b/SRC/dgemqr.f @@ -1,8 +1,8 @@ -* +* * Definition: * =========== * -* SUBROUTINE DGEMQR( SIDE, TRANS, M, N, K, A, LDA, WORK1, +* SUBROUTINE DGEMQR( SIDE, TRANS, M, N, K, A, LDA, WORK1, * $ LWORK1, C, LDC, WORK2, LWORK2, INFO ) * * @@ -14,21 +14,21 @@ * DOUBLE PRECISION A( LDA, * ), WORK1( * ), C(LDC, * ), * $ WORK2( * ) * .. -* +* * *> \par Purpose: * ============= *> *> \verbatim -*> +*> *> SGEMQR overwrites the general real M-by-N matrix C with *> -*> +*> *> SIDE = 'L' SIDE = 'R' *> TRANS = 'N': Q * C C * Q *> TRANS = 'T': Q**T * C C * Q**T -*> where Q is a real orthogonal matrix defined as the product -*> of blocked elementary reflectors computed by tall skinny +*> where Q is a real orthogonal matrix defined as the product +*> of blocked elementary reflectors computed by tall skinny *> QR factorization (DGEQR) *> \endverbatim * @@ -62,15 +62,15 @@ *> The number of elementary reflectors whose product defines *> the matrix Q. *> N >= K >= 0; -*> +*> *> \endverbatim *> *> \param[in,out] A *> \verbatim *> A is DOUBLE PRECISION array, dimension (LDA,K) -*> The i-th column must contain the vector which defines the -*> blockedelementary reflector H(i), for i = 1,2,...,k, as -*> returned by DGETSQR in the first k columns of +*> The i-th column must contain the vector which defines the +*> blockedelementary reflector H(i), for i = 1,2,...,k, as +*> returned by DGETSQR in the first k columns of *> its array argument A. *> \endverbatim *> @@ -106,15 +106,15 @@ *> \param[out] WORK2 *> \verbatim *> (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK2)) -*> +*> *> \endverbatim *> \param[in] LWORK2 *> \verbatim *> LWORK2 is INTEGER -*> The dimension of the array WORK2. +*> The dimension of the array WORK2. *> If LWORK2 = -1, then a workspace query is assumed; the routine *> only calculates the optimal size of the WORK2 array, returns -*> this value as the third entry of the WORK2 array (WORK2(1)), +*> this value as the third entry of the WORK2 array (WORK2(1)), *> and no error message related to LWORK2 is issued by XERBLA. *> *> \endverbatim @@ -140,19 +140,19 @@ *> Depending on the matrix dimensions M and N, and row and column *> block sizes MB and NB returned by ILAENV, GEQR will use either *> LATSQR (if the matrix is tall-and-skinny) or GEQRT to compute -*> the QR decomposition. +*> the QR decomposition. *> The output of LATSQR or GEQRT representing Q is stored in A and in -*> array WORK1(6:LWORK1) for later use. -*> WORK1(2:5) contains the matrix dimensions M,N and block sizes MB,NB -*> which are needed to interpret A and WORK1(6:LWORK1) for later use. -*> WORK1(1)=1 indicates that the code needed to take WORK1(2:5) and -*> decide whether LATSQR or GEQRT was used is the same as used below in +*> array WORK1(6:LWORK1) for later use. +*> WORK1(2:5) contains the matrix dimensions M,N and block sizes MB,NB +*> which are needed to interpret A and WORK1(6:LWORK1) for later use. +*> WORK1(1)=1 indicates that the code needed to take WORK1(2:5) and +*> decide whether LATSQR or GEQRT was used is the same as used below in *> GEQR. For a detailed description of A and WORK1(6:LWORK1), see *> Further Details in LATSQR or GEQRT. *> \endverbatim *> * ===================================================================== - SUBROUTINE DGEMQR( SIDE, TRANS, M, N, K, A, LDA, WORK1, LWORK1, + SUBROUTINE DGEMQR( SIDE, TRANS, M, N, K, A, LDA, WORK1, LWORK1, $ C, LDC, WORK2, LWORK2, INFO ) * * -- LAPACK computational routine (version 3.5.0) -- @@ -180,7 +180,7 @@ LOGICAL LSAME EXTERNAL LSAME * .. External Subroutines .. - EXTERNAL DGEMQRT, DTPMQRT, XERBLA + EXTERNAL DGEMQRT, DTPMQRT, XERBLA * .. Intrinsic Functions .. INTRINSIC INT, MAX, MIN, MOD * .. @@ -202,7 +202,7 @@ ELSE IF(RIGHT) THEN LW = MB * NB MN = N - END IF + END IF * IF ((MB.GT.K).AND.(MN.GT.K)) THEN IF(MOD(MN-K, MB-K).EQ.0) THEN @@ -236,9 +236,9 @@ END IF * * Determine the block size if it is tall skinny or short and wide -* +* IF( INFO.EQ.0) THEN - WORK2(1) = LW + WORK2(1) = LW END IF * IF( INFO.NE.0 ) THEN @@ -256,17 +256,17 @@ * IF((LEFT.AND.M.LE.K).OR.(RIGHT.AND.N.LE.K).OR.(MB.LE.K).OR. $ (MB.GE.MAX(M,N,K))) THEN - CALL DGEMQRT( SIDE, TRANS, M, N, K, NB, A, LDA, - $ WORK1(6), NB, C, LDC, WORK2, INFO) + CALL DGEMQRT( SIDE, TRANS, M, N, K, NB, A, LDA, + $ WORK1(6), NB, C, LDC, WORK2, INFO) ELSE CALL DLAMTSQR( SIDE, TRANS, M, N, K, MB, NB, A, LDA, WORK1(6), $ NB, C, LDC, WORK2, LWORK2, INFO ) - END IF + END IF * WORK2(1) = LW -* +* RETURN * * End of DGEMQR * - END
\ No newline at end of file + END diff --git a/SRC/dgeqr.f b/SRC/dgeqr.f index e0c6d75b..da0fc4ad 100644 --- a/SRC/dgeqr.f +++ b/SRC/dgeqr.f @@ -1,26 +1,26 @@ -* +* * Definition: * =========== * * SUBROUTINE DGEQR( M, N, A, LDA, WORK1, LWORK1, WORK2, LWORK2, * INFO) -* +* * .. Scalar Arguments .. * INTEGER INFO, LDA, M, N, LWORK1, LWORK2 * .. * .. Array Arguments .. * DOUBLE PRECISION A( LDA, * ), WORK1( * ), WORK2( * ) * .. -* +* * *> \par Purpose: * ============= *> *> \verbatim -*> -*> DGEQR computes a QR factorization of an M-by-N matrix A, -*> using DLATSQR when A is tall and skinny -*> (M sufficiently greater than N), and otherwise DGEQRT: +*> +*> DGEQR computes a QR factorization of an M-by-N matrix A, +*> using DLATSQR when A is tall and skinny +*> (M sufficiently greater than N), and otherwise DGEQRT: *> A = Q * R . *> \endverbatim * @@ -44,7 +44,7 @@ *> A is DOUBLE PRECISION array, dimension (LDA,N) *> On entry, the M-by-N matrix A. *> On exit, the elements on and above the diagonal of the array -*> contain the min(M,N)-by-N upper trapezoidal matrix R +*> contain the min(M,N)-by-N upper trapezoidal matrix R *> (R is upper triangular if M >= N); *> the elements below the diagonal represent Q (see Further Details). *> \endverbatim @@ -59,13 +59,13 @@ *> \verbatim *> WORK1 is DOUBLE PRECISION array, dimension (MAX(1,LWORK1)) *> WORK1 contains part of the data structure used to store Q. -*> WORK1(1): algorithm type = 1, to indicate output from +*> WORK1(1): algorithm type = 1, to indicate output from *> DLATSQR or DGEQRT *> WORK1(2): optimum size of WORK1 *> WORK1(3): minimum size of WORK1 *> WORK1(4): row block size *> WORK1(5): column block size -*> WORK1(6:LWORK1): data structure needed for Q, computed by +*> WORK1(6:LWORK1): data structure needed for Q, computed by *> DLATSQR or DGEQRT *> \endverbatim *> @@ -73,25 +73,25 @@ *> \verbatim *> LWORK1 is INTEGER *> The dimension of the array WORK1. -*> If LWORK1 = -1, then a query is assumed. In this case the +*> If LWORK1 = -1, then a query is assumed. In this case the *> routine calculates the optimal size of WORK1 and -*> returns this value in WORK1(2), and calculates the minimum -*> size of WORK1 and returns this value in WORK1(3). -*> No error message related to LWORK1 is issued by XERBLA when +*> returns this value in WORK1(2), and calculates the minimum +*> size of WORK1 and returns this value in WORK1(3). +*> No error message related to LWORK1 is issued by XERBLA when *> LWORK1 = -1. *> \endverbatim *> *> \param[out] WORK2 *> \verbatim -*> (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK2)) +*> (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK2)) *> \endverbatim *> *> \param[in] LWORK2 *> \verbatim *> LWORK2 is INTEGER *> The dimension of the array WORK2. -*> If LWORK2 = -1, then a query is assumed. In this case the -*> routine calculates the optimal size of WORK2 and +*> If LWORK2 = -1, then a query is assumed. In this case the +*> routine calculates the optimal size of WORK2 and *> returns this value in WORK2(1), and calculates the minimum *> size of WORK2 and returns this value in WORK2(2). *> No error message related to LWORK2 is issued by XERBLA when @@ -120,19 +120,19 @@ *> Depending on the matrix dimensions M and N, and row and column *> block sizes MB and NB returned by ILAENV, GEQR will use either *> LATSQR (if the matrix is tall-and-skinny) or GEQRT to compute -*> the QR decomposition. +*> the QR decomposition. *> The output of LATSQR or GEQRT representing Q is stored in A and in -*> array WORK1(6:LWORK1) for later use. -*> WORK1(2:5) contains the matrix dimensions M,N and block sizes MB,NB -*> which are needed to interpret A and WORK1(6:LWORK1) for later use. -*> WORK1(1)=1 indicates that the code needed to take WORK1(2:5) and -*> decide whether LATSQR or GEQRT was used is the same as used below in -*> GEQR. For a detailed description of A and WORK1(6:LWORK1), see +*> array WORK1(6:LWORK1) for later use. +*> WORK1(2:5) contains the matrix dimensions M,N and block sizes MB,NB +*> which are needed to interpret A and WORK1(6:LWORK1) for later use. +*> WORK1(1)=1 indicates that the code needed to take WORK1(2:5) and +*> decide whether LATSQR or GEQRT was used is the same as used below in +*> GEQR. For a detailed description of A and WORK1(6:LWORK1), see *> Further Details in LATSQR or GEQRT. *> \endverbatim *> * ===================================================================== - SUBROUTINE DGEQR( M, N, A, LDA, WORK1, LWORK1, WORK2, LWORK2, + SUBROUTINE DGEQR( M, N, A, LDA, WORK1, LWORK1, WORK2, LWORK2, $ INFO) * * -- LAPACK computational routine (version 3.5.0) -- @@ -174,8 +174,8 @@ * LQUERY = ( LWORK1.EQ.-1 .OR. LWORK2.EQ.-1 ) * -* Determine the block size -* +* Determine the block size +* IF ( MIN(M,N).GT.0 ) THEN MB = ILAENV( 1, 'DGEQR ', ' ', M, N, 1, -1) NB = ILAENV( 1, 'DGEQR ', ' ', M, N, 2, -1) @@ -197,18 +197,18 @@ END IF * * Determine if the workspace size satisfies minimum size -* +* LMINWS = .FALSE. - IF((LWORK1.LT.MAX(1, NB*N*NBLCKS+5) - $ .OR.(LWORK2.LT.NB*N)).AND.(LWORK2.GE.N).AND.(LWORK1.GT.N+5) + IF((LWORK1.LT.MAX(1, NB*N*NBLCKS+5) + $ .OR.(LWORK2.LT.NB*N)).AND.(LWORK2.GE.N).AND.(LWORK1.GT.N+5) $ .AND.(.NOT.LQUERY)) THEN IF (LWORK1.LT.MAX(1, NB * N * NBLCKS+5)) THEN LMINWS = .TRUE. NB = 1 - END IF + END IF IF (LWORK1.LT.MAX(1, N * NBLCKS+5)) THEN LMINWS = .TRUE. - MB = M + MB = M END IF IF (LWORK2.LT.NB*N) THEN LMINWS = .TRUE. @@ -222,13 +222,13 @@ INFO = -2 ELSE IF( LDA.LT.MAX( 1, M ) ) THEN INFO = -4 - ELSE IF( LWORK1.LT.MAX( 1, NB * N * NBLCKS + 5 ) + ELSE IF( LWORK1.LT.MAX( 1, NB * N * NBLCKS + 5 ) $ .AND.(.NOT.LQUERY).AND.(.NOT.LMINWS)) THEN INFO = -6 - ELSE IF( (LWORK2.LT.MAX(1,N*NB)).AND.(.NOT.LQUERY) + ELSE IF( (LWORK2.LT.MAX(1,N*NB)).AND.(.NOT.LQUERY) $ .AND.(.NOT.LMINWS)) THEN - INFO = -8 - END IF + INFO = -8 + END IF IF( INFO.EQ.0) THEN WORK1(1) = 1 @@ -256,12 +256,12 @@ * IF((M.LE.N).OR.(MB.LE.N).OR.(MB.GE.M)) THEN CALL DGEQRT( M, N, NB, A, LDA, WORK1(6), NB, WORK2, INFO) - ELSE - CALL DLATSQR( M, N, MB, NB, A, LDA, WORK1(6), NB, WORK2, + ELSE + CALL DLATSQR( M, N, MB, NB, A, LDA, WORK1(6), NB, WORK2, $ LWORK2, INFO) END IF RETURN -* +* * End of DGEQR * - END
\ No newline at end of file + END diff --git a/SRC/dgetsls.f b/SRC/dgetsls.f index fb797f12..b619f1d6 100644 --- a/SRC/dgetsls.f +++ b/SRC/dgetsls.f @@ -472,4 +472,4 @@ * * End of DGETSLS * - END
\ No newline at end of file + END diff --git a/SRC/dlamswlq.f b/SRC/dlamswlq.f index 6230e65f..3bf0e798 100644 --- a/SRC/dlamswlq.f +++ b/SRC/dlamswlq.f @@ -1,8 +1,8 @@ -* +* * Definition: * =========== * -* SUBROUTINE DLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, +* SUBROUTINE DLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, * $ LDT, C, LDC, WORK, LWORK, INFO ) * * @@ -17,15 +17,15 @@ * ============= *> *> \verbatim -*> +*> *> DLAMQRTS overwrites the general real M-by-N matrix C with *> -*> +*> *> SIDE = 'L' SIDE = 'R' *> TRANS = 'N': Q * C C * Q *> TRANS = 'T': Q**T * C C * Q**T *> where Q is a real orthogonal matrix defined as the product of blocked -*> elementary reflectors computed by short wide LQ +*> elementary reflectors computed by short wide LQ *> factorization (DLASWLQ) *> \endverbatim * @@ -59,28 +59,28 @@ *> The number of elementary reflectors whose product defines *> the matrix Q. *> M >= K >= 0; -*> +*> *> \endverbatim *> \param[in] MB *> \verbatim *> MB is INTEGER -*> The row block size to be used in the blocked QR. -*> M >= MB >= 1 +*> The row block size to be used in the blocked QR. +*> M >= MB >= 1 *> \endverbatim *> *> \param[in] NB *> \verbatim *> NB is INTEGER -*> The column block size to be used in the blocked QR. +*> The column block size to be used in the blocked QR. *> NB > M. *> \endverbatim *> *> \param[in] NB *> \verbatim *> NB is INTEGER -*> The block size to be used in the blocked QR. +*> The block size to be used in the blocked QR. *> MB > M. -*> +*> *> \endverbatim *> *> \param[in,out] A @@ -101,7 +101,7 @@ *> *> \param[in] T *> \verbatim -*> T is DOUBLE PRECISION array, dimension +*> T is DOUBLE PRECISION array, dimension *> ( M * Number of blocks(CEIL(N-K/NB-K)), *> The blocked upper triangular block reflectors stored in compact form *> as a sequence of upper triangular blocks. See below @@ -125,7 +125,7 @@ *> \param[out] WORK *> \verbatim *> (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK)) -*> +*> *> \endverbatim *> \param[in] LWORK *> \verbatim @@ -177,7 +177,7 @@ *> block reflectors, stored in array T(1:LDT,(i-1)*M+1:i*M). *> The last Q(k) may use fewer rows. *> For more information see Further Details in TPQRT. -*> +*> *> For more details of the overall algorithm, see the description of *> Sequential TSQR in Section 2.2 of [1]. *> @@ -187,7 +187,7 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE DLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, + SUBROUTINE DLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, $ LDT, C, LDC, WORK, LWORK, INFO ) * * -- LAPACK computational routine (version 3.5.0) -- @@ -266,11 +266,11 @@ * IF( MIN(M,N,K).EQ.0 ) THEN RETURN - END IF + END IF * IF((NB.LE.K).OR.(NB.GE.MAX(M,N,K))) THEN - CALL DGEMLQT( SIDE, TRANS, M, N, K, MB, A, LDA, - $ T, LDT, C, LDC, WORK, INFO) + CALL DGEMLQT( SIDE, TRANS, M, N, K, MB, A, LDA, + $ T, LDT, C, LDC, WORK, INFO) RETURN END IF * @@ -354,7 +354,7 @@ * * Multiply Q to the current block of C (1:M,I:I+MB) * - CTR = CTR - 1 + CTR = CTR - 1 CALL DTPMLQT('R','N', M, NB-K, K, 0, MB, A(1, I), LDA, $ T(1,CTR*K+1), LDT, C(1,1), LDC, $ C(1,I), LDC, WORK, INFO ) @@ -389,7 +389,7 @@ IF(II.LE.N) THEN * * Multiply Q to the last block of C -* +* CALL DTPMLQT('R','T',M , KK, K, 0,MB, A(1,II), LDA, $ T(1,CTR*K+1),LDT, C(1,1), LDC, $ C(1,II), LDC, WORK, INFO ) @@ -403,4 +403,4 @@ * * End of DLAMSWLQ * - END
\ No newline at end of file + END diff --git a/SRC/dlamtsqr.f b/SRC/dlamtsqr.f index 2cb9f96a..a4f5a025 100644 --- a/SRC/dlamtsqr.f +++ b/SRC/dlamtsqr.f @@ -1,8 +1,8 @@ -* +* * Definition: * =========== * -* SUBROUTINE DLAMTSQR( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, +* SUBROUTINE DLAMTSQR( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, * $ LDT, C, LDC, WORK, LWORK, INFO ) * * @@ -17,15 +17,15 @@ * ============= *> *> \verbatim -*> +*> *> DLAMTSQR overwrites the general real M-by-N matrix C with *> -*> +*> *> SIDE = 'L' SIDE = 'R' *> TRANS = 'N': Q * C C * Q *> TRANS = 'T': Q**T * C C * Q**T -*> where Q is a real orthogonal matrix defined as the product -*> of blocked elementary reflectors computed by tall skinny +*> where Q is a real orthogonal matrix defined as the product +*> of blocked elementary reflectors computed by tall skinny *> QR factorization (DLATSQR) *> \endverbatim * @@ -59,29 +59,29 @@ *> The number of elementary reflectors whose product defines *> the matrix Q. *> N >= K >= 0; -*> +*> *> \endverbatim *> *> \param[in] MB *> \verbatim *> MB is INTEGER -*> The block size to be used in the blocked QR. +*> The block size to be used in the blocked QR. *> MB > N. (must be the same as DLATSQR) *> \endverbatim *> *> \param[in] NB *> \verbatim *> NB is INTEGER -*> The column block size to be used in the blocked QR. +*> The column block size to be used in the blocked QR. *> N >= NB >= 1. *> \endverbatim *> *> \param[in,out] A *> \verbatim *> A is DOUBLE PRECISION array, dimension (LDA,K) -*> The i-th column must contain the vector which defines the -*> blockedelementary reflector H(i), for i = 1,2,...,k, as -*> returned by DLATSQR in the first k columns of +*> The i-th column must contain the vector which defines the +*> blockedelementary reflector H(i), for i = 1,2,...,k, as +*> returned by DLATSQR in the first k columns of *> its array argument A. *> \endverbatim *> @@ -95,7 +95,7 @@ *> *> \param[in] T *> \verbatim -*> T is DOUBLE PRECISION array, dimension +*> T is DOUBLE PRECISION array, dimension *> ( N * Number of blocks(CEIL(M-K/MB-K)), *> The blocked upper triangular block reflectors stored in compact form *> as a sequence of upper triangular blocks. See below @@ -119,13 +119,13 @@ *> \param[out] WORK *> \verbatim *> (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK)) -*> +*> *> \endverbatim *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER *> The dimension of the array WORK. -*> +*> *> If SIDE = 'L', LWORK >= max(1,N)*NB; *> if SIDE = 'R', LWORK >= max(1,MB)*NB. *> If LWORK = -1, then a workspace query is assumed; the routine @@ -172,7 +172,7 @@ *> block reflectors, stored in array T(1:LDT,(i-1)*N+1:i*N). *> The last Q(k) may use fewer rows. *> For more information see Further Details in TPQRT. -*> +*> *> For more details of the overall algorithm, see the description of *> Sequential TSQR in Section 2.2 of [1]. *> @@ -182,7 +182,7 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE DLAMTSQR( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, + SUBROUTINE DLAMTSQR( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, $ LDT, C, LDC, WORK, LWORK, INFO ) * * -- LAPACK computational routine (version 3.5.0) -- @@ -210,7 +210,7 @@ LOGICAL LSAME EXTERNAL LSAME * .. External Subroutines .. - EXTERNAL DGEMQRT, DTPMQRT, XERBLA + EXTERNAL DGEMQRT, DTPMQRT, XERBLA * .. * .. Executable Statements .. * @@ -249,7 +249,7 @@ END IF * * Determine the block size if it is tall skinny or short and wide -* +* IF( INFO.EQ.0) THEN WORK(1) = LW END IF @@ -267,10 +267,10 @@ END IF * IF((MB.LE.K).OR.(MB.GE.MAX(M,N,K))) THEN - CALL DGEMQRT( SIDE, TRANS, M, N, K, NB, A, LDA, - $ T, LDT, C, LDC, WORK, INFO) + CALL DGEMQRT( SIDE, TRANS, M, N, K, NB, A, LDA, + $ T, LDT, C, LDC, WORK, INFO) RETURN - END IF + END IF * IF(LEFT.AND.NOTRAN) THEN * @@ -326,7 +326,7 @@ IF(II.LE.M) THEN * * Multiply Q to the last block of C -* +* CALL DTPMQRT('L','T',KK , N, K, 0,NB, A(II,1), LDA, $ T(1,CTR * K + 1), LDT, C(1,1), LDC, $ C(II,1), LDC, WORK, INFO ) @@ -396,9 +396,9 @@ * END IF * - WORK(1) = LW + WORK(1) = LW RETURN * * End of DLAMTSQR * - END
\ No newline at end of file + END diff --git a/SRC/dlaswlq.f b/SRC/dlaswlq.f index e9be802c..95f2025e 100644 --- a/SRC/dlaswlq.f +++ b/SRC/dlaswlq.f @@ -1,24 +1,24 @@ -* +* * Definition: * =========== * * SUBROUTINE DLASWLQ( M, N, MB, NB, A, LDA, T, LDT, WORK, * LWORK, INFO) -* +* * .. Scalar Arguments .. * INTEGER INFO, LDA, M, N, MB, NB, LDT, LWORK * .. * .. Array Arguments .. * DOUBLE PRECISION A( LDA, * ), T( LDT, * ), WORK( * ) * .. -* +* * *> \par Purpose: * ============= *> *> \verbatim -*> -*> DLASWLQ computes a blocked Short-Wide LQ factorization of a +*> +*> DLASWLQ computes a blocked Short-Wide LQ factorization of a *> M-by-N matrix A, where N >= M: *> A = L * Q *> \endverbatim @@ -41,13 +41,13 @@ *> \param[in] MB *> \verbatim *> MB is INTEGER -*> The row block size to be used in the blocked QR. -*> M >= MB >= 1 +*> The row block size to be used in the blocked QR. +*> M >= MB >= 1 *> \endverbatim *> \param[in] NB *> \verbatim *> NB is INTEGER -*> The column block size to be used in the blocked QR. +*> The column block size to be used in the blocked QR. *> NB > M. *> \endverbatim *> @@ -55,9 +55,9 @@ *> \verbatim *> A is DOUBLE PRECISION array, dimension (LDA,N) *> On entry, the M-by-N matrix A. -*> On exit, the elements on and bleow the diagonal -*> of the array contain the N-by-N lower triangular matrix L; -*> the elements above the diagonal represent Q by the rows +*> On exit, the elements on and bleow the diagonal +*> of the array contain the N-by-N lower triangular matrix L; +*> the elements above the diagonal represent Q by the rows *> of blocked V (see Further Details). *> *> \endverbatim @@ -70,11 +70,11 @@ *> *> \param[out] T *> \verbatim -*> T is DOUBLE PRECISION array, -*> dimension (LDT, N * Number_of_row_blocks) +*> T is DOUBLE PRECISION array, +*> dimension (LDT, N * Number_of_row_blocks) *> where Number_of_row_blocks = CEIL((N-M)/(NB-M)) *> The blocked upper triangular block reflectors stored in compact form -*> as a sequence of upper triangular blocks. +*> as a sequence of upper triangular blocks. *> See Further Details below. *> \endverbatim *> @@ -88,7 +88,7 @@ *> \param[out] WORK *> \verbatim *> (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK)) -*> +*> *> \endverbatim *> \param[in] LWORK *> \verbatim @@ -137,7 +137,7 @@ *> block reflectors, stored in array T(1:LDT,(i-1)*M+1:i*M). *> The last Q(k) may use fewer rows. *> For more information see Further Details in TPQRT. -*> +*> *> For more details of the overall algorithm, see the description of *> Sequential TSQR in Section 2.2 of [1]. *> @@ -147,7 +147,7 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE DLASWLQ( M, N, MB, NB, A, LDA, T, LDT, WORK, LWORK, + SUBROUTINE DLASWLQ( M, N, MB, NB, A, LDA, T, LDT, WORK, LWORK, $ INFO) * * -- LAPACK computational routine (version 3.5.0) -- @@ -190,7 +190,7 @@ ELSE IF( N.LT.0 .OR. N.LT.M ) THEN INFO = -2 ELSE IF( MB.LT.1 .OR. ( MB.GT.M .AND. M.GT.0 )) THEN - INFO = -3 + INFO = -3 ELSE IF( NB.LE.M ) THEN INFO = -4 ELSE IF( LDA.LT.MAX( 1, M ) ) THEN @@ -198,9 +198,9 @@ ELSE IF( LDT.LT.MB ) THEN INFO = -8 ELSE IF( ( LWORK.LT.M*MB) .AND. (.NOT.LQUERY) ) THEN - INFO = -10 - END IF - IF( INFO.EQ.0) THEN + INFO = -10 + END IF + IF( INFO.EQ.0) THEN WORK(1) = MB*M END IF * @@ -222,10 +222,10 @@ IF((M.GE.N).OR.(NB.LE.M).OR.(NB.GE.N)) THEN CALL DGELQT( M, N, MB, A, LDA, T, LDT, WORK, INFO) RETURN - END IF -* + END IF +* KK = MOD((N-M),(NB-M)) - II=N-KK+1 + II=N-KK+1 * * Compute the LQ factorization of the first block A(1:M,1:NB) * @@ -233,7 +233,7 @@ CTR = 1 * DO I = NB+1, II-NB+M , (NB-M) -* +* * Compute the QR factorization of the current block A(1:M,I:I+NB-M) * CALL DTPLQT( M, NB-M, 0, MB, A(1,1), LDA, A( 1, I ), @@ -248,11 +248,11 @@ CALL DTPLQT( M, KK, 0, MB, A(1,1), LDA, A( 1, II ), $ LDA, T(1, CTR * M + 1), LDT, $ WORK, INFO ) - END IF + END IF * WORK( 1 ) = M * MB RETURN -* +* * End of DLASWLQ * - END
\ No newline at end of file + END diff --git a/SRC/dlasyf_aasen.f b/SRC/dlasyf_aasen.f index 6a287515..4d158852 100644 --- a/SRC/dlasyf_aasen.f +++ b/SRC/dlasyf_aasen.f @@ -2,25 +2,25 @@ * * =========== 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 DLASYF_AASEN + dependencies -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlasyf_aasen.f"> -*> [TGZ]</a> -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlasyf_aasen.f"> -*> [ZIP]</a> -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlasyf_aasen.f"> +*> Download DLASYF_AASEN + dependencies +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlasyf_aasen.f"> +*> [TGZ]</a> +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlasyf_aasen.f"> +*> [ZIP]</a> +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlasyf_aasen.f"> *> [TXT]</a> -*> \endhtmlonly +*> \endhtmlonly * * Definition: * =========== * -* SUBROUTINE DLASYF_AASEN( UPLO, J1, M, NB, A, LDA, IPIV, +* SUBROUTINE DLASYF_AASEN( UPLO, J1, M, NB, A, LDA, IPIV, * H, LDH, WORK, INFO ) -* +* * .. Scalar Arguments .. * CHARACTER UPLO * INTEGER J1, M, NB, LDA, LDH, INFO @@ -29,7 +29,7 @@ * INTEGER IPIV( * ) * DOUBLE PRECISION A( LDA, * ), H( LDH, * ), WORK( * ) * .. -* +* * *> \par Purpose: * ============= @@ -44,9 +44,9 @@ *> last row, or column, of the previous panel. The first row, or column, *> of A is set to be the first row, or column, of an identity matrix, *> which is used to factorize the first panel. -*> +*> *> The resulting J-th row of U, or J-th column of L, is stored in the -*> (J-1)-th row, or column, of A (without the unit diatonals), while +*> (J-1)-th row, or column, of A (without the unit diatonals), while *> the diagonal and subdiagonal of A are overwritten by those of T. *> *> \endverbatim @@ -141,10 +141,10 @@ * 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 2016 * @@ -153,7 +153,7 @@ * @precisions fortran d -> s * * ===================================================================== - SUBROUTINE DLASYF_AASEN( UPLO, J1, M, NB, A, LDA, IPIV, + SUBROUTINE DLASYF_AASEN( UPLO, J1, M, NB, A, LDA, IPIV, $ H, LDH, WORK, INFO ) * * -- LAPACK computational routine (version 3.4.0) -- @@ -179,7 +179,7 @@ * * .. Local Scalars .. INTEGER J, K, K1, I1, I2 - DOUBLE PRECISION PIV, ALPHA + DOUBLE PRECISION PIV, ALPHA * .. * .. External Functions .. LOGICAL LSAME @@ -253,14 +253,14 @@ * A( K, J ) = WORK( 1 ) * - IF( J.LT.M ) THEN + IF( J.LT.M ) THEN * * Compute WORK(2:N) = T(J, J) L(J, (J+1):N) * where A(J, J) stores T(J, J) and A(J-1, (J+1):N) stores U(J, (J+1):N) * IF( (J1+J-1).GT.1 ) THEN - ALPHA = -A( K, J ) - CALL DAXPY( M-J, ALPHA, A( K-1, J+1 ), LDA, + ALPHA = -A( K, J ) + CALL DAXPY( M-J, ALPHA, A( K-1, J+1 ), LDA, $ WORK( 2 ), 1 ) ENDIF * @@ -283,12 +283,12 @@ * I1 = I1+J-1 I2 = I2+J-1 - CALL DSWAP( I2-I1-1, A( J1+I1-1, I1+1 ), LDA, + CALL DSWAP( I2-I1-1, A( J1+I1-1, I1+1 ), LDA, $ A( J1+I1, I2 ), 1 ) * * Swap A(I1, I2+1:N) with A(I2, I2+1:N) * - CALL DSWAP( M-I2, A( J1+I1-1, I2+1 ), LDA, + CALL DSWAP( M-I2, A( J1+I1-1, I2+1 ), LDA, $ A( J1+I2-1, I2+1 ), LDA ) * * Swap A(I1, I1) with A(I2,I2) @@ -307,17 +307,17 @@ * Swap L(1:I1-1, I1) with L(1:I1-1, I2), * skipping the first column * - CALL DSWAP( I1-K1+1, A( 1, I1 ), 1, + CALL DSWAP( I1-K1+1, A( 1, I1 ), 1, $ A( 1, I2 ), 1 ) END IF - ELSE + ELSE IPIV( J+1 ) = J+1 ENDIF * * Set A(J, J+1) = T(J, J+1) * A( K, J+1 ) = WORK( 2 ) - IF( (A( K, J ).EQ.ZERO ) .AND. + IF( (A( K, J ).EQ.ZERO ) .AND. $ ( (J.EQ.M) .OR. (A( K, J+1 ).EQ.ZERO))) THEN IF(INFO .EQ. 0) THEN INFO = J @@ -326,9 +326,9 @@ * IF( J.LT.NB ) THEN * -* Copy A(J+1:N, J+1) into H(J:N, J), +* Copy A(J+1:N, J+1) into H(J:N, J), * - CALL DCOPY( M-J, A( K+1, J+1 ), LDA, + CALL DCOPY( M-J, A( K+1, J+1 ), LDA, $ H( J+1, J+1 ), 1 ) END IF * @@ -340,7 +340,7 @@ CALL DCOPY( M-J-1, WORK( 3 ), 1, A( K, J+2 ), LDA ) CALL DSCAL( M-J-1, ALPHA, A( K, J+2 ), LDA ) ELSE - CALL DLASET( 'Full', 1, M-J-1, ZERO, ZERO, + CALL DLASET( 'Full', 1, M-J-1, ZERO, ZERO, $ A( K, J+2 ), LDA) END IF ELSE @@ -403,14 +403,14 @@ * A( J, K ) = WORK( 1 ) * - IF( J.LT.M ) THEN + IF( J.LT.M ) THEN * * Compute WORK(2:N) = T(J, J) L((J+1):N, J) * where A(J, J) = T(J, J) and A((J+1):N, J-1) = L((J+1):N, J) * IF( (J1+J-1).GT.1 ) THEN - ALPHA = -A( J, K ) - CALL DAXPY( M-J, ALPHA, A( J+1, K-1 ), 1, + ALPHA = -A( J, K ) + CALL DAXPY( M-J, ALPHA, A( J+1, K-1 ), 1, $ WORK( 2 ), 1 ) ENDIF * @@ -433,12 +433,12 @@ * I1 = I1+J-1 I2 = I2+J-1 - CALL DSWAP( I2-I1-1, A( I1+1, J1+I1-1 ), 1, + CALL DSWAP( I2-I1-1, A( I1+1, J1+I1-1 ), 1, $ A( I2, J1+I1 ), LDA ) * * Swap A(I2+1:N, I1) with A(I2+1:N, I2) * - CALL DSWAP( M-I2, A( I2+1, J1+I1-1 ), 1, + CALL DSWAP( M-I2, A( I2+1, J1+I1-1 ), 1, $ A( I2+1, J1+I2-1 ), 1 ) * * Swap A(I1, I1) with A(I2, I2) @@ -457,27 +457,27 @@ * Swap L(1:I1-1, I1) with L(1:I1-1, I2), * skipping the first column * - CALL DSWAP( I1-K1+1, A( I1, 1 ), LDA, + CALL DSWAP( I1-K1+1, A( I1, 1 ), LDA, $ A( I2, 1 ), LDA ) END IF - ELSE + ELSE IPIV( J+1 ) = J+1 ENDIF * * Set A(J+1, J) = T(J+1, J) * A( J+1, K ) = WORK( 2 ) - IF( (A( J, K ).EQ.ZERO) .AND. + IF( (A( J, K ).EQ.ZERO) .AND. $ ( (J.EQ.M) .OR. (A( J+1, K ).EQ.ZERO)) ) THEN - IF (INFO .EQ. 0) + IF (INFO .EQ. 0) $ INFO = J END IF * IF( J.LT.NB ) THEN * -* Copy A(J+1:N, J+1) into H(J+1:N, J), +* Copy A(J+1:N, J+1) into H(J+1:N, J), * - CALL DCOPY( M-J, A( J+1, K+1 ), 1, + CALL DCOPY( M-J, A( J+1, K+1 ), 1, $ H( J+1, J+1 ), 1 ) END IF * @@ -489,7 +489,7 @@ CALL DCOPY( M-J-1, WORK( 3 ), 1, A( J+2, K ), 1 ) CALL DSCAL( M-J-1, ALPHA, A( J+2, K ), 1 ) ELSE - CALL DLASET( 'Full', M-J-1, 1, ZERO, ZERO, + CALL DLASET( 'Full', M-J-1, 1, ZERO, ZERO, $ A( J+2, K ), LDA ) END IF ELSE diff --git a/SRC/dlatsqr.f b/SRC/dlatsqr.f index 4b9a787a..b8c502e6 100644 --- a/SRC/dlatsqr.f +++ b/SRC/dlatsqr.f @@ -1,26 +1,26 @@ -* +* * Definition: * =========== * -* SUBROUTINE DLATSQR( M, N, MB, NB, A, LDA, T, LDT, WORK, +* SUBROUTINE DLATSQR( M, N, MB, NB, A, LDA, T, LDT, WORK, * LWORK, INFO) -* +* * .. Scalar Arguments .. * INTEGER INFO, LDA, M, N, MB, NB, LDT, LWORK * .. * .. Array Arguments .. * DOUBLE PRECISION A( LDA, * ), T( LDT, * ), WORK( * ) * .. -* +* * *> \par Purpose: * ============= *> *> \verbatim -*> -*> DLATSQR computes a blocked Tall-Skinny QR factorization of +*> +*> DLATSQR computes a blocked Tall-Skinny QR factorization of *> an M-by-N matrix A, where M >= N: -*> A = Q * R . +*> A = Q * R . *> \endverbatim * * Arguments: @@ -41,14 +41,14 @@ *> \param[in] MB *> \verbatim *> MB is INTEGER -*> The row block size to be used in the blocked QR. +*> The row block size to be used in the blocked QR. *> MB > N. *> \endverbatim *> *> \param[in] NB *> \verbatim *> NB is INTEGER -*> The column block size to be used in the blocked QR. +*> The column block size to be used in the blocked QR. *> N >= NB >= 1. *> \endverbatim *> @@ -56,9 +56,9 @@ *> \verbatim *> A is DOUBLE PRECISION array, dimension (LDA,N) *> On entry, the M-by-N matrix A. -*> On exit, the elements on and above the diagonal -*> of the array contain the N-by-N upper triangular matrix R; -*> the elements below the diagonal represent Q by the columns +*> On exit, the elements on and above the diagonal +*> of the array contain the N-by-N upper triangular matrix R; +*> the elements below the diagonal represent Q by the columns *> of blocked V (see Further Details). *> \endverbatim *> @@ -70,11 +70,11 @@ *> *> \param[out] T *> \verbatim -*> T is DOUBLE PRECISION array, -*> dimension (LDT, N * Number_of_row_blocks) +*> T is DOUBLE PRECISION array, +*> dimension (LDT, N * Number_of_row_blocks) *> where Number_of_row_blocks = CEIL((M-N)/(MB-N)) *> The blocked upper triangular block reflectors stored in compact form -*> as a sequence of upper triangular blocks. +*> as a sequence of upper triangular blocks. *> See Further Details below. *> \endverbatim *> @@ -86,7 +86,7 @@ *> *> \param[out] WORK *> \verbatim -*> (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK)) +*> (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK)) *> \endverbatim *> *> \param[in] LWORK @@ -136,7 +136,7 @@ *> block reflectors, stored in array T(1:LDT,(i-1)*N+1:i*N). *> The last Q(k) may use fewer rows. *> For more information see Further Details in TPQRT. -*> +*> *> For more details of the overall algorithm, see the description of *> Sequential TSQR in Section 2.2 of [1]. *> @@ -146,7 +146,7 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE DLATSQR( M, N, MB, NB, A, LDA, T, LDT, WORK, + SUBROUTINE DLATSQR( M, N, MB, NB, A, LDA, T, LDT, WORK, $ LWORK, INFO) * * -- LAPACK computational routine (version 3.5.0) -- @@ -189,7 +189,7 @@ ELSE IF( N.LT.0 .OR. M.LT.N ) THEN INFO = -2 ELSE IF( MB.LE.N ) THEN - INFO = -3 + INFO = -3 ELSE IF( NB.LT.1 .OR. ( NB.GT.N .AND. N.GT.0 )) THEN INFO = -4 ELSE IF( LDA.LT.MAX( 1, M ) ) THEN @@ -197,8 +197,8 @@ ELSE IF( LDT.LT.NB ) THEN INFO = -8 ELSE IF( LWORK.LT.(N*NB) .AND. (.NOT.LQUERY) ) THEN - INFO = -10 - END IF + INFO = -10 + END IF IF( INFO.EQ.0) THEN WORK(1) = NB*N END IF @@ -220,10 +220,10 @@ IF ((MB.LE.N).OR.(MB.GE.M)) THEN CALL DGEQRT( M, N, NB, A, LDA, T, LDT, WORK, INFO) RETURN - END IF + END IF * KK = MOD((M-N),(MB-N)) - II=M-KK+1 + II=M-KK+1 * * Compute the QR factorization of the first block A(1:MB,1:N) * @@ -231,7 +231,7 @@ * CTR = 1 DO I = MB+1, II-MB+N , (MB-N) -* +* * Compute the QR factorization of the current block A(I:I+MB-N,1:N) * CALL DTPQRT( MB-N, N, 0, NB, A(1,1), LDA, A( I, 1 ), LDA, @@ -246,11 +246,11 @@ CALL DTPQRT( KK, N, 0, NB, A(1,1), LDA, A( II, 1 ), LDA, $ T(1, CTR * N + 1), LDT, $ WORK, INFO ) - END IF + END IF * WORK( 1 ) = N*NB RETURN -* +* * End of DLATSQR * - END
\ No newline at end of file + END diff --git a/SRC/dsyevr.f b/SRC/dsyevr.f index 3684c429..3353b7e5 100644 --- a/SRC/dsyevr.f +++ b/SRC/dsyevr.f @@ -257,7 +257,7 @@ *> indicating the nonzero elements in Z. The i-th eigenvector *> is nonzero only in elements ISUPPZ( 2*i-1 ) through *> ISUPPZ( 2*i ). This is an output of DSTEMR (tridiagonal -*> matrix). The support of the eigenvectors of A is typically +*> matrix). The support of the eigenvectors of A is typically *> 1:N because of the orthogonal transformations applied by DORMTR. *> Implemented only for RANGE = 'A' or 'I' and IU - IL = N - 1 *> \endverbatim diff --git a/SRC/dsysv_aasen.f b/SRC/dsysv_aasen.f index 63cb8a57..9bf30de9 100644 --- a/SRC/dsysv_aasen.f +++ b/SRC/dsysv_aasen.f @@ -2,25 +2,25 @@ * * =========== 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 DSYSV_AASEN + dependencies -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsysv_aasen.f"> -*> [TGZ]</a> -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsysv_aasen.f"> -*> [ZIP]</a> -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsysv_aasen.f"> +*> Download DSYSV_AASEN + dependencies +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsysv_aasen.f"> +*> [TGZ]</a> +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsysv_aasen.f"> +*> [ZIP]</a> +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsysv_aasen.f"> *> [TXT]</a> -*> \endhtmlonly +*> \endhtmlonly * * Definition: * =========== * * SUBROUTINE DSYSV_AASEN( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, * LWORK, INFO ) -* +* * .. Scalar Arguments .. * CHARACTER UPLO * INTEGER N, NRHS, LDA, LDB, LWORK, INFO @@ -29,7 +29,7 @@ * INTEGER IPIV( * ) * DOUBLE PRECISION A( LDA, * ), B( LDB, * ), WORK( * ) * .. -* +* * *> \par Purpose: * ============= @@ -45,7 +45,7 @@ *> A = U * T * U**T, if UPLO = 'U', or *> A = L * T * L**T, if UPLO = 'L', *> where U (or L) is a product of permutation and unit upper (lower) -*> triangular matrices, and T is symmetric tridiagonal. The factored +*> triangular matrices, and T is symmetric tridiagonal. The factored *> form of A is then used to solve the system of equations A * X = B. *> \endverbatim * @@ -99,8 +99,8 @@ *> \param[out] IPIV *> \verbatim *> IPIV is INTEGER array, dimension (N) -*> On exit, it contains the details of the interchanges, i.e., -*> the row and column k of A were interchanged with the +*> On exit, it contains the details of the interchanges, i.e., +*> the row and column k of A were interchanged with the *> row and column IPIV(k). *> \endverbatim *> @@ -126,8 +126,8 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The length of WORK. LWORK >= MAX(2*N, 3*N-2), and for -*> the best performance, LWORK >= max(1,N*NB), where NB is +*> The length of WORK. LWORK >= MAX(2*N, 3*N-2), and for +*> the best performance, LWORK >= max(1,N*NB), where NB is *> the optimal blocksize for DSYTRF_AASEN. *> *> If LWORK = -1, then a workspace query is assumed; the routine @@ -149,10 +149,10 @@ * 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 2016 * diff --git a/SRC/dsytrf_aasen.f b/SRC/dsytrf_aasen.f index f484c6b9..4881376b 100644 --- a/SRC/dsytrf_aasen.f +++ b/SRC/dsytrf_aasen.f @@ -2,24 +2,24 @@ * * =========== 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 DSYTRF_AASEN + dependencies -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsytrf_aasen.f"> -*> [TGZ]</a> -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsytrf_aasen.f"> -*> [ZIP]</a> -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsytrf_aasen.f"> +*> Download DSYTRF_AASEN + dependencies +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsytrf_aasen.f"> +*> [TGZ]</a> +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsytrf_aasen.f"> +*> [ZIP]</a> +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsytrf_aasen.f"> *> [TXT]</a> -*> \endhtmlonly +*> \endhtmlonly * * Definition: * =========== * * SUBROUTINE DSYTRF_AASEN( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) -* +* * .. Scalar Arguments .. * CHARACTER UPLO * INTEGER N, LDA, LWORK, INFO @@ -73,7 +73,7 @@ *> triangular part of A is not referenced. *> *> On exit, the tridiagonal matrix is stored in the diagonals -*> and the subdiagonals of A just below (or above) the diagonals, +*> and the subdiagonals of A just below (or above) the diagonals, *> and L is stored below (or above) the subdiaonals, when UPLO *> is 'L' (or 'U'). *> \endverbatim @@ -87,8 +87,8 @@ *> \param[out] IPIV *> \verbatim *> IPIV is INTEGER array, dimension (N) -*> On exit, it contains the details of the interchanges, i.e., -*> the row and column k of A were interchanged with the +*> On exit, it contains the details of the interchanges, i.e., +*> the row and column k of A were interchanged with the *> row and column IPIV(k). *> \endverbatim *> @@ -124,10 +124,10 @@ * 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 2016 * @@ -244,14 +244,14 @@ * J = 0 10 CONTINUE - IF( J.GE.N ) + IF( J.GE.N ) $ GO TO 20 * * each step of the main loop * J is the last column of the previous panel * J1 is the first column of the current panel * K1 identifies if the previous column of the panel has been -* explicitly stored, e.g., K1=1 for the first panel, and +* explicitly stored, e.g., K1=1 for the first panel, and * K1=0 for the rest * J1 = J + 1 @@ -260,27 +260,27 @@ * * Panel factorization * - CALL DLASYF_AASEN( UPLO, 2-K1, N-J, JB, + CALL DLASYF_AASEN( UPLO, 2-K1, N-J, JB, $ A( MAX(1, J), J+1 ), LDA, - $ IPIV( J+1 ), WORK, N, WORK( N*NB+1 ), + $ IPIV( J+1 ), WORK, N, WORK( N*NB+1 ), $ IINFO ) IF( (IINFO.GT.0) .AND. (INFO.EQ.0) ) THEN INFO = IINFO+J - ENDIF + ENDIF * * Ajust IPIV and apply it back (J-th step picks (J+1)-th pivot) * DO J2 = J+2, MIN(N, J+JB+1) IPIV( J2 ) = IPIV( J2 ) + J IF( (J2.NE.IPIV(J2)) .AND. ((J1-K1).GT.2) ) THEN - CALL DSWAP( J1-K1-2, A( 1, J2 ), 1, + CALL DSWAP( J1-K1-2, A( 1, J2 ), 1, $ A( 1, IPIV(J2) ), 1 ) END IF END DO J = J + JB * * Trailing submatrix update, where -* the row A(J1-1, J2-1:N) stores U(J1, J2+1:N) and +* the row A(J1-1, J2-1:N) stores U(J1, J2+1:N) and * WORK stores the current block of the auxiriarly matrix H * IF( J.LT.N ) THEN @@ -293,12 +293,12 @@ * ALPHA = A( J, J+1 ) A( J, J+1 ) = ONE - CALL DCOPY( N-J, A( J-1, J+1 ), LDA, + CALL DCOPY( N-J, A( J-1, J+1 ), LDA, $ WORK( (J+1-J1+1)+JB*N ), 1 ) CALL DSCAL( N-J, ALPHA, WORK( (J+1-J1+1)+JB*N ), 1 ) * * K1 identifies if the previous column of the panel has been -* explicitly stored, e.g., K1=1 and K2= 0 for the first panel, +* explicitly stored, e.g., K1=1 and K2= 0 for the first panel, * while K1=0 and K2=1 for the rest * IF( J1.GT.1 ) THEN @@ -306,13 +306,13 @@ * Not first panel * K2 = 1 - ELSE + ELSE * * First panel * K2 = 0 * -* First update skips the first column +* First update skips the first column * JB = JB - 1 END IF @@ -333,7 +333,7 @@ * * Update off-diagonal block of J2-th block row with DGEMM * - CALL DGEMM( 'Transpose', 'Transpose', + CALL DGEMM( 'Transpose', 'Transpose', $ NJ, N-J3+1, JB+1, $ -ONE, A( J1-K2, J2 ), LDA, $ WORK( J3-J1+1+K1*N ), N, @@ -356,7 +356,7 @@ * Factorize A as L*D*L**T using the lower triangle of A * ..................................................... * -* copy first column A(1:N, 1) into H(1:N, 1) +* copy first column A(1:N, 1) into H(1:N, 1) * (stored in WORK(1:N)) * CALL DCOPY( N, A( 1, 1 ), 1, WORK( 1 ), 1 ) @@ -367,14 +367,14 @@ * J = 0 11 CONTINUE - IF( J.GE.N ) + IF( J.GE.N ) $ GO TO 20 * * each step of the main loop * J is the last column of the previous panel * J1 is the first column of the current panel * K1 identifies if the previous column of the panel has been -* explicitly stored, e.g., K1=1 for the first panel, and +* explicitly stored, e.g., K1=1 for the first panel, and * K1=0 for the rest * J1 = J+1 @@ -383,26 +383,26 @@ * * Panel factorization * - CALL DLASYF_AASEN( UPLO, 2-K1, N-J, JB, + CALL DLASYF_AASEN( UPLO, 2-K1, N-J, JB, $ A( J+1, MAX(1, J) ), LDA, $ IPIV( J+1 ), WORK, N, WORK( N*NB+1 ), IINFO) IF( (IINFO.GT.0) .AND. (INFO.EQ.0) ) THEN INFO = IINFO+J - ENDIF + ENDIF * * Ajust IPIV and apply it back (J-th step picks (J+1)-th pivot) * DO J2 = J+2, MIN(N, J+JB+1) IPIV( J2 ) = IPIV( J2 ) + J IF( (J2.NE.IPIV(J2)) .AND. ((J1-K1).GT.2) ) THEN - CALL DSWAP( J1-K1-2, A( J2, 1 ), LDA, + CALL DSWAP( J1-K1-2, A( J2, 1 ), LDA, $ A( IPIV(J2), 1 ), LDA ) END IF END DO J = J + JB * * Trailing submatrix update, where -* A(J2+1, J1-1) stores L(J2+1, J1) and +* A(J2+1, J1-1) stores L(J2+1, J1) and * WORK(J2+1, 1) stores H(J2+1, 1) * IF( J.LT.N ) THEN @@ -415,12 +415,12 @@ * ALPHA = A( J+1, J ) A( J+1, J ) = ONE - CALL DCOPY( N-J, A( J+1, J-1 ), 1, + CALL DCOPY( N-J, A( J+1, J-1 ), 1, $ WORK( (J+1-J1+1)+JB*N ), 1 ) CALL DSCAL( N-J, ALPHA, WORK( (J+1-J1+1)+JB*N ), 1 ) * * K1 identifies if the previous column of the panel has been -* explicitly stored, e.g., K1=1 and K2= 0 for the first panel, +* explicitly stored, e.g., K1=1 and K2= 0 for the first panel, * while K1=0 and K2=1 for the rest * IF( J1.GT.1 ) THEN @@ -434,7 +434,7 @@ * K2 = 0 * -* First update skips the first column +* First update skips the first column * JB = JB - 1 END IF @@ -455,7 +455,7 @@ * * Update off-diagonal block in J2-th block column with DGEMM * - CALL DGEMM( 'No transpose', 'Transpose', + CALL DGEMM( 'No transpose', 'Transpose', $ N-J3+1, NJ, JB+1, $ -ONE, WORK( J3-J1+1+K1*N ), N, $ A( J2, J1-K2 ), LDA, diff --git a/SRC/dsytrs_aasen.f b/SRC/dsytrs_aasen.f index 05bcda32..4eb4dbf3 100644 --- a/SRC/dsytrs_aasen.f +++ b/SRC/dsytrs_aasen.f @@ -2,25 +2,25 @@ * * =========== 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 DSYTRS_AASEN + dependencies *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsytrs_aasen.f"> -*> [TGZ]</a> +*> [TGZ]</a> *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsytrs_aasen.f"> -*> [ZIP]</a> +*> [ZIP]</a> *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsytrs_aasen.f"> *> [TXT]</a> -*> \endhtmlonly +*> \endhtmlonly * * Definition: * =========== * * SUBROUTINE DSYTRS_AASEN( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, * WORK, LWORK, INFO ) -* +* * .. Scalar Arguments .. * CHARACTER UPLO * INTEGER N, NRHS, LDA, LDB, LWORK, INFO @@ -29,7 +29,7 @@ * INTEGER IPIV( * ) * DOUBLE PRECISION A( LDA, * ), B( LDB, * ), WORK( * ) * .. -* +* * *> \par Purpose: * ============= @@ -116,10 +116,10 @@ * 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 2016 * @@ -261,7 +261,7 @@ $ INFO) * * Compute (L**T \ B) -> B [ L**T \ (T \ (L \P**T * B) ) ] -* +* CALL DTRSM( 'L', 'L', 'T', 'U', N-1, NRHS, ONE, A( 2, 1 ), LDA, $ B( 2, 1 ), LDB) * diff --git a/SRC/dtplqt.f b/SRC/dtplqt.f index eea37b82..029e4b6f 100644 --- a/SRC/dtplqt.f +++ b/SRC/dtplqt.f @@ -2,41 +2,41 @@ * * =========== 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 DTPQRT + dependencies -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dtplqt.f"> -*> [TGZ]</a> -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dtplqt.f"> -*> [ZIP]</a> -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dtplqt.f"> +*> Download DTPQRT + dependencies +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dtplqt.f"> +*> [TGZ]</a> +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dtplqt.f"> +*> [ZIP]</a> +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dtplqt.f"> *> [TXT]</a> -*> \endhtmlonly +*> \endhtmlonly * * Definition: * =========== * * SUBROUTINE DTPLQT( M, N, L, MB, A, LDA, B, LDB, T, LDT, WORK, * INFO ) -* +* * .. Scalar Arguments .. * INTEGER INFO, LDA, LDB, LDT, N, M, L, MB * .. * .. Array Arguments .. * DOUBLE PRECISION A( LDA, * ), B( LDB, * ), T( LDT, * ), WORK( * ) * .. -* +* * *> \par Purpose: * ============= *> *> \verbatim *> -*> DTPLQT computes a blocked LQ factorization of a real -*> "triangular-pentagonal" matrix C, which is composed of a -*> triangular block A and pentagonal block B, using the compact +*> DTPLQT computes a blocked LQ factorization of a real +*> "triangular-pentagonal" matrix C, which is composed of a +*> triangular block A and pentagonal block B, using the compact *> WY representation for Q. *> \endverbatim * @@ -47,7 +47,7 @@ *> \verbatim *> M is INTEGER *> The number of rows of the matrix B, and the order of the -*> triangular matrix A. +*> triangular matrix A. *> M >= 0. *> \endverbatim *> @@ -88,7 +88,7 @@ *> \param[in,out] B *> \verbatim *> B is DOUBLE PRECISION array, dimension (LDB,N) -*> On entry, the pentagonal M-by-N matrix B. The first N-L columns +*> On entry, the pentagonal M-by-N matrix B. The first N-L columns *> are rectangular, and the last L columns are lower trapezoidal. *> On exit, B contains the pentagonal matrix V. See Further Details. *> \endverbatim @@ -105,7 +105,7 @@ *> The lower triangular block reflectors stored in compact form *> as a sequence of upper triangular blocks. See Further Details. *> \endverbatim -*> +*> *> \param[in] LDT *> \verbatim *> LDT is INTEGER @@ -127,10 +127,10 @@ * 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 2013 * @@ -141,45 +141,45 @@ *> *> \verbatim *> -*> The input matrix C is a M-by-(M+N) matrix +*> The input matrix C is a M-by-(M+N) matrix *> *> C = [ A ] [ B ] -*> +*> *> *> where A is an lower triangular N-by-N matrix, and B is M-by-N pentagonal *> matrix consisting of a M-by-(N-L) rectangular matrix B1 on left of a M-by-L *> upper trapezoidal matrix B2: -*> [ B ] = [ B1 ] [ B2 ] +*> [ B ] = [ B1 ] [ B2 ] *> [ B1 ] <- M-by-(N-L) rectangular *> [ B2 ] <- M-by-L upper trapezoidal. *> *> The lower trapezoidal matrix B2 consists of the first L columns of a -*> N-by-N lower triangular matrix, where 0 <= L <= MIN(M,N). If L=0, -*> B is rectangular M-by-N; if M=L=N, B is lower triangular. +*> N-by-N lower triangular matrix, where 0 <= L <= MIN(M,N). If L=0, +*> B is rectangular M-by-N; if M=L=N, B is lower triangular. *> *> The matrix W stores the elementary reflectors H(i) in the i-th row *> above the diagonal (of A) in the M-by-(M+N) input matrix C -*> [ C ] = [ A ] [ B ] +*> [ C ] = [ A ] [ B ] *> [ A ] <- lower triangular N-by-N *> [ B ] <- M-by-N pentagonal *> *> so that W can be represented as -*> [ W ] = [ I ] [ V ] +*> [ W ] = [ I ] [ V ] *> [ I ] <- identity, N-by-N *> [ V ] <- M-by-N, same form as B. *> *> Thus, all of information needed for W is contained on exit in B, which -*> we call V above. Note that V has the same form as B; that is, -*> [ V ] = [ V1 ] [ V2 ] +*> we call V above. Note that V has the same form as B; that is, +*> [ V ] = [ V1 ] [ V2 ] *> [ V1 ] <- M-by-(N-L) rectangular *> [ V2 ] <- M-by-L lower trapezoidal. *> -*> The rows of V represent the vectors which define the H(i)'s. +*> The rows of V represent the vectors which define the H(i)'s. *> *> The number of blocks is B = ceiling(M/MB), where each -*> block is of order MB except for the last block, which is of order +*> block is of order MB except for the last block, which is of order *> IB = M - (M-1)*MB. For each of the B blocks, a upper triangular block -*> reflector factor is computed: T1, T2, ..., TB. The MB-by-MB (and IB-by-IB +*> reflector factor is computed: T1, T2, ..., TB. The MB-by-MB (and IB-by-IB *> for the last block) T's are stored in the MB-by-N matrix T as *> *> T = [T1 T2 ... TB]. @@ -240,7 +240,7 @@ IF( M.EQ.0 .OR. N.EQ.0 ) RETURN * DO I = 1, M, MB -* +* * Compute the QR factorization of the current block * IB = MIN( M-I+1, MB ) @@ -251,20 +251,20 @@ LB = NB-N+L-I+1 END IF * - CALL DTPLQT2( IB, NB, LB, A(I,I), LDA, B( I, 1 ), LDB, + CALL DTPLQT2( IB, NB, LB, A(I,I), LDA, B( I, 1 ), LDB, $ T(1, I ), LDT, IINFO ) * * Update by applying H**T to B(I+IB:M,:) from the right * IF( I+IB.LE.M ) THEN CALL DTPRFB( 'R', 'N', 'F', 'R', M-I-IB+1, NB, IB, LB, - $ B( I, 1 ), LDB, T( 1, I ), LDT, - $ A( I+IB, I ), LDA, B( I+IB, 1 ), LDB, + $ B( I, 1 ), LDB, T( 1, I ), LDT, + $ A( I+IB, I ), LDA, B( I+IB, 1 ), LDB, $ WORK, M-I-IB+1) END IF END DO RETURN -* +* * End of DTPLQT * END diff --git a/SRC/dtplqt2.f b/SRC/dtplqt2.f index 9ed7c6ae..a1d57cbc 100644 --- a/SRC/dtplqt2.f +++ b/SRC/dtplqt2.f @@ -2,31 +2,31 @@ * * =========== 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 DTPLQT2 + dependencies -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dtplqt2.f"> -*> [TGZ]</a> -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dtplqt2.f"> -*> [ZIP]</a> -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dtplqt2.f"> +*> Download DTPLQT2 + dependencies +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dtplqt2.f"> +*> [TGZ]</a> +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dtplqt2.f"> +*> [ZIP]</a> +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dtplqt2.f"> *> [TXT]</a> -*> \endhtmlonly +*> \endhtmlonly * * Definition: * =========== * * SUBROUTINE DTPLQT2( M, N, L, A, LDA, B, LDB, T, LDT, INFO ) -* +* * .. Scalar Arguments .. * INTEGER INFO, LDA, LDB, LDT, N, M, L * .. * .. Array Arguments .. * DOUBLE PRECISION A( LDA, * ), B( LDB, * ), T( LDT, * ) * .. -* +* * *> \par Purpose: * ============= @@ -34,7 +34,7 @@ *> \verbatim *> *> DTPLQT2 computes a LQ a factorization of a real "triangular-pentagonal" -*> matrix C, which is composed of a triangular block A and pentagonal block B, +*> matrix C, which is composed of a triangular block A and pentagonal block B, *> using the compact WY representation for Q. *> \endverbatim * @@ -44,7 +44,7 @@ *> \param[in] M *> \verbatim *> M is INTEGER -*> The total number of rows of the matrix B. +*> The total number of rows of the matrix B. *> M >= 0. *> \endverbatim *> @@ -59,7 +59,7 @@ *> \param[in] L *> \verbatim *> L is INTEGER -*> The number of rows of the lower trapezoidal part of B. +*> The number of rows of the lower trapezoidal part of B. *> MIN(M,N) >= L >= 0. See Further Details. *> \endverbatim *> @@ -80,7 +80,7 @@ *> \param[in,out] B *> \verbatim *> B is DOUBLE PRECISION array, dimension (LDB,N) -*> On entry, the pentagonal M-by-N matrix B. The first N-L columns +*> On entry, the pentagonal M-by-N matrix B. The first N-L columns *> are rectangular, and the last L columns are lower trapezoidal. *> On exit, B contains the pentagonal matrix V. See Further Details. *> \endverbatim @@ -114,10 +114,10 @@ * 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 * @@ -128,10 +128,10 @@ *> *> \verbatim *> -*> The input matrix C is a M-by-(M+N) matrix +*> The input matrix C is a M-by-(M+N) matrix *> *> C = [ A ][ B ] -*> +*> *> *> where A is an lower triangular N-by-N matrix, and B is M-by-N pentagonal *> matrix consisting of a M-by-(N-L) rectangular matrix B1 left of a M-by-L @@ -142,8 +142,8 @@ *> [ B2 ] <- M-by-L lower trapezoidal. *> *> The lower trapezoidal matrix B2 consists of the first L columns of a -*> N-by-N lower triangular matrix, where 0 <= L <= MIN(M,N). If L=0, -*> B is rectangular M-by-N; if M=L=N, B is lower triangular. +*> N-by-N lower triangular matrix, where 0 <= L <= MIN(M,N). If L=0, +*> B is rectangular M-by-N; if M=L=N, B is lower triangular. *> *> The matrix W stores the elementary reflectors H(i) in the i-th row *> above the diagonal (of A) in the M-by-(M+N) input matrix C @@ -154,18 +154,18 @@ *> *> so that W can be represented as *> -*> W = [ I ][ V ] +*> W = [ I ][ V ] *> [ I ] <- identity, N-by-N *> [ V ] <- M-by-N, same form as B. *> *> Thus, all of information needed for W is contained on exit in B, which -*> we call V above. Note that V has the same form as B; that is, +*> we call V above. Note that V has the same form as B; that is, *> -*> W = [ V1 ][ V2 ] +*> W = [ V1 ][ V2 ] *> [ V1 ] <- M-by-(N-L) rectangular *> [ V2 ] <- M-by-L lower trapezoidal. *> -*> The rows of V represent the vectors which define the H(i)'s. +*> The rows of V represent the vectors which define the H(i)'s. *> The (M+N)-by-(M+N) block reflector H is then given by *> *> H = I - W**T * T * W @@ -231,7 +231,7 @@ * Quick return if possible * IF( N.EQ.0 .OR. M.EQ.0 ) RETURN -* +* DO I = 1, M * * Generate elementary reflector H(I) to annihilate B(I,:) @@ -245,12 +245,12 @@ DO J = 1, M-I T( M, J ) = (A( I+J, I )) END DO - CALL DGEMV( 'N', M-I, P, ONE, B( I+1, 1 ), LDB, + CALL DGEMV( 'N', M-I, P, ONE, B( I+1, 1 ), LDB, $ B( I, 1 ), LDB, ONE, T( M, 1 ), LDT ) * * C(I+1:M,I:N) = C(I+1:M,I:N) + alpha * C(I,I:N)*W(M-1:1)^H * - ALPHA = -(T( 1, I )) + ALPHA = -(T( 1, I )) DO J = 1, M-I A( I+J, I ) = A( I+J, I ) + ALPHA*(T( M, J )) END DO @@ -282,13 +282,13 @@ * * Rectangular part of B2 * - CALL DGEMV( 'N', I-1-P, L, ALPHA, B( MP, NP ), LDB, + CALL DGEMV( 'N', I-1-P, L, ALPHA, B( MP, NP ), LDB, $ B( I, NP ), LDB, ZERO, T( I,MP ), LDT ) * * B1 * - CALL DGEMV( 'N', I-1, N-L, ALPHA, B, LDB, B( I, 1 ), LDB, - $ ONE, T( I, 1 ), LDT ) + CALL DGEMV( 'N', I-1, N-L, ALPHA, B, LDB, B( I, 1 ), LDB, + $ ONE, T( I, 1 ), LDT ) * * T(1:I-1,I) := T(1:I-1,1:I-1) * T(I,1:I-1) * @@ -305,7 +305,7 @@ T(J,I)= ZERO END DO END DO - + * * End of DTPLQT2 * diff --git a/SRC/dtpmlqt.f b/SRC/dtpmlqt.f index d1193391..f1406e23 100644 --- a/SRC/dtpmlqt.f +++ b/SRC/dtpmlqt.f @@ -2,41 +2,41 @@ * * =========== 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 DTPMQRT + dependencies -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dtpmlqt.f"> -*> [TGZ]</a> -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dtpmlqt.f"> -*> [ZIP]</a> -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dtpmlqt.f"> +*> Download DTPMQRT + dependencies +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dtpmlqt.f"> +*> [TGZ]</a> +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dtpmlqt.f"> +*> [ZIP]</a> +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dtpmlqt.f"> *> [TXT]</a> -*> \endhtmlonly +*> \endhtmlonly * * Definition: * =========== * * SUBROUTINE DTPMLQT( SIDE, TRANS, M, N, K, L, MB, V, LDV, T, LDT, * A, LDA, B, LDB, WORK, INFO ) -* +* * .. Scalar Arguments .. * CHARACTER SIDE, TRANS * INTEGER INFO, K, LDV, LDA, LDB, M, N, L, MB, LDT * .. * .. Array Arguments .. -* DOUBLE PRECISION V( LDV, * ), A( LDA, * ), B( LDB, * ), +* DOUBLE PRECISION V( LDV, * ), A( LDA, * ), B( LDB, * ), * $ T( LDT, * ), WORK( * ) * .. -* +* * *> \par Purpose: * ============= *> *> \verbatim *> -*> DTPMQRT applies a real orthogonal matrix Q obtained from a +*> DTPMQRT applies a real orthogonal matrix Q obtained from a *> "triangular-pentagonal" real block reflector H to a general *> real matrix C, which consists of two blocks A and B. *> \endverbatim @@ -69,7 +69,7 @@ *> N is INTEGER *> The number of columns of the matrix B. N >= 0. *> \endverbatim -*> +*> *> \param[in] K *> \verbatim *> K is INTEGER @@ -80,7 +80,7 @@ *> \param[in] L *> \verbatim *> L is INTEGER -*> The order of the trapezoidal part of V. +*> The order of the trapezoidal part of V. *> K >= L >= 0. See Further Details. *> \endverbatim *> @@ -124,19 +124,19 @@ *> \param[in,out] A *> \verbatim *> A is DOUBLE PRECISION array, dimension -*> (LDA,N) if SIDE = 'L' or +*> (LDA,N) if SIDE = 'L' or *> (LDA,K) if SIDE = 'R' *> On entry, the K-by-N or M-by-K matrix A. -*> On exit, A is overwritten by the corresponding block of +*> On exit, A is overwritten by the corresponding block of *> Q*C or Q**T*C or C*Q or C*Q**T. See Further Details. *> \endverbatim *> *> \param[in] LDA *> \verbatim *> LDA is INTEGER -*> The leading dimension of the array A. +*> The leading dimension of the array A. *> If SIDE = 'L', LDC >= max(1,K); -*> If SIDE = 'R', LDC >= max(1,M). +*> If SIDE = 'R', LDC >= max(1,M). *> \endverbatim *> *> \param[in,out] B @@ -150,7 +150,7 @@ *> \param[in] LDB *> \verbatim *> LDB is INTEGER -*> The leading dimension of the array B. +*> The leading dimension of the array B. *> LDB >= max(1,M). *> \endverbatim *> @@ -170,10 +170,10 @@ * 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 2015 * @@ -185,20 +185,20 @@ *> \verbatim *> *> The columns of the pentagonal matrix V contain the elementary reflectors -*> H(1), H(2), ..., H(K); V is composed of a rectangular block V1 and a +*> H(1), H(2), ..., H(K); V is composed of a rectangular block V1 and a *> trapezoidal block V2: *> *> V = [V1] [V2]. -*> *> -*> The size of the trapezoidal block V2 is determined by the parameter L, +*> +*> The size of the trapezoidal block V2 is determined by the parameter L, *> where 0 <= L <= K; V2 is lower trapezoidal, consisting of the first L *> rows of a K-by-K upper triangular matrix. If L=K, V2 is lower triangular; *> if L=0, there is no trapezoidal block, hence V = V1 is rectangular. *> -*> If SIDE = 'L': C = [A] where A is K-by-N, B is M-by-N and V is K-by-M. -*> [B] -*> +*> If SIDE = 'L': C = [A] where A is K-by-N, B is M-by-N and V is K-by-M. +*> [B] +*> *> If SIDE = 'R': C = [A B] where A is M-by-K, B is M-by-N and V is K-by-N. *> *> The real orthogonal matrix Q is formed from V and T. @@ -226,7 +226,7 @@ INTEGER INFO, K, LDV, LDA, LDB, M, N, L, MB, LDT * .. * .. Array Arguments .. - DOUBLE PRECISION V( LDV, * ), A( LDA, * ), B( LDB, * ), + DOUBLE PRECISION V( LDV, * ), A( LDA, * ), B( LDB, * ), $ T( LDT, * ), WORK( * ) * .. * @@ -256,7 +256,7 @@ RIGHT = LSAME( SIDE, 'R' ) TRAN = LSAME( TRANS, 'T' ) NOTRAN = LSAME( TRANS, 'N' ) -* +* IF ( LEFT ) THEN LDAQ = MAX( 1, K ) ELSE IF ( RIGHT ) THEN @@ -273,7 +273,7 @@ ELSE IF( K.LT.0 ) THEN INFO = -5 ELSE IF( L.LT.0 .OR. L.GT.K ) THEN - INFO = -6 + INFO = -6 ELSE IF( MB.LT.1 .OR. (MB.GT.K .AND. K.GT.0) ) THEN INFO = -7 ELSE IF( LDV.LT.K ) THEN @@ -305,11 +305,11 @@ ELSE LB = 0 END IF - CALL DTPRFB( 'L', 'T', 'F', 'R', NB, N, IB, LB, - $ V( I, 1 ), LDV, T( 1, I ), LDT, + CALL DTPRFB( 'L', 'T', 'F', 'R', NB, N, IB, LB, + $ V( I, 1 ), LDV, T( 1, I ), LDT, $ A( I, 1 ), LDA, B, LDB, WORK, IB ) END DO -* +* ELSE IF( RIGHT .AND. TRAN ) THEN * DO I = 1, K, MB @@ -320,8 +320,8 @@ ELSE LB = NB-N+L-I+1 END IF - CALL DTPRFB( 'R', 'N', 'F', 'R', M, NB, IB, LB, - $ V( I, 1 ), LDV, T( 1, I ), LDT, + CALL DTPRFB( 'R', 'N', 'F', 'R', M, NB, IB, LB, + $ V( I, 1 ), LDV, T( 1, I ), LDT, $ A( 1, I ), LDA, B, LDB, WORK, M ) END DO * @@ -329,15 +329,15 @@ * KF = ((K-1)/MB)*MB+1 DO I = KF, 1, -MB - IB = MIN( MB, K-I+1 ) + IB = MIN( MB, K-I+1 ) NB = MIN( M-L+I+IB-1, M ) IF( I.GE.L ) THEN LB = 0 ELSE LB = 0 - END IF + END IF CALL DTPRFB( 'L', 'N', 'F', 'R', NB, N, IB, LB, - $ V( I, 1 ), LDV, T( 1, I ), LDT, + $ V( I, 1 ), LDV, T( 1, I ), LDT, $ A( I, 1 ), LDA, B, LDB, WORK, IB ) END DO * @@ -345,7 +345,7 @@ * KF = ((K-1)/MB)*MB+1 DO I = KF, 1, -MB - IB = MIN( MB, K-I+1 ) + IB = MIN( MB, K-I+1 ) NB = MIN( N-L+I+IB-1, N ) IF( I.GE.L ) THEN LB = 0 @@ -353,7 +353,7 @@ LB = NB-N+L-I+1 END IF CALL DTPRFB( 'R', 'T', 'F', 'R', M, NB, IB, LB, - $ V( I, 1 ), LDV, T( 1, I ), LDT, + $ V( I, 1 ), LDV, T( 1, I ), LDT, $ A( 1, I ), LDA, B, LDB, WORK, M ) END DO * diff --git a/SRC/ilaenv.f b/SRC/ilaenv.f index 87ab858a..42a380cf 100644 --- a/SRC/ilaenv.f +++ b/SRC/ilaenv.f @@ -297,7 +297,7 @@ NB = N1 ELSE NB = 32768/N2 - END IF + END IF END IF ELSE IF( SNAME ) THEN @@ -320,7 +320,7 @@ NB = N1 ELSE NB = 32768/N2 - END IF + END IF END IF ELSE IF( SNAME ) THEN diff --git a/SRC/sgelq.f b/SRC/sgelq.f index 4e5a3500..8a759834 100644 --- a/SRC/sgelq.f +++ b/SRC/sgelq.f @@ -1,26 +1,26 @@ -* +* * Definition: * =========== * -* SUBROUTINE SGELQ( M, N, A, LDA, WORK1, LWORK1, WORK2, LWORK2, +* SUBROUTINE SGELQ( M, N, A, LDA, WORK1, LWORK1, WORK2, LWORK2, * INFO) -* +* * .. Scalar Arguments .. * INTEGER INFO, LDA, M, N, LWORK1, LWORK2 * .. * .. Array Arguments .. * REAL A( LDA, * ), WORK1( * ), WORK2( * ) * .. -* +* * *> \par Purpose: * ============= *> *> \verbatim -*> -*> SGELQ computes an LQ factorization of an M-by-N matrix A, -*> using SLASWLQ when A is short and wide -*> (N sufficiently greater than M), and otherwise SGELQT: +*> +*> SGELQ computes an LQ factorization of an M-by-N matrix A, +*> using SLASWLQ when A is short and wide +*> (N sufficiently greater than M), and otherwise SGELQT: *> A = L * Q . *> \endverbatim * @@ -43,10 +43,10 @@ *> \verbatim *> A is REAL array, dimension (LDA,N) *> On entry, the M-by-N matrix A. -*> On exit, the elements on and below the diagonal of the array -*> contain the M-by-min(M,N) lower trapezoidal matrix L +*> On exit, the elements on and below the diagonal of the array +*> contain the M-by-min(M,N) lower trapezoidal matrix L *> (L is lower triangular if M <= N); -*> the elements above the diagonal are the rows of +*> the elements above the diagonal are the rows of *> blocked V representing Q (see Further Details). *> \endverbatim *> @@ -60,13 +60,13 @@ *> \verbatim *> WORK1 is REAL array, dimension (MAX(1,LWORK1)) *> WORK1 contains part of the data structure used to store Q. -*> WORK1(1): algorithm type = 1, to indicate output from +*> WORK1(1): algorithm type = 1, to indicate output from *> SLASWLQ or SGELQT *> WORK1(2): optimum size of WORK1 *> WORK1(3): minimum size of WORK1 *> WORK1(4): horizontal block size *> WORK1(5): vertical block size -*> WORK1(6:LWORK1): data structure needed for Q, computed by +*> WORK1(6:LWORK1): data structure needed for Q, computed by *> SLASWLQ or SGELQT *> \endverbatim *> @@ -74,25 +74,25 @@ *> \verbatim *> LWORK1 is INTEGER *> The dimension of the array WORK1. -*> If LWORK1 = -1, then a query is assumed. In this case the +*> If LWORK1 = -1, then a query is assumed. In this case the *> routine calculates the optimal size of WORK1 and -*> returns this value in WORK1(2), and calculates the minimum -*> size of WORK1 and returns this value in WORK1(3). -*> No error message related to LWORK1 is issued by XERBLA when +*> returns this value in WORK1(2), and calculates the minimum +*> size of WORK1 and returns this value in WORK1(3). +*> No error message related to LWORK1 is issued by XERBLA when *> LWORK1 = -1. *> \endverbatim *> *> \param[out] WORK2 *> \verbatim *> (workspace) REAL array, dimension (MAX(1,LWORK2)) -*> +*> *> \endverbatim *> \param[in] LWORK2 *> \verbatim *> LWORK2 is INTEGER *> The dimension of the array WORK2. *> If LWORK2 = -1, then a query is assumed. In this case the -*> routine calculates the optimal size of WORK2 and +*> routine calculates the optimal size of WORK2 and *> returns this value in WORK2(1), and calculates the minimum *> size of WORK2 and returns this value in WORK2(2). *> No error message related to LWORK2 is issued by XERBLA when @@ -121,20 +121,20 @@ *> Depending on the matrix dimensions M and N, and row and column *> block sizes MB and NB returned by ILAENV, GELQ will use either *> LASWLQ(if the matrix is short-and-wide) or GELQT to compute -*> the LQ decomposition. +*> the LQ decomposition. *> The output of LASWLQ or GELQT representing Q is stored in A and in -*> array WORK1(6:LWORK1) for later use. -*> WORK1(2:5) contains the matrix dimensions M,N and block sizes MB, NB -*> which are needed to interpret A and WORK1(6:LWORK1) for later use. -*> WORK1(1)=1 indicates that the code needed to take WORK1(2:5) and +*> array WORK1(6:LWORK1) for later use. +*> WORK1(2:5) contains the matrix dimensions M,N and block sizes MB, NB +*> which are needed to interpret A and WORK1(6:LWORK1) for later use. +*> WORK1(1)=1 indicates that the code needed to take WORK1(2:5) and *> decide whether LASWLQ or GELQT was used is the same as used below in -*> GELQ. For a detailed description of A and WORK1(6:LWORK1), see +*> GELQ. For a detailed description of A and WORK1(6:LWORK1), see *> Further Details in LASWLQ or GELQT. *> \endverbatim *> *> * ===================================================================== - SUBROUTINE SGELQ( M, N, A, LDA, WORK1, LWORK1, WORK2, LWORK2, + SUBROUTINE SGELQ( M, N, A, LDA, WORK1, LWORK1, WORK2, LWORK2, $ INFO) * * -- LAPACK computational routine (version 3.5.0) -- @@ -176,8 +176,8 @@ * LQUERY = ( LWORK1.EQ.-1 .OR. LWORK2.EQ.-1 ) * -* Determine the block size -* +* Determine the block size +* IF ( MIN(M,N).GT.0 ) THEN MB = ILAENV( 1, 'SGELQ ', ' ', M, N, 1, -1) NB = ILAENV( 1, 'SGELQ ', ' ', M, N, 2, -1) @@ -199,7 +199,7 @@ END IF * * Determine if the workspace size satisfies minimum size -* +* LMINWS = .FALSE. IF((LWORK1.LT.MAX(1,MB*M*NBLCKS+5) $ .OR.(LWORK2.LT.MB*M)).AND.(LWORK2.GE.M).AND.(LWORK1.GE.M+5) @@ -207,10 +207,10 @@ IF (LWORK1.LT.MAX(1,MB*M*NBLCKS+5)) THEN LMINWS = .TRUE. MB = 1 - END IF + END IF IF (LWORK1.LT.MAX(1,M*NBLCKS+5)) THEN LMINWS = .TRUE. - NB = N + NB = N END IF IF (LWORK2.LT.MB*M) THEN LMINWS = .TRUE. @@ -224,13 +224,13 @@ INFO = -2 ELSE IF( LDA.LT.MAX( 1, M ) ) THEN INFO = -4 - ELSE IF( LWORK1.LT.MAX( 1, MB*M*NBLCKS+5 ) + ELSE IF( LWORK1.LT.MAX( 1, MB*M*NBLCKS+5 ) $ .AND.(.NOT.LQUERY).AND. (.NOT.LMINWS)) THEN INFO = -6 ELSE IF( (LWORK2.LT.MAX(1,M*MB)).AND.(.NOT.LQUERY) $ .AND.(.NOT.LMINWS) ) THEN - INFO = -8 - END IF + INFO = -8 + END IF * IF( INFO.EQ.0) THEN WORK1(1) = 1 @@ -258,12 +258,12 @@ * IF((N.LE.M).OR.(NB.LE.M).OR.(NB.GE.N)) THEN CALL SGELQT( M, N, MB, A, LDA, WORK1(6), MB, WORK2, INFO) - ELSE - CALL SLASWLQ( M, N, MB, NB, A, LDA, WORK1(6), MB, WORK2, + ELSE + CALL SLASWLQ( M, N, MB, NB, A, LDA, WORK1(6), MB, WORK2, $ LWORK2, INFO) END IF RETURN -* +* * End of SGELQ * - END
\ No newline at end of file + END diff --git a/SRC/sgelqt.f b/SRC/sgelqt.f index 6b037811..5c391704 100644 --- a/SRC/sgelqt.f +++ b/SRC/sgelqt.f @@ -2,14 +2,14 @@ * =========== * * SUBROUTINE SGELQT( M, N, MB, A, LDA, T, LDT, WORK, INFO ) -* +* * .. Scalar Arguments .. * INTEGER INFO, LDA, LDT, M, N, MB * .. * .. Array Arguments .. * REAL A( LDA, * ), T( LDT, * ), WORK( * ) * .. -* +* * *> \par Purpose: * ============= @@ -17,7 +17,7 @@ *> \verbatim *> *> DGELQT computes a blocked LQ factorization of a real M-by-N matrix A -*> using the compact WY representation of Q. +*> using the compact WY representation of Q. *> \endverbatim * * Arguments: @@ -86,10 +86,10 @@ * 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 2013 * @@ -106,14 +106,14 @@ *> V = ( 1 v1 v1 v1 v1 ) *> ( 1 v2 v2 v2 ) *> ( 1 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. +*> in the matrix A. The 1's along the diagonal of V are not stored in A. *> Let K=MIN(M,N). The number of blocks is B = ceiling(K/NB), where each -*> block is of order NB except for the last block, which is of order +*> block is of order NB except for the last block, which is of order *> IB = K - (B-1)*NB. For each of the B blocks, a upper triangular block -*> reflector factor is computed: T1, T2, ..., TB. The NB-by-NB (and IB-by-IB +*> reflector factor is computed: T1, T2, ..., TB. The NB-by-NB (and IB-by-IB *> for the last block) T's are stored in the NB-by-N matrix T as *> *> T = (T1 T2 ... TB). @@ -173,21 +173,21 @@ * DO I = 1, K, MB IB = MIN( K-I+1, MB ) -* +* * Compute the LQ factorization of the current block A(I:M,I:I+IB-1) -* +* CALL SGELQT3( IB, N-I+1, A(I,I), LDA, T(1,I), LDT, IINFO ) IF( I+IB.LE.M ) THEN * * Update by applying H**T to A(I:M,I+IB:N) from the right * CALL SLARFB( 'R', 'N', 'F', 'R', M-I-IB+1, N-I+1, IB, - $ A( I, I ), LDA, T( 1, I ), LDT, + $ A( I, I ), LDA, T( 1, I ), LDT, $ A( I+IB, I ), LDA, WORK , M-I-IB+1 ) END IF END DO RETURN -* +* * End of SGELQT * END diff --git a/SRC/sgelqt3.f b/SRC/sgelqt3.f index 3d9bc468..fb6c3e49 100644 --- a/SRC/sgelqt3.f +++ b/SRC/sgelqt3.f @@ -2,24 +2,24 @@ * =========== * * RECURSIVE SUBROUTINE SGELQT3( M, N, A, LDA, T, LDT, INFO ) -* +* * .. Scalar Arguments .. * INTEGER INFO, LDA, M, N, LDT * .. * .. Array Arguments .. * REAL 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 * @@ -78,10 +78,10 @@ * 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 * @@ -98,7 +98,7 @@ *> 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 @@ -160,7 +160,7 @@ * Compute Householder transform when N=1 * CALL SLARFG( N, A, A( 1, MIN( 2, N ) ), LDA, T ) -* +* ELSE * * Otherwise, split A into blocks... @@ -181,7 +181,7 @@ T( I+M1, J ) = A( I+M1, J ) END DO END DO - CALL STRMM( 'R', 'U', 'T', 'U', M2, M1, ONE, + CALL STRMM( 'R', 'U', 'T', 'U', M2, M1, ONE, & A, LDA, T( I1, 1 ), LDT ) * CALL SGEMM( 'N', 'T', M2, M1, N-M1, ONE, A( I1, I1 ), LDA, @@ -190,7 +190,7 @@ CALL STRMM( 'R', 'U', 'N', 'N', M2, M1, ONE, & T, LDT, T( I1, 1 ), LDT ) * - CALL SGEMM( 'N', 'N', M2, N-M1, M1, -ONE, T( I1, 1 ), LDT, + CALL SGEMM( 'N', 'N', M2, N-M1, M1, -ONE, T( I1, 1 ), LDT, & A( 1, I1 ), LDA, ONE, A( I1, I1 ), LDA ) * CALL STRMM( 'R', 'U', 'N', 'U', M2, M1 , ONE, @@ -205,7 +205,7 @@ * * Compute A(J1:M,J1:N) <- (Y2,R2,T2) where Q2 = I - Y2 T2 Y2^H * - CALL SGELQT3( M2, N-M1, A( I1, I1 ), LDA, + CALL SGELQT3( M2, N-M1, A( I1, I1 ), LDA, & T( I1, I1 ), LDT, IINFO ) * * Compute T3 = T(J1:N1,1:N) = -T1 Y1^H Y2 T2 @@ -222,13 +222,13 @@ CALL SGEMM( 'N', 'T', M1, M2, N-M, ONE, A( 1, J1 ), LDA, & A( I1, J1 ), LDA, ONE, T( 1, I1 ), LDT ) * - CALL STRMM( 'L', 'U', 'N', 'N', M1, M2, -ONE, T, LDT, + CALL STRMM( 'L', 'U', 'N', 'N', M1, M2, -ONE, T, LDT, & T( 1, I1 ), LDT ) * - CALL STRMM( 'R', 'U', 'N', 'N', M1, M2, ONE, + CALL STRMM( '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] diff --git a/SRC/sgemlq.f b/SRC/sgemlq.f index 37a9fb9b..14a37a4d 100644 --- a/SRC/sgemlq.f +++ b/SRC/sgemlq.f @@ -1,8 +1,8 @@ -* +* * Definition: * =========== * -* SUBROUTINE SGEMLQ( SIDE, TRANS, M, N, K, A, LDA, WORK1, +* SUBROUTINE SGEMLQ( SIDE, TRANS, M, N, K, A, LDA, WORK1, * $ LWORK1, C, LDC, WORK2, LWORK2, INFO ) * * @@ -17,15 +17,15 @@ * ============= *> *> \verbatim -*> +*> *> DGEMLQ overwrites the general real M-by-N matrix C with *> -*> +*> *> SIDE = 'L' SIDE = 'R' *> TRANS = 'N': Q * C C * Q *> TRANS = 'T': Q**T * C C * Q**T -*> where Q is a real orthogonal matrix defined as the product -*> of blocked elementary reflectors computed by short wide LQ +*> where Q is a real orthogonal matrix defined as the product +*> of blocked elementary reflectors computed by short wide LQ *> factorization (DGELQ) *> \endverbatim * @@ -59,7 +59,7 @@ *> The number of elementary reflectors whose product defines *> the matrix Q. *> M >= K >= 0; -*> +*> *> \endverbatim *> *> \param[in,out] A @@ -101,15 +101,15 @@ *> \param[out] WORK2 *> \verbatim *> (workspace) REAL array, dimension (MAX(1,LWORK2)) -*> +*> *> \endverbatim *> \param[in] LWORK2 *> \verbatim *> LWORK2 is INTEGER -*> The dimension of the array WORK2. +*> The dimension of the array WORK2. *> If LWORK2 = -1, then a workspace query is assumed; the routine *> only calculates the optimal size of the WORK2 array, returns -*> this value as the third entry of the WORK2 array (WORK2(1)), +*> this value as the third entry of the WORK2 array (WORK2(1)), *> and no error message related to LWORK2 is issued by XERBLA. *> *> \endverbatim @@ -135,19 +135,19 @@ *> Depending on the matrix dimensions M and N, and row and column *> block sizes MB and NB returned by ILAENV, GELQ will use either *> LASWLQ(if the matrix is short-and-wide) or GELQT to compute -*> the LQ decomposition. +*> the LQ decomposition. *> The output of LASWLQ or GELQT representing Q is stored in A and in -*> array WORK1(6:LWORK1) for later use. -*> WORK1(2:5) contains the matrix dimensions M,N and block sizes MB, NB -*> which are needed to interpret A and WORK1(6:LWORK1) for later use. -*> WORK1(1)=1 indicates that the code needed to take WORK1(2:5) and +*> array WORK1(6:LWORK1) for later use. +*> WORK1(2:5) contains the matrix dimensions M,N and block sizes MB, NB +*> which are needed to interpret A and WORK1(6:LWORK1) for later use. +*> WORK1(1)=1 indicates that the code needed to take WORK1(2:5) and *> decide whether LASWLQ or GELQT was used is the same as used below in -*> GELQ. For a detailed description of A and WORK1(6:LWORK1), see +*> GELQ. For a detailed description of A and WORK1(6:LWORK1), see *> Further Details in LASWLQ or GELQT. *> \endverbatim *> * ===================================================================== - SUBROUTINE SGEMLQ( SIDE, TRANS, M, N, K, A, LDA, WORK1, LWORK1, + SUBROUTINE SGEMLQ( SIDE, TRANS, M, N, K, A, LDA, WORK1, LWORK1, $ C, LDC, WORK2, LWORK2, INFO ) * * -- LAPACK computational routine (version 3.5.0) -- @@ -242,12 +242,12 @@ * IF( MIN(M,N,K).EQ.0 ) THEN RETURN - END IF + END IF * IF((LEFT.AND.M.LE.K).OR.(RIGHT.AND.N.LE.K).OR.(NB.LE.K).OR. $ (NB.GE.MAX(M,N,K))) THEN - CALL SGEMLQT( SIDE, TRANS, M, N, K, MB, A, LDA, - $ WORK1(6), MB, C, LDC, WORK2, INFO) + CALL SGEMLQT( SIDE, TRANS, M, N, K, MB, A, LDA, + $ WORK1(6), MB, C, LDC, WORK2, INFO) ELSE CALL SLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, WORK1(6), $ MB, C, LDC, WORK2, LWORK2, INFO ) @@ -258,4 +258,4 @@ * * End of SGEMLQ * - END
\ No newline at end of file + END diff --git a/SRC/sgemlqt.f b/SRC/sgemlqt.f index 7e0dfff7..56c604bf 100644 --- a/SRC/sgemlqt.f +++ b/SRC/sgemlqt.f @@ -1,9 +1,9 @@ * Definition: * =========== * -* SUBROUTINE SGEMLQT( SIDE, TRANS, M, N, K, MB, V, LDV, T, LDT, +* SUBROUTINE SGEMLQT( SIDE, TRANS, M, N, K, MB, V, LDV, T, LDT, * C, LDC, WORK, INFO ) -* +* * .. Scalar Arguments .. * CHARACTER SIDE, TRANS * INTEGER INFO, K, LDV, LDC, M, N, MB, LDT @@ -11,7 +11,7 @@ * .. Array Arguments .. * REAL V( LDV, * ), C( LDC, * ), T( LDT, * ), WORK( * ) * .. -* +* * *> \par Purpose: * ============= @@ -29,7 +29,7 @@ *> *> Q = H(1) H(2) . . . H(K) = I - V T V**T *> -*> generated using the compact WY representation as returned by DGELQT. +*> generated using the compact WY representation as returned by DGELQT. *> *> Q is of order M if SIDE = 'L' and of order N if SIDE = 'R'. *> \endverbatim @@ -138,17 +138,17 @@ * 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 2013 * *> \ingroup doubleGEcomputational * * ===================================================================== - SUBROUTINE SGEMLQT( SIDE, TRANS, M, N, K, MB, V, LDV, T, LDT, + SUBROUTINE SGEMLQT( SIDE, TRANS, M, N, K, MB, V, LDV, T, LDT, $ C, LDC, WORK, INFO ) * * -- LAPACK computational routine (version 3.5.0) -- @@ -190,7 +190,7 @@ RIGHT = LSAME( SIDE, 'R' ) TRAN = LSAME( TRANS, 'T' ) NOTRAN = LSAME( TRANS, 'N' ) -* +* IF( LEFT ) THEN LDWORK = MAX( 1, N ) ELSE IF ( RIGHT ) THEN @@ -229,17 +229,17 @@ * DO I = 1, K, MB IB = MIN( MB, K-I+1 ) - CALL SLARFB( 'L', 'T', 'F', 'R', M-I+1, N, IB, - $ V( I, I ), LDV, T( 1, I ), LDT, + CALL SLARFB( 'L', 'T', 'F', 'R', M-I+1, N, IB, + $ V( I, I ), LDV, T( 1, I ), LDT, $ C( I, 1 ), LDC, WORK, LDWORK ) END DO -* +* ELSE IF( RIGHT .AND. TRAN ) THEN * DO I = 1, K, MB IB = MIN( MB, K-I+1 ) - CALL SLARFB( 'R', 'N', 'F', 'R', M, N-I+1, IB, - $ V( I, I ), LDV, T( 1, I ), LDT, + CALL SLARFB( 'R', 'N', 'F', 'R', M, N-I+1, IB, + $ V( I, I ), LDV, T( 1, I ), LDT, $ C( 1, I ), LDC, WORK, LDWORK ) END DO * @@ -247,9 +247,9 @@ * KF = ((K-1)/MB)*MB+1 DO I = KF, 1, -MB - IB = MIN( MB, K-I+1 ) - CALL SLARFB( 'L', 'N', 'F', 'R', M-I+1, N, IB, - $ V( I, I ), LDV, T( 1, I ), LDT, + IB = MIN( MB, K-I+1 ) + CALL SLARFB( 'L', 'N', 'F', 'R', M-I+1, N, IB, + $ V( I, I ), LDV, T( 1, I ), LDT, $ C( I, 1 ), LDC, WORK, LDWORK ) END DO * @@ -257,9 +257,9 @@ * KF = ((K-1)/MB)*MB+1 DO I = KF, 1, -MB - IB = MIN( MB, K-I+1 ) - CALL SLARFB( 'R', 'T', 'F', 'R', M, N-I+1, IB, - $ V( I, I ), LDV, T( 1, I ), LDT, + IB = MIN( MB, K-I+1 ) + CALL SLARFB( 'R', 'T', 'F', 'R', M, N-I+1, IB, + $ V( I, I ), LDV, T( 1, I ), LDT, $ C( 1, I ), LDC, WORK, LDWORK ) END DO * diff --git a/SRC/sgemqr.f b/SRC/sgemqr.f index 8e3deacb..cda7990c 100644 --- a/SRC/sgemqr.f +++ b/SRC/sgemqr.f @@ -1,8 +1,8 @@ -* +* * Definition: * =========== * -* SUBROUTINE SGEMQR( SIDE, TRANS, M, N, K, A, LDA, WORK1, +* SUBROUTINE SGEMQR( SIDE, TRANS, M, N, K, A, LDA, WORK1, * $ LWORK1, C, LDC, WORK2, LWORK2, INFO ) * * @@ -17,15 +17,15 @@ * ============= *> *> \verbatim -*> +*> *> SGEMQR overwrites the general real M-by-N matrix C with *> -*> +*> *> SIDE = 'L' SIDE = 'R' *> TRANS = 'N': Q * C C * Q *> TRANS = 'T': Q**T * C C * Q**T -*> where Q is a real orthogonal matrix defined as the product -*> of blocked elementary reflectors computed by tall skinny +*> where Q is a real orthogonal matrix defined as the product +*> of blocked elementary reflectors computed by tall skinny *> QR factorization (DGEQR) *> \endverbatim * @@ -59,15 +59,15 @@ *> The number of elementary reflectors whose product defines *> the matrix Q. *> N >= K >= 0; -*> +*> *> \endverbatim *> *> \param[in,out] A *> \verbatim *> A is REAL array, dimension (LDA,K) -*> The i-th column must contain the vector which defines the -*> blockedelementary reflector H(i), for i = 1,2,...,k, as -*> returned by DGETSQR in the first k columns of +*> The i-th column must contain the vector which defines the +*> blockedelementary reflector H(i), for i = 1,2,...,k, as +*> returned by DGETSQR in the first k columns of *> its array argument A. *> \endverbatim *> @@ -103,15 +103,15 @@ *> \param[out] WORK2 *> \verbatim *> (workspace) REAL array, dimension (MAX(1,LWORK2)) -*> +*> *> \endverbatim *> \param[in] LWORK2 *> \verbatim *> LWORK2 is INTEGER -*> The dimension of the array WORK2. +*> The dimension of the array WORK2. *> If LWORK2 = -1, then a workspace query is assumed; the routine *> only calculates the optimal size of the WORK2 array, returns -*> this value as the third entry of the WORK2 array (WORK2(1)), +*> this value as the third entry of the WORK2 array (WORK2(1)), *> and no error message related to LWORK2 is issued by XERBLA. *> *> \endverbatim @@ -137,19 +137,19 @@ *> Depending on the matrix dimensions M and N, and row and column *> block sizes MB and NB returned by ILAENV, GEQR will use either *> LATSQR (if the matrix is tall-and-skinny) or GEQRT to compute -*> the QR decomposition. +*> the QR decomposition. *> The output of LATSQR or GEQRT representing Q is stored in A and in -*> array WORK1(6:LWORK1) for later use. -*> WORK1(2:5) contains the matrix dimensions M,N and block sizes MB,NB -*> which are needed to interpret A and WORK1(6:LWORK1) for later use. -*> WORK1(1)=1 indicates that the code needed to take WORK1(2:5) and -*> decide whether LATSQR or GEQRT was used is the same as used below in +*> array WORK1(6:LWORK1) for later use. +*> WORK1(2:5) contains the matrix dimensions M,N and block sizes MB,NB +*> which are needed to interpret A and WORK1(6:LWORK1) for later use. +*> WORK1(1)=1 indicates that the code needed to take WORK1(2:5) and +*> decide whether LATSQR or GEQRT was used is the same as used below in *> GEQR. For a detailed description of A and WORK1(6:LWORK1), see *> Further Details in LATSQR or GEQRT. *> \endverbatim *> * ===================================================================== - SUBROUTINE SGEMQR( SIDE, TRANS, M, N, K, A, LDA, WORK1, LWORK1, + SUBROUTINE SGEMQR( SIDE, TRANS, M, N, K, A, LDA, WORK1, LWORK1, $ C, LDC, WORK2, LWORK2, INFO ) * * -- LAPACK computational routine (version 3.5.0) -- @@ -177,7 +177,7 @@ LOGICAL LSAME EXTERNAL LSAME * .. External Subroutines .. - EXTERNAL SGEMQRT, STPMQRT, XERBLA + EXTERNAL SGEMQRT, STPMQRT, XERBLA * .. Intrinsic Functions .. INTRINSIC INT, MAX, MIN, MOD * .. @@ -199,7 +199,7 @@ ELSE IF(RIGHT) THEN LW = MB * NB MN = N - END IF + END IF * IF ((MB.GT.K).AND.(MN.GT.K)) THEN IF(MOD(MN-K, MB-K).EQ.0) THEN @@ -233,9 +233,9 @@ END IF * * Determine the block size if it is tall skinny or short and wide -* +* IF( INFO.EQ.0) THEN - WORK2(1) = LW + WORK2(1) = LW END IF * IF( INFO.NE.0 ) THEN @@ -253,17 +253,17 @@ * IF((LEFT.AND.M.LE.K).OR.(RIGHT.AND.N.LE.K).OR.(MB.LE.K).OR. $ (MB.GE.MAX(M,N,K))) THEN - CALL SGEMQRT( SIDE, TRANS, M, N, K, NB, A, LDA, - $ WORK1(6), NB, C, LDC, WORK2, INFO) + CALL SGEMQRT( SIDE, TRANS, M, N, K, NB, A, LDA, + $ WORK1(6), NB, C, LDC, WORK2, INFO) ELSE CALL SLAMTSQR( SIDE, TRANS, M, N, K, MB, NB, A, LDA, WORK1(6), $ NB, C, LDC, WORK2, LWORK2, INFO ) - END IF + END IF * WORK2(1) = LW -* +* RETURN * * End of SGEMQR * - END
\ No newline at end of file + END diff --git a/SRC/sgeqr.f b/SRC/sgeqr.f index c984404c..41e04622 100644 --- a/SRC/sgeqr.f +++ b/SRC/sgeqr.f @@ -1,26 +1,26 @@ -* +* * Definition: * =========== * * SUBROUTINE SGEQR( M, N, A, LDA, WORK1, LWORK1, WORK2, LWORK2, * INFO) -* +* * .. Scalar Arguments .. * INTEGER INFO, LDA, M, N, LWORK1, LWORK2 * .. * .. Array Arguments .. * REAL A( LDA, * ), WORK1( * ), WORK2( * ) * .. -* +* * *> \par Purpose: * ============= *> *> \verbatim -*> -*> SGEQR computes a QR factorization of an M-by-N matrix A, -*> using SLATSQR when A is tall and skinny -*> (M sufficiently greater than N), and otherwise SGEQRT: +*> +*> SGEQR computes a QR factorization of an M-by-N matrix A, +*> using SLATSQR when A is tall and skinny +*> (M sufficiently greater than N), and otherwise SGEQRT: *> A = Q * R . *> \endverbatim * @@ -44,7 +44,7 @@ *> A is REAL array, dimension (LDA,N) *> On entry, the M-by-N matrix A. *> On exit, the elements on and above the diagonal of the array -*> contain the min(M,N)-by-N upper trapezoidal matrix R +*> contain the min(M,N)-by-N upper trapezoidal matrix R *> (R is upper triangular if M >= N); *> the elements below the diagonal represent Q (see Further Details). *> \endverbatim @@ -59,13 +59,13 @@ *> \verbatim *> WORK1 is REAL array, dimension (MAX(1,LWORK1)) *> WORK1 contains part of the data structure used to store Q. -*> WORK1(1): algorithm type = 1, to indicate output from +*> WORK1(1): algorithm type = 1, to indicate output from *> DLATSQR or DGEQRT *> WORK1(2): optimum size of WORK1 *> WORK1(3): minimum size of WORK1 *> WORK1(4): row block size *> WORK1(5): column block size -*> WORK1(6:LWORK1): data structure needed for Q, computed by +*> WORK1(6:LWORK1): data structure needed for Q, computed by *> SLATSQR or SGEQRT *> \endverbatim *> @@ -73,25 +73,25 @@ *> \verbatim *> LWORK1 is INTEGER *> The dimension of the array WORK1. -*> If LWORK1 = -1, then a query is assumed. In this case the +*> If LWORK1 = -1, then a query is assumed. In this case the *> routine calculates the optimal size of WORK1 and -*> returns this value in WORK1(2), and calculates the minimum -*> size of WORK1 and returns this value in WORK1(3). -*> No error message related to LWORK1 is issued by XERBLA when +*> returns this value in WORK1(2), and calculates the minimum +*> size of WORK1 and returns this value in WORK1(3). +*> No error message related to LWORK1 is issued by XERBLA when *> LWORK1 = -1. *> \endverbatim *> *> \param[out] WORK2 *> \verbatim -*> (workspace) REAL array, dimension (MAX(1,LWORK2)) +*> (workspace) REAL array, dimension (MAX(1,LWORK2)) *> \endverbatim *> *> \param[in] LWORK2 *> \verbatim *> LWORK2 is INTEGER *> The dimension of the array WORK2. -*> If LWORK2 = -1, then a query is assumed. In this case the -*> routine calculates the optimal size of WORK2 and +*> If LWORK2 = -1, then a query is assumed. In this case the +*> routine calculates the optimal size of WORK2 and *> returns this value in WORK2(1), and calculates the minimum *> size of WORK2 and returns this value in WORK2(2). *> No error message related to LWORK2 is issued by XERBLA when @@ -120,19 +120,19 @@ *> Depending on the matrix dimensions M and N, and row and column *> block sizes MB and NB returned by ILAENV, GEQR will use either *> LATSQR (if the matrix is tall-and-skinny) or GEQRT to compute -*> the QR decomposition. +*> the QR decomposition. *> The output of LATSQR or GEQRT representing Q is stored in A and in -*> array WORK1(6:LWORK1) for later use. -*> WORK1(2:5) contains the matrix dimensions M,N and block sizes MB,NB -*> which are needed to interpret A and WORK1(6:LWORK1) for later use. -*> WORK1(1)=1 indicates that the code needed to take WORK1(2:5) and -*> decide whether LATSQR or GEQRT was used is the same as used below in -*> GEQR. For a detailed description of A and WORK1(6:LWORK1), see +*> array WORK1(6:LWORK1) for later use. +*> WORK1(2:5) contains the matrix dimensions M,N and block sizes MB,NB +*> which are needed to interpret A and WORK1(6:LWORK1) for later use. +*> WORK1(1)=1 indicates that the code needed to take WORK1(2:5) and +*> decide whether LATSQR or GEQRT was used is the same as used below in +*> GEQR. For a detailed description of A and WORK1(6:LWORK1), see *> Further Details in LATSQR or GEQRT. *> \endverbatim *> * ===================================================================== - SUBROUTINE SGEQR( M, N, A, LDA, WORK1, LWORK1, WORK2, LWORK2, + SUBROUTINE SGEQR( M, N, A, LDA, WORK1, LWORK1, WORK2, LWORK2, $ INFO) * * -- LAPACK computational routine (version 3.5.0) -- @@ -174,8 +174,8 @@ * LQUERY = ( LWORK1.EQ.-1 .OR. LWORK2.EQ.-1 ) * -* Determine the block size -* +* Determine the block size +* IF ( MIN(M,N).GT.0 ) THEN MB = ILAENV( 1, 'SGEQR ', ' ', M, N, 1, -1) NB = ILAENV( 1, 'SGEQR ', ' ', M, N, 2, -1) @@ -197,18 +197,18 @@ END IF * * Determine if the workspace size satisfies minimum size -* +* LMINWS = .FALSE. - IF((LWORK1.LT.MAX(1, NB*N*NBLCKS+5) - $ .OR.(LWORK2.LT.NB*N)).AND.(LWORK2.GE.N).AND.(LWORK1.GT.N+5) + IF((LWORK1.LT.MAX(1, NB*N*NBLCKS+5) + $ .OR.(LWORK2.LT.NB*N)).AND.(LWORK2.GE.N).AND.(LWORK1.GT.N+5) $ .AND.(.NOT.LQUERY)) THEN IF (LWORK1.LT.MAX(1, NB * N * NBLCKS+5)) THEN LMINWS = .TRUE. NB = 1 - END IF + END IF IF (LWORK1.LT.MAX(1, N * NBLCKS+5)) THEN LMINWS = .TRUE. - MB = M + MB = M END IF IF (LWORK2.LT.NB*N) THEN LMINWS = .TRUE. @@ -222,13 +222,13 @@ INFO = -2 ELSE IF( LDA.LT.MAX( 1, M ) ) THEN INFO = -4 - ELSE IF( LWORK1.LT.MAX( 1, NB * N * NBLCKS + 5 ) + ELSE IF( LWORK1.LT.MAX( 1, NB * N * NBLCKS + 5 ) $ .AND.(.NOT.LQUERY).AND.(.NOT.LMINWS)) THEN INFO = -6 - ELSE IF( (LWORK2.LT.MAX(1,N*NB)).AND.(.NOT.LQUERY) + ELSE IF( (LWORK2.LT.MAX(1,N*NB)).AND.(.NOT.LQUERY) $ .AND.(.NOT.LMINWS)) THEN - INFO = -8 - END IF + INFO = -8 + END IF IF( INFO.EQ.0) THEN WORK1(1) = 1 @@ -256,12 +256,12 @@ * IF((M.LE.N).OR.(MB.LE.N).OR.(MB.GE.M)) THEN CALL SGEQRT( M, N, NB, A, LDA, WORK1(6), NB, WORK2, INFO) - ELSE - CALL SLATSQR( M, N, MB, NB, A, LDA, WORK1(6), NB, WORK2, + ELSE + CALL SLATSQR( M, N, MB, NB, A, LDA, WORK1(6), NB, WORK2, $ LWORK2, INFO) END IF RETURN -* +* * End of SGEQR * - END
\ No newline at end of file + END diff --git a/SRC/sgetsls.f b/SRC/sgetsls.f index 050b3b93..b7bcd0f0 100644 --- a/SRC/sgetsls.f +++ b/SRC/sgetsls.f @@ -4,7 +4,7 @@ * SUBROUTINE SGETSLS( TRANS, M, N, NRHS, A, LDA, B, LDB * $ , WORK, LWORK, INFO ) -* +* * .. Scalar Arguments .. * CHARACTER TRANS * INTEGER INFO, LDA, LDB, LWORK, M, N, NRHS @@ -12,7 +12,7 @@ * .. Array Arguments .. * REAL A( LDA, * ), B( LDB, * ), WORK( * ) * .. -* +* * *> \par Purpose: * ============= @@ -20,10 +20,10 @@ *> \verbatim *> *> SGETSLS 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: *> @@ -121,7 +121,7 @@ *> \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 @@ -140,10 +140,10 @@ * 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 * @@ -187,7 +187,7 @@ EXTERNAL LSAME, ILAENV, SLABAD, SLAMCH, SLANGE * .. * .. External Subroutines .. - EXTERNAL SGEQR, SGEMQR, SLASCL, SLASET, + EXTERNAL SGEQR, SGEMQR, SLASCL, SLASET, $ STRTRS, XERBLA, SGELQ, SGEMLQ * .. * .. Intrinsic Functions .. @@ -204,7 +204,7 @@ 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 @@ -222,9 +222,9 @@ IF( INFO.EQ.0) THEN * * Determine the block size and minimum LWORK -* +* IF ( M.GE.N ) THEN - CALL SGEQR( M, N, A, LDA, WORK(1), -1, WORK(6), -1, + CALL SGEQR( M, N, A, LDA, WORK(1), -1, WORK(6), -1, $ INFO2) MB = INT(WORK(4)) NB = INT(WORK(5)) @@ -233,8 +233,8 @@ $ 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 SGELQ( M, N, A, LDA, WORK(1), -1, WORK(6), -1, + ELSE + CALL SGELQ( M, N, A, LDA, WORK(1), -1, WORK(6), -1, $ INFO2) MB = INT(WORK(4)) NB = INT(WORK(5)) @@ -271,7 +271,7 @@ * Quick return if possible * IF( MIN( M, N, NRHS ).EQ.0 ) THEN - CALL SLASET( 'FULL', MAX( M, N ), NRHS, ZERO, ZERO, + CALL SLASET( 'FULL', MAX( M, N ), NRHS, ZERO, ZERO, $ B, LDB ) RETURN END IF @@ -340,7 +340,7 @@ * * B(1:M,1:NRHS) := Q**T * B(1:M,1:NRHS) * - CALL SGEMQR( 'L' , 'T', M, NRHS, N, A, LDA, + CALL SGEMQR( '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) @@ -376,7 +376,7 @@ * CALL SGEMQR( 'L', 'N', M, NRHS, N, A, LDA, $ WORK( LW2+1), LW1, B, LDB, WORK( 1 ), LW2, - $ INFO ) + $ INFO ) * SCLLEN = M * @@ -473,4 +473,4 @@ * * End of SGETSLS * - END
\ No newline at end of file + END diff --git a/SRC/slamswlq.f b/SRC/slamswlq.f index c636c70c..f8719139 100644 --- a/SRC/slamswlq.f +++ b/SRC/slamswlq.f @@ -1,8 +1,8 @@ -* +* * Definition: * =========== * -* SUBROUTINE SLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, +* SUBROUTINE SLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, * $ LDT, C, LDC, WORK, LWORK, INFO ) * * @@ -17,15 +17,15 @@ * ============= *> *> \verbatim -*> +*> *> DLAMQRTS overwrites the general real M-by-N matrix C with *> -*> +*> *> SIDE = 'L' SIDE = 'R' *> TRANS = 'N': Q * C C * Q *> TRANS = 'T': Q**T * C C * Q**T *> where Q is a real orthogonal matrix defined as the product of blocked -*> elementary reflectors computed by short wide LQ +*> elementary reflectors computed by short wide LQ *> factorization (DLASWLQ) *> \endverbatim * @@ -59,28 +59,28 @@ *> The number of elementary reflectors whose product defines *> the matrix Q. *> M >= K >= 0; -*> +*> *> \endverbatim *> \param[in] MB *> \verbatim *> MB is INTEGER -*> The row block size to be used in the blocked QR. -*> M >= MB >= 1 +*> The row block size to be used in the blocked QR. +*> M >= MB >= 1 *> \endverbatim *> *> \param[in] NB *> \verbatim *> NB is INTEGER -*> The column block size to be used in the blocked QR. +*> The column block size to be used in the blocked QR. *> NB > M. *> \endverbatim *> *> \param[in] NB *> \verbatim *> NB is INTEGER -*> The block size to be used in the blocked QR. +*> The block size to be used in the blocked QR. *> MB > M. -*> +*> *> \endverbatim *> *> \param[in,out] A @@ -101,7 +101,7 @@ *> *> \param[in] T *> \verbatim -*> T is REAL array, dimension +*> T is REAL array, dimension *> ( M * Number of blocks(CEIL(N-K/NB-K)), *> The blocked upper triangular block reflectors stored in compact form *> as a sequence of upper triangular blocks. See below @@ -125,7 +125,7 @@ *> \param[out] WORK *> \verbatim *> (workspace) REAL array, dimension (MAX(1,LWORK)) -*> +*> *> \endverbatim *> \param[in] LWORK *> \verbatim @@ -177,7 +177,7 @@ *> block reflectors, stored in array T(1:LDT,(i-1)*M+1:i*M). *> The last Q(k) may use fewer rows. *> For more information see Further Details in TPQRT. -*> +*> *> For more details of the overall algorithm, see the description of *> Sequential TSQR in Section 2.2 of [1]. *> @@ -187,7 +187,7 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE SLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, + SUBROUTINE SLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, $ LDT, C, LDC, WORK, LWORK, INFO ) * * -- LAPACK computational routine (version 3.5.0) -- @@ -269,8 +269,8 @@ END IF * IF((NB.LE.K).OR.(NB.GE.MAX(M,N,K))) THEN - CALL DGEMLQT( SIDE, TRANS, M, N, K, MB, A, LDA, - $ T, LDT, C, LDC, WORK, INFO) + CALL DGEMLQT( SIDE, TRANS, M, N, K, MB, A, LDA, + $ T, LDT, C, LDC, WORK, INFO) RETURN END IF * @@ -389,7 +389,7 @@ IF(II.LE.N) THEN * * Multiply Q to the last block of C -* +* CALL STPMLQT('R','T',M , KK, K, 0,MB, A(1,II), LDA, $ T(1,CTR*K+1),LDT, C(1,1), LDC, $ C(1,II), LDC, WORK, INFO ) @@ -403,4 +403,4 @@ * * End of SLAMSWLQ * - END
\ No newline at end of file + END diff --git a/SRC/slamtsqr.f b/SRC/slamtsqr.f index 3618db08..69d6c327 100644 --- a/SRC/slamtsqr.f +++ b/SRC/slamtsqr.f @@ -1,8 +1,8 @@ -* +* * Definition: * =========== * -* SUBROUTINE SLAMTSQR( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, +* SUBROUTINE SLAMTSQR( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, * $ LDT, C, LDC, WORK, LWORK, INFO ) * * @@ -17,15 +17,15 @@ * ============= *> *> \verbatim -*> +*> *> SLAMTSQR overwrites the general real M-by-N matrix C with *> -*> +*> *> SIDE = 'L' SIDE = 'R' *> TRANS = 'N': Q * C C * Q *> TRANS = 'T': Q**T * C C * Q**T -*> where Q is a real orthogonal matrix defined as the product -*> of blocked elementary reflectors computed by tall skinny +*> where Q is a real orthogonal matrix defined as the product +*> of blocked elementary reflectors computed by tall skinny *> QR factorization (DLATSQR) *> \endverbatim * @@ -59,29 +59,29 @@ *> The number of elementary reflectors whose product defines *> the matrix Q. *> N >= K >= 0; -*> +*> *> \endverbatim *> *> \param[in] MB *> \verbatim *> MB is INTEGER -*> The block size to be used in the blocked QR. +*> The block size to be used in the blocked QR. *> MB > N. (must be the same as DLATSQR) *> \endverbatim *> *> \param[in] NB *> \verbatim *> NB is INTEGER -*> The column block size to be used in the blocked QR. +*> The column block size to be used in the blocked QR. *> N >= NB >= 1. *> \endverbatim *> *> \param[in,out] A *> \verbatim *> A is REAL array, dimension (LDA,K) -*> The i-th column must contain the vector which defines the -*> blockedelementary reflector H(i), for i = 1,2,...,k, as -*> returned by DLATSQR in the first k columns of +*> The i-th column must contain the vector which defines the +*> blockedelementary reflector H(i), for i = 1,2,...,k, as +*> returned by DLATSQR in the first k columns of *> its array argument A. *> \endverbatim *> @@ -95,7 +95,7 @@ *> *> \param[in] T *> \verbatim -*> T is REAL array, dimension +*> T is REAL array, dimension *> ( N * Number of blocks(CEIL(M-K/MB-K)), *> The blocked upper triangular block reflectors stored in compact form *> as a sequence of upper triangular blocks. See below @@ -119,13 +119,13 @@ *> \param[out] WORK *> \verbatim *> (workspace) REAL array, dimension (MAX(1,LWORK)) -*> +*> *> \endverbatim *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER *> The dimension of the array WORK. -*> +*> *> If SIDE = 'L', LWORK >= max(1,N)*NB; *> if SIDE = 'R', LWORK >= max(1,MB)*NB. *> If LWORK = -1, then a workspace query is assumed; the routine @@ -172,7 +172,7 @@ *> block reflectors, stored in array T(1:LDT,(i-1)*N+1:i*N). *> The last Q(k) may use fewer rows. *> For more information see Further Details in TPQRT. -*> +*> *> For more details of the overall algorithm, see the description of *> Sequential TSQR in Section 2.2 of [1]. *> @@ -182,7 +182,7 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE SLAMTSQR( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, + SUBROUTINE SLAMTSQR( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, $ LDT, C, LDC, WORK, LWORK, INFO ) * * -- LAPACK computational routine (version 3.5.0) -- @@ -204,13 +204,13 @@ * .. * .. Local Scalars .. LOGICAL LEFT, RIGHT, TRAN, NOTRAN, LQUERY - INTEGER I, II, KK, LW, CTR + INTEGER I, II, KK, LW, CTR * .. * .. External Functions .. LOGICAL LSAME EXTERNAL LSAME * .. External Subroutines .. - EXTERNAL SGEMQRT, STPMQRT, XERBLA + EXTERNAL SGEMQRT, STPMQRT, XERBLA * .. * .. Executable Statements .. * @@ -250,7 +250,7 @@ IF( INFO.EQ.0) THEN * * Determine the block size if it is tall skinny or short and wide -* +* IF( INFO.EQ.0) THEN WORK(1) = LW END IF @@ -269,10 +269,10 @@ END IF * IF((MB.LE.K).OR.(MB.GE.MAX(M,N,K))) THEN - CALL SGEMQRT( SIDE, TRANS, M, N, K, NB, A, LDA, - $ T, LDT, C, LDC, WORK, INFO) + CALL SGEMQRT( SIDE, TRANS, M, N, K, NB, A, LDA, + $ T, LDT, C, LDC, WORK, INFO) RETURN - END IF + END IF * IF(LEFT.AND.NOTRAN) THEN * @@ -297,7 +297,7 @@ CALL STPMQRT('L','N',MB-K , N, K, 0,NB, A(I,1), LDA, $ T(1, CTR * K + 1), LDT, C(1,1), LDC, $ C(I,1), LDC, WORK, INFO ) -* +* END DO * * Multiply Q to the first block of C (1:MB,1:N) @@ -328,7 +328,7 @@ IF(II.LE.M) THEN * * Multiply Q to the last block of C -* +* CALL STPMQRT('L','T',KK , N, K, 0,NB, A(II,1), LDA, $ T(1, CTR * K + 1), LDT, C(1,1), LDC, $ C(II,1), LDC, WORK, INFO ) @@ -397,9 +397,9 @@ * END IF * - WORK(1) = LW + WORK(1) = LW RETURN * * End of SLAMTSQR * - END
\ No newline at end of file + END diff --git a/SRC/slaswlq.f b/SRC/slaswlq.f index acd9170d..e5180f76 100644 --- a/SRC/slaswlq.f +++ b/SRC/slaswlq.f @@ -1,24 +1,24 @@ -* +* * Definition: * =========== * * SUBROUTINE SLASWLQ( M, N, MB, NB, A, LDA, T, LDT, WORK, * LWORK, INFO) -* +* * .. Scalar Arguments .. * INTEGER INFO, LDA, M, N, MB, NB, LDT, LWORK * .. * .. Array Arguments .. * REAL A( LDA, * ), T( LDT, * ), WORK( * ) * .. -* +* * *> \par Purpose: * ============= *> *> \verbatim -*> -*> SLASWLQ computes a blocked Short-Wide LQ factorization of a +*> +*> SLASWLQ computes a blocked Short-Wide LQ factorization of a *> M-by-N matrix A, where N >= M: *> A = L * Q *> \endverbatim @@ -41,13 +41,13 @@ *> \param[in] MB *> \verbatim *> MB is INTEGER -*> The row block size to be used in the blocked QR. -*> M >= MB >= 1 +*> The row block size to be used in the blocked QR. +*> M >= MB >= 1 *> \endverbatim *> \param[in] NB *> \verbatim *> NB is INTEGER -*> The column block size to be used in the blocked QR. +*> The column block size to be used in the blocked QR. *> NB > M. *> \endverbatim *> @@ -55,9 +55,9 @@ *> \verbatim *> A is REAL array, dimension (LDA,N) *> On entry, the M-by-N matrix A. -*> On exit, the elements on and bleow the diagonal -*> of the array contain the N-by-N lower triangular matrix L; -*> the elements above the diagonal represent Q by the rows +*> On exit, the elements on and bleow the diagonal +*> of the array contain the N-by-N lower triangular matrix L; +*> the elements above the diagonal represent Q by the rows *> of blocked V (see Further Details). *> *> \endverbatim @@ -70,11 +70,11 @@ *> *> \param[out] T *> \verbatim -*> T is REAL array, -*> dimension (LDT, N * Number_of_row_blocks) +*> T is REAL array, +*> dimension (LDT, N * Number_of_row_blocks) *> where Number_of_row_blocks = CEIL((N-M)/(NB-M)) *> The blocked upper triangular block reflectors stored in compact form -*> as a sequence of upper triangular blocks. +*> as a sequence of upper triangular blocks. *> See Further Details below. *> \endverbatim *> @@ -88,7 +88,7 @@ *> \param[out] WORK *> \verbatim *> (workspace) REAL array, dimension (MAX(1,LWORK)) -*> +*> *> \endverbatim *> \param[in] LWORK *> \verbatim @@ -137,7 +137,7 @@ *> block reflectors, stored in array T(1:LDT,(i-1)*M+1:i*M). *> The last Q(k) may use fewer rows. *> For more information see Further Details in TPQRT. -*> +*> *> For more details of the overall algorithm, see the description of *> Sequential TSQR in Section 2.2 of [1]. *> @@ -147,7 +147,7 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE SLASWLQ( M, N, MB, NB, A, LDA, T, LDT, WORK, LWORK, + SUBROUTINE SLASWLQ( M, N, MB, NB, A, LDA, T, LDT, WORK, LWORK, $ INFO) * * -- LAPACK computational routine (version 3.5.0) -- @@ -190,7 +190,7 @@ ELSE IF( N.LT.0 .OR. N.LT.M ) THEN INFO = -2 ELSE IF( MB.LT.1 .OR. ( MB.GT.M .AND. M.GT.0 )) THEN - INFO = -3 + INFO = -3 ELSE IF( NB.LE.M ) THEN INFO = -4 ELSE IF( LDA.LT.MAX( 1, M ) ) THEN @@ -198,9 +198,9 @@ ELSE IF( LDT.LT.MB ) THEN INFO = -8 ELSE IF( ( LWORK.LT.M*MB) .AND. (.NOT.LQUERY) ) THEN - INFO = -10 - END IF - IF( INFO.EQ.0) THEN + INFO = -10 + END IF + IF( INFO.EQ.0) THEN WORK(1) = MB*M END IF * @@ -222,10 +222,10 @@ IF((M.GE.N).OR.(NB.LE.M).OR.(NB.GE.N)) THEN CALL SGELQT( M, N, MB, A, LDA, T, LDT, WORK, INFO) RETURN - END IF -* + END IF +* KK = MOD((N-M),(NB-M)) - II=N-KK+1 + II=N-KK+1 * * Compute the LQ factorization of the first block A(1:M,1:NB) * @@ -233,7 +233,7 @@ CTR = 1 * DO I = NB+1, II-NB+M , (NB-M) -* +* * Compute the QR factorization of the current block A(1:M,I:I+NB-M) * CALL STPLQT( M, NB-M, 0, MB, A(1,1), LDA, A( 1, I ), @@ -248,11 +248,11 @@ CALL STPLQT( M, KK, 0, MB, A(1,1), LDA, A( 1, II ), $ LDA, T(1, CTR * M + 1), LDT, $ WORK, INFO ) - END IF + END IF * WORK( 1 ) = M * MB RETURN -* +* * End of SLASWLQ * - END
\ No newline at end of file + END diff --git a/SRC/slasyf_aasen.f b/SRC/slasyf_aasen.f index 2c8f4e0c..8d4bb796 100644 --- a/SRC/slasyf_aasen.f +++ b/SRC/slasyf_aasen.f @@ -2,25 +2,25 @@ * * =========== 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 SLASYF_AASEN + dependencies -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slasyf_aasen.f"> -*> [TGZ]</a> -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slasyf_aasen.f"> -*> [ZIP]</a> -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slasyf_aasen.f"> +*> Download SLASYF_AASEN + dependencies +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slasyf_aasen.f"> +*> [TGZ]</a> +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slasyf_aasen.f"> +*> [ZIP]</a> +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slasyf_aasen.f"> *> [TXT]</a> -*> \endhtmlonly +*> \endhtmlonly * * Definition: * =========== * -* SUBROUTINE SLASYF_AASEN( UPLO, J1, M, NB, A, LDA, IPIV, +* SUBROUTINE SLASYF_AASEN( UPLO, J1, M, NB, A, LDA, IPIV, * H, LDH, WORK, INFO ) -* +* * .. Scalar Arguments .. * CHARACTER UPLO * INTEGER J1, M, NB, LDA, LDH, INFO @@ -29,7 +29,7 @@ * INTEGER IPIV( * ) * REAL A( LDA, * ), H( LDH, * ), WORK( * ) * .. -* +* * *> \par Purpose: * ============= @@ -44,9 +44,9 @@ *> last row, or column, of the previous panel. The first row, or column, *> of A is set to be the first row, or column, of an identity matrix, *> which is used to factorize the first panel. -*> +*> *> The resulting J-th row of U, or J-th column of L, is stored in the -*> (J-1)-th row, or column, of A (without the unit diatonals), while +*> (J-1)-th row, or column, of A (without the unit diatonals), while *> the diagonal and subdiagonal of A are overwritten by those of T. *> *> \endverbatim @@ -141,10 +141,10 @@ * 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 2016 * @@ -153,7 +153,7 @@ * @generated from dlasyf_aasen.f, fortran d -> s, Sun Oct 2 22:57:56 2016 * * ===================================================================== - SUBROUTINE SLASYF_AASEN( UPLO, J1, M, NB, A, LDA, IPIV, + SUBROUTINE SLASYF_AASEN( UPLO, J1, M, NB, A, LDA, IPIV, $ H, LDH, WORK, INFO ) * * -- LAPACK computational routine (version 3.4.0) -- @@ -179,7 +179,7 @@ * * .. Local Scalars .. INTEGER J, K, K1, I1, I2 - REAL PIV, ALPHA + REAL PIV, ALPHA * .. * .. External Functions .. LOGICAL LSAME @@ -253,14 +253,14 @@ * A( K, J ) = WORK( 1 ) * - IF( J.LT.M ) THEN + IF( J.LT.M ) THEN * * Compute WORK(2:N) = T(J, J) L(J, (J+1):N) * where A(J, J) stores T(J, J) and A(J-1, (J+1):N) stores U(J, (J+1):N) * IF( (J1+J-1).GT.1 ) THEN - ALPHA = -A( K, J ) - CALL SAXPY( M-J, ALPHA, A( K-1, J+1 ), LDA, + ALPHA = -A( K, J ) + CALL SAXPY( M-J, ALPHA, A( K-1, J+1 ), LDA, $ WORK( 2 ), 1 ) ENDIF * @@ -283,12 +283,12 @@ * I1 = I1+J-1 I2 = I2+J-1 - CALL SSWAP( I2-I1-1, A( J1+I1-1, I1+1 ), LDA, + CALL SSWAP( I2-I1-1, A( J1+I1-1, I1+1 ), LDA, $ A( J1+I1, I2 ), 1 ) * * Swap A(I1, I2+1:N) with A(I2, I2+1:N) * - CALL SSWAP( M-I2, A( J1+I1-1, I2+1 ), LDA, + CALL SSWAP( M-I2, A( J1+I1-1, I2+1 ), LDA, $ A( J1+I2-1, I2+1 ), LDA ) * * Swap A(I1, I1) with A(I2,I2) @@ -307,17 +307,17 @@ * Swap L(1:I1-1, I1) with L(1:I1-1, I2), * skipping the first column * - CALL SSWAP( I1-K1+1, A( 1, I1 ), 1, + CALL SSWAP( I1-K1+1, A( 1, I1 ), 1, $ A( 1, I2 ), 1 ) END IF - ELSE + ELSE IPIV( J+1 ) = J+1 ENDIF * * Set A(J, J+1) = T(J, J+1) * A( K, J+1 ) = WORK( 2 ) - IF( (A( K, J ).EQ.ZERO ) .AND. + IF( (A( K, J ).EQ.ZERO ) .AND. $ ( (J.EQ.M) .OR. (A( K, J+1 ).EQ.ZERO))) THEN IF(INFO .EQ. 0) THEN INFO = J @@ -326,9 +326,9 @@ * IF( J.LT.NB ) THEN * -* Copy A(J+1:N, J+1) into H(J:N, J), +* Copy A(J+1:N, J+1) into H(J:N, J), * - CALL SCOPY( M-J, A( K+1, J+1 ), LDA, + CALL SCOPY( M-J, A( K+1, J+1 ), LDA, $ H( J+1, J+1 ), 1 ) END IF * @@ -340,7 +340,7 @@ CALL SCOPY( M-J-1, WORK( 3 ), 1, A( K, J+2 ), LDA ) CALL SSCAL( M-J-1, ALPHA, A( K, J+2 ), LDA ) ELSE - CALL SLASET( 'Full', 1, M-J-1, ZERO, ZERO, + CALL SLASET( 'Full', 1, M-J-1, ZERO, ZERO, $ A( K, J+2 ), LDA) END IF ELSE @@ -403,14 +403,14 @@ * A( J, K ) = WORK( 1 ) * - IF( J.LT.M ) THEN + IF( J.LT.M ) THEN * * Compute WORK(2:N) = T(J, J) L((J+1):N, J) * where A(J, J) = T(J, J) and A((J+1):N, J-1) = L((J+1):N, J) * IF( (J1+J-1).GT.1 ) THEN - ALPHA = -A( J, K ) - CALL SAXPY( M-J, ALPHA, A( J+1, K-1 ), 1, + ALPHA = -A( J, K ) + CALL SAXPY( M-J, ALPHA, A( J+1, K-1 ), 1, $ WORK( 2 ), 1 ) ENDIF * @@ -433,12 +433,12 @@ * I1 = I1+J-1 I2 = I2+J-1 - CALL SSWAP( I2-I1-1, A( I1+1, J1+I1-1 ), 1, + CALL SSWAP( I2-I1-1, A( I1+1, J1+I1-1 ), 1, $ A( I2, J1+I1 ), LDA ) * * Swap A(I2+1:N, I1) with A(I2+1:N, I2) * - CALL SSWAP( M-I2, A( I2+1, J1+I1-1 ), 1, + CALL SSWAP( M-I2, A( I2+1, J1+I1-1 ), 1, $ A( I2+1, J1+I2-1 ), 1 ) * * Swap A(I1, I1) with A(I2, I2) @@ -457,27 +457,27 @@ * Swap L(1:I1-1, I1) with L(1:I1-1, I2), * skipping the first column * - CALL SSWAP( I1-K1+1, A( I1, 1 ), LDA, + CALL SSWAP( I1-K1+1, A( I1, 1 ), LDA, $ A( I2, 1 ), LDA ) END IF - ELSE + ELSE IPIV( J+1 ) = J+1 ENDIF * * Set A(J+1, J) = T(J+1, J) * A( J+1, K ) = WORK( 2 ) - IF( (A( J, K ).EQ.ZERO) .AND. + IF( (A( J, K ).EQ.ZERO) .AND. $ ( (J.EQ.M) .OR. (A( J+1, K ).EQ.ZERO)) ) THEN - IF (INFO .EQ. 0) + IF (INFO .EQ. 0) $ INFO = J END IF * IF( J.LT.NB ) THEN * -* Copy A(J+1:N, J+1) into H(J+1:N, J), +* Copy A(J+1:N, J+1) into H(J+1:N, J), * - CALL SCOPY( M-J, A( J+1, K+1 ), 1, + CALL SCOPY( M-J, A( J+1, K+1 ), 1, $ H( J+1, J+1 ), 1 ) END IF * @@ -489,7 +489,7 @@ CALL SCOPY( M-J-1, WORK( 3 ), 1, A( J+2, K ), 1 ) CALL SSCAL( M-J-1, ALPHA, A( J+2, K ), 1 ) ELSE - CALL SLASET( 'Full', M-J-1, 1, ZERO, ZERO, + CALL SLASET( 'Full', M-J-1, 1, ZERO, ZERO, $ A( J+2, K ), LDA ) END IF ELSE diff --git a/SRC/slatsqr.f b/SRC/slatsqr.f index 3fbf8b88..435204e7 100644 --- a/SRC/slatsqr.f +++ b/SRC/slatsqr.f @@ -1,26 +1,26 @@ -* +* * Definition: * =========== * -* SUBROUTINE SLATSQR( M, N, MB, NB, A, LDA, T, LDT, WORK, +* SUBROUTINE SLATSQR( M, N, MB, NB, A, LDA, T, LDT, WORK, * LWORK, INFO) -* +* * .. Scalar Arguments .. * INTEGER INFO, LDA, M, N, MB, NB, LDT, LWORK * .. * .. Array Arguments .. * REAL A( LDA, * ), T( LDT, * ), WORK( * ) * .. -* +* * *> \par Purpose: * ============= *> *> \verbatim -*> -*> SLATSQR computes a blocked Tall-Skinny QR factorization of +*> +*> SLATSQR computes a blocked Tall-Skinny QR factorization of *> an M-by-N matrix A, where M >= N: -*> A = Q * R . +*> A = Q * R . *> \endverbatim * * Arguments: @@ -41,14 +41,14 @@ *> \param[in] MB *> \verbatim *> MB is INTEGER -*> The row block size to be used in the blocked QR. +*> The row block size to be used in the blocked QR. *> MB > N. *> \endverbatim *> *> \param[in] NB *> \verbatim *> NB is INTEGER -*> The column block size to be used in the blocked QR. +*> The column block size to be used in the blocked QR. *> N >= NB >= 1. *> \endverbatim *> @@ -56,9 +56,9 @@ *> \verbatim *> A is REAL array, dimension (LDA,N) *> On entry, the M-by-N matrix A. -*> On exit, the elements on and above the diagonal -*> of the array contain the N-by-N upper triangular matrix R; -*> the elements below the diagonal represent Q by the columns +*> On exit, the elements on and above the diagonal +*> of the array contain the N-by-N upper triangular matrix R; +*> the elements below the diagonal represent Q by the columns *> of blocked V (see Further Details). *> \endverbatim *> @@ -70,11 +70,11 @@ *> *> \param[out] T *> \verbatim -*> T is REAL array, -*> dimension (LDT, N * Number_of_row_blocks) +*> T is REAL array, +*> dimension (LDT, N * Number_of_row_blocks) *> where Number_of_row_blocks = CEIL((M-N)/(MB-N)) *> The blocked upper triangular block reflectors stored in compact form -*> as a sequence of upper triangular blocks. +*> as a sequence of upper triangular blocks. *> See Further Details below. *> \endverbatim *> @@ -86,7 +86,7 @@ *> *> \param[out] WORK *> \verbatim -*> (workspace) REAL array, dimension (MAX(1,LWORK)) +*> (workspace) REAL array, dimension (MAX(1,LWORK)) *> \endverbatim *> *> \param[in] LWORK @@ -136,7 +136,7 @@ *> block reflectors, stored in array T(1:LDT,(i-1)*N+1:i*N). *> The last Q(k) may use fewer rows. *> For more information see Further Details in TPQRT. -*> +*> *> For more details of the overall algorithm, see the description of *> Sequential TSQR in Section 2.2 of [1]. *> @@ -146,7 +146,7 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE SLATSQR( M, N, MB, NB, A, LDA, T, LDT, WORK, + SUBROUTINE SLATSQR( M, N, MB, NB, A, LDA, T, LDT, WORK, $ LWORK, INFO) * * -- LAPACK computational routine (version 3.5.0) -- @@ -189,7 +189,7 @@ ELSE IF( N.LT.0 .OR. M.LT.N ) THEN INFO = -2 ELSE IF( MB.LE.N ) THEN - INFO = -3 + INFO = -3 ELSE IF( NB.LT.1 .OR. ( NB.GT.N .AND. N.GT.0 )) THEN INFO = -4 ELSE IF( LDA.LT.MAX( 1, M ) ) THEN @@ -197,8 +197,8 @@ ELSE IF( LDT.LT.NB ) THEN INFO = -8 ELSE IF( LWORK.LT.(N*NB) .AND. (.NOT.LQUERY) ) THEN - INFO = -10 - END IF + INFO = -10 + END IF IF( INFO.EQ.0) THEN WORK(1) = NB*N END IF @@ -220,9 +220,9 @@ IF ((MB.LE.N).OR.(MB.GE.M)) THEN CALL SGEQRT( M, N, NB, A, LDA, T, LDT, WORK, INFO) RETURN - END IF + END IF KK = MOD((M-N),(MB-N)) - II=M-KK+1 + II=M-KK+1 * * Compute the QR factorization of the first block A(1:MB,1:N) * @@ -230,7 +230,7 @@ * CTR = 1 DO I = MB+1, II-MB+N , (MB-N) -* +* * Compute the QR factorization of the current block A(I:I+MB-N,1:N) * CALL STPQRT( MB-N, N, 0, NB, A(1,1), LDA, A( I, 1 ), LDA, @@ -245,11 +245,11 @@ CALL STPQRT( KK, N, 0, NB, A(1,1), LDA, A( II, 1 ), LDA, $ T(1, CTR * N + 1), LDT, $ WORK, INFO ) - END IF + END IF * work( 1 ) = N*NB RETURN -* +* * End of SLATSQR * - END
\ No newline at end of file + END diff --git a/SRC/ssyevr.f b/SRC/ssyevr.f index 542a0f1b..bb9fddee 100644 --- a/SRC/ssyevr.f +++ b/SRC/ssyevr.f @@ -257,7 +257,7 @@ *> indicating the nonzero elements in Z. The i-th eigenvector *> is nonzero only in elements ISUPPZ( 2*i-1 ) through *> ISUPPZ( 2*i ). This is an output of SSTEMR (tridiagonal -*> matrix). The support of the eigenvectors of A is typically +*> matrix). The support of the eigenvectors of A is typically *> 1:N because of the orthogonal transformations applied by SORMTR. *> Implemented only for RANGE = 'A' or 'I' and IU - IL = N - 1 *> \endverbatim diff --git a/SRC/ssysv_aasen.f b/SRC/ssysv_aasen.f index 52f507e3..9c72fc45 100644 --- a/SRC/ssysv_aasen.f +++ b/SRC/ssysv_aasen.f @@ -2,25 +2,25 @@ * * =========== 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 SSYSV_AASEN + dependencies -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ssysv_aasen.f"> -*> [TGZ]</a> -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ssysv_aasen.f"> -*> [ZIP]</a> -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ssysv_aasen.f"> +*> Download SSYSV_AASEN + dependencies +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ssysv_aasen.f"> +*> [TGZ]</a> +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ssysv_aasen.f"> +*> [ZIP]</a> +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ssysv_aasen.f"> *> [TXT]</a> -*> \endhtmlonly +*> \endhtmlonly * * Definition: * =========== * * SUBROUTINE SSYSV_AASEN( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, * LWORK, INFO ) -* +* * .. Scalar Arguments .. * CHARACTER UPLO * INTEGER N, NRHS, LDA, LDB, LWORK, INFO @@ -29,7 +29,7 @@ * INTEGER IPIV( * ) * REAL A( LDA, * ), B( LDB, * ), WORK( * ) * .. -* +* * *> \par Purpose: * ============= @@ -45,7 +45,7 @@ *> A = U * T * U**T, if UPLO = 'U', or *> A = L * T * L**T, if UPLO = 'L', *> where U (or L) is a product of permutation and unit upper (lower) -*> triangular matrices, and T is symmetric tridiagonal. The factored +*> triangular matrices, and T is symmetric tridiagonal. The factored *> form of A is then used to solve the system of equations A * X = B. *> \endverbatim * @@ -99,8 +99,8 @@ *> \param[out] IPIV *> \verbatim *> IPIV is INTEGER array, dimension (N) -*> On exit, it contains the details of the interchanges, i.e., -*> the row and column k of A were interchanged with the +*> On exit, it contains the details of the interchanges, i.e., +*> the row and column k of A were interchanged with the *> row and column IPIV(k). *> \endverbatim *> @@ -126,8 +126,8 @@ *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER -*> The length of WORK. LWORK >= MAX(2*N, 3*N-2), and for -*> the best performance, LWORK >= max(1,N*NB), where NB is +*> The length of WORK. LWORK >= MAX(2*N, 3*N-2), and for +*> the best performance, LWORK >= max(1,N*NB), where NB is *> the optimal blocksize for SSYTRF_AASEN. *> *> If LWORK = -1, then a workspace query is assumed; the routine @@ -149,10 +149,10 @@ * 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 2016 * diff --git a/SRC/ssytrf_aasen.f b/SRC/ssytrf_aasen.f index ba395185..5e9748a1 100644 --- a/SRC/ssytrf_aasen.f +++ b/SRC/ssytrf_aasen.f @@ -2,24 +2,24 @@ * * =========== 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 SSYTRF_AASEN + dependencies -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ssytrf_aasen.f"> -*> [TGZ]</a> -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ssytrf_aasen.f"> -*> [ZIP]</a> -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ssytrf_aasen.f"> +*> Download SSYTRF_AASEN + dependencies +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ssytrf_aasen.f"> +*> [TGZ]</a> +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ssytrf_aasen.f"> +*> [ZIP]</a> +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ssytrf_aasen.f"> *> [TXT]</a> -*> \endhtmlonly +*> \endhtmlonly * * Definition: * =========== * * SUBROUTINE SSYTRF_AASEN( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) -* +* * .. Scalar Arguments .. * CHARACTER UPLO * INTEGER N, LDA, LWORK, INFO @@ -73,7 +73,7 @@ *> triangular part of A is not referenced. *> *> On exit, the tridiagonal matrix is stored in the diagonals -*> and the subdiagonals of A just below (or above) the diagonals, +*> and the subdiagonals of A just below (or above) the diagonals, *> and L is stored below (or above) the subdiaonals, when UPLO *> is 'L' (or 'U'). *> \endverbatim @@ -87,8 +87,8 @@ *> \param[out] IPIV *> \verbatim *> IPIV is INTEGER array, dimension (N) -*> On exit, it contains the details of the interchanges, i.e., -*> the row and column k of A were interchanged with the +*> On exit, it contains the details of the interchanges, i.e., +*> the row and column k of A were interchanged with the *> row and column IPIV(k). *> \endverbatim *> @@ -124,10 +124,10 @@ * 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 2016 * @@ -244,14 +244,14 @@ * J = 0 10 CONTINUE - IF( J.GE.N ) + IF( J.GE.N ) $ GO TO 20 * * each step of the main loop * J is the last column of the previous panel * J1 is the first column of the current panel * K1 identifies if the previous column of the panel has been -* explicitly stored, e.g., K1=1 for the first panel, and +* explicitly stored, e.g., K1=1 for the first panel, and * K1=0 for the rest * J1 = J + 1 @@ -260,27 +260,27 @@ * * Panel factorization * - CALL SLASYF_AASEN( UPLO, 2-K1, N-J, JB, + CALL SLASYF_AASEN( UPLO, 2-K1, N-J, JB, $ A( MAX(1, J), J+1 ), LDA, - $ IPIV( J+1 ), WORK, N, WORK( N*NB+1 ), + $ IPIV( J+1 ), WORK, N, WORK( N*NB+1 ), $ IINFO ) IF( (IINFO.GT.0) .AND. (INFO.EQ.0) ) THEN INFO = IINFO+J - ENDIF + ENDIF * * Ajust IPIV and apply it back (J-th step picks (J+1)-th pivot) * DO J2 = J+2, MIN(N, J+JB+1) IPIV( J2 ) = IPIV( J2 ) + J IF( (J2.NE.IPIV(J2)) .AND. ((J1-K1).GT.2) ) THEN - CALL SSWAP( J1-K1-2, A( 1, J2 ), 1, + CALL SSWAP( J1-K1-2, A( 1, J2 ), 1, $ A( 1, IPIV(J2) ), 1 ) END IF END DO J = J + JB * * Trailing submatrix update, where -* the row A(J1-1, J2-1:N) stores U(J1, J2+1:N) and +* the row A(J1-1, J2-1:N) stores U(J1, J2+1:N) and * WORK stores the current block of the auxiriarly matrix H * IF( J.LT.N ) THEN @@ -293,12 +293,12 @@ * ALPHA = A( J, J+1 ) A( J, J+1 ) = ONE - CALL SCOPY( N-J, A( J-1, J+1 ), LDA, + CALL SCOPY( N-J, A( J-1, J+1 ), LDA, $ WORK( (J+1-J1+1)+JB*N ), 1 ) CALL SSCAL( N-J, ALPHA, WORK( (J+1-J1+1)+JB*N ), 1 ) * * K1 identifies if the previous column of the panel has been -* explicitly stored, e.g., K1=1 and K2= 0 for the first panel, +* explicitly stored, e.g., K1=1 and K2= 0 for the first panel, * while K1=0 and K2=1 for the rest * IF( J1.GT.1 ) THEN @@ -306,13 +306,13 @@ * Not first panel * K2 = 1 - ELSE + ELSE * * First panel * K2 = 0 * -* First update skips the first column +* First update skips the first column * JB = JB - 1 END IF @@ -333,7 +333,7 @@ * * Update off-diagonal block of J2-th block row with SGEMM * - CALL SGEMM( 'Transpose', 'Transpose', + CALL SGEMM( 'Transpose', 'Transpose', $ NJ, N-J3+1, JB+1, $ -ONE, A( J1-K2, J2 ), LDA, $ WORK( J3-J1+1+K1*N ), N, @@ -356,7 +356,7 @@ * Factorize A as L*D*L**T using the lower triangle of A * ..................................................... * -* copy first column A(1:N, 1) into H(1:N, 1) +* copy first column A(1:N, 1) into H(1:N, 1) * (stored in WORK(1:N)) * CALL SCOPY( N, A( 1, 1 ), 1, WORK( 1 ), 1 ) @@ -367,14 +367,14 @@ * J = 0 11 CONTINUE - IF( J.GE.N ) + IF( J.GE.N ) $ GO TO 20 * * each step of the main loop * J is the last column of the previous panel * J1 is the first column of the current panel * K1 identifies if the previous column of the panel has been -* explicitly stored, e.g., K1=1 for the first panel, and +* explicitly stored, e.g., K1=1 for the first panel, and * K1=0 for the rest * J1 = J+1 @@ -383,26 +383,26 @@ * * Panel factorization * - CALL SLASYF_AASEN( UPLO, 2-K1, N-J, JB, + CALL SLASYF_AASEN( UPLO, 2-K1, N-J, JB, $ A( J+1, MAX(1, J) ), LDA, $ IPIV( J+1 ), WORK, N, WORK( N*NB+1 ), IINFO) IF( (IINFO.GT.0) .AND. (INFO.EQ.0) ) THEN INFO = IINFO+J - ENDIF + ENDIF * * Ajust IPIV and apply it back (J-th step picks (J+1)-th pivot) * DO J2 = J+2, MIN(N, J+JB+1) IPIV( J2 ) = IPIV( J2 ) + J IF( (J2.NE.IPIV(J2)) .AND. ((J1-K1).GT.2) ) THEN - CALL SSWAP( J1-K1-2, A( J2, 1 ), LDA, + CALL SSWAP( J1-K1-2, A( J2, 1 ), LDA, $ A( IPIV(J2), 1 ), LDA ) END IF END DO J = J + JB * * Trailing submatrix update, where -* A(J2+1, J1-1) stores L(J2+1, J1) and +* A(J2+1, J1-1) stores L(J2+1, J1) and * WORK(J2+1, 1) stores H(J2+1, 1) * IF( J.LT.N ) THEN @@ -415,12 +415,12 @@ * ALPHA = A( J+1, J ) A( J+1, J ) = ONE - CALL SCOPY( N-J, A( J+1, J-1 ), 1, + CALL SCOPY( N-J, A( J+1, J-1 ), 1, $ WORK( (J+1-J1+1)+JB*N ), 1 ) CALL SSCAL( N-J, ALPHA, WORK( (J+1-J1+1)+JB*N ), 1 ) * * K1 identifies if the previous column of the panel has been -* explicitly stored, e.g., K1=1 and K2= 0 for the first panel, +* explicitly stored, e.g., K1=1 and K2= 0 for the first panel, * while K1=0 and K2=1 for the rest * IF( J1.GT.1 ) THEN @@ -434,7 +434,7 @@ * K2 = 0 * -* First update skips the first column +* First update skips the first column * JB = JB - 1 END IF @@ -455,7 +455,7 @@ * * Update off-diagonal block in J2-th block column with SGEMM * - CALL SGEMM( 'No transpose', 'Transpose', + CALL SGEMM( 'No transpose', 'Transpose', $ N-J3+1, NJ, JB+1, $ -ONE, WORK( J3-J1+1+K1*N ), N, $ A( J2, J1-K2 ), LDA, diff --git a/SRC/ssytrs_aasen.f b/SRC/ssytrs_aasen.f index 05d7923e..7ce9117a 100644 --- a/SRC/ssytrs_aasen.f +++ b/SRC/ssytrs_aasen.f @@ -2,25 +2,25 @@ * * =========== 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 SSYTRS_AASEN + dependencies *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ssytrs_aasen.f"> -*> [TGZ]</a> +*> [TGZ]</a> *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ssytrs_aasen.f"> -*> [ZIP]</a> +*> [ZIP]</a> *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ssytrs_aasen.f"> *> [TXT]</a> -*> \endhtmlonly +*> \endhtmlonly * * Definition: * =========== * * SUBROUTINE SSYTRS_AASEN( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, * WORK, LWORK, INFO ) -* +* * .. Scalar Arguments .. * CHARACTER UPLO * INTEGER N, NRHS, LDA, LDB, LWORK, INFO @@ -29,7 +29,7 @@ * INTEGER IPIV( * ) * REAL A( LDA, * ), B( LDB, * ), WORK( * ) * .. -* +* * *> \par Purpose: * ============= @@ -116,10 +116,10 @@ * 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 2016 * @@ -221,7 +221,7 @@ END IF CALL SGTSV(N, NRHS, WORK(1), WORK(N), WORK(2*N), B, LDB, $ INFO) -* +* * * Compute (U**T \ B) -> B [ U**T \ (T \ (U \P**T * B) ) ] * @@ -254,7 +254,7 @@ * * Compute (L \P**T * B) -> B [ (L \P**T * B) ] * - CALL STRSM( 'L', 'L', 'N', 'U', N-1, NRHS, ONE, A( 2, 1), LDA, + CALL STRSM( 'L', 'L', 'N', 'U', N-1, NRHS, ONE, A( 2, 1), LDA, $ B(2, 1), LDB) * * Compute T \ B -> B [ T \ (L \P**T * B) ] @@ -268,7 +268,7 @@ $ INFO) * * Compute (L**T \ B) -> B [ L**T \ (T \ (L \P**T * B) ) ] -* +* CALL STRSM( 'L', 'L', 'T', 'U', N-1, NRHS, ONE, A( 2, 1 ), LDA, $ B( 2, 1 ), LDB) * diff --git a/SRC/stplqt.f b/SRC/stplqt.f index 56d19d71..cffb8aef 100644 --- a/SRC/stplqt.f +++ b/SRC/stplqt.f @@ -2,41 +2,41 @@ * * =========== 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 DTPQRT + dependencies -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/stplqt.f"> -*> [TGZ]</a> -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/stplqt.f"> -*> [ZIP]</a> -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/stplqt.f"> +*> Download DTPQRT + dependencies +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/stplqt.f"> +*> [TGZ]</a> +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/stplqt.f"> +*> [ZIP]</a> +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/stplqt.f"> *> [TXT]</a> -*> \endhtmlonly +*> \endhtmlonly * * Definition: * =========== * * SUBROUTINE STPLQT( M, N, L, MB, A, LDA, B, LDB, T, LDT, WORK, * INFO ) -* +* * .. Scalar Arguments .. * INTEGER INFO, LDA, LDB, LDT, N, M, L, MB * .. * .. Array Arguments .. * REAL A( LDA, * ), B( LDB, * ), T( LDT, * ), WORK( * ) * .. -* +* * *> \par Purpose: * ============= *> *> \verbatim *> -*> DTPLQT computes a blocked LQ factorization of a real -*> "triangular-pentagonal" matrix C, which is composed of a -*> triangular block A and pentagonal block B, using the compact +*> DTPLQT computes a blocked LQ factorization of a real +*> "triangular-pentagonal" matrix C, which is composed of a +*> triangular block A and pentagonal block B, using the compact *> WY representation for Q. *> \endverbatim * @@ -47,7 +47,7 @@ *> \verbatim *> M is INTEGER *> The number of rows of the matrix B, and the order of the -*> triangular matrix A. +*> triangular matrix A. *> M >= 0. *> \endverbatim *> @@ -88,7 +88,7 @@ *> \param[in,out] B *> \verbatim *> B is REAL array, dimension (LDB,N) -*> On entry, the pentagonal M-by-N matrix B. The first N-L columns +*> On entry, the pentagonal M-by-N matrix B. The first N-L columns *> are rectangular, and the last L columns are lower trapezoidal. *> On exit, B contains the pentagonal matrix V. See Further Details. *> \endverbatim @@ -105,7 +105,7 @@ *> The lower triangular block reflectors stored in compact form *> as a sequence of upper triangular blocks. See Further Details. *> \endverbatim -*> +*> *> \param[in] LDT *> \verbatim *> LDT is INTEGER @@ -127,10 +127,10 @@ * 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 2013 * @@ -141,45 +141,45 @@ *> *> \verbatim *> -*> The input matrix C is a M-by-(M+N) matrix +*> The input matrix C is a M-by-(M+N) matrix *> *> C = [ A ] [ B ] -*> +*> *> *> where A is an lower triangular N-by-N matrix, and B is M-by-N pentagonal *> matrix consisting of a M-by-(N-L) rectangular matrix B1 on left of a M-by-L *> upper trapezoidal matrix B2: -*> [ B ] = [ B1 ] [ B2 ] +*> [ B ] = [ B1 ] [ B2 ] *> [ B1 ] <- M-by-(N-L) rectangular *> [ B2 ] <- M-by-L upper trapezoidal. *> *> The lower trapezoidal matrix B2 consists of the first L columns of a -*> N-by-N lower triangular matrix, where 0 <= L <= MIN(M,N). If L=0, -*> B is rectangular M-by-N; if M=L=N, B is lower triangular. +*> N-by-N lower triangular matrix, where 0 <= L <= MIN(M,N). If L=0, +*> B is rectangular M-by-N; if M=L=N, B is lower triangular. *> *> The matrix W stores the elementary reflectors H(i) in the i-th row *> above the diagonal (of A) in the M-by-(M+N) input matrix C -*> [ C ] = [ A ] [ B ] +*> [ C ] = [ A ] [ B ] *> [ A ] <- lower triangular N-by-N *> [ B ] <- M-by-N pentagonal *> *> so that W can be represented as -*> [ W ] = [ I ] [ V ] +*> [ W ] = [ I ] [ V ] *> [ I ] <- identity, N-by-N *> [ V ] <- M-by-N, same form as B. *> *> Thus, all of information needed for W is contained on exit in B, which -*> we call V above. Note that V has the same form as B; that is, -*> [ V ] = [ V1 ] [ V2 ] +*> we call V above. Note that V has the same form as B; that is, +*> [ V ] = [ V1 ] [ V2 ] *> [ V1 ] <- M-by-(N-L) rectangular *> [ V2 ] <- M-by-L lower trapezoidal. *> -*> The rows of V represent the vectors which define the H(i)'s. +*> The rows of V represent the vectors which define the H(i)'s. *> *> The number of blocks is B = ceiling(M/MB), where each -*> block is of order MB except for the last block, which is of order +*> block is of order MB except for the last block, which is of order *> IB = M - (M-1)*MB. For each of the B blocks, a upper triangular block -*> reflector factor is computed: T1, T2, ..., TB. The MB-by-MB (and IB-by-IB +*> reflector factor is computed: T1, T2, ..., TB. The MB-by-MB (and IB-by-IB *> for the last block) T's are stored in the MB-by-N matrix T as *> *> T = [T1 T2 ... TB]. @@ -240,7 +240,7 @@ IF( M.EQ.0 .OR. N.EQ.0 ) RETURN * DO I = 1, M, MB -* +* * Compute the QR factorization of the current block * IB = MIN( M-I+1, MB ) @@ -251,20 +251,20 @@ LB = NB-N+L-I+1 END IF * - CALL STPLQT2( IB, NB, LB, A(I,I), LDA, B( I, 1 ), LDB, + CALL STPLQT2( IB, NB, LB, A(I,I), LDA, B( I, 1 ), LDB, $ T(1, I ), LDT, IINFO ) * * Update by applying H**T to B(I+IB:M,:) from the right * IF( I+IB.LE.M ) THEN CALL STPRFB( 'R', 'N', 'F', 'R', M-I-IB+1, NB, IB, LB, - $ B( I, 1 ), LDB, T( 1, I ), LDT, - $ A( I+IB, I ), LDA, B( I+IB, 1 ), LDB, + $ B( I, 1 ), LDB, T( 1, I ), LDT, + $ A( I+IB, I ), LDA, B( I+IB, 1 ), LDB, $ WORK, M-I-IB+1) END IF END DO RETURN -* +* * End of STPLQT * END diff --git a/SRC/stplqt2.f b/SRC/stplqt2.f index e8b9f19d..fec00809 100644 --- a/SRC/stplqt2.f +++ b/SRC/stplqt2.f @@ -2,31 +2,31 @@ * * =========== 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 STPLQT2 + dependencies -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/stplqt2.f"> -*> [TGZ]</a> -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/stplqt2.f"> -*> [ZIP]</a> -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/stplqt2.f"> +*> Download STPLQT2 + dependencies +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/stplqt2.f"> +*> [TGZ]</a> +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/stplqt2.f"> +*> [ZIP]</a> +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/stplqt2.f"> *> [TXT]</a> -*> \endhtmlonly +*> \endhtmlonly * * Definition: * =========== * * SUBROUTINE STPLQT2( M, N, L, A, LDA, B, LDB, T, LDT, INFO ) -* +* * .. Scalar Arguments .. * INTEGER INFO, LDA, LDB, LDT, N, M, L * .. * .. Array Arguments .. * REAL A( LDA, * ), B( LDB, * ), T( LDT, * ) * .. -* +* * *> \par Purpose: * ============= @@ -34,7 +34,7 @@ *> \verbatim *> *> STPLQT2 computes a LQ a factorization of a real "triangular-pentagonal" -*> matrix C, which is composed of a triangular block A and pentagonal block B, +*> matrix C, which is composed of a triangular block A and pentagonal block B, *> using the compact WY representation for Q. *> \endverbatim * @@ -44,7 +44,7 @@ *> \param[in] M *> \verbatim *> M is INTEGER -*> The total number of rows of the matrix B. +*> The total number of rows of the matrix B. *> M >= 0. *> \endverbatim *> @@ -59,7 +59,7 @@ *> \param[in] L *> \verbatim *> L is INTEGER -*> The number of rows of the lower trapezoidal part of B. +*> The number of rows of the lower trapezoidal part of B. *> MIN(M,N) >= L >= 0. See Further Details. *> \endverbatim *> @@ -80,7 +80,7 @@ *> \param[in,out] B *> \verbatim *> B is REAL array, dimension (LDB,N) -*> On entry, the pentagonal M-by-N matrix B. The first N-L columns +*> On entry, the pentagonal M-by-N matrix B. The first N-L columns *> are rectangular, and the last L columns are lower trapezoidal. *> On exit, B contains the pentagonal matrix V. See Further Details. *> \endverbatim @@ -114,10 +114,10 @@ * 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 * @@ -128,10 +128,10 @@ *> *> \verbatim *> -*> The input matrix C is a M-by-(M+N) matrix +*> The input matrix C is a M-by-(M+N) matrix *> *> C = [ A ][ B ] -*> +*> *> *> where A is an lower triangular N-by-N matrix, and B is M-by-N pentagonal *> matrix consisting of a M-by-(N-L) rectangular matrix B1 left of a M-by-L @@ -142,8 +142,8 @@ *> [ B2 ] <- M-by-L lower trapezoidal. *> *> The lower trapezoidal matrix B2 consists of the first L columns of a -*> N-by-N lower triangular matrix, where 0 <= L <= MIN(M,N). If L=0, -*> B is rectangular M-by-N; if M=L=N, B is lower triangular. +*> N-by-N lower triangular matrix, where 0 <= L <= MIN(M,N). If L=0, +*> B is rectangular M-by-N; if M=L=N, B is lower triangular. *> *> The matrix W stores the elementary reflectors H(i) in the i-th row *> above the diagonal (of A) in the M-by-(M+N) input matrix C @@ -154,18 +154,18 @@ *> *> so that W can be represented as *> -*> W = [ I ][ V ] +*> W = [ I ][ V ] *> [ I ] <- identity, N-by-N *> [ V ] <- M-by-N, same form as B. *> *> Thus, all of information needed for W is contained on exit in B, which -*> we call V above. Note that V has the same form as B; that is, +*> we call V above. Note that V has the same form as B; that is, *> -*> W = [ V1 ][ V2 ] +*> W = [ V1 ][ V2 ] *> [ V1 ] <- M-by-(N-L) rectangular *> [ V2 ] <- M-by-L lower trapezoidal. *> -*> The rows of V represent the vectors which define the H(i)'s. +*> The rows of V represent the vectors which define the H(i)'s. *> The (M+N)-by-(M+N) block reflector H is then given by *> *> H = I - W**T * T * W @@ -231,7 +231,7 @@ * Quick return if possible * IF( N.EQ.0 .OR. M.EQ.0 ) RETURN -* +* DO I = 1, M * * Generate elementary reflector H(I) to annihilate B(I,:) @@ -245,12 +245,12 @@ DO J = 1, M-I T( M, J ) = (A( I+J, I )) END DO - CALL SGEMV( 'N', M-I, P, ONE, B( I+1, 1 ), LDB, + CALL SGEMV( 'N', M-I, P, ONE, B( I+1, 1 ), LDB, $ B( I, 1 ), LDB, ONE, T( M, 1 ), LDT ) * * C(I+1:M,I:N) = C(I+1:M,I:N) + alpha * C(I,I:N)*W(M-1:1)^H * - ALPHA = -(T( 1, I )) + ALPHA = -(T( 1, I )) DO J = 1, M-I A( I+J, I ) = A( I+J, I ) + ALPHA*(T( M, J )) END DO @@ -282,13 +282,13 @@ * * Rectangular part of B2 * - CALL SGEMV( 'N', I-1-P, L, ALPHA, B( MP, NP ), LDB, + CALL SGEMV( 'N', I-1-P, L, ALPHA, B( MP, NP ), LDB, $ B( I, NP ), LDB, ZERO, T( I,MP ), LDT ) * * B1 * - CALL SGEMV( 'N', I-1, N-L, ALPHA, B, LDB, B( I, 1 ), LDB, - $ ONE, T( I, 1 ), LDT ) + CALL SGEMV( 'N', I-1, N-L, ALPHA, B, LDB, B( I, 1 ), LDB, + $ ONE, T( I, 1 ), LDT ) * * T(1:I-1,I) := T(1:I-1,1:I-1) * T(I,1:I-1) * @@ -305,7 +305,7 @@ T(J,I)= ZERO END DO END DO - + * * End of STPLQT2 * diff --git a/SRC/stpmlqt.f b/SRC/stpmlqt.f index 2dcdb0d1..a9c67c31 100644 --- a/SRC/stpmlqt.f +++ b/SRC/stpmlqt.f @@ -2,41 +2,41 @@ * * =========== 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 DTPMQRT + dependencies -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/stpmlqt.f"> -*> [TGZ]</a> -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/stpmlqt.f"> -*> [ZIP]</a> -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/stpmlqt.f"> +*> Download DTPMQRT + dependencies +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/stpmlqt.f"> +*> [TGZ]</a> +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/stpmlqt.f"> +*> [ZIP]</a> +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/stpmlqt.f"> *> [TXT]</a> -*> \endhtmlonly +*> \endhtmlonly * * Definition: * =========== * * SUBROUTINE STPMLQT( SIDE, TRANS, M, N, K, L, MB, V, LDV, T, LDT, * A, LDA, B, LDB, WORK, INFO ) -* +* * .. Scalar Arguments .. * CHARACTER SIDE, TRANS * INTEGER INFO, K, LDV, LDA, LDB, M, N, L, MB, LDT * .. * .. Array Arguments .. -* REAL V( LDV, * ), A( LDA, * ), B( LDB, * ), +* REAL V( LDV, * ), A( LDA, * ), B( LDB, * ), * $ T( LDT, * ), WORK( * ) * .. -* +* * *> \par Purpose: * ============= *> *> \verbatim *> -*> DTPMQRT applies a real orthogonal matrix Q obtained from a +*> DTPMQRT applies a real orthogonal matrix Q obtained from a *> "triangular-pentagonal" real block reflector H to a general *> real matrix C, which consists of two blocks A and B. *> \endverbatim @@ -69,7 +69,7 @@ *> N is INTEGER *> The number of columns of the matrix B. N >= 0. *> \endverbatim -*> +*> *> \param[in] K *> \verbatim *> K is INTEGER @@ -80,7 +80,7 @@ *> \param[in] L *> \verbatim *> L is INTEGER -*> The order of the trapezoidal part of V. +*> The order of the trapezoidal part of V. *> K >= L >= 0. See Further Details. *> \endverbatim *> @@ -124,19 +124,19 @@ *> \param[in,out] A *> \verbatim *> A is REAL array, dimension -*> (LDA,N) if SIDE = 'L' or +*> (LDA,N) if SIDE = 'L' or *> (LDA,K) if SIDE = 'R' *> On entry, the K-by-N or M-by-K matrix A. -*> On exit, A is overwritten by the corresponding block of +*> On exit, A is overwritten by the corresponding block of *> Q*C or Q**T*C or C*Q or C*Q**T. See Further Details. *> \endverbatim *> *> \param[in] LDA *> \verbatim *> LDA is INTEGER -*> The leading dimension of the array A. +*> The leading dimension of the array A. *> If SIDE = 'L', LDC >= max(1,K); -*> If SIDE = 'R', LDC >= max(1,M). +*> If SIDE = 'R', LDC >= max(1,M). *> \endverbatim *> *> \param[in,out] B @@ -150,7 +150,7 @@ *> \param[in] LDB *> \verbatim *> LDB is INTEGER -*> The leading dimension of the array B. +*> The leading dimension of the array B. *> LDB >= max(1,M). *> \endverbatim *> @@ -170,10 +170,10 @@ * 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 2015 * @@ -185,20 +185,20 @@ *> \verbatim *> *> The columns of the pentagonal matrix V contain the elementary reflectors -*> H(1), H(2), ..., H(K); V is composed of a rectangular block V1 and a +*> H(1), H(2), ..., H(K); V is composed of a rectangular block V1 and a *> trapezoidal block V2: *> *> V = [V1] [V2]. -*> *> -*> The size of the trapezoidal block V2 is determined by the parameter L, +*> +*> The size of the trapezoidal block V2 is determined by the parameter L, *> where 0 <= L <= K; V2 is lower trapezoidal, consisting of the first L *> rows of a K-by-K upper triangular matrix. If L=K, V2 is lower triangular; *> if L=0, there is no trapezoidal block, hence V = V1 is rectangular. *> -*> If SIDE = 'L': C = [A] where A is K-by-N, B is M-by-N and V is K-by-M. -*> [B] -*> +*> If SIDE = 'L': C = [A] where A is K-by-N, B is M-by-N and V is K-by-M. +*> [B] +*> *> If SIDE = 'R': C = [A B] where A is M-by-K, B is M-by-N and V is K-by-N. *> *> The real orthogonal matrix Q is formed from V and T. @@ -226,7 +226,7 @@ INTEGER INFO, K, LDV, LDA, LDB, M, N, L, MB, LDT * .. * .. Array Arguments .. - REAL V( LDV, * ), A( LDA, * ), B( LDB, * ), + REAL V( LDV, * ), A( LDA, * ), B( LDB, * ), $ T( LDT, * ), WORK( * ) * .. * @@ -256,7 +256,7 @@ RIGHT = LSAME( SIDE, 'R' ) TRAN = LSAME( TRANS, 'T' ) NOTRAN = LSAME( TRANS, 'N' ) -* +* IF ( LEFT ) THEN LDAQ = MAX( 1, K ) ELSE IF ( RIGHT ) THEN @@ -273,7 +273,7 @@ ELSE IF( K.LT.0 ) THEN INFO = -5 ELSE IF( L.LT.0 .OR. L.GT.K ) THEN - INFO = -6 + INFO = -6 ELSE IF( MB.LT.1 .OR. (MB.GT.K .AND. K.GT.0) ) THEN INFO = -7 ELSE IF( LDV.LT.K ) THEN @@ -305,11 +305,11 @@ ELSE LB = 0 END IF - CALL STPRFB( 'L', 'T', 'F', 'R', NB, N, IB, LB, - $ V( I, 1 ), LDV, T( 1, I ), LDT, + CALL STPRFB( 'L', 'T', 'F', 'R', NB, N, IB, LB, + $ V( I, 1 ), LDV, T( 1, I ), LDT, $ A( I, 1 ), LDA, B, LDB, WORK, IB ) END DO -* +* ELSE IF( RIGHT .AND. TRAN ) THEN * DO I = 1, K, MB @@ -320,8 +320,8 @@ ELSE LB = NB-N+L-I+1 END IF - CALL STPRFB( 'R', 'N', 'F', 'R', M, NB, IB, LB, - $ V( I, 1 ), LDV, T( 1, I ), LDT, + CALL STPRFB( 'R', 'N', 'F', 'R', M, NB, IB, LB, + $ V( I, 1 ), LDV, T( 1, I ), LDT, $ A( 1, I ), LDA, B, LDB, WORK, M ) END DO * @@ -329,15 +329,15 @@ * KF = ((K-1)/MB)*MB+1 DO I = KF, 1, -MB - IB = MIN( MB, K-I+1 ) + IB = MIN( MB, K-I+1 ) NB = MIN( M-L+I+IB-1, M ) IF( I.GE.L ) THEN LB = 0 ELSE LB = 0 - END IF + END IF CALL STPRFB( 'L', 'N', 'F', 'R', NB, N, IB, LB, - $ V( I, 1 ), LDV, T( 1, I ), LDT, + $ V( I, 1 ), LDV, T( 1, I ), LDT, $ A( I, 1 ), LDA, B, LDB, WORK, IB ) END DO * @@ -345,7 +345,7 @@ * KF = ((K-1)/MB)*MB+1 DO I = KF, 1, -MB - IB = MIN( MB, K-I+1 ) + IB = MIN( MB, K-I+1 ) NB = MIN( N-L+I+IB-1, N ) IF( I.GE.L ) THEN LB = 0 @@ -353,7 +353,7 @@ LB = NB-N+L-I+1 END IF CALL STPRFB( 'R', 'T', 'F', 'R', M, NB, IB, LB, - $ V( I, 1 ), LDV, T( 1, I ), LDT, + $ V( I, 1 ), LDV, T( 1, I ), LDT, $ A( 1, I ), LDA, B, LDB, WORK, M ) END DO * diff --git a/SRC/zgelq.f b/SRC/zgelq.f index 2e188df9..33125b3d 100644 --- a/SRC/zgelq.f +++ b/SRC/zgelq.f @@ -1,26 +1,26 @@ -* +* * Definition: * =========== * -* SUBROUTINE CGELQ( M, N, A, LDA, WORK1, LWORK1, WORK2, LWORK2, +* SUBROUTINE CGELQ( M, N, A, LDA, WORK1, LWORK1, WORK2, LWORK2, * INFO) -* +* * .. Scalar Arguments .. * INTEGER INFO, LDA, M, N, LWORK1, LWORK2 * .. * .. Array Arguments .. * COMPLEX*16 A( LDA, * ), WORK1( * ), WORK2( * ) * .. -* +* * *> \par Purpose: * ============= *> *> \verbatim -*> -*> ZGELQ computes an LQ factorization of an M-by-N matrix A, -*> using ZLASWLQ when A is short and wide -*> (N sufficiently greater than M), and otherwise ZGELQT: +*> +*> ZGELQ computes an LQ factorization of an M-by-N matrix A, +*> using ZLASWLQ when A is short and wide +*> (N sufficiently greater than M), and otherwise ZGELQT: *> A = L * Q . *> \endverbatim * @@ -43,10 +43,10 @@ *> \verbatim *> A is COMPLEX*16 array, dimension (LDA,N) *> On entry, the M-by-N matrix A. -*> On exit, the elements on and below the diagonal of the array -*> contain the M-by-min(M,N) lower trapezoidal matrix L +*> On exit, the elements on and below the diagonal of the array +*> contain the M-by-min(M,N) lower trapezoidal matrix L *> (L is lower triangular if M <= N); -*> the elements above the diagonal are the rows of +*> the elements above the diagonal are the rows of *> blocked V representing Q (see Further Details). *> \endverbatim *> @@ -60,13 +60,13 @@ *> \verbatim *> WORK1 is COMPLEX*16 array, dimension (MAX(1,LWORK1)) *> WORK1 contains part of the data structure used to store Q. -*> WORK1(1): algorithm type = 1, to indicate output from +*> WORK1(1): algorithm type = 1, to indicate output from *> ZLASWLQ or ZGELQT *> WORK1(2): optimum size of WORK1 *> WORK1(3): minimum size of WORK1 *> WORK1(4): horizontal block size *> WORK1(5): vertical block size -*> WORK1(6:LWORK1): data structure needed for Q, computed by +*> WORK1(6:LWORK1): data structure needed for Q, computed by *> ZLASWLQ or ZGELQT *> \endverbatim *> @@ -74,25 +74,25 @@ *> \verbatim *> LWORK1 is INTEGER *> The dimension of the array WORK1. -*> If LWORK1 = -1, then a query is assumed. In this case the +*> If LWORK1 = -1, then a query is assumed. In this case the *> routine calculates the optimal size of WORK1 and -*> returns this value in WORK1(2), and calculates the minimum -*> size of WORK1 and returns this value in WORK1(3). -*> No error message related to LWORK1 is issued by XERBLA when +*> returns this value in WORK1(2), and calculates the minimum +*> size of WORK1 and returns this value in WORK1(3). +*> No error message related to LWORK1 is issued by XERBLA when *> LWORK1 = -1. *> \endverbatim *> *> \param[out] WORK2 *> \verbatim *> (workspace) COMPLEX*16 array, dimension (MAX(1,LWORK2)) -*> +*> *> \endverbatim *> \param[in] LWORK2 *> \verbatim *> LWORK2 is INTEGER *> The dimension of the array WORK2. *> If LWORK2 = -1, then a query is assumed. In this case the -*> routine calculates the optimal size of WORK2 and +*> routine calculates the optimal size of WORK2 and *> returns this value in WORK2(1), and calculates the minimum *> size of WORK2 and returns this value in WORK2(2). *> No error message related to LWORK2 is issued by XERBLA when @@ -121,19 +121,19 @@ *> Depending on the matrix dimensions M and N, and row and column *> block sizes MB and NB returned by ILAENV, GELQ will use either *> LASWLQ(if the matrix is short-and-wide) or GELQT to compute -*> the LQ decomposition. +*> the LQ decomposition. *> The output of LASWLQ or GELQT representing Q is stored in A and in -*> array WORK1(6:LWORK1) for later use. -*> WORK1(2:5) contains the matrix dimensions M,N and block sizes MB, NB -*> which are needed to interpret A and WORK1(6:LWORK1) for later use. -*> WORK1(1)=1 indicates that the code needed to take WORK1(2:5) and +*> array WORK1(6:LWORK1) for later use. +*> WORK1(2:5) contains the matrix dimensions M,N and block sizes MB, NB +*> which are needed to interpret A and WORK1(6:LWORK1) for later use. +*> WORK1(1)=1 indicates that the code needed to take WORK1(2:5) and *> decide whether LASWLQ or GELQT was used is the same as used below in -*> GELQ. For a detailed description of A and WORK1(6:LWORK1), see +*> GELQ. For a detailed description of A and WORK1(6:LWORK1), see *> Further Details in LASWLQ or GELQT. *> \endverbatim *> * ===================================================================== - SUBROUTINE ZGELQ( M, N, A, LDA, WORK1, LWORK1, WORK2, LWORK2, + SUBROUTINE ZGELQ( M, N, A, LDA, WORK1, LWORK1, WORK2, LWORK2, $ INFO) * * -- LAPACK computational routine (version 3.5.0) -- @@ -175,8 +175,8 @@ * LQUERY = ( LWORK1.EQ.-1 .OR. LWORK2.EQ.-1 ) * -* Determine the block size -* +* Determine the block size +* IF ( MIN(M,N).GT.0 ) THEN MB = ILAENV( 1, 'ZGELQ ', ' ', M, N, 1, -1) NB = ILAENV( 1, 'ZGELQ ', ' ', M, N, 2, -1) @@ -198,18 +198,18 @@ END IF * * Determine if the workspace size satisfies minimum size -* - LMINWS = .FALSE. +* + LMINWS = .FALSE. IF((LWORK1.LT.MAX(1,MB*M*NBLCKS+5) $ .OR.(LWORK2.LT.MB*M)).AND.(LWORK2.GE.M).AND.(LWORK1.GE.M+5) $ .AND.(.NOT.LQUERY)) THEN IF (LWORK1.LT.MAX(1,MB*M*NBLCKS+5)) THEN LMINWS = .TRUE. MB = 1 - END IF + END IF IF (LWORK1.LT.MAX(1,M*NBLCKS+5)) THEN LMINWS = .TRUE. - NB = N + NB = N END IF IF (LWORK2.LT.MB*M) THEN LMINWS = .TRUE. @@ -223,13 +223,13 @@ INFO = -2 ELSE IF( LDA.LT.MAX( 1, M ) ) THEN INFO = -4 - ELSE IF( LWORK1.LT.MAX( 1, MB*M*NBLCKS+5 ) + ELSE IF( LWORK1.LT.MAX( 1, MB*M*NBLCKS+5 ) $ .AND.(.NOT.LQUERY).AND. (.NOT.LMINWS)) THEN INFO = -6 ELSE IF( (LWORK2.LT.MAX(1,M*MB)).AND.(.NOT.LQUERY) $ .AND.(.NOT.LMINWS) ) THEN - INFO = -8 - END IF + INFO = -8 + END IF * IF( INFO.EQ.0) THEN WORK1(1) = 1 @@ -257,12 +257,12 @@ * IF((N.LE.M).OR.(NB.LE.M).OR.(NB.GE.N)) THEN CALL ZGELQT( M, N, MB, A, LDA, WORK1(6), MB, WORK2, INFO) - ELSE - CALL ZLASWLQ( M, N, MB, NB, A, LDA, WORK1(6), MB, WORK2, + ELSE + CALL ZLASWLQ( M, N, MB, NB, A, LDA, WORK1(6), MB, WORK2, $ LWORK2, INFO) END IF RETURN -* +* * End of ZGELQ * - END
\ No newline at end of file + END diff --git a/SRC/zgelqt.f b/SRC/zgelqt.f index d726db78..67da0b68 100644 --- a/SRC/zgelqt.f +++ b/SRC/zgelqt.f @@ -2,31 +2,31 @@ * * =========== 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 DGEQRT + dependencies -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zgelqt.f"> -*> [TGZ]</a> -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zgelqt.f"> -*> [ZIP]</a> -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zgelqt.f"> +*> Download DGEQRT + dependencies +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zgelqt.f"> +*> [TGZ]</a> +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zgelqt.f"> +*> [ZIP]</a> +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zgelqt.f"> *> [TXT]</a> -*> \endhtmlonly +*> \endhtmlonly * * Definition: * =========== * * SUBROUTINE ZGELQT( M, N, MB, A, LDA, T, LDT, WORK, INFO ) -* +* * .. Scalar Arguments .. * INTEGER INFO, LDA, LDT, M, N, MB * .. * .. Array Arguments .. * COMPLEX*16 A( LDA, * ), T( LDT, * ), WORK( * ) * .. -* +* * *> \par Purpose: * ============= @@ -34,7 +34,7 @@ *> \verbatim *> *> ZGELQT computes a blocked LQ factorization of a complex M-by-N matrix A -*> using the compact WY representation of Q. +*> using the compact WY representation of Q. *> \endverbatim * * Arguments: @@ -103,10 +103,10 @@ * 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 2013 * @@ -123,14 +123,14 @@ *> V = ( 1 v1 v1 v1 v1 ) *> ( 1 v2 v2 v2 ) *> ( 1 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. +*> in the matrix A. The 1's along the diagonal of V are not stored in A. *> Let K=MIN(M,N). The number of blocks is B = ceiling(K/NB), where each -*> block is of order NB except for the last block, which is of order +*> block is of order NB except for the last block, which is of order *> IB = K - (B-1)*NB. For each of the B blocks, a upper triangular block -*> reflector factor is computed: T1, T2, ..., TB. The NB-by-NB (and IB-by-IB +*> reflector factor is computed: T1, T2, ..., TB. The NB-by-NB (and IB-by-IB *> for the last block) T's are stored in the NB-by-N matrix T as *> *> T = (T1 T2 ... TB). @@ -190,21 +190,21 @@ * DO I = 1, K, MB IB = MIN( K-I+1, MB ) -* +* * Compute the LQ factorization of the current block A(I:M,I:I+IB-1) -* +* CALL ZGELQT3( IB, N-I+1, A(I,I), LDA, T(1,I), LDT, IINFO ) IF( I+IB.LE.M ) THEN * * Update by applying H**T to A(I:M,I+IB:N) from the right * CALL ZLARFB( 'R', 'N', 'F', 'R', M-I-IB+1, N-I+1, IB, - $ A( I, I ), LDA, T( 1, I ), LDT, + $ A( I, I ), LDA, T( 1, I ), LDT, $ A( I+IB, I ), LDA, WORK , M-I-IB+1 ) END IF END DO RETURN -* +* * End of ZGELQT * END diff --git a/SRC/zgemlq.f b/SRC/zgemlq.f index f71b6fd8..10d3a5e4 100644 --- a/SRC/zgemlq.f +++ b/SRC/zgemlq.f @@ -1,8 +1,8 @@ -* +* * Definition: * =========== * -* SUBROUTINE ZGEMLQ( SIDE, TRANS, M, N, K, A, LDA, WORK1, +* SUBROUTINE ZGEMLQ( SIDE, TRANS, M, N, K, A, LDA, WORK1, * $ LWORK1, C, LDC, WORK2, LWORK2, INFO ) * * @@ -17,15 +17,15 @@ * ============= *> *> \verbatim -*> +*> *> ZGEMLQ overwrites the general real M-by-N matrix C with *> -*> +*> *> SIDE = 'L' SIDE = 'R' *> TRANS = 'N': Q * C C * Q *> TRANS = 'T': Q**T * C C * Q**T -*> where Q is a complex orthogonal matrix defined as the product -*> of blocked elementary reflectors computed by short wide LQ +*> where Q is a complex orthogonal matrix defined as the product +*> of blocked elementary reflectors computed by short wide LQ *> factorization (DGELQ) *> \endverbatim * @@ -59,7 +59,7 @@ *> The number of elementary reflectors whose product defines *> the matrix Q. *> M >= K >= 0; -*> +*> *> \endverbatim *> *> \param[in,out] A @@ -101,15 +101,15 @@ *> \param[out] WORK2 *> \verbatim *> (workspace) COMPLEX*16 array, dimension (MAX(1,LWORK2)) -*> +*> *> \endverbatim *> \param[in] LWORK2 *> \verbatim *> LWORK2 is INTEGER -*> The dimension of the array WORK2. +*> The dimension of the array WORK2. *> If LWORK2 = -1, then a workspace query is assumed; the routine *> only calculates the optimal size of the WORK2 array, returns -*> this value as the third entry of the WORK2 array (WORK2(1)), +*> this value as the third entry of the WORK2 array (WORK2(1)), *> and no error message related to LWORK2 is issued by XERBLA. *> *> \endverbatim @@ -135,19 +135,19 @@ *> Depending on the matrix dimensions M and N, and row and column *> block sizes MB and NB returned by ILAENV, GELQ will use either *> LASWLQ(if the matrix is short-and-wide) or GELQT to compute -*> the LQ decomposition. +*> the LQ decomposition. *> The output of LASWLQ or GELQT representing Q is stored in A and in -*> array WORK1(6:LWORK1) for later use. -*> WORK1(2:5) contains the matrix dimensions M,N and block sizes MB, NB -*> which are needed to interpret A and WORK1(6:LWORK1) for later use. -*> WORK1(1)=1 indicates that the code needed to take WORK1(2:5) and +*> array WORK1(6:LWORK1) for later use. +*> WORK1(2:5) contains the matrix dimensions M,N and block sizes MB, NB +*> which are needed to interpret A and WORK1(6:LWORK1) for later use. +*> WORK1(1)=1 indicates that the code needed to take WORK1(2:5) and *> decide whether LASWLQ or GELQT was used is the same as used below in -*> GELQ. For a detailed description of A and WORK1(6:LWORK1), see +*> GELQ. For a detailed description of A and WORK1(6:LWORK1), see *> Further Details in LASWLQ or GELQT. *> \endverbatim *> * ===================================================================== - SUBROUTINE ZGEMLQ( SIDE, TRANS, M, N, K, A, LDA, WORK1, LWORK1, + SUBROUTINE ZGEMLQ( SIDE, TRANS, M, N, K, A, LDA, WORK1, LWORK1, $ C, LDC, WORK2, LWORK2, INFO ) * * -- LAPACK computational routine (version 3.5.0) -- @@ -242,12 +242,12 @@ * IF( MIN(M,N,K).EQ.0 ) THEN RETURN - END IF + END IF * IF((LEFT.AND.M.LE.K).OR.(RIGHT.AND.N.LE.K).OR.(NB.LE.K).OR. $ (NB.GE.MAX(M,N,K))) THEN - CALL ZGEMLQT( SIDE, TRANS, M, N, K, MB, A, LDA, - $ WORK1(6), MB, C, LDC, WORK2, INFO) + CALL ZGEMLQT( SIDE, TRANS, M, N, K, MB, A, LDA, + $ WORK1(6), MB, C, LDC, WORK2, INFO) ELSE CALL ZLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, WORK1(6), $ MB, C, LDC, WORK2, LWORK2, INFO ) @@ -258,4 +258,4 @@ * * End of ZGEMLQ * - END
\ No newline at end of file + END diff --git a/SRC/zgemlqt.f b/SRC/zgemlqt.f index 6060f9ef..e5385626 100644 --- a/SRC/zgemlqt.f +++ b/SRC/zgemlqt.f @@ -2,25 +2,25 @@ * * =========== 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 DGEMQRT + dependencies -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zgemlqt.f"> -*> [TGZ]</a> -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zgemlqt.f"> -*> [ZIP]</a> -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zgemlqt.f"> +*> Download DGEMQRT + dependencies +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zgemlqt.f"> +*> [TGZ]</a> +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zgemlqt.f"> +*> [ZIP]</a> +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zgemlqt.f"> *> [TXT]</a> -*> \endhtmlonly +*> \endhtmlonly * * Definition: * =========== * -* SUBROUTINE ZGEMLQT( SIDE, TRANS, M, N, K, MB, V, LDV, T, LDT, +* SUBROUTINE ZGEMLQT( SIDE, TRANS, M, N, K, MB, V, LDV, T, LDT, * C, LDC, WORK, INFO ) -* +* * .. Scalar Arguments .. * CHARACTER SIDE, TRANS * INTEGER INFO, K, LDV, LDC, M, N, MB, LDT @@ -28,7 +28,7 @@ * .. Array Arguments .. * DOUBLE PRECISION V( LDV, * ), C( LDC, * ), T( LDT, * ), WORK( * ) * .. -* +* * *> \par Purpose: * ============= @@ -46,7 +46,7 @@ *> *> Q = H(1) H(2) . . . H(K) = I - V C V**C *> -*> generated using the compact WY representation as returned by ZGELQT. +*> generated using the compact WY representation as returned by ZGELQT. *> *> Q is of order M if SIDE = 'L' and of order N if SIDE = 'R'. *> \endverbatim @@ -155,17 +155,17 @@ * 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 2013 * *> \ingroup doubleGEcomputational * * ===================================================================== - SUBROUTINE ZGEMLQT( SIDE, TRANS, M, N, K, MB, V, LDV, T, LDT, + SUBROUTINE ZGEMLQT( SIDE, TRANS, M, N, K, MB, V, LDV, T, LDT, $ C, LDC, WORK, INFO ) * * -- LAPACK computational routine (version 3.5.0) -- @@ -207,7 +207,7 @@ RIGHT = LSAME( SIDE, 'R' ) TRAN = LSAME( TRANS, 'C' ) NOTRAN = LSAME( TRANS, 'N' ) -* +* IF( LEFT ) THEN LDWORK = MAX( 1, N ) ELSE IF ( RIGHT ) THEN @@ -246,17 +246,17 @@ * DO I = 1, K, MB IB = MIN( MB, K-I+1 ) - CALL ZLARFB( 'L', 'C', 'F', 'R', M-I+1, N, IB, - $ V( I, I ), LDV, T( 1, I ), LDT, + CALL ZLARFB( 'L', 'C', 'F', 'R', M-I+1, N, IB, + $ V( I, I ), LDV, T( 1, I ), LDT, $ C( I, 1 ), LDC, WORK, LDWORK ) END DO -* +* ELSE IF( RIGHT .AND. TRAN ) THEN * DO I = 1, K, MB IB = MIN( MB, K-I+1 ) - CALL ZLARFB( 'R', 'N', 'F', 'R', M, N-I+1, IB, - $ V( I, I ), LDV, T( 1, I ), LDT, + CALL ZLARFB( 'R', 'N', 'F', 'R', M, N-I+1, IB, + $ V( I, I ), LDV, T( 1, I ), LDT, $ C( 1, I ), LDC, WORK, LDWORK ) END DO * @@ -264,9 +264,9 @@ * KF = ((K-1)/MB)*MB+1 DO I = KF, 1, -MB - IB = MIN( MB, K-I+1 ) - CALL ZLARFB( 'L', 'N', 'F', 'R', M-I+1, N, IB, - $ V( I, I ), LDV, T( 1, I ), LDT, + IB = MIN( MB, K-I+1 ) + CALL ZLARFB( 'L', 'N', 'F', 'R', M-I+1, N, IB, + $ V( I, I ), LDV, T( 1, I ), LDT, $ C( I, 1 ), LDC, WORK, LDWORK ) END DO * @@ -274,9 +274,9 @@ * KF = ((K-1)/MB)*MB+1 DO I = KF, 1, -MB - IB = MIN( MB, K-I+1 ) - CALL ZLARFB( 'R', 'C', 'F', 'R', M, N-I+1, IB, - $ V( I, I ), LDV, T( 1, I ), LDT, + IB = MIN( MB, K-I+1 ) + CALL ZLARFB( 'R', 'C', 'F', 'R', M, N-I+1, IB, + $ V( I, I ), LDV, T( 1, I ), LDT, $ C( 1, I ), LDC, WORK, LDWORK ) END DO * diff --git a/SRC/zgemqr.f b/SRC/zgemqr.f index c78fe4d0..3141067f 100644 --- a/SRC/zgemqr.f +++ b/SRC/zgemqr.f @@ -1,8 +1,8 @@ -* +* * Definition: * =========== * -* SUBROUTINE ZGEMQR( SIDE, TRANS, M, N, K, A, LDA, WORK1, +* SUBROUTINE ZGEMQR( SIDE, TRANS, M, N, K, A, LDA, WORK1, * $ LWORK1, C, LDC, WORK2, LWORK2, INFO ) * * @@ -17,15 +17,15 @@ * ============= *> *> \verbatim -*> +*> *> ZGEMQR overwrites the general real M-by-N matrix C with *> -*> +*> *> SIDE = 'L' SIDE = 'R' *> TRANS = 'N': Q * C C * Q *> TRANS = 'T': Q**T * C C * Q**T -*> where Q is a complex orthogonal matrix defined as the product -*> of blocked elementary reflectors computed by tall skinny +*> where Q is a complex orthogonal matrix defined as the product +*> of blocked elementary reflectors computed by tall skinny *> QR factorization (ZGEQR) *> \endverbatim * @@ -59,15 +59,15 @@ *> The number of elementary reflectors whose product defines *> the matrix Q. *> N >= K >= 0; -*> +*> *> \endverbatim *> *> \param[in,out] A *> \verbatim *> A is COMPLEX*16 array, dimension (LDA,K) -*> The i-th column must contain the vector which defines the -*> blockedelementary reflector H(i), for i = 1,2,...,k, as -*> returned by DGETSQR in the first k columns of +*> The i-th column must contain the vector which defines the +*> blockedelementary reflector H(i), for i = 1,2,...,k, as +*> returned by DGETSQR in the first k columns of *> its array argument A. *> \endverbatim *> @@ -103,15 +103,15 @@ *> \param[out] WORK2 *> \verbatim *> (workspace) COMPLEX*16 array, dimension (MAX(1,LWORK2)) -*> +*> *> \endverbatim *> \param[in] LWORK2 *> \verbatim *> LWORK2 is INTEGER -*> The dimension of the array WORK2. +*> The dimension of the array WORK2. *> If LWORK2 = -1, then a workspace query is assumed; the routine *> only calculates the optimal size of the WORK2 array, returns -*> this value as the third entry of the WORK2 array (WORK2(1)), +*> this value as the third entry of the WORK2 array (WORK2(1)), *> and no error message related to LWORK2 is issued by XERBLA. *> *> \endverbatim @@ -137,19 +137,19 @@ *> Depending on the matrix dimensions M and N, and row and column *> block sizes MB and NB returned by ILAENV, GEQR will use either *> LATSQR (if the matrix is tall-and-skinny) or GEQRT to compute -*> the QR decomposition. +*> the QR decomposition. *> The output of LATSQR or GEQRT representing Q is stored in A and in -*> array WORK1(6:LWORK1) for later use. -*> WORK1(2:5) contains the matrix dimensions M,N and block sizes MB,NB -*> which are needed to interpret A and WORK1(6:LWORK1) for later use. -*> WORK1(1)=1 indicates that the code needed to take WORK1(2:5) and -*> decide whether LATSQR or GEQRT was used is the same as used below in +*> array WORK1(6:LWORK1) for later use. +*> WORK1(2:5) contains the matrix dimensions M,N and block sizes MB,NB +*> which are needed to interpret A and WORK1(6:LWORK1) for later use. +*> WORK1(1)=1 indicates that the code needed to take WORK1(2:5) and +*> decide whether LATSQR or GEQRT was used is the same as used below in *> GEQR. For a detailed description of A and WORK1(6:LWORK1), see *> Further Details in LATSQR or GEQRT. *> \endverbatim *> * ===================================================================== - SUBROUTINE ZGEMQR( SIDE, TRANS, M, N, K, A, LDA, WORK1, LWORK1, + SUBROUTINE ZGEMQR( SIDE, TRANS, M, N, K, A, LDA, WORK1, LWORK1, $ C, LDC, WORK2, LWORK2, INFO ) * * -- LAPACK computational routine (version 3.5.0) -- @@ -177,7 +177,7 @@ LOGICAL LSAME EXTERNAL LSAME * .. External Subroutines .. - EXTERNAL ZGEMQRT, ZLAMTSQR, XERBLA + EXTERNAL ZGEMQRT, ZLAMTSQR, XERBLA * .. Intrinsic Functions .. INTRINSIC INT, MAX, MIN, MOD * .. @@ -199,7 +199,7 @@ ELSE IF(RIGHT) THEN LW = MB * NB MN = N - END IF + END IF * IF ((MB.GT.K).AND.(MN.GT.K)) THEN IF(MOD(MN-K, MB-K).EQ.0) THEN @@ -233,9 +233,9 @@ END IF * * Determine the block size if it is tall skinny or short and wide -* +* IF( INFO.EQ.0) THEN - WORK2(1) = LW + WORK2(1) = LW END IF * IF( INFO.NE.0 ) THEN @@ -253,16 +253,16 @@ * IF((LEFT.AND.M.LE.K).OR.(RIGHT.AND.N.LE.K).OR.(MB.LE.K).OR. $ (MB.GE.MAX(M,N,K))) THEN - CALL ZGEMQRT( SIDE, TRANS, M, N, K, NB, A, LDA, - $ WORK1(6), NB, C, LDC, WORK2, INFO) + CALL ZGEMQRT( SIDE, TRANS, M, N, K, NB, A, LDA, + $ WORK1(6), NB, C, LDC, WORK2, INFO) ELSE CALL ZLAMTSQR( SIDE, TRANS, M, N, K, MB, NB, A, LDA, WORK1(6), $ NB, C, LDC, WORK2, LWORK2, INFO ) - END IF + END IF * - WORK2(1) = LW + WORK2(1) = LW RETURN * * End of DGEMQR * - END
\ No newline at end of file + END diff --git a/SRC/zgeqr.f b/SRC/zgeqr.f index 18a7f100..10fab97f 100644 --- a/SRC/zgeqr.f +++ b/SRC/zgeqr.f @@ -1,26 +1,26 @@ -* +* * Definition: * =========== * * SUBROUTINE ZGEQR( M, N, A, LDA, WORK1, LWORK1, WORK2, LWORK2, * INFO) -* +* * .. Scalar Arguments .. * INTEGER INFO, LDA, M, N, LWORK1, LWORK2 * .. * .. Array Arguments .. * COMPLEX*16 A( LDA, * ), WORK1( * ), WORK2( * ) * .. -* +* * *> \par Purpose: * ============= *> *> \verbatim -*> -*> ZGEQR computes a QR factorization of an M-by-N matrix A, -*> using ZLATSQR when A is tall and skinny -*> (M sufficiently greater than N), and otherwise ZGEQRT: +*> +*> ZGEQR computes a QR factorization of an M-by-N matrix A, +*> using ZLATSQR when A is tall and skinny +*> (M sufficiently greater than N), and otherwise ZGEQRT: *> A = Q * R . *> \endverbatim * @@ -44,7 +44,7 @@ *> A is COMPLEX*16 array, dimension (LDA,N) *> On entry, the M-by-N matrix A. *> On exit, the elements on and above the diagonal of the array -*> contain the min(M,N)-by-N upper trapezoidal matrix R +*> contain the min(M,N)-by-N upper trapezoidal matrix R *> (R is upper triangular if M >= N); *> the elements below the diagonal represent Q (see Further Details). *> \endverbatim @@ -59,13 +59,13 @@ *> \verbatim *> WORK1 is COMPLEX*16 array, dimension (MAX(1,LWORK1)) *> WORK1 contains part of the data structure used to store Q. -*> WORK1(1): algorithm type = 1, to indicate output from +*> WORK1(1): algorithm type = 1, to indicate output from *> ZLATSQR or ZGEQRT *> WORK1(2): optimum size of WORK1 *> WORK1(3): minimum size of WORK1 *> WORK1(4): row block size *> WORK1(5): column block size -*> WORK1(6:LWORK1): data structure needed for Q, computed by +*> WORK1(6:LWORK1): data structure needed for Q, computed by *> CLATSQR or CGEQRT *> \endverbatim *> @@ -73,25 +73,25 @@ *> \verbatim *> LWORK1 is INTEGER *> The dimension of the array WORK1. -*> If LWORK1 = -1, then a query is assumed. In this case the +*> If LWORK1 = -1, then a query is assumed. In this case the *> routine calculates the optimal size of WORK1 and -*> returns this value in WORK1(2), and calculates the minimum -*> size of WORK1 and returns this value in WORK1(3). -*> No error message related to LWORK1 is issued by XERBLA when +*> returns this value in WORK1(2), and calculates the minimum +*> size of WORK1 and returns this value in WORK1(3). +*> No error message related to LWORK1 is issued by XERBLA when *> LWORK1 = -1. *> \endverbatim *> *> \param[out] WORK2 *> \verbatim -*> (workspace) COMPLEX*16 array, dimension (MAX(1,LWORK2)) +*> (workspace) COMPLEX*16 array, dimension (MAX(1,LWORK2)) *> \endverbatim *> *> \param[in] LWORK2 *> \verbatim *> LWORK2 is INTEGER *> The dimension of the array WORK2. -*> If LWORK2 = -1, then a query is assumed. In this case the -*> routine calculates the optimal size of WORK2 and +*> If LWORK2 = -1, then a query is assumed. In this case the +*> routine calculates the optimal size of WORK2 and *> returns this value in WORK2(1), and calculates the minimum *> size of WORK2 and returns this value in WORK2(2). *> No error message related to LWORK2 is issued by XERBLA when @@ -120,19 +120,19 @@ *> Depending on the matrix dimensions M and N, and row and column *> block sizes MB and NB returned by ILAENV, GEQR will use either *> LATSQR (if the matrix is tall-and-skinny) or GEQRT to compute -*> the QR decomposition. +*> the QR decomposition. *> The output of LATSQR or GEQRT representing Q is stored in A and in -*> array WORK1(6:LWORK1) for later use. -*> WORK1(2:5) contains the matrix dimensions M,N and block sizes MB,NB -*> which are needed to interpret A and WORK1(6:LWORK1) for later use. -*> WORK1(1)=1 indicates that the code needed to take WORK1(2:5) and -*> decide whether LATSQR or GEQRT was used is the same as used below in +*> array WORK1(6:LWORK1) for later use. +*> WORK1(2:5) contains the matrix dimensions M,N and block sizes MB,NB +*> which are needed to interpret A and WORK1(6:LWORK1) for later use. +*> WORK1(1)=1 indicates that the code needed to take WORK1(2:5) and +*> decide whether LATSQR or GEQRT was used is the same as used below in *> GEQR. For a detailed description of A and WORK1(6:LWORK1), see *> Further Details in LATSQR or GEQRT. *> \endverbatim *> * ===================================================================== - SUBROUTINE ZGEQR( M, N, A, LDA, WORK1, LWORK1, WORK2, LWORK2, + SUBROUTINE ZGEQR( M, N, A, LDA, WORK1, LWORK1, WORK2, LWORK2, $ INFO) * * -- LAPACK computational routine (version 3.5.0) -- @@ -174,8 +174,8 @@ * LQUERY = ( LWORK1.EQ.-1 .OR. LWORK2.EQ.-1 ) * -* Determine the block size -* +* Determine the block size +* IF ( MIN(M,N).GT.0 ) THEN MB = ILAENV( 1, 'ZGEQR ', ' ', M, N, 1, -1) NB = ILAENV( 1, 'ZGEQR ', ' ', M, N, 2, -1) @@ -197,18 +197,18 @@ END IF * * Determine if the workspace size satisfies minimum size -* +* LMINWS = .FALSE. - IF((LWORK1.LT.MAX(1, NB*N*NBLCKS+5) - $ .OR.(LWORK2.LT.NB*N)).AND.(LWORK2.GE.N).AND.(LWORK1.GT.N+5) + IF((LWORK1.LT.MAX(1, NB*N*NBLCKS+5) + $ .OR.(LWORK2.LT.NB*N)).AND.(LWORK2.GE.N).AND.(LWORK1.GT.N+5) $ .AND.(.NOT.LQUERY)) THEN IF (LWORK1.LT.MAX(1, NB * N * NBLCKS+5)) THEN LMINWS = .TRUE. NB = 1 - END IF + END IF IF (LWORK1.LT.MAX(1, N * NBLCKS+5)) THEN LMINWS = .TRUE. - MB = M + MB = M END IF IF (LWORK2.LT.NB*N) THEN LMINWS = .TRUE. @@ -222,13 +222,13 @@ INFO = -2 ELSE IF( LDA.LT.MAX( 1, M ) ) THEN INFO = -4 - ELSE IF( LWORK1.LT.MAX( 1, NB * N * NBLCKS + 5 ) + ELSE IF( LWORK1.LT.MAX( 1, NB * N * NBLCKS + 5 ) $ .AND.(.NOT.LQUERY).AND.(.NOT.LMINWS)) THEN INFO = -6 - ELSE IF( (LWORK2.LT.MAX(1,N*NB)).AND.(.NOT.LQUERY) + ELSE IF( (LWORK2.LT.MAX(1,N*NB)).AND.(.NOT.LQUERY) $ .AND.(.NOT.LMINWS)) THEN - INFO = -8 - END IF + INFO = -8 + END IF IF( INFO.EQ.0) THEN WORK1(1) = 1 @@ -256,12 +256,12 @@ * IF((M.LE.N).OR.(MB.LE.N).OR.(MB.GE.M)) THEN CALL ZGEQRT( M, N, NB, A, LDA, WORK1(6), NB, WORK2, INFO) - ELSE - CALL ZLATSQR( M, N, MB, NB, A, LDA, WORK1(6), NB, WORK2, + ELSE + CALL ZLATSQR( M, N, MB, NB, A, LDA, WORK1(6), NB, WORK2, $ LWORK2, INFO) END IF RETURN -* +* * End of ZGEQR * - END
\ No newline at end of file + END diff --git a/SRC/zgetsls.f b/SRC/zgetsls.f index 038d2adb..9b04227f 100644 --- a/SRC/zgetsls.f +++ b/SRC/zgetsls.f @@ -487,4 +487,4 @@ * * End of ZGETSLS * - END
\ No newline at end of file + END diff --git a/SRC/zheevr.f b/SRC/zheevr.f index 42ce60bc..024ad8c8 100644 --- a/SRC/zheevr.f +++ b/SRC/zheevr.f @@ -258,7 +258,7 @@ *> indicating the nonzero elements in Z. The i-th eigenvector *> is nonzero only in elements ISUPPZ( 2*i-1 ) through *> ISUPPZ( 2*i ). This is an output of ZSTEMR (tridiagonal -*> matrix). The support of the eigenvectors of A is typically +*> matrix). The support of the eigenvectors of A is typically *> 1:N because of the unitary transformations applied by ZUNMTR. *> Implemented only for RANGE = 'A' or 'I' and IU - IL = N - 1 *> \endverbatim diff --git a/SRC/zhesv_aasen.f b/SRC/zhesv_aasen.f index 2db96990..3d56dfc4 100644 --- a/SRC/zhesv_aasen.f +++ b/SRC/zhesv_aasen.f @@ -2,25 +2,25 @@ * * =========== 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 ZHESV_AASEN + dependencies -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zhesv_aasen.f"> -*> [TGZ]</a> -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zhesv_aasen.f"> -*> [ZIP]</a> -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zhesv_aasen.f"> +*> Download ZHESV_AASEN + dependencies +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zhesv_aasen.f"> +*> [TGZ]</a> +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zhesv_aasen.f"> +*> [ZIP]</a> +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zhesv_aasen.f"> *> [TXT]</a> -*> \endhtmlonly +*> \endhtmlonly * * Definition: * =========== * * SUBROUTINE ZHESV_AASEN( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, * LWORK, INFO ) -* +* * .. Scalar Arguments .. * CHARACTER UPLO * INTEGER INFO, LDA, LDB, LWORK, N, NRHS @@ -29,7 +29,7 @@ * INTEGER IPIV( * ) * COMPLEX*16 A( LDA, * ), B( LDB, * ), WORK( * ) * .. -* +* * *> \par Purpose: * ============= @@ -45,7 +45,7 @@ *> A = U * T * U**H, if UPLO = 'U', or *> A = L * T * L**H, if UPLO = 'L', *> where U (or L) is a product of permutation and unit upper (lower) -*> triangular matrices, and T is Hermitian and tridiagonal. The factored form +*> triangular matrices, and T is Hermitian and tridiagonal. The factored form *> of A is then used to solve the system of equations A * X = B. *> \endverbatim * @@ -99,8 +99,8 @@ *> \param[out] IPIV *> \verbatim *> IPIV is INTEGER array, dimension (N) -*> On exit, it contains the details of the interchanges, i.e., -*> the row and column k of A were interchanged with the +*> On exit, it contains the details of the interchanges, i.e., +*> the row and column k of A were interchanged with the *> row and column IPIV(k). *> \endverbatim *> @@ -151,10 +151,10 @@ * 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 2016 * diff --git a/SRC/zhetrf_aasen.f b/SRC/zhetrf_aasen.f index 75d6951c..e56fcc67 100644 --- a/SRC/zhetrf_aasen.f +++ b/SRC/zhetrf_aasen.f @@ -2,24 +2,24 @@ * * =========== 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 ZHETRF_AASEN + dependencies -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zhetrf_aasen.f"> -*> [TGZ]</a> -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zhetrf_aasen.f"> -*> [ZIP]</a> -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zhetrf_aasen.f"> +*> Download ZHETRF_AASEN + dependencies +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zhetrf_aasen.f"> +*> [TGZ]</a> +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zhetrf_aasen.f"> +*> [ZIP]</a> +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zhetrf_aasen.f"> *> [TXT]</a> -*> \endhtmlonly +*> \endhtmlonly * * Definition: * =========== * * SUBROUTINE ZHETRF_AASEN( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO ) -* +* * .. Scalar Arguments .. * CHARACTER UPLO * INTEGER N, LDA, LWORK, INFO @@ -73,7 +73,7 @@ *> triangular part of A is not referenced. *> *> On exit, the tridiagonal matrix is stored in the diagonals -*> and the subdiagonals of A just below (or above) the diagonals, +*> and the subdiagonals of A just below (or above) the diagonals, *> and L is stored below (or above) the subdiaonals, when UPLO *> is 'L' (or 'U'). *> \endverbatim @@ -87,8 +87,8 @@ *> \param[out] IPIV *> \verbatim *> IPIV is INTEGER array, dimension (N) -*> On exit, it contains the details of the interchanges, i.e., -*> the row and column k of A were interchanged with the +*> On exit, it contains the details of the interchanges, i.e., +*> the row and column k of A were interchanged with the *> row and column IPIV(k). *> \endverbatim *> @@ -124,10 +124,10 @@ * 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 2016 * @@ -245,14 +245,14 @@ * J = 0 10 CONTINUE - IF( J.GE.N ) + IF( J.GE.N ) $ GO TO 20 * * each step of the main loop * J is the last column of the previous panel * J1 is the first column of the current panel * K1 identifies if the previous column of the panel has been -* explicitly stored, e.g., K1=1 for the first panel, and +* explicitly stored, e.g., K1=1 for the first panel, and * K1=0 for the rest * J1 = J + 1 @@ -261,27 +261,27 @@ * * Panel factorization * - CALL ZLAHEF_AASEN( UPLO, 2-K1, N-J, JB, + CALL ZLAHEF_AASEN( UPLO, 2-K1, N-J, JB, $ A( MAX(1, J), J+1 ), LDA, - $ IPIV( J+1 ), WORK, N, WORK( N*NB+1 ), + $ IPIV( J+1 ), WORK, N, WORK( N*NB+1 ), $ IINFO ) IF( (IINFO.GT.0) .AND. (INFO.EQ.0) ) THEN INFO = IINFO+J - ENDIF + ENDIF * * Ajust IPIV and apply it back (J-th step picks (J+1)-th pivot) * DO J2 = J+2, MIN(N, J+JB+1) IPIV( J2 ) = IPIV( J2 ) + J IF( (J2.NE.IPIV(J2)) .AND. ((J1-K1).GT.2) ) THEN - CALL ZSWAP( J1-K1-2, A( 1, J2 ), 1, + CALL ZSWAP( J1-K1-2, A( 1, J2 ), 1, $ A( 1, IPIV(J2) ), 1 ) END IF END DO J = J + JB * * Trailing submatrix update, where -* the row A(J1-1, J2-1:N) stores U(J1, J2+1:N) and +* the row A(J1-1, J2-1:N) stores U(J1, J2+1:N) and * WORK stores the current block of the auxiriarly matrix H * IF( J.LT.N ) THEN @@ -313,7 +313,7 @@ * K2 = 0 * -* First update skips the first column +* First update skips the first column * JB = JB - 1 END IF @@ -335,7 +335,7 @@ * * Update off-diagonal block of J2-th block row with ZGEMM * - CALL ZGEMM( 'Conjugate transpose', 'Transpose', + CALL ZGEMM( 'Conjugate transpose', 'Transpose', $ NJ, N-J3+1, JB+1, $ -ONE, A( J1-K2, J2 ), LDA, $ WORK( (J3-J1+1)+K1*N ), N, @@ -358,7 +358,7 @@ * Factorize A as L*D*L**T using the lower triangle of A * ..................................................... * -* copy first column A(1:N, 1) into H(1:N, 1) +* copy first column A(1:N, 1) into H(1:N, 1) * (stored in WORK(1:N)) * CALL ZCOPY( N, A( 1, 1 ), 1, WORK( 1 ), 1 ) @@ -369,14 +369,14 @@ * J = 0 11 CONTINUE - IF( J.GE.N ) + IF( J.GE.N ) $ GO TO 20 * * each step of the main loop * J is the last column of the previous panel * J1 is the first column of the current panel * K1 identifies if the previous column of the panel has been -* explicitly stored, e.g., K1=1 for the first panel, and +* explicitly stored, e.g., K1=1 for the first panel, and * K1=0 for the rest * J1 = J+1 @@ -385,26 +385,26 @@ * * Panel factorization * - CALL ZLAHEF_AASEN( UPLO, 2-K1, N-J, JB, + CALL ZLAHEF_AASEN( UPLO, 2-K1, N-J, JB, $ A( J+1, MAX(1, J) ), LDA, $ IPIV( J+1 ), WORK, N, WORK( N*NB+1 ), IINFO) IF( (IINFO.GT.0) .AND. (INFO.EQ.0) ) THEN INFO = IINFO+J - ENDIF + ENDIF * * Ajust IPIV and apply it back (J-th step picks (J+1)-th pivot) * DO J2 = J+2, MIN(N, J+JB+1) IPIV( J2 ) = IPIV( J2 ) + J IF( (J2.NE.IPIV(J2)) .AND. ((J1-K1).GT.2) ) THEN - CALL ZSWAP( J1-K1-2, A( J2, 1 ), LDA, + CALL ZSWAP( J1-K1-2, A( J2, 1 ), LDA, $ A( IPIV(J2), 1 ), LDA ) END IF END DO J = J + JB * * Trailing submatrix update, where -* A(J2+1, J1-1) stores L(J2+1, J1) and +* A(J2+1, J1-1) stores L(J2+1, J1) and * WORK(J2+1, 1) stores H(J2+1, 1) * IF( J.LT.N ) THEN @@ -436,7 +436,7 @@ * K2 = 0 * -* First update skips the first column +* First update skips the first column * JB = JB - 1 END IF @@ -458,7 +458,7 @@ * * Update off-diagonal block of J2-th block column with ZGEMM * - CALL ZGEMM( 'No transpose', 'Conjugate transpose', + CALL ZGEMM( 'No transpose', 'Conjugate transpose', $ N-J3+1, NJ, JB+1, $ -ONE, WORK( (J3-J1+1)+K1*N ), N, $ A( J2, J1-K2 ), LDA, diff --git a/SRC/zhetrs_aasen.f b/SRC/zhetrs_aasen.f index 309f1e79..6d2c73cc 100644 --- a/SRC/zhetrs_aasen.f +++ b/SRC/zhetrs_aasen.f @@ -2,25 +2,25 @@ * * =========== 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 ZHETRS_AASEN + dependencies *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zhetrs_aasen.f"> -*> [TGZ]</a> +*> [TGZ]</a> *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zhetrs_aasen.f"> -*> [ZIP]</a> +*> [ZIP]</a> *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zhetrs_aasen.f"> *> [TXT]</a> -*> \endhtmlonly +*> \endhtmlonly * * Definition: * =========== * * SUBROUTINE ZHETRS_AASEN( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, * WORK, LWORK, INFO ) -* +* * .. Scalar Arguments .. * CHARACTER UPLO * INTEGER N, NRHS, LDA, LDB, LWORK, INFO @@ -29,7 +29,7 @@ * INTEGER IPIV( * ) * COMPLEX*16 A( LDA, * ), B( LDB, * ), WORK( * ) * .. -* +* * *> \par Purpose: * ============= @@ -116,10 +116,10 @@ * 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 2016 * @@ -211,7 +211,7 @@ $ B( 2, 1 ), LDB) * * Compute T \ B -> B [ T \ (U \P**T * B) ] -* +* CALL ZLACPY( 'F', 1, N, A(1, 1), LDA+1, WORK(N), 1) IF( N.GT.1 ) THEN CALL ZLACPY( 'F', 1, N-1, A( 1, 2 ), LDA+1, WORK( 2*N ), 1) @@ -220,7 +220,7 @@ END IF CALL ZGTSV(N, NRHS, WORK(1), WORK(N), WORK(2*N), B, LDB, $ INFO) -* +* * Compute (U**T \ B) -> B [ U**T \ (T \ (U \P**T * B) ) ] * CALL ZTRSM( 'L', 'U', 'N', 'U', N-1, NRHS, ONE, A( 1, 2 ), LDA, @@ -261,9 +261,9 @@ END IF CALL ZGTSV(N, NRHS, WORK(1), WORK(N), WORK(2*N), B, LDB, $ INFO) -* +* * Compute (L**T \ B) -> B [ L**T \ (T \ (L \P**T * B) ) ] -* +* CALL ZTRSM( 'L', 'L', 'C', 'U', N-1, NRHS, ONE, A( 2, 1 ), LDA, $ B( 2, 1 ), LDB) * diff --git a/SRC/zlahef_aasen.f b/SRC/zlahef_aasen.f index d85669e5..61510a74 100644 --- a/SRC/zlahef_aasen.f +++ b/SRC/zlahef_aasen.f @@ -2,25 +2,25 @@ * * =========== 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 ZLAHEF_AASEN + dependencies -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zlahef_aasen.f"> -*> [TGZ]</a> -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zlahef_aasen.f"> -*> [ZIP]</a> -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zlahef_aasen.f"> +*> Download ZLAHEF_AASEN + dependencies +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zlahef_aasen.f"> +*> [TGZ]</a> +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zlahef_aasen.f"> +*> [ZIP]</a> +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zlahef_aasen.f"> *> [TXT]</a> -*> \endhtmlonly +*> \endhtmlonly * * Definition: * =========== * -* SUBROUTINE ZLAHEF_AASEN( UPLO, J1, M, NB, A, LDA, IPIV, +* SUBROUTINE ZLAHEF_AASEN( UPLO, J1, M, NB, A, LDA, IPIV, * H, LDH, WORK, INFO ) -* +* * .. Scalar Arguments .. * CHARACTER UPLO * INTEGER J1, M, NB, LDA, LDH, INFO @@ -29,7 +29,7 @@ * INTEGER IPIV( * ) * COMPLEX*16 A( LDA, * ), H( LDH, * ), WORK( * ) * .. -* +* * *> \par Purpose: * ============= @@ -44,9 +44,9 @@ *> last row, or column, of the previous panel. The first row, or column, *> of A is set to be the first row, or column, of an identity matrix, *> which is used to factorize the first panel. -*> +*> *> The resulting J-th row of U, or J-th column of L, is stored in the -*> (J-1)-th row, or column, of A (without the unit diatonals), while +*> (J-1)-th row, or column, of A (without the unit diatonals), while *> the diagonal and subdiagonal of A are overwritten by those of T. *> *> \endverbatim @@ -141,10 +141,10 @@ * 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 2016 * @@ -153,7 +153,7 @@ * @precisions fortran z -> c * * ===================================================================== - SUBROUTINE ZLAHEF_AASEN( UPLO, J1, M, NB, A, LDA, IPIV, + SUBROUTINE ZLAHEF_AASEN( UPLO, J1, M, NB, A, LDA, IPIV, $ H, LDH, WORK, INFO ) * * -- LAPACK computational routine (version 3.4.0) -- @@ -179,7 +179,7 @@ * * .. Local Scalars .. INTEGER J, K, K1, I1, I2 - COMPLEX*16 PIV, ALPHA + COMPLEX*16 PIV, ALPHA * .. * .. External Functions .. LOGICAL LSAME @@ -255,14 +255,14 @@ * A( K, J ) = DBLE( WORK( 1 ) ) * - IF( J.LT.M ) THEN + IF( J.LT.M ) THEN * * Compute WORK(2:N) = T(J, J) L(J, (J+1):N) * where A(J, J) stores T(J, J) and A(J-1, (J+1):N) stores U(J, (J+1):N) * IF( (J1+J-1).GT.1 ) THEN - ALPHA = -A( K, J ) - CALL ZAXPY( M-J, ALPHA, A( K-1, J+1 ), LDA, + ALPHA = -A( K, J ) + CALL ZAXPY( M-J, ALPHA, A( K-1, J+1 ), LDA, $ WORK( 2 ), 1 ) ENDIF * @@ -285,14 +285,14 @@ * I1 = I1+J-1 I2 = I2+J-1 - CALL ZSWAP( I2-I1-1, A( J1+I1-1, I1+1 ), LDA, + CALL ZSWAP( I2-I1-1, A( J1+I1-1, I1+1 ), LDA, $ A( J1+I1, I2 ), 1 ) CALL ZLACGV( I2-I1, A( J1+I1-1, I1+1 ), LDA ) CALL ZLACGV( I2-I1-1, A( J1+I1, I2 ), 1 ) * * Swap A(I1, I2+1:N) with A(I2, I2+1:N) * - CALL ZSWAP( M-I2, A( J1+I1-1, I2+1 ), LDA, + CALL ZSWAP( M-I2, A( J1+I1-1, I2+1 ), LDA, $ A( J1+I2-1, I2+1 ), LDA ) * * Swap A(I1, I1) with A(I2,I2) @@ -311,17 +311,17 @@ * Swap L(1:I1-1, I1) with L(1:I1-1, I2), * skipping the first column * - CALL ZSWAP( I1-K1+1, A( 1, I1 ), 1, + CALL ZSWAP( I1-K1+1, A( 1, I1 ), 1, $ A( 1, I2 ), 1 ) END IF - ELSE + ELSE IPIV( J+1 ) = J+1 ENDIF * * Set A(J, J+1) = T(J, J+1) * A( K, J+1 ) = WORK( 2 ) - IF( (A( K, J ).EQ.ZERO ) .AND. + IF( (A( K, J ).EQ.ZERO ) .AND. $ ( (J.EQ.M) .OR. (A( K, J+1 ).EQ.ZERO))) THEN IF(INFO .EQ. 0) THEN INFO = J @@ -330,9 +330,9 @@ * IF( J.LT.NB ) THEN * -* Copy A(J+1:N, J+1) into H(J:N, J), +* Copy A(J+1:N, J+1) into H(J:N, J), * - CALL ZCOPY( M-J, A( K+1, J+1 ), LDA, + CALL ZCOPY( M-J, A( K+1, J+1 ), LDA, $ H( J+1, J+1 ), 1 ) END IF * @@ -344,7 +344,7 @@ CALL ZCOPY( M-J-1, WORK( 3 ), 1, A( K, J+2 ), LDA ) CALL ZSCAL( M-J-1, ALPHA, A( K, J+2 ), LDA ) ELSE - CALL ZLASET( 'Full', 1, M-J-1, ZERO, ZERO, + CALL ZLASET( 'Full', 1, M-J-1, ZERO, ZERO, $ A( K, J+2 ), LDA) END IF ELSE @@ -409,14 +409,14 @@ * A( J, K ) = DBLE( WORK( 1 ) ) * - IF( J.LT.M ) THEN + IF( J.LT.M ) THEN * * Compute WORK(2:N) = T(J, J) L((J+1):N, J) * where A(J, J) = T(J, J) and A((J+1):N, J-1) = L((J+1):N, J) * IF( (J1+J-1).GT.1 ) THEN ALPHA = -A( J, K ) - CALL ZAXPY( M-J, ALPHA, A( J+1, K-1 ), 1, + CALL ZAXPY( M-J, ALPHA, A( J+1, K-1 ), 1, $ WORK( 2 ), 1 ) ENDIF * @@ -439,14 +439,14 @@ * I1 = I1+J-1 I2 = I2+J-1 - CALL ZSWAP( I2-I1-1, A( I1+1, J1+I1-1 ), 1, + CALL ZSWAP( I2-I1-1, A( I1+1, J1+I1-1 ), 1, $ A( I2, J1+I1 ), LDA ) CALL ZLACGV( I2-I1, A( I1+1, J1+I1-1 ), 1 ) CALL ZLACGV( I2-I1-1, A( I2, J1+I1 ), LDA ) * * Swap A(I2+1:N, I1) with A(I2+1:N, I2) * - CALL ZSWAP( M-I2, A( I2+1, J1+I1-1 ), 1, + CALL ZSWAP( M-I2, A( I2+1, J1+I1-1 ), 1, $ A( I2+1, J1+I2-1 ), 1 ) * * Swap A(I1, I1) with A(I2, I2) @@ -465,27 +465,27 @@ * Swap L(1:I1-1, I1) with L(1:I1-1, I2), * skipping the first column * - CALL ZSWAP( I1-K1+1, A( I1, 1 ), LDA, + CALL ZSWAP( I1-K1+1, A( I1, 1 ), LDA, $ A( I2, 1 ), LDA ) END IF - ELSE + ELSE IPIV( J+1 ) = J+1 ENDIF * * Set A(J+1, J) = T(J+1, J) * A( J+1, K ) = WORK( 2 ) - IF( (A( J, K ).EQ.ZERO) .AND. + IF( (A( J, K ).EQ.ZERO) .AND. $ ( (J.EQ.M) .OR. (A( J+1, K ).EQ.ZERO)) ) THEN - IF (INFO .EQ. 0) + IF (INFO .EQ. 0) $ INFO = J END IF * IF( J.LT.NB ) THEN * -* Copy A(J+1:N, J+1) into H(J+1:N, J), +* Copy A(J+1:N, J+1) into H(J+1:N, J), * - CALL ZCOPY( M-J, A( J+1, K+1 ), 1, + CALL ZCOPY( M-J, A( J+1, K+1 ), 1, $ H( J+1, J+1 ), 1 ) END IF * @@ -497,11 +497,11 @@ CALL ZCOPY( M-J-1, WORK( 3 ), 1, A( J+2, K ), 1 ) CALL ZSCAL( M-J-1, ALPHA, A( J+2, K ), 1 ) ELSE - CALL ZLASET( 'Full', M-J-1, 1, ZERO, ZERO, + CALL ZLASET( 'Full', M-J-1, 1, ZERO, ZERO, $ A( J+2, K ), LDA ) END IF ELSE - IF( (A( J, K ).EQ.ZERO) .AND. (J.EQ.M) + IF( (A( J, K ).EQ.ZERO) .AND. (J.EQ.M) $ .AND. (INFO.EQ.0) ) INFO = J END IF J = J + 1 diff --git a/SRC/zlamswlq.f b/SRC/zlamswlq.f index af0c62ef..365530c3 100644 --- a/SRC/zlamswlq.f +++ b/SRC/zlamswlq.f @@ -1,8 +1,8 @@ -* +* * Definition: * =========== * -* SUBROUTINE ZLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, +* SUBROUTINE ZLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, * $ LDT, C, LDC, WORK, LWORK, INFO ) * * @@ -17,15 +17,15 @@ * ============= *> *> \verbatim -*> +*> *> ZLAMQRTS overwrites the general real M-by-N matrix C with *> -*> +*> *> SIDE = 'L' SIDE = 'R' *> TRANS = 'N': Q * C C * Q *> TRANS = 'T': Q**T * C C * Q**T *> where Q is a real orthogonal matrix defined as the product of blocked -*> elementary reflectors computed by short wide LQ +*> elementary reflectors computed by short wide LQ *> factorization (ZLASWLQ) *> \endverbatim * @@ -59,28 +59,28 @@ *> The number of elementary reflectors whose product defines *> the matrix Q. *> M >= K >= 0; -*> +*> *> \endverbatim *> \param[in] MB *> \verbatim *> MB is INTEGER -*> The row block size to be used in the blocked QR. -*> M >= MB >= 1 +*> The row block size to be used in the blocked QR. +*> M >= MB >= 1 *> \endverbatim *> *> \param[in] NB *> \verbatim *> NB is INTEGER -*> The column block size to be used in the blocked QR. +*> The column block size to be used in the blocked QR. *> NB > M. *> \endverbatim *> *> \param[in] NB *> \verbatim *> NB is INTEGER -*> The block size to be used in the blocked QR. +*> The block size to be used in the blocked QR. *> MB > M. -*> +*> *> \endverbatim *> *> \param[in,out] A @@ -101,7 +101,7 @@ *> *> \param[in] T *> \verbatim -*> T is COMPLEX*16 array, dimension +*> T is COMPLEX*16 array, dimension *> ( M * Number of blocks(CEIL(N-K/NB-K)), *> The blocked upper triangular block reflectors stored in compact form *> as a sequence of upper triangular blocks. See below @@ -125,7 +125,7 @@ *> \param[out] WORK *> \verbatim *> (workspace) COMPLEX*16 array, dimension (MAX(1,LWORK)) -*> +*> *> \endverbatim *> \param[in] LWORK *> \verbatim @@ -177,7 +177,7 @@ *> block reflectors, stored in array T(1:LDT,(i-1)*M+1:i*M). *> The last Q(k) may use fewer rows. *> For more information see Further Details in TPQRT. -*> +*> *> For more details of the overall algorithm, see the description of *> Sequential TSQR in Section 2.2 of [1]. *> @@ -187,7 +187,7 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE ZLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, + SUBROUTINE ZLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, $ LDT, C, LDC, WORK, LWORK, INFO ) * * -- LAPACK computational routine (version 3.5.0) -- @@ -266,11 +266,11 @@ * IF( MIN(M,N,K).EQ.0 ) THEN RETURN - END IF + END IF * IF((NB.LE.K).OR.(NB.GE.MAX(M,N,K))) THEN - CALL ZGEMLQT( SIDE, TRANS, M, N, K, MB, A, LDA, - $ T, LDT, C, LDC, WORK, INFO) + CALL ZGEMLQT( SIDE, TRANS, M, N, K, MB, A, LDA, + $ T, LDT, C, LDC, WORK, INFO) RETURN END IF * @@ -390,7 +390,7 @@ IF(II.LE.N) THEN * * Multiply Q to the last block of C -* +* CALL ZTPMLQT('R','C',M , KK, K, 0,MB, A(1,II), LDA, $ T(1, CTR * K + 1),LDT, C(1,1), LDC, $ C(1,II), LDC, WORK, INFO ) @@ -404,4 +404,4 @@ * * End of ZLAMSWLQ * - END
\ No newline at end of file + END diff --git a/SRC/zlamtsqr.f b/SRC/zlamtsqr.f index 21513027..7195f9e1 100644 --- a/SRC/zlamtsqr.f +++ b/SRC/zlamtsqr.f @@ -1,8 +1,8 @@ -* +* * Definition: * =========== * -* SUBROUTINE ZLAMTSQR( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, +* SUBROUTINE ZLAMTSQR( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, * $ LDT, C, LDC, WORK, LWORK, INFO ) * * @@ -17,15 +17,15 @@ * ============= *> *> \verbatim -*> +*> *> ZLAMTSQR overwrites the general complex M-by-N matrix C with *> -*> +*> *> SIDE = 'L' SIDE = 'R' *> TRANS = 'N': Q * C C * Q *> TRANS = 'C': Q**C * C C * Q**C -*> where Q is a real orthogonal matrix defined as the product -*> of blocked elementary reflectors computed by tall skinny +*> where Q is a real orthogonal matrix defined as the product +*> of blocked elementary reflectors computed by tall skinny *> QR factorization (ZLATSQR) *> \endverbatim * @@ -59,29 +59,29 @@ *> The number of elementary reflectors whose product defines *> the matrix Q. *> N >= K >= 0; -*> +*> *> \endverbatim *> *> \param[in] MB *> \verbatim *> MB is INTEGER -*> The block size to be used in the blocked QR. +*> The block size to be used in the blocked QR. *> MB > N. (must be the same as DLATSQR) *> \endverbatim *> *> \param[in] NB *> \verbatim *> NB is INTEGER -*> The column block size to be used in the blocked QR. +*> The column block size to be used in the blocked QR. *> N >= NB >= 1. *> \endverbatim *> *> \param[in,out] A *> \verbatim *> A is COMPLEX*16 array, dimension (LDA,K) -*> The i-th column must contain the vector which defines the -*> blockedelementary reflector H(i), for i = 1,2,...,k, as -*> returned by DLATSQR in the first k columns of +*> The i-th column must contain the vector which defines the +*> blockedelementary reflector H(i), for i = 1,2,...,k, as +*> returned by DLATSQR in the first k columns of *> its array argument A. *> \endverbatim *> @@ -95,7 +95,7 @@ *> *> \param[in] T *> \verbatim -*> T is COMPLEX*16 array, dimension +*> T is COMPLEX*16 array, dimension *> ( N * Number of blocks(CEIL(M-K/MB-K)), *> The blocked upper triangular block reflectors stored in compact form *> as a sequence of upper triangular blocks. See below @@ -119,13 +119,13 @@ *> \param[out] WORK *> \verbatim *> (workspace) COMPLEX*16 array, dimension (MAX(1,LWORK)) -*> +*> *> \endverbatim *> \param[in] LWORK *> \verbatim *> LWORK is INTEGER *> The dimension of the array WORK. -*> +*> *> If SIDE = 'L', LWORK >= max(1,N)*NB; *> if SIDE = 'R', LWORK >= max(1,MB)*NB. *> If LWORK = -1, then a workspace query is assumed; the routine @@ -172,7 +172,7 @@ *> block reflectors, stored in array T(1:LDT,(i-1)*N+1:i*N). *> The last Q(k) may use fewer rows. *> For more information see Further Details in TPQRT. -*> +*> *> For more details of the overall algorithm, see the description of *> Sequential TSQR in Section 2.2 of [1]. *> @@ -182,7 +182,7 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE ZLAMTSQR( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, + SUBROUTINE ZLAMTSQR( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, $ LDT, C, LDC, WORK, LWORK, INFO ) * * -- LAPACK computational routine (version 3.5.0) -- @@ -210,7 +210,7 @@ LOGICAL LSAME EXTERNAL LSAME * .. External Subroutines .. - EXTERNAL ZGEMQRT, ZTPMQRT, XERBLA + EXTERNAL ZGEMQRT, ZTPMQRT, XERBLA * .. * .. Executable Statements .. * @@ -249,11 +249,11 @@ END IF * * Determine the block size if it is tall skinny or short and wide -* +* IF( INFO.EQ.0) THEN WORK(1) = LW END IF -* +* IF( INFO.NE.0 ) THEN CALL XERBLA( 'ZLAMTSQR', -INFO ) RETURN @@ -268,10 +268,10 @@ END IF * IF((MB.LE.K).OR.(MB.GE.MAX(M,N,K))) THEN - CALL ZGEMQRT( SIDE, TRANS, M, N, K, NB, A, LDA, - $ T, LDT, C, LDC, WORK, INFO) + CALL ZGEMQRT( SIDE, TRANS, M, N, K, NB, A, LDA, + $ T, LDT, C, LDC, WORK, INFO) RETURN - END IF + END IF * IF(LEFT.AND.NOTRAN) THEN * @@ -327,7 +327,7 @@ IF(II.LE.M) THEN * * Multiply Q to the last block of C -* +* CALL ZTPMQRT('L','C',KK , N, K, 0,NB, A(II,1), LDA, $ T(1, CTR * K + 1), LDT, C(1,1), LDC, $ C(II,1), LDC, WORK, INFO ) @@ -397,9 +397,9 @@ * END IF * - WORK(1) = LW + WORK(1) = LW RETURN * * End of ZLAMTSQR * - END
\ No newline at end of file + END diff --git a/SRC/zlaswlq.f b/SRC/zlaswlq.f index 67178c29..fec26cff 100644 --- a/SRC/zlaswlq.f +++ b/SRC/zlaswlq.f @@ -1,24 +1,24 @@ -* +* * Definition: * =========== * * SUBROUTINE ZLASWLQ( M, N, MB, NB, A, LDA, T, LDT, WORK, * LWORK, INFO) -* +* * .. Scalar Arguments .. * INTEGER INFO, LDA, M, N, MB, NB, LDT, LWORK * .. * .. Array Arguments .. * COMPLEX*16 A( LDA, * ), T( LDT, * ), WORK( * ) * .. -* +* * *> \par Purpose: * ============= *> *> \verbatim -*> -*> ZLASWLQ computes a blocked Short-Wide LQ factorization of a +*> +*> ZLASWLQ computes a blocked Short-Wide LQ factorization of a *> M-by-N matrix A, where N >= M: *> A = L * Q *> \endverbatim @@ -41,13 +41,13 @@ *> \param[in] MB *> \verbatim *> MB is INTEGER -*> The row block size to be used in the blocked QR. -*> M >= MB >= 1 +*> The row block size to be used in the blocked QR. +*> M >= MB >= 1 *> \endverbatim *> \param[in] NB *> \verbatim *> NB is INTEGER -*> The column block size to be used in the blocked QR. +*> The column block size to be used in the blocked QR. *> NB > M. *> \endverbatim *> @@ -55,9 +55,9 @@ *> \verbatim *> A is COMPLEX*16 array, dimension (LDA,N) *> On entry, the M-by-N matrix A. -*> On exit, the elements on and bleow the diagonal -*> of the array contain the N-by-N lower triangular matrix L; -*> the elements above the diagonal represent Q by the rows +*> On exit, the elements on and bleow the diagonal +*> of the array contain the N-by-N lower triangular matrix L; +*> the elements above the diagonal represent Q by the rows *> of blocked V (see Further Details). *> *> \endverbatim @@ -70,11 +70,11 @@ *> *> \param[out] T *> \verbatim -*> T is COMPLEX*16 array, -*> dimension (LDT, N * Number_of_row_blocks) +*> T is COMPLEX*16 array, +*> dimension (LDT, N * Number_of_row_blocks) *> where Number_of_row_blocks = CEIL((N-M)/(NB-M)) *> The blocked upper triangular block reflectors stored in compact form -*> as a sequence of upper triangular blocks. +*> as a sequence of upper triangular blocks. *> See Further Details below. *> \endverbatim *> @@ -88,7 +88,7 @@ *> \param[out] WORK *> \verbatim *> (workspace) COMPLEX*16 array, dimension (MAX(1,LWORK)) -*> +*> *> \endverbatim *> \param[in] LWORK *> \verbatim @@ -137,7 +137,7 @@ *> block reflectors, stored in array T(1:LDT,(i-1)*M+1:i*M). *> The last Q(k) may use fewer rows. *> For more information see Further Details in TPQRT. -*> +*> *> For more details of the overall algorithm, see the description of *> Sequential TSQR in Section 2.2 of [1]. *> @@ -147,7 +147,7 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE ZLASWLQ( M, N, MB, NB, A, LDA, T, LDT, WORK, LWORK, + SUBROUTINE ZLASWLQ( M, N, MB, NB, A, LDA, T, LDT, WORK, LWORK, $ INFO) * * -- LAPACK computational routine (version 3.5.0) -- @@ -190,7 +190,7 @@ ELSE IF( N.LT.0 .OR. N.LT.M ) THEN INFO = -2 ELSE IF( MB.LT.1 .OR. ( MB.GT.M .AND. M.GT.0 )) THEN - INFO = -3 + INFO = -3 ELSE IF( NB.LE.M ) THEN INFO = -4 ELSE IF( LDA.LT.MAX( 1, M ) ) THEN @@ -198,9 +198,9 @@ ELSE IF( LDT.LT.MB ) THEN INFO = -8 ELSE IF( ( LWORK.LT.M*MB) .AND. (.NOT.LQUERY) ) THEN - INFO = -10 - END IF - IF( INFO.EQ.0) THEN + INFO = -10 + END IF + IF( INFO.EQ.0) THEN WORK(1) = MB*M END IF * @@ -222,10 +222,10 @@ IF((M.GE.N).OR.(NB.LE.M).OR.(NB.GE.N)) THEN CALL ZGELQT( M, N, MB, A, LDA, T, LDT, WORK, INFO) RETURN - END IF -* + END IF +* KK = MOD((N-M),(NB-M)) - II=N-KK+1 + II=N-KK+1 * * Compute the LQ factorization of the first block A(1:M,1:NB) * @@ -233,7 +233,7 @@ CTR = 1 * DO I = NB+1, II-NB+M , (NB-M) -* +* * Compute the QR factorization of the current block A(1:M,I:I+NB-M) * CALL ZTPLQT( M, NB-M, 0, MB, A(1,1), LDA, A( 1, I ), @@ -248,11 +248,11 @@ CALL ZTPLQT( M, KK, 0, MB, A(1,1), LDA, A( 1, II ), $ LDA, T(1, CTR * M + 1), LDT, $ WORK, INFO ) - END IF + END IF * WORK( 1 ) = M * MB RETURN -* +* * End of ZLASWLQ * - END
\ No newline at end of file + END diff --git a/SRC/zlatsqr.f b/SRC/zlatsqr.f index aa2cdef9..5c813292 100644 --- a/SRC/zlatsqr.f +++ b/SRC/zlatsqr.f @@ -1,26 +1,26 @@ -* +* * Definition: * =========== * -* SUBROUTINE ZLATSQR( M, N, MB, NB, A, LDA, T, LDT, WORK, +* SUBROUTINE ZLATSQR( M, N, MB, NB, A, LDA, T, LDT, WORK, * LWORK, INFO) -* +* * .. Scalar Arguments .. * INTEGER INFO, LDA, M, N, MB, NB, LDT, LWORK * .. * .. Array Arguments .. * COMPLEX*16 A( LDA, * ), T( LDT, * ), WORK( * ) * .. -* +* * *> \par Purpose: * ============= *> *> \verbatim -*> -*> SLATSQR computes a blocked Tall-Skinny QR factorization of +*> +*> SLATSQR computes a blocked Tall-Skinny QR factorization of *> an M-by-N matrix A, where M >= N: -*> A = Q * R . +*> A = Q * R . *> \endverbatim * * Arguments: @@ -41,14 +41,14 @@ *> \param[in] MB *> \verbatim *> MB is INTEGER -*> The row block size to be used in the blocked QR. +*> The row block size to be used in the blocked QR. *> MB > N. *> \endverbatim *> *> \param[in] NB *> \verbatim *> NB is INTEGER -*> The column block size to be used in the blocked QR. +*> The column block size to be used in the blocked QR. *> N >= NB >= 1. *> \endverbatim *> @@ -56,9 +56,9 @@ *> \verbatim *> A is COMPLEX*16 array, dimension (LDA,N) *> On entry, the M-by-N matrix A. -*> On exit, the elements on and above the diagonal -*> of the array contain the N-by-N upper triangular matrix R; -*> the elements below the diagonal represent Q by the columns +*> On exit, the elements on and above the diagonal +*> of the array contain the N-by-N upper triangular matrix R; +*> the elements below the diagonal represent Q by the columns *> of blocked V (see Further Details). *> \endverbatim *> @@ -70,11 +70,11 @@ *> *> \param[out] T *> \verbatim -*> T is COMPLEX*16 array, -*> dimension (LDT, N * Number_of_row_blocks) +*> T is COMPLEX*16 array, +*> dimension (LDT, N * Number_of_row_blocks) *> where Number_of_row_blocks = CEIL((M-N)/(MB-N)) *> The blocked upper triangular block reflectors stored in compact form -*> as a sequence of upper triangular blocks. +*> as a sequence of upper triangular blocks. *> See Further Details below. *> \endverbatim *> @@ -86,7 +86,7 @@ *> *> \param[out] WORK *> \verbatim -*> (workspace) COMPLEX*16 array, dimension (MAX(1,LWORK)) +*> (workspace) COMPLEX*16 array, dimension (MAX(1,LWORK)) *> \endverbatim *> *> \param[in] LWORK @@ -136,7 +136,7 @@ *> block reflectors, stored in array T(1:LDT,(i-1)*N+1:i*N). *> The last Q(k) may use fewer rows. *> For more information see Further Details in TPQRT. -*> +*> *> For more details of the overall algorithm, see the description of *> Sequential TSQR in Section 2.2 of [1]. *> @@ -146,7 +146,7 @@ *> \endverbatim *> * ===================================================================== - SUBROUTINE ZLATSQR( M, N, MB, NB, A, LDA, T, LDT, WORK, + SUBROUTINE ZLATSQR( M, N, MB, NB, A, LDA, T, LDT, WORK, $ LWORK, INFO) * * -- LAPACK computational routine (version 3.5.0) -- @@ -189,7 +189,7 @@ ELSE IF( N.LT.0 .OR. M.LT.N ) THEN INFO = -2 ELSE IF( MB.LE.N ) THEN - INFO = -3 + INFO = -3 ELSE IF( NB.LT.1 .OR. ( NB.GT.N .AND. N.GT.0 )) THEN INFO = -4 ELSE IF( LDA.LT.MAX( 1, M ) ) THEN @@ -197,8 +197,8 @@ ELSE IF( LDT.LT.NB ) THEN INFO = -8 ELSE IF( LWORK.LT.(N*NB) .AND. (.NOT.LQUERY) ) THEN - INFO = -10 - END IF + INFO = -10 + END IF IF( INFO.EQ.0) THEN WORK(1) = NB*N END IF @@ -220,9 +220,9 @@ IF ((MB.LE.N).OR.(MB.GE.M)) THEN CALL ZGEQRT( M, N, NB, A, LDA, T, LDT, WORK, INFO) RETURN - END IF + END IF KK = MOD((M-N),(MB-N)) - II=M-KK+1 + II=M-KK+1 * * Compute the QR factorization of the first block A(1:MB,1:N) * @@ -230,7 +230,7 @@ CTR = 1 * DO I = MB+1, II-MB+N , (MB-N) -* +* * Compute the QR factorization of the current block A(I:I+MB-N,1:N) * CALL ZTPQRT( MB-N, N, 0, NB, A(1,1), LDA, A( I, 1 ), LDA, @@ -245,11 +245,11 @@ CALL ZTPQRT( KK, N, 0, NB, A(1,1), LDA, A( II, 1 ), LDA, $ T(1,CTR * N + 1), LDT, $ WORK, INFO ) - END IF + END IF * work( 1 ) = N*NB RETURN -* +* * End of ZLATSQR * - END
\ No newline at end of file + END diff --git a/SRC/ztplqt.f b/SRC/ztplqt.f index 2d75d76e..76d31e6f 100644 --- a/SRC/ztplqt.f +++ b/SRC/ztplqt.f @@ -2,41 +2,41 @@ * * =========== 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 DTPQRT + dependencies -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dtplqt.f"> -*> [TGZ]</a> -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dtplqt.f"> -*> [ZIP]</a> -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dtplqt.f"> +*> Download DTPQRT + dependencies +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dtplqt.f"> +*> [TGZ]</a> +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dtplqt.f"> +*> [ZIP]</a> +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dtplqt.f"> *> [TXT]</a> -*> \endhtmlonly +*> \endhtmlonly * * Definition: * =========== * * SUBROUTINE ZTPLQT( M, N, L, MB, A, LDA, B, LDB, T, LDT, WORK, * INFO ) -* +* * .. Scalar Arguments .. * INTEGER INFO, LDA, LDB, LDT, N, M, L, MB * .. * .. Array Arguments .. * COMPLEX*16 A( LDA, * ), B( LDB, * ), T( LDT, * ), WORK( * ) * .. -* +* * *> \par Purpose: * ============= *> *> \verbatim *> -*> DTPLQT computes a blocked LQ factorization of a complex -*> "triangular-pentagonal" matrix C, which is composed of a -*> triangular block A and pentagonal block B, using the compact +*> DTPLQT computes a blocked LQ factorization of a complex +*> "triangular-pentagonal" matrix C, which is composed of a +*> triangular block A and pentagonal block B, using the compact *> WY representation for Q. *> \endverbatim * @@ -47,7 +47,7 @@ *> \verbatim *> M is INTEGER *> The number of rows of the matrix B, and the order of the -*> triangular matrix A. +*> triangular matrix A. *> M >= 0. *> \endverbatim *> @@ -88,7 +88,7 @@ *> \param[in,out] B *> \verbatim *> B is COMPLEX*16 array, dimension (LDB,N) -*> On entry, the pentagonal M-by-N matrix B. The first N-L columns +*> On entry, the pentagonal M-by-N matrix B. The first N-L columns *> are rectangular, and the last L columns are lower trapezoidal. *> On exit, B contains the pentagonal matrix V. See Further Details. *> \endverbatim @@ -105,7 +105,7 @@ *> The lower triangular block reflectors stored in compact form *> as a sequence of upper triangular blocks. See Further Details. *> \endverbatim -*> +*> *> \param[in] LDT *> \verbatim *> LDT is INTEGER @@ -127,10 +127,10 @@ * 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 2013 * @@ -141,45 +141,45 @@ *> *> \verbatim *> -*> The input matrix C is a M-by-(M+N) matrix +*> The input matrix C is a M-by-(M+N) matrix *> *> C = [ A ] [ B ] -*> +*> *> *> where A is an lower triangular N-by-N matrix, and B is M-by-N pentagonal *> matrix consisting of a M-by-(N-L) rectangular matrix B1 on left of a M-by-L *> upper trapezoidal matrix B2: -*> [ B ] = [ B1 ] [ B2 ] +*> [ B ] = [ B1 ] [ B2 ] *> [ B1 ] <- M-by-(N-L) rectangular *> [ B2 ] <- M-by-L upper trapezoidal. *> *> The lower trapezoidal matrix B2 consists of the first L columns of a -*> N-by-N lower triangular matrix, where 0 <= L <= MIN(M,N). If L=0, -*> B is rectangular M-by-N; if M=L=N, B is lower triangular. +*> N-by-N lower triangular matrix, where 0 <= L <= MIN(M,N). If L=0, +*> B is rectangular M-by-N; if M=L=N, B is lower triangular. *> *> The matrix W stores the elementary reflectors H(i) in the i-th row *> above the diagonal (of A) in the M-by-(M+N) input matrix C -*> [ C ] = [ A ] [ B ] +*> [ C ] = [ A ] [ B ] *> [ A ] <- lower triangular N-by-N *> [ B ] <- M-by-N pentagonal *> *> so that W can be represented as -*> [ W ] = [ I ] [ V ] +*> [ W ] = [ I ] [ V ] *> [ I ] <- identity, N-by-N *> [ V ] <- M-by-N, same form as B. *> *> Thus, all of information needed for W is contained on exit in B, which -*> we call V above. Note that V has the same form as B; that is, -*> [ V ] = [ V1 ] [ V2 ] +*> we call V above. Note that V has the same form as B; that is, +*> [ V ] = [ V1 ] [ V2 ] *> [ V1 ] <- M-by-(N-L) rectangular *> [ V2 ] <- M-by-L lower trapezoidal. *> -*> The rows of V represent the vectors which define the H(i)'s. +*> The rows of V represent the vectors which define the H(i)'s. *> *> The number of blocks is B = ceiling(M/MB), where each -*> block is of order MB except for the last block, which is of order +*> block is of order MB except for the last block, which is of order *> IB = M - (M-1)*MB. For each of the B blocks, a upper triangular block -*> reflector factor is computed: T1, T2, ..., TB. The MB-by-MB (and IB-by-IB +*> reflector factor is computed: T1, T2, ..., TB. The MB-by-MB (and IB-by-IB *> for the last block) T's are stored in the MB-by-N matrix T as *> *> T = [T1 T2 ... TB]. @@ -240,7 +240,7 @@ IF( M.EQ.0 .OR. N.EQ.0 ) RETURN * DO I = 1, M, MB -* +* * Compute the QR factorization of the current block * IB = MIN( M-I+1, MB ) @@ -251,20 +251,20 @@ LB = NB-N+L-I+1 END IF * - CALL ZTPLQT2( IB, NB, LB, A(I,I), LDA, B( I, 1 ), LDB, + CALL ZTPLQT2( IB, NB, LB, A(I,I), LDA, B( I, 1 ), LDB, $ T(1, I ), LDT, IINFO ) * * Update by applying H**T to B(I+IB:M,:) from the right * IF( I+IB.LE.M ) THEN CALL ZTPRFB( 'R', 'N', 'F', 'R', M-I-IB+1, NB, IB, LB, - $ B( I, 1 ), LDB, T( 1, I ), LDT, - $ A( I+IB, I ), LDA, B( I+IB, 1 ), LDB, + $ B( I, 1 ), LDB, T( 1, I ), LDT, + $ A( I+IB, I ), LDA, B( I+IB, 1 ), LDB, $ WORK, M-I-IB+1) END IF END DO RETURN -* +* * End of ZTPLQT * END diff --git a/SRC/ztplqt2.f b/SRC/ztplqt2.f index 7ad75719..af92aaaf 100644 --- a/SRC/ztplqt2.f +++ b/SRC/ztplqt2.f @@ -2,31 +2,31 @@ * * =========== 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 ZTPLQT2 + dependencies -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ztplqt2.f"> -*> [TGZ]</a> -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ztplqt2.f"> -*> [ZIP]</a> -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ztplqt2.f"> +*> Download ZTPLQT2 + dependencies +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ztplqt2.f"> +*> [TGZ]</a> +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ztplqt2.f"> +*> [ZIP]</a> +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ztplqt2.f"> *> [TXT]</a> -*> \endhtmlonly +*> \endhtmlonly * * Definition: * =========== * * SUBROUTINE ZTPLQT2( M, N, L, A, LDA, B, LDB, T, LDT, INFO ) -* +* * .. Scalar Arguments .. * INTEGER INFO, LDA, LDB, LDT, N, M, L * .. * .. Array Arguments .. * COMPLEX*16 A( LDA, * ), B( LDB, * ), T( LDT, * ) * .. -* +* * *> \par Purpose: * ============= @@ -34,7 +34,7 @@ *> \verbatim *> *> ZTPLQT2 computes a LQ a factorization of a complex "triangular-pentagonal" -*> matrix C, which is composed of a triangular block A and pentagonal block B, +*> matrix C, which is composed of a triangular block A and pentagonal block B, *> using the compact WY representation for Q. *> \endverbatim * @@ -44,7 +44,7 @@ *> \param[in] M *> \verbatim *> M is INTEGER -*> The total number of rows of the matrix B. +*> The total number of rows of the matrix B. *> M >= 0. *> \endverbatim *> @@ -59,7 +59,7 @@ *> \param[in] L *> \verbatim *> L is INTEGER -*> The number of rows of the lower trapezoidal part of B. +*> The number of rows of the lower trapezoidal part of B. *> MIN(M,N) >= L >= 0. See Further Details. *> \endverbatim *> @@ -80,7 +80,7 @@ *> \param[in,out] B *> \verbatim *> B is COMPLEX*16 array, dimension (LDB,N) -*> On entry, the pentagonal M-by-N matrix B. The first N-L columns +*> On entry, the pentagonal M-by-N matrix B. The first N-L columns *> are rectangular, and the last L columns are lower trapezoidal. *> On exit, B contains the pentagonal matrix V. See Further Details. *> \endverbatim @@ -114,10 +114,10 @@ * 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 * @@ -128,10 +128,10 @@ *> *> \verbatim *> -*> The input matrix C is a M-by-(M+N) matrix +*> The input matrix C is a M-by-(M+N) matrix *> *> C = [ A ][ B ] -*> +*> *> *> where A is an lower triangular N-by-N matrix, and B is M-by-N pentagonal *> matrix consisting of a M-by-(N-L) rectangular matrix B1 left of a M-by-L @@ -142,8 +142,8 @@ *> [ B2 ] <- M-by-L lower trapezoidal. *> *> The lower trapezoidal matrix B2 consists of the first L columns of a -*> N-by-N lower triangular matrix, where 0 <= L <= MIN(M,N). If L=0, -*> B is rectangular M-by-N; if M=L=N, B is lower triangular. +*> N-by-N lower triangular matrix, where 0 <= L <= MIN(M,N). If L=0, +*> B is rectangular M-by-N; if M=L=N, B is lower triangular. *> *> The matrix W stores the elementary reflectors H(i) in the i-th row *> above the diagonal (of A) in the M-by-(M+N) input matrix C @@ -154,18 +154,18 @@ *> *> so that W can be represented as *> -*> W = [ I ][ V ] +*> W = [ I ][ V ] *> [ I ] <- identity, N-by-N *> [ V ] <- M-by-N, same form as B. *> *> Thus, all of information needed for W is contained on exit in B, which -*> we call V above. Note that V has the same form as B; that is, +*> we call V above. Note that V has the same form as B; that is, *> -*> W = [ V1 ][ V2 ] +*> W = [ V1 ][ V2 ] *> [ V1 ] <- M-by-(N-L) rectangular *> [ V2 ] <- M-by-L lower trapezoidal. *> -*> The rows of V represent the vectors which define the H(i)'s. +*> The rows of V represent the vectors which define the H(i)'s. *> The (M+N)-by-(M+N) block reflector H is then given by *> *> H = I - W**T * T * W @@ -231,7 +231,7 @@ * Quick return if possible * IF( N.EQ.0 .OR. M.EQ.0 ) RETURN -* +* DO I = 1, M * * Generate elementary reflector H(I) to annihilate B(I,:) @@ -249,7 +249,7 @@ DO J = 1, M-I T( M, J ) = (A( I+J, I )) END DO - CALL ZGEMV( 'N', M-I, P, ONE, B( I+1, 1 ), LDB, + CALL ZGEMV( 'N', M-I, P, ONE, B( I+1, 1 ), LDB, $ B( I, 1 ), LDB, ONE, T( M, 1 ), LDT ) * * C(I+1:M,I:N) = C(I+1:M,I:N) + alpha * C(I,I:N)*W(M-1:1)^H @@ -291,16 +291,16 @@ * * Rectangular part of B2 * - CALL ZGEMV( 'N', I-1-P, L, ALPHA, B( MP, NP ), LDB, + CALL ZGEMV( 'N', I-1-P, L, ALPHA, B( MP, NP ), LDB, $ B( I, NP ), LDB, ZERO, T( I,MP ), LDT ) * * B1 * - CALL ZGEMV( 'N', I-1, N-L, ALPHA, B, LDB, B( I, 1 ), LDB, - $ ONE, T( I, 1 ), LDT ) + CALL ZGEMV( 'N', I-1, N-L, ALPHA, B, LDB, B( I, 1 ), LDB, + $ ONE, T( I, 1 ), LDT ) * - + * * T(1:I-1,I) := T(1:I-1,1:I-1) * T(I,1:I-1) * @@ -313,7 +313,7 @@ END DO DO J = 1, N-L+P B(I,J)=CONJG(B(I,J)) - END DO + END DO * * T(I,I) = tau(I) * @@ -326,7 +326,7 @@ T(J,I)=ZERO END DO END DO - + * * End of ZTPLQT2 * diff --git a/SRC/ztpmlqt.f b/SRC/ztpmlqt.f index ebdefee5..d4cb43b8 100644 --- a/SRC/ztpmlqt.f +++ b/SRC/ztpmlqt.f @@ -2,41 +2,41 @@ * * =========== 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 DTPMQRT + dependencies -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ztpmlqt.f"> -*> [TGZ]</a> -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ztpmlqt.f"> -*> [ZIP]</a> -*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ztpmlqt.f"> +*> Download DTPMQRT + dependencies +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ztpmlqt.f"> +*> [TGZ]</a> +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ztpmlqt.f"> +*> [ZIP]</a> +*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ztpmlqt.f"> *> [TXT]</a> -*> \endhtmlonly +*> \endhtmlonly * * Definition: * =========== * * SUBROUTINE ZTPMLQT( SIDE, TRANS, M, N, K, L, MB, V, LDV, T, LDT, * A, LDA, B, LDB, WORK, INFO ) -* +* * .. Scalar Arguments .. * CHARACTER SIDE, TRANS * INTEGER INFO, K, LDV, LDA, LDB, M, N, L, MB, LDT * .. * .. Array Arguments .. -* COMPLEX*16 V( LDV, * ), A( LDA, * ), B( LDB, * ), +* COMPLEX*16 V( LDV, * ), A( LDA, * ), B( LDB, * ), * $ T( LDT, * ), WORK( * ) * .. -* +* * *> \par Purpose: * ============= *> *> \verbatim *> -*> ZTPMQRT applies a complex orthogonal matrix Q obtained from a +*> ZTPMQRT applies a complex orthogonal matrix Q obtained from a *> "triangular-pentagonal" real block reflector H to a general *> real matrix C, which consists of two blocks A and B. *> \endverbatim @@ -69,7 +69,7 @@ *> N is INTEGER *> The number of columns of the matrix B. N >= 0. *> \endverbatim -*> +*> *> \param[in] K *> \verbatim *> K is INTEGER @@ -80,7 +80,7 @@ *> \param[in] L *> \verbatim *> L is INTEGER -*> The order of the trapezoidal part of V. +*> The order of the trapezoidal part of V. *> K >= L >= 0. See Further Details. *> \endverbatim *> @@ -124,19 +124,19 @@ *> \param[in,out] A *> \verbatim *> A is COMPLEX*16 array, dimension -*> (LDA,N) if SIDE = 'L' or +*> (LDA,N) if SIDE = 'L' or *> (LDA,K) if SIDE = 'R' *> On entry, the K-by-N or M-by-K matrix A. -*> On exit, A is overwritten by the corresponding block of +*> On exit, A is overwritten by the corresponding block of *> Q*C or Q**C*C or C*Q or C*Q**C. See Further Details. *> \endverbatim *> *> \param[in] LDA *> \verbatim *> LDA is INTEGER -*> The leading dimension of the array A. +*> The leading dimension of the array A. *> If SIDE = 'L', LDC >= max(1,K); -*> If SIDE = 'R', LDC >= max(1,M). +*> If SIDE = 'R', LDC >= max(1,M). *> \endverbatim *> *> \param[in,out] B @@ -150,7 +150,7 @@ *> \param[in] LDB *> \verbatim *> LDB is INTEGER -*> The leading dimension of the array B. +*> The leading dimension of the array B. *> LDB >= max(1,M). *> \endverbatim *> @@ -170,10 +170,10 @@ * 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 2015 * @@ -185,20 +185,20 @@ *> \verbatim *> *> The columns of the pentagonal matrix V contain the elementary reflectors -*> H(1), H(2), ..., H(K); V is composed of a rectangular block V1 and a +*> H(1), H(2), ..., H(K); V is composed of a rectangular block V1 and a *> trapezoidal block V2: *> *> V = [V1] [V2]. -*> *> -*> The size of the trapezoidal block V2 is determined by the parameter L, +*> +*> The size of the trapezoidal block V2 is determined by the parameter L, *> where 0 <= L <= K; V2 is lower trapezoidal, consisting of the first L *> rows of a K-by-K upper triangular matrix. If L=K, V2 is lower triangular; *> if L=0, there is no trapezoidal block, hence V = V1 is rectangular. *> -*> If SIDE = 'L': C = [A] where A is K-by-N, B is M-by-N and V is K-by-M. -*> [B] -*> +*> If SIDE = 'L': C = [A] where A is K-by-N, B is M-by-N and V is K-by-M. +*> [B] +*> *> If SIDE = 'R': C = [A B] where A is M-by-K, B is M-by-N and V is K-by-N. *> *> The real orthogonal matrix Q is formed from V and T. @@ -226,7 +226,7 @@ INTEGER INFO, K, LDV, LDA, LDB, M, N, L, MB, LDT * .. * .. Array Arguments .. - COMPLEX*16 V( LDV, * ), A( LDA, * ), B( LDB, * ), + COMPLEX*16 V( LDV, * ), A( LDA, * ), B( LDB, * ), $ T( LDT, * ), WORK( * ) * .. * @@ -256,7 +256,7 @@ RIGHT = LSAME( SIDE, 'R' ) TRAN = LSAME( TRANS, 'C' ) NOTRAN = LSAME( TRANS, 'N' ) -* +* IF ( LEFT ) THEN LDAQ = MAX( 1, K ) ELSE IF ( RIGHT ) THEN @@ -273,7 +273,7 @@ ELSE IF( K.LT.0 ) THEN INFO = -5 ELSE IF( L.LT.0 .OR. L.GT.K ) THEN - INFO = -6 + INFO = -6 ELSE IF( MB.LT.1 .OR. (MB.GT.K .AND. K.GT.0) ) THEN INFO = -7 ELSE IF( LDV.LT.K ) THEN @@ -305,11 +305,11 @@ ELSE LB = 0 END IF - CALL ZTPRFB( 'L', 'C', 'F', 'R', NB, N, IB, LB, - $ V( I, 1 ), LDV, T( 1, I ), LDT, + CALL ZTPRFB( 'L', 'C', 'F', 'R', NB, N, IB, LB, + $ V( I, 1 ), LDV, T( 1, I ), LDT, $ A( I, 1 ), LDA, B, LDB, WORK, IB ) END DO -* +* ELSE IF( RIGHT .AND. TRAN ) THEN * DO I = 1, K, MB @@ -320,8 +320,8 @@ ELSE LB = NB-N+L-I+1 END IF - CALL ZTPRFB( 'R', 'N', 'F', 'R', M, NB, IB, LB, - $ V( I, 1 ), LDV, T( 1, I ), LDT, + CALL ZTPRFB( 'R', 'N', 'F', 'R', M, NB, IB, LB, + $ V( I, 1 ), LDV, T( 1, I ), LDT, $ A( 1, I ), LDA, B, LDB, WORK, M ) END DO * @@ -329,15 +329,15 @@ * KF = ((K-1)/MB)*MB+1 DO I = KF, 1, -MB - IB = MIN( MB, K-I+1 ) + IB = MIN( MB, K-I+1 ) NB = MIN( M-L+I+IB-1, M ) IF( I.GE.L ) THEN LB = 0 ELSE LB = 0 - END IF + END IF CALL ZTPRFB( 'L', 'N', 'F', 'R', NB, N, IB, LB, - $ V( I, 1 ), LDV, T( 1, I ), LDT, + $ V( I, 1 ), LDV, T( 1, I ), LDT, $ A( I, 1 ), LDA, B, LDB, WORK, IB ) END DO * @@ -345,7 +345,7 @@ * KF = ((K-1)/MB)*MB+1 DO I = KF, 1, -MB - IB = MIN( MB, K-I+1 ) + IB = MIN( MB, K-I+1 ) NB = MIN( N-L+I+IB-1, N ) IF( I.GE.L ) THEN LB = 0 @@ -353,7 +353,7 @@ LB = NB-N+L-I+1 END IF CALL ZTPRFB( 'R', 'C', 'F', 'R', M, NB, IB, LB, - $ V( I, 1 ), LDV, T( 1, I ), LDT, + $ V( I, 1 ), LDV, T( 1, I ), LDT, $ A( 1, I ), LDA, B, LDB, WORK, M ) END DO * |