From bbff7393714b29a6ff70e8c1565784cb16a0e746 Mon Sep 17 00:00:00 2001 From: Julien Langou Date: Thu, 3 Nov 2016 08:48:54 +0100 Subject: [PATCH] Lots of trailing whitespaces in the files of Syd. Cleaning this. No big deal. --- SRC/CMakeLists.txt | 4 +-- SRC/cgelq.f | 78 ++++++++++++++++++++--------------------- SRC/cgelqt.f | 30 ++++++++-------- SRC/cgemlq.f | 42 +++++++++++----------- SRC/cgemlqt.f | 42 +++++++++++----------- SRC/cgemqr.f | 54 ++++++++++++++--------------- SRC/cgeqr.f | 78 ++++++++++++++++++++--------------------- SRC/cgetsls.f | 2 +- SRC/cheevr.f | 2 +- SRC/chesv_aasen.f | 36 +++++++++---------- SRC/chetrf_aasen.f | 70 ++++++++++++++++++------------------- SRC/chetrs_aasen.f | 26 +++++++------- SRC/clahef_aasen.f | 86 +++++++++++++++++++++++----------------------- SRC/clamswlq.f | 40 ++++++++++----------- SRC/clamtsqr.f | 52 ++++++++++++++-------------- SRC/claswlq.f | 56 +++++++++++++++--------------- SRC/clatsqr.f | 54 ++++++++++++++--------------- SRC/ctplqt.f | 58 +++++++++++++++---------------- SRC/ctplqt2.f | 52 ++++++++++++++-------------- SRC/ctpmlqt.f | 68 ++++++++++++++++++------------------ SRC/dgelq.f | 76 ++++++++++++++++++++-------------------- SRC/dgelqt.f | 48 +++++++++++++------------- SRC/dgemlq.f | 42 +++++++++++----------- SRC/dgemlqt.f | 60 ++++++++++++++++---------------- SRC/dgemqr.f | 60 ++++++++++++++++---------------- SRC/dgeqr.f | 80 +++++++++++++++++++++--------------------- SRC/dgetsls.f | 2 +- SRC/dlamswlq.f | 42 +++++++++++----------- SRC/dlamtsqr.f | 50 +++++++++++++-------------- SRC/dlaswlq.f | 56 +++++++++++++++--------------- SRC/dlasyf_aasen.f | 86 +++++++++++++++++++++++----------------------- SRC/dlatsqr.f | 54 ++++++++++++++--------------- SRC/dsyevr.f | 2 +- SRC/dsysv_aasen.f | 40 ++++++++++----------- SRC/dsytrf_aasen.f | 80 +++++++++++++++++++++--------------------- SRC/dsytrs_aasen.f | 24 ++++++------- SRC/dtplqt.f | 76 ++++++++++++++++++++-------------------- SRC/dtplqt2.f | 68 ++++++++++++++++++------------------ SRC/dtpmlqt.f | 86 +++++++++++++++++++++++----------------------- SRC/ilaenv.f | 4 +-- SRC/sgelq.f | 76 ++++++++++++++++++++-------------------- SRC/sgelqt.f | 30 ++++++++-------- SRC/sgelqt3.f | 34 +++++++++--------- SRC/sgemlq.f | 42 +++++++++++----------- SRC/sgemlqt.f | 42 +++++++++++----------- SRC/sgemqr.f | 58 +++++++++++++++---------------- SRC/sgeqr.f | 80 +++++++++++++++++++++--------------------- SRC/sgetsls.f | 38 ++++++++++---------- SRC/slamswlq.f | 38 ++++++++++---------- SRC/slamtsqr.f | 54 ++++++++++++++--------------- SRC/slaswlq.f | 56 +++++++++++++++--------------- SRC/slasyf_aasen.f | 86 +++++++++++++++++++++++----------------------- SRC/slatsqr.f | 54 ++++++++++++++--------------- SRC/ssyevr.f | 2 +- SRC/ssysv_aasen.f | 40 ++++++++++----------- SRC/ssytrf_aasen.f | 80 +++++++++++++++++++++--------------------- SRC/ssytrs_aasen.f | 28 +++++++-------- SRC/stplqt.f | 76 ++++++++++++++++++++-------------------- SRC/stplqt2.f | 68 ++++++++++++++++++------------------ SRC/stpmlqt.f | 86 +++++++++++++++++++++++----------------------- SRC/zgelq.f | 78 ++++++++++++++++++++--------------------- SRC/zgelqt.f | 48 +++++++++++++------------- SRC/zgemlq.f | 42 +++++++++++----------- SRC/zgemlqt.f | 60 ++++++++++++++++---------------- SRC/zgemqr.f | 58 +++++++++++++++---------------- SRC/zgeqr.f | 78 ++++++++++++++++++++--------------------- SRC/zgetsls.f | 2 +- SRC/zheevr.f | 2 +- SRC/zhesv_aasen.f | 36 +++++++++---------- SRC/zhetrf_aasen.f | 70 ++++++++++++++++++------------------- SRC/zhetrs_aasen.f | 30 ++++++++-------- SRC/zlahef_aasen.f | 86 +++++++++++++++++++++++----------------------- SRC/zlamswlq.f | 40 ++++++++++----------- SRC/zlamtsqr.f | 52 ++++++++++++++-------------- SRC/zlaswlq.f | 56 +++++++++++++++--------------- SRC/zlatsqr.f | 54 ++++++++++++++--------------- SRC/ztplqt.f | 76 ++++++++++++++++++++-------------------- SRC/ztplqt2.f | 70 ++++++++++++++++++------------------- SRC/ztpmlqt.f | 86 +++++++++++++++++++++++----------------------- TESTING/LIN/aladhd.f | 8 ++--- TESTING/LIN/cchkaa.f | 16 ++++----- TESTING/LIN/cchkhe_aasen.f | 8 ++--- TESTING/LIN/cchklqt.f | 20 +++++------ TESTING/LIN/cchklqtp.f | 22 ++++++------ TESTING/LIN/cchktsqr.f | 42 +++++++++++----------- TESTING/LIN/cdrvhe_aasen.f | 8 ++--- TESTING/LIN/cdrvls.f | 10 +++--- TESTING/LIN/cerrlqt.f | 18 +++++----- TESTING/LIN/cerrlqtp.f | 40 ++++++++++----------- TESTING/LIN/cerrtsqr.f | 16 ++++----- TESTING/LIN/chet01_aasen.f | 4 +-- TESTING/LIN/clqt04.f | 48 +++++++++++++------------- TESTING/LIN/clqt05.f | 46 ++++++++++++------------- TESTING/LIN/ctsqr01.f | 74 +++++++++++++++++++-------------------- TESTING/LIN/dchkaa.f | 12 +++---- TESTING/LIN/dchklqt.f | 20 +++++------ TESTING/LIN/dchklqtp.f | 20 +++++------ TESTING/LIN/dchksy_aasen.f | 8 ++--- TESTING/LIN/dchktsqr.f | 44 ++++++++++++------------ TESTING/LIN/ddrvls.f | 14 ++++---- TESTING/LIN/ddrvsy_aasen.f | 2 +- TESTING/LIN/derrlqt.f | 18 +++++----- TESTING/LIN/derrlqtp.f | 40 ++++++++++----------- TESTING/LIN/derrtsqr.f | 16 ++++----- TESTING/LIN/dlqt04.f | 48 +++++++++++++------------- TESTING/LIN/dlqt05.f | 46 ++++++++++++------------- TESTING/LIN/dtplqt.f | 76 ++++++++++++++++++++-------------------- TESTING/LIN/dtsqr01.f | 72 +++++++++++++++++++------------------- TESTING/LIN/schkaa.f | 8 ++--- TESTING/LIN/schklqt.f | 20 +++++------ TESTING/LIN/schklqtp.f | 20 +++++------ TESTING/LIN/schksy_aasen.f | 10 +++--- TESTING/LIN/schktsqr.f | 38 ++++++++++---------- TESTING/LIN/sdrvls.f | 16 ++++----- TESTING/LIN/sdrvsy_aasen.f | 6 ++-- TESTING/LIN/serrlqt.f | 18 +++++----- TESTING/LIN/serrlqtp.f | 40 ++++++++++----------- TESTING/LIN/serrtsqr.f | 16 ++++----- TESTING/LIN/slqt04.f | 48 +++++++++++++------------- TESTING/LIN/slqt05.f | 42 +++++++++++----------- TESTING/LIN/stplqt.f | 58 +++++++++++++++---------------- TESTING/LIN/stsqr01.f | 74 +++++++++++++++++++-------------------- TESTING/LIN/zchkaa.f | 10 +++--- TESTING/LIN/zchkhe_aasen.f | 10 +++--- TESTING/LIN/zchklqt.f | 20 +++++------ TESTING/LIN/zchklqtp.f | 22 ++++++------ TESTING/LIN/zchktsqr.f | 42 +++++++++++----------- TESTING/LIN/zdrvhe_aasen.f | 6 ++-- TESTING/LIN/zdrvls.f | 6 ++-- TESTING/LIN/zerrlqt.f | 18 +++++----- TESTING/LIN/zerrlqtp.f | 40 ++++++++++----------- TESTING/LIN/zerrtsqr.f | 16 ++++----- TESTING/LIN/zhet01_aasen.f | 2 +- TESTING/LIN/zlqt04.f | 48 +++++++++++++------------- TESTING/LIN/zlqt05.f | 46 ++++++++++++------------- TESTING/LIN/ztsqr01.f | 74 +++++++++++++++++++-------------------- 136 files changed, 2824 insertions(+), 2824 deletions(-) diff --git a/SRC/CMakeLists.txt b/SRC/CMakeLists.txt index 0ceea60..30cf707 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 e6e2b12..c6c962d 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 70abe1a..043fc9d 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 bd7823d..1a551ca 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 04f44e4..b34afc9 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 de2965e..51d38b8 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 c515140..330fda5 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 222f021..af5bd2c 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 31df2cb..e3a31ca 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 e5d1cb6..f9d188a 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 -*> -*> [TGZ] -*> -*> [ZIP] -*> +*> Download CHESV_AASEN + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> *> [TXT] -*> \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 deb0b64..8d8a08c 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 -*> -*> [TGZ] -*> -*> [ZIP] -*> +*> Download CHETRF_AASEN + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> *> [TXT] -*> \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 629084e..33f32fa 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 *> -*> [TGZ] +*> [TGZ] *> -*> [ZIP] +*> [ZIP] *> *> [TXT] -*> \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 f79c8b7..73f750f 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 -*> -*> [TGZ] -*> -*> [ZIP] -*> +*> Download CLAHEF_AASEN + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> *> [TXT] -*> \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 3b640b8..9e3338e 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 0f9ac57..387e1fe 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 91db14c..a57771f 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 e462ab7..88ec86e 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 4de8615..731b211 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 7497936..0981e39 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 411ef72..f567e6d 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 4086cd3..d73f745 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 0f30169..f826abd 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 -*> -*> [TGZ] -*> -*> [ZIP] -*> +*> Download DGEQRT + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> *> [TXT] -*> \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 8cf911b..7bdf97a 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 ebf3e47..0519a4d 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 -*> -*> [TGZ] -*> -*> [ZIP] -*> +*> Download DGEMQRT + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> *> [TXT] -*> \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 73c84bf..0ceea6f 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 e0c6d75..da0fc4a 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 fb797f1..b619f1d 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 6230e65..3bf0e79 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 2cb9f96..a4f5a02 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 e9be802..95f2025 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 6a28751..4d15885 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 -*> -*> [TGZ] -*> -*> [ZIP] -*> +*> Download DLASYF_AASEN + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> *> [TXT] -*> \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 4b9a787..b8c502e 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 3684c42..3353b7e 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 63cb8a5..9bf30de 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 -*> -*> [TGZ] -*> -*> [ZIP] -*> +*> Download DSYSV_AASEN + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> *> [TXT] -*> \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 f484c6b..4881376 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 -*> -*> [TGZ] -*> -*> [ZIP] -*> +*> Download DSYTRF_AASEN + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> *> [TXT] -*> \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 05bcda3..4eb4dbf 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 *> -*> [TGZ] +*> [TGZ] *> -*> [ZIP] +*> [ZIP] *> *> [TXT] -*> \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 eea37b8..029e4b6 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 -*> -*> [TGZ] -*> -*> [ZIP] -*> +*> Download DTPQRT + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> *> [TXT] -*> \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 9ed7c6a..a1d57cb 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 -*> -*> [TGZ] -*> -*> [ZIP] -*> +*> Download DTPLQT2 + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> *> [TXT] -*> \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 d119339..f1406e2 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 -*> -*> [TGZ] -*> -*> [ZIP] -*> +*> Download DTPMQRT + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> *> [TXT] -*> \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 87ab858..42a380c 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 4e5a350..8a75983 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 6b03781..5c39170 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 3d9bc46..fb6c3e4 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 37a9fb9..14a37a4 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 7e0dfff..56c604b 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 8e3deac..cda7990 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 c984404..41e0462 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 050b3b9..b7bcd0f 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 c636c70..f871913 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 3618db0..69d6c32 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 acd9170..e5180f7 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 2c8f4e0..8d4bb79 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 -*> -*> [TGZ] -*> -*> [ZIP] -*> +*> Download SLASYF_AASEN + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> *> [TXT] -*> \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 3fbf8b8..435204e 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 542a0f1..bb9fdde 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 52f507e..9c72fc4 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 -*> -*> [TGZ] -*> -*> [ZIP] -*> +*> Download SSYSV_AASEN + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> *> [TXT] -*> \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 ba39518..5e9748a 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 -*> -*> [TGZ] -*> -*> [ZIP] -*> +*> Download SSYTRF_AASEN + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> *> [TXT] -*> \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 05d7923..7ce9117 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 *> -*> [TGZ] +*> [TGZ] *> -*> [ZIP] +*> [ZIP] *> *> [TXT] -*> \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 56d19d7..cffb8ae 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 -*> -*> [TGZ] -*> -*> [ZIP] -*> +*> Download DTPQRT + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> *> [TXT] -*> \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 e8b9f19..fec0080 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 -*> -*> [TGZ] -*> -*> [ZIP] -*> +*> Download STPLQT2 + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> *> [TXT] -*> \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 2dcdb0d..a9c67c3 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 -*> -*> [TGZ] -*> -*> [ZIP] -*> +*> Download DTPMQRT + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> *> [TXT] -*> \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 2e188df..33125b3 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 d726db7..67da0b6 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 -*> -*> [TGZ] -*> -*> [ZIP] -*> +*> Download DGEQRT + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> *> [TXT] -*> \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 f71b6fd..10d3a5e 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 6060f9e..e538562 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 -*> -*> [TGZ] -*> -*> [ZIP] -*> +*> Download DGEMQRT + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> *> [TXT] -*> \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 c78fe4d..3141067 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 18a7f10..10fab97 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 038d2ad..9b04227 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 42ce60b..024ad8c 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 2db9699..3d56dfc 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 -*> -*> [TGZ] -*> -*> [ZIP] -*> +*> Download ZHESV_AASEN + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> *> [TXT] -*> \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 75d6951..e56fcc6 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 -*> -*> [TGZ] -*> -*> [ZIP] -*> +*> Download ZHETRF_AASEN + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> *> [TXT] -*> \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 309f1e7..6d2c73c 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 *> -*> [TGZ] +*> [TGZ] *> -*> [ZIP] +*> [ZIP] *> *> [TXT] -*> \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 d85669e..61510a7 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 -*> -*> [TGZ] -*> -*> [ZIP] -*> +*> Download ZLAHEF_AASEN + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> *> [TXT] -*> \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 af0c62e..365530c 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 2151302..7195f9e 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 67178c2..fec26cf 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 aa2cdef..5c81329 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 2d75d76..76d31e6 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 -*> -*> [TGZ] -*> -*> [ZIP] -*> +*> Download DTPQRT + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> *> [TXT] -*> \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 7ad7571..af92aaa 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 -*> -*> [TGZ] -*> -*> [ZIP] -*> +*> Download ZTPLQT2 + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> *> [TXT] -*> \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 ebdefee..d4cb43b 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 -*> -*> [TGZ] -*> -*> [ZIP] -*> +*> Download DTPMQRT + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> *> [TXT] -*> \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 * diff --git a/TESTING/LIN/aladhd.f b/TESTING/LIN/aladhd.f index 3a53e0b..a45a56f 100644 --- a/TESTING/LIN/aladhd.f +++ b/TESTING/LIN/aladhd.f @@ -279,7 +279,7 @@ * ELSE IF( LSAMEN( 2, P2, 'HA' ) ) THEN * -* HA: Hermitian +* HA: Hermitian * Aasen algorithm WRITE( IOUNIT, FMT = 9971 )PATH, 'Hermitian' * @@ -294,9 +294,9 @@ WRITE( IOUNIT, FMT = 9978 )5 WRITE( IOUNIT, FMT = 9976 )6 WRITE( IOUNIT, FMT = '( '' Messages:'' )' ) - - - ELSE IF( LSAMEN( 2, P2, 'HE' ) .OR. + + + ELSE IF( LSAMEN( 2, P2, 'HE' ) .OR. $ LSAMEN( 2, P2, 'HP' ) ) THEN * * HE: Hermitian indefinite full diff --git a/TESTING/LIN/cchkaa.f b/TESTING/LIN/cchkaa.f index f448e82..b3c6c0d 100644 --- a/TESTING/LIN/cchkaa.f +++ b/TESTING/LIN/cchkaa.f @@ -652,7 +652,7 @@ * IF( TSTCHK ) THEN CALL CCHKHE_AASEN( DOTYPE, NN, NVAL, NNB2, NBVAL2, NNS, - $ NSVAL, THRESH, TSTERR, LDA, + $ NSVAL, THRESH, TSTERR, LDA, $ A( 1, 1 ), A( 1, 2 ), A( 1, 3 ), $ B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), $ WORK, RWORK, IWORK, NOUT ) @@ -661,9 +661,9 @@ END IF * IF( TSTDRV ) THEN - CALL CDRVHE_AASEN( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, - $ LDA, A( 1, 1 ), A( 1, 2 ), A( 1, 3 ), - $ B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), + CALL CDRVHE_AASEN( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, + $ LDA, A( 1, 1 ), A( 1, 2 ), A( 1, 3 ), + $ B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), $ WORK, RWORK, IWORK, NOUT ) ELSE WRITE( NOUT, FMT = 9988 )PATH @@ -987,7 +987,7 @@ * QX: QRT routines for triangular-pentagonal matrices * IF( TSTCHK ) THEN - CALL CCHKQRTP( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, + CALL CCHKQRTP( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, $ NBVAL, NOUT ) ELSE WRITE( NOUT, FMT = 9989 )PATH @@ -998,7 +998,7 @@ * TQ: LQT routines for general matrices * IF( TSTCHK ) THEN - CALL CCHKLQT( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, + CALL CCHKLQT( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, $ NBVAL, NOUT ) ELSE WRITE( NOUT, FMT = 9989 )PATH @@ -1009,7 +1009,7 @@ * XQ: LQT routines for triangular-pentagonal matrices * IF( TSTCHK ) THEN - CALL CCHKLQTP( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, + CALL CCHKLQTP( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, $ NBVAL, NOUT ) ELSE WRITE( NOUT, FMT = 9989 )PATH @@ -1020,7 +1020,7 @@ * TS: QR routines for tall-skinny matrices * IF( TSTCHK ) THEN - CALL CCHKTSQR( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, + CALL CCHKTSQR( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, $ NBVAL, NOUT ) ELSE WRITE( NOUT, FMT = 9989 )PATH diff --git a/TESTING/LIN/cchkhe_aasen.f b/TESTING/LIN/cchkhe_aasen.f index 355dd25..3369112 100644 --- a/TESTING/LIN/cchkhe_aasen.f +++ b/TESTING/LIN/cchkhe_aasen.f @@ -225,7 +225,7 @@ * .. External Subroutines .. EXTERNAL ALAERH, ALAHD, ALASUM, XLAENV, CERRHE, CGET04, $ ZHECON, CHERFS, CHET01, CHETRF_AASEN, ZHETRI2, - $ CHETRS_AASEN, CLACPY, CLAIPD, CLARHS, CLATB4, + $ CHETRS_AASEN, CLACPY, CLAIPD, CLARHS, CLATB4, $ CLATMS, CPOT02, ZPOT03, ZPOT05 * .. * .. Intrinsic Functions .. @@ -433,7 +433,7 @@ * LWORK = ( NB+1 )*LDA SRNAMT = 'CHETRF_AASEN' - CALL CHETRF_AASEN( UPLO, N, AFAC, LDA, IWORK, AINV, + CALL CHETRF_AASEN( UPLO, N, AFAC, LDA, IWORK, AINV, $ LWORK, INFO ) * * Adjust the expected value of INFO to account for @@ -459,8 +459,8 @@ * Check error code from CHETRF and handle error. * IF( INFO.NE.K ) THEN - CALL ALAERH( PATH, 'CHETRF_AASEN', INFO, K, UPLO, - $ N, N, -1, -1, NB, IMAT, NFAIL, NERRS, + CALL ALAERH( PATH, 'CHETRF_AASEN', INFO, K, UPLO, + $ N, N, -1, -1, NB, IMAT, NFAIL, NERRS, $ NOUT ) END IF * diff --git a/TESTING/LIN/cchklqt.f b/TESTING/LIN/cchklqt.f index d6c4f7e..04f3cbf 100644 --- a/TESTING/LIN/cchklqt.f +++ b/TESTING/LIN/cchklqt.f @@ -2,15 +2,15 @@ * * =========== 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/ * * Definition: * =========== * -* SUBROUTINE CCHKLQT( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, +* SUBROUTINE CCHKLQT( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, * NBVAL, NOUT ) -* +* * .. Scalar Arguments .. * LOGICAL TSTERR * INTEGER NM, NN, NNB, NOUT @@ -89,17 +89,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 2011 * *> \ingroup double_lin * * ===================================================================== - SUBROUTINE CCHKLQT( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, + SUBROUTINE CCHKLQT( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, $ NBVAL, NOUT ) IMPLICIT NONE * @@ -175,7 +175,7 @@ NB = NBVAL( K ) * * Test CGELQT and CUNMLQT -* +* IF( (NB.LE.MINMN).AND.(NB.GT.0) ) THEN CALL CLQT04( M, N, NB, RESULT ) * diff --git a/TESTING/LIN/cchklqtp.f b/TESTING/LIN/cchklqtp.f index 5e573e4..46aa97b 100644 --- a/TESTING/LIN/cchklqtp.f +++ b/TESTING/LIN/cchklqtp.f @@ -2,13 +2,13 @@ * * =========== 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/ * * Definition: * =========== * -* SUBROUTINE CCHKLQTP( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, +* SUBROUTINE CCHKLQTP( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, * NBVAL, NOUT ) * * .. Scalar Arguments .. @@ -89,17 +89,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 2011 * *> \ingroup double_lin * * ===================================================================== - SUBROUTINE CCHKLQTP( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, + SUBROUTINE CCHKLQTP( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, $ NBVAL, NOUT ) IMPLICIT NONE * @@ -172,14 +172,14 @@ * MINMN = MIN( M, N ) DO L = 0, MINMN, MAX( MINMN, 1 ) -* +* * Do for each possible value of NB * DO K = 1, NNB NB = NBVAL( K ) * * Test DTPLQT and DTPMLQT -* +* IF( (NB.LE.M).AND.(NB.GT.0) ) THEN CALL CLQT05( M, N, L, NB, RESULT ) * @@ -212,4 +212,4 @@ * * End of CCHKLQTP * - END \ No newline at end of file + END diff --git a/TESTING/LIN/cchktsqr.f b/TESTING/LIN/cchktsqr.f index 8c55f39..9a76134 100644 --- a/TESTING/LIN/cchktsqr.f +++ b/TESTING/LIN/cchktsqr.f @@ -2,15 +2,15 @@ * * =========== 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/ * * Definition: * =========== * -* SUBROUTINE CCHKTSQR( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, +* SUBROUTINE CCHKTSQR( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, * NBVAL, NOUT ) -* +* * .. Scalar Arguments .. * LOGICAL TSTERR * INTEGER NM, NN, NNB, NOUT @@ -89,17 +89,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 2011 * *> \ingroup double_lin * * ===================================================================== - SUBROUTINE CCHKTSQR( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, + SUBROUTINE CCHKTSQR( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, $ NBVAL, NOUT ) IMPLICIT NONE * @@ -132,11 +132,11 @@ REAL RESULT( NTESTS ) * .. * .. External Subroutines .. - EXTERNAL ALAERH, ALAHD, ALASUM, CERRTSQR, + EXTERNAL ALAERH, ALAHD, ALASUM, CERRTSQR, $ CTSQR01, XLAENV * .. * .. Intrinsic Functions .. - INTRINSIC MAX, MIN + INTRINSIC MAX, MIN * .. * .. Scalars in Common .. LOGICAL LERR, OK @@ -172,7 +172,7 @@ DO J = 1, NN N = NVAL( J ) IF (MIN(M,N).NE.0) THEN - DO INB = 1, NNB + DO INB = 1, NNB MB = NBVAL( INB ) CALL XLAENV( 1, MB ) DO IMB = 1, NNB @@ -180,7 +180,7 @@ CALL XLAENV( 2, NB ) * * Test DGEQR and DGEMQR -* +* CALL CTSQR01( 'TS', M, N, MB, NB, RESULT ) * * Print information about the tests that did not @@ -196,9 +196,9 @@ END IF END DO NRUN = NRUN + NTESTS - END DO - END DO - END IF + END DO + END DO + END IF END DO END DO * @@ -212,7 +212,7 @@ DO J = 1, NN N = NVAL( J ) IF (MIN(M,N).NE.0) THEN - DO INB = 1, NNB + DO INB = 1, NNB MB = NBVAL( INB ) CALL XLAENV( 1, MB ) DO IMB = 1, NNB @@ -220,7 +220,7 @@ CALL XLAENV( 2, NB ) * * Test DGEQR and DGEMQR -* +* CALL CTSQR01( 'SW', M, N, MB, NB, RESULT ) * * Print information about the tests that did not @@ -236,9 +236,9 @@ END IF END DO NRUN = NRUN + NTESTS - END DO - END DO - END IF + END DO + END DO + END IF END DO END DO * diff --git a/TESTING/LIN/cdrvhe_aasen.f b/TESTING/LIN/cdrvhe_aasen.f index 617f307..ed64507 100644 --- a/TESTING/LIN/cdrvhe_aasen.f +++ b/TESTING/LIN/cdrvhe_aasen.f @@ -465,10 +465,10 @@ c END IF END IF * * Check error code from CHESV_AASEN . -* +* IF( INFO.NE.K ) THEN - CALL ALAERH( PATH, 'CHESV_AASEN', INFO, K, - $ UPLO, N, N, -1, -1, NRHS, + CALL ALAERH( PATH, 'CHESV_AASEN', INFO, K, + $ UPLO, N, N, -1, -1, NRHS, $ IMAT, NFAIL, NERRS, NOUT ) GO TO 120 ELSE IF( INFO.NE.0 ) THEN @@ -479,7 +479,7 @@ c END IF * residual. * CALL CHET01_AASEN( UPLO, N, A, LDA, AFAC, LDA, - $ IWORK, AINV, LDA, RWORK, + $ IWORK, AINV, LDA, RWORK, $ RESULT( 1 ) ) * * Compute residual of the computed solution. diff --git a/TESTING/LIN/cdrvls.f b/TESTING/LIN/cdrvls.f index af55dba..de9890f 100644 --- a/TESTING/LIN/cdrvls.f +++ b/TESTING/LIN/cdrvls.f @@ -262,8 +262,8 @@ * .. * .. External Subroutines .. EXTERNAL ALAERH, ALAHD, ALASVM, CERRLS, CGELS, CGELSD, - $ CGELSS, CGELSY, CGEMM, CGETSLS, CLACPY, - $ CLARNV, CQRT13, CQRT15, CQRT16, CSSCAL, + $ CGELSS, CGELSY, CGEMM, CGETSLS, CLACPY, + $ CLARNV, CQRT13, CQRT15, CQRT16, CSSCAL, $ SAXPY, XLAENV * .. * .. Intrinsic Functions .. @@ -490,7 +490,7 @@ $ COPYB, LDB, B, LDB ) END IF SRNAMT = 'DGETSLS ' - CALL CGETSLS( TRANS, M, N, NRHS, A, + CALL CGETSLS( TRANS, M, N, NRHS, A, $ LDA, B, LDB, WORK, LWORK, INFO ) IF( INFO.NE.0 ) $ CALL ALAERH( PATH, 'CGETSLS ', INFO, 0, @@ -773,8 +773,8 @@ $ ', NB=', I4, ', type', I2, ', test(', I2, ')=', G12.5 ) 9998 FORMAT( ' M=', I5, ', N=', I5, ', NRHS=', I4, ', NB=', I4, $ ', type', I2, ', test(', I2, ')=', G12.5 ) - 9997 FORMAT( ' TRANS=''', A1,' M=', I5, ', N=', I5, ', NRHS=', I4, - $ ', MB=', I4,', NB=', I4,', type', I2, + 9997 FORMAT( ' TRANS=''', A1,' M=', I5, ', N=', I5, ', NRHS=', I4, + $ ', MB=', I4,', NB=', I4,', type', I2, $ ', test(', I2, ')=', G12.5 ) RETURN * diff --git a/TESTING/LIN/cerrlqt.f b/TESTING/LIN/cerrlqt.f index 008cb0a..8308d10 100644 --- a/TESTING/LIN/cerrlqt.f +++ b/TESTING/LIN/cerrlqt.f @@ -2,19 +2,19 @@ * * =========== 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/ * * Definition: * =========== * * SUBROUTINE CERRLQT( PATH, NUNIT ) -* +* * .. Scalar Arguments .. * CHARACTER*3 PATH * INTEGER NUNIT * .. -* +* * *> \par Purpose: * ============= @@ -43,10 +43,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 * @@ -81,7 +81,7 @@ * .. * .. External Subroutines .. EXTERNAL ALAESM, CHKXER, CGELQT3, CGELQT, - $ CGEMLQT + $ CGEMLQT * .. * .. Scalars in Common .. LOGICAL LERR, OK diff --git a/TESTING/LIN/cerrlqtp.f b/TESTING/LIN/cerrlqtp.f index 45797dd..04dffb8 100644 --- a/TESTING/LIN/cerrlqtp.f +++ b/TESTING/LIN/cerrlqtp.f @@ -2,19 +2,19 @@ * * =========== 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/ * * Definition: * =========== * * SUBROUTINE CERRLQTP( PATH, NUNIT ) -* +* * .. Scalar Arguments .. * CHARACTER*3 PATH * INTEGER NUNIT * .. -* +* * *> \par Purpose: * ============= @@ -43,10 +43,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 * @@ -81,7 +81,7 @@ * .. * .. External Subroutines .. EXTERNAL ALAESM, CHKXER, CTPLQT2, CTPLQT, - $ CTPMLQT + $ CTPMLQT * .. * .. Scalars in Common .. LOGICAL LERR, OK @@ -171,46 +171,46 @@ * SRNAMT = 'CTPMLQT' INFOT = 1 - CALL CTPMLQT( '/', 'N', 0, 0, 0, 0, 1, A, 1, T, 1, B, 1, C, 1, + CALL CTPMLQT( '/', 'N', 0, 0, 0, 0, 1, A, 1, T, 1, B, 1, C, 1, $ W, INFO ) CALL CHKXER( 'CTPMLQT', INFOT, NOUT, LERR, OK ) INFOT = 2 - CALL CTPMLQT( 'L', '/', 0, 0, 0, 0, 1, A, 1, T, 1, B, 1, C, 1, + CALL CTPMLQT( 'L', '/', 0, 0, 0, 0, 1, A, 1, T, 1, B, 1, C, 1, $ W, INFO ) CALL CHKXER( 'CTPMLQT', INFOT, NOUT, LERR, OK ) INFOT = 3 - CALL CTPMLQT( 'L', 'N', -1, 0, 0, 0, 1, A, 1, T, 1, B, 1, C, 1, + CALL CTPMLQT( 'L', 'N', -1, 0, 0, 0, 1, A, 1, T, 1, B, 1, C, 1, $ W, INFO ) CALL CHKXER( 'CTPMLQT', INFOT, NOUT, LERR, OK ) INFOT = 4 - CALL CTPMLQT( 'L', 'N', 0, -1, 0, 0, 1, A, 1, T, 1, B, 1, C, 1, + CALL CTPMLQT( 'L', 'N', 0, -1, 0, 0, 1, A, 1, T, 1, B, 1, C, 1, $ W, INFO ) CALL CHKXER( 'CTPMLQT', INFOT, NOUT, LERR, OK ) INFOT = 5 - CALL CTPMLQT( 'L', 'N', 0, 0, -1, 0, 1, A, 1, T, 1, B, 1, C, 1, + CALL CTPMLQT( 'L', 'N', 0, 0, -1, 0, 1, A, 1, T, 1, B, 1, C, 1, $ W, INFO ) INFOT = 6 - CALL CTPMLQT( 'L', 'N', 0, 0, 0, -1, 1, A, 1, T, 1, B, 1, C, 1, + CALL CTPMLQT( 'L', 'N', 0, 0, 0, -1, 1, A, 1, T, 1, B, 1, C, 1, $ W, INFO ) CALL CHKXER( 'CTPMLQT', INFOT, NOUT, LERR, OK ) INFOT = 7 - CALL CTPMLQT( 'L', 'N', 0, 0, 0, 0, 0, A, 1, T, 1, B, 1, C, 1, + CALL CTPMLQT( 'L', 'N', 0, 0, 0, 0, 0, A, 1, T, 1, B, 1, C, 1, $ W, INFO ) CALL CHKXER( 'CTPMLQT', INFOT, NOUT, LERR, OK ) INFOT = 9 - CALL CTPMLQT( 'R', 'N', 2, 2, 2, 1, 1, A, 1, T, 1, B, 1, C, 1, + CALL CTPMLQT( 'R', 'N', 2, 2, 2, 1, 1, A, 1, T, 1, B, 1, C, 1, $ W, INFO ) CALL CHKXER( 'CTPMLQT', INFOT, NOUT, LERR, OK ) INFOT = 11 - CALL CTPMLQT( 'R', 'N', 1, 1, 1, 1, 1, A, 1, T, 0, B, 1, C, 1, + CALL CTPMLQT( 'R', 'N', 1, 1, 1, 1, 1, A, 1, T, 0, B, 1, C, 1, $ W, INFO ) CALL CHKXER( 'CTPMLQT', INFOT, NOUT, LERR, OK ) INFOT = 13 - CALL CTPMLQT( 'L', 'N', 1, 1, 1, 1, 1, A, 1, T, 1, B, 0, C, 1, + CALL CTPMLQT( 'L', 'N', 1, 1, 1, 1, 1, A, 1, T, 1, B, 0, C, 1, $ W, INFO ) CALL CHKXER( 'CTPMLQT', INFOT, NOUT, LERR, OK ) INFOT = 15 - CALL CTPMLQT( 'L', 'N', 1, 1, 1, 1, 1, A, 1, T, 1, B, 1, C, 0, + CALL CTPMLQT( 'L', 'N', 1, 1, 1, 1, 1, A, 1, T, 1, B, 1, C, 0, $ W, INFO ) CALL CHKXER( 'CTPMLQT', INFOT, NOUT, LERR, OK ) * diff --git a/TESTING/LIN/cerrtsqr.f b/TESTING/LIN/cerrtsqr.f index 3ca8b37..b8b42dc 100644 --- a/TESTING/LIN/cerrtsqr.f +++ b/TESTING/LIN/cerrtsqr.f @@ -2,19 +2,19 @@ * * =========== 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/ * * Definition: * =========== * * SUBROUTINE CERRTSQR( PATH, NUNIT ) -* +* * .. Scalar Arguments .. * CHARACTER*3 PATH * INTEGER NUNIT * .. -* +* * *> \par Purpose: * ============= @@ -43,10 +43,10 @@ * Authors: * ======== * -*> \author Univ. of Tennessee -*> \author Univ. of California Berkeley -*> \author Univ. of Colorado Zenver -*> \author NAG Ltd. +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Zenver +*> \author NAG Ltd. * *> \date November 2011 * diff --git a/TESTING/LIN/chet01_aasen.f b/TESTING/LIN/chet01_aasen.f index d87a610..71abfc8 100644 --- a/TESTING/LIN/chet01_aasen.f +++ b/TESTING/LIN/chet01_aasen.f @@ -8,7 +8,7 @@ * Definition: * =========== * -* SUBROUTINE CHET01_AASEN( UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, +* SUBROUTINE CHET01_AASEN( UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, * C, LDC, RWORK, RESID ) * * .. Scalar Arguments .. @@ -145,7 +145,7 @@ * * .. Parameters .. COMPLEX CZERO, CONE - PARAMETER ( CZERO = ( 0.0E+0, 0.0E+0 ), + PARAMETER ( CZERO = ( 0.0E+0, 0.0E+0 ), $ CONE = ( 1.0E+0, 0.0E+0 ) ) REAL ZERO, ONE PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 ) diff --git a/TESTING/LIN/clqt04.f b/TESTING/LIN/clqt04.f index cdab2df..f1b722b 100644 --- a/TESTING/LIN/clqt04.f +++ b/TESTING/LIN/clqt04.f @@ -2,19 +2,19 @@ * * =========== 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/ * * Definition: * =========== * * SUBROUTINE CLQT04(M,N,NB,RESULT) -* +* * .. Scalar Arguments .. * INTEGER M, N, NB * .. Return values .. * REAL RESULT(6) -* +* * *> \par Purpose: * ============= @@ -54,17 +54,17 @@ *> RESULT(2) = | I - Q Q^H | *> RESULT(3) = | Q C - Q C | *> RESULT(4) = | Q^H C - Q^H C | -*> RESULT(5) = | C Q - C Q | +*> RESULT(5) = | C Q - C Q | *> RESULT(6) = | C Q^H - C Q^H | *> \endverbatim * * Authors: * ======== * -*> \author Univ. of Tennessee -*> \author Univ. of California Berkeley -*> \author Univ. of Colorado Denver -*> \author NAG Ltd. +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. * *> \date April 2012 * @@ -87,9 +87,9 @@ * ===================================================================== * * .. -* .. Local allocatable arrays +* .. Local allocatable arrays COMPLEX, ALLOCATABLE :: AF(:,:), Q(:,:), - $ L(:,:), RWORK(:), WORK( : ), T(:,:), + $ L(:,:), RWORK(:), WORK( : ), T(:,:), $ CF(:,:), DF(:,:), A(:,:), C(:,:), D(:,:) * * .. Parameters .. @@ -112,11 +112,11 @@ EXTERNAL SLAMCH, CLANGE, CLANSY, LSAME * .. * .. Intrinsic Functions .. - INTRINSIC MAX, MIN + INTRINSIC MAX, MIN * .. * .. Data statements .. - DATA ISEED / 1988, 1989, 1990, 1991 / -* + DATA ISEED / 1988, 1989, 1990, 1991 / +* EPS = SLAMCH( 'Epsilon' ) K = MIN(M,N) LL = MAX(M,N) @@ -124,8 +124,8 @@ * * Dynamically allocate local arrays * - ALLOCATE ( A(M,N), AF(M,N), Q(N,N), L(LL,N), RWORK(LL), - $ WORK(LWORK), T(NB,N), C(M,N), CF(M,N), + ALLOCATE ( A(M,N), AF(M,N), Q(N,N), L(LL,N), RWORK(LL), + $ WORK(LWORK), T(NB,N), C(M,N), CF(M,N), $ D(N,M), DF(N,M) ) * * Put random numbers into A and copy to AF @@ -143,7 +143,7 @@ * Generate the n-by-n matrix Q * CALL CLASET( 'Full', N, N, CZERO, ONE, Q, N ) - CALL CGEMLQT( 'R', 'N', N, N, K, NB, AF, M, T, LDT, Q, N, + CALL CGEMLQT( 'R', 'N', N, N, K, NB, AF, M, T, LDT, Q, N, $ WORK, INFO ) * * Copy L @@ -179,7 +179,7 @@ * * Apply Q to C as Q*C * - CALL CGEMLQT( 'L', 'N', N, M, K, NB, AF, M, T, NB, DF, N, + CALL CGEMLQT( 'L', 'N', N, M, K, NB, AF, M, T, NB, DF, N, $ WORK, INFO) * * Compute |Q*D - Q*D| / |D| @@ -198,7 +198,7 @@ * * Apply Q to D as QT*D * - CALL CGEMLQT( 'L', 'C', N, M, K, NB, AF, M, T, NB, DF, N, + CALL CGEMLQT( 'L', 'C', N, M, K, NB, AF, M, T, NB, DF, N, $ WORK, INFO) * * Compute |QT*D - QT*D| / |D| @@ -209,7 +209,7 @@ RESULT( 4 ) = RESID / (EPS*MAX(1,M)*DNORM) ELSE RESULT( 4 ) = ZERO - END IF + END IF * * Generate random n-by-m matrix D and a copy DF * @@ -221,8 +221,8 @@ * * Apply Q to C as C*Q * - CALL CGEMLQT( 'R', 'N', M, N, K, NB, AF, M, T, NB, CF, M, - $ WORK, INFO) + CALL CGEMLQT( 'R', 'N', M, N, K, NB, AF, M, T, NB, CF, M, + $ WORK, INFO) * * Compute |C*Q - C*Q| / |C| * @@ -240,8 +240,8 @@ * * Apply Q to D as D*QT * - CALL CGEMLQT( 'R', 'C', M, N, K, NB, AF, M, T, NB, CF, M, - $ WORK, INFO) + CALL CGEMLQT( 'R', 'C', M, N, K, NB, AF, M, T, NB, CF, M, + $ WORK, INFO) * * Compute |C*QT - C*QT| / |C| * diff --git a/TESTING/LIN/clqt05.f b/TESTING/LIN/clqt05.f index 22ffcc0..3eed9f3 100644 --- a/TESTING/LIN/clqt05.f +++ b/TESTING/LIN/clqt05.f @@ -2,19 +2,19 @@ * * =========== 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/ * * Definition: * =========== * * SUBROUTINE CLQT05(M,N,L,NB,RESULT) -* +* * .. Scalar Arguments .. * INTEGER LWORK, M, N, L, NB, LDT * .. Return values .. * DOUBLE PRECISION RESULT(6) -* +* * *> \par Purpose: * ============= @@ -45,7 +45,7 @@ *> The number of rows of the upper trapezoidal part the *> lower test matrix. 0 <= L <= M. *> \endverbatim -*> +*> *> \param[in] NB *> \verbatim *> NB is INTEGER @@ -61,17 +61,17 @@ *> RESULT(2) = | I - Q^H Q | *> RESULT(3) = | Q C - Q C | *> RESULT(4) = | Q^H C - Q^H C | -*> RESULT(5) = | C Q - C Q | +*> RESULT(5) = | C Q - C Q | *> RESULT(6) = | C Q^H - C Q^H | *> \endverbatim * * Authors: * ======== * -*> \author Univ. of Tennessee -*> \author Univ. of California Berkeley -*> \author Univ. of Colorado Denver -*> \author NAG Ltd. +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. * *> \date April 2012 * @@ -92,11 +92,11 @@ REAL RESULT(6) * * ===================================================================== -* +* * .. -* .. Local allocatable arrays +* .. Local allocatable arrays COMPLEX, ALLOCATABLE :: AF(:,:), Q(:,:), - $ R(:,:), RWORK(:), WORK( : ), T(:,:), + $ R(:,:), RWORK(:), WORK( : ), T(:,:), $ CF(:,:), DF(:,:), A(:,:), C(:,:), D(:,:) * * .. Parameters .. @@ -119,7 +119,7 @@ * .. * .. Data statements .. DATA ISEED / 1988, 1989, 1990, 1991 / -* +* EPS = SLAMCH( 'Epsilon' ) K = M N2 = M+N @@ -133,7 +133,7 @@ * Dynamically allocate all arrays * ALLOCATE(A(M,N2),AF(M,N2),Q(N2,N2),R(N2,N2),RWORK(N2), - $ WORK(LWORK),T(NB,M),C(N2,M),CF(N2,M), + $ WORK(LWORK),T(NB,M),C(N2,M),CF(N2,M), $ D(M,N2),DF(M,N2) ) * * Put random stuff into A @@ -151,7 +151,7 @@ END IF IF( L.GT.0 ) THEN DO J=1,L - CALL CLARNV( 2, ISEED, M-J+1, A( J, MIN(N+M,N+M-L+1) + CALL CLARNV( 2, ISEED, M-J+1, A( J, MIN(N+M,N+M-L+1) $ + J - 1 ) ) END DO END IF @@ -204,7 +204,7 @@ CALL CLACPY( 'Full', N2, M, C, N2, CF, N2 ) * * Apply Q to C as Q*C -* +* CALL CTPMLQT( 'L','N', N,M,K,L,NB,AF(1, NP1),M,T,LDT,CF,N2, $ CF(NP1,1),N2,WORK,INFO) * @@ -226,18 +226,18 @@ * Apply Q to C as QT*C * CALL CTPMLQT( 'L','C',N,M,K,L,NB,AF(1,NP1),M,T,LDT,CF,N2, - $ CF(NP1,1),N2,WORK,INFO) + $ CF(NP1,1),N2,WORK,INFO) * * Compute |QT*C - QT*C| / |C| * CALL CGEMM('C','N',N2,M,N2,-ONE,Q,N2,C,N2,ONE,CF,N2) RESID = CLANGE( '1', N2, M, CF, N2, RWORK ) - + IF( CNORM.GT.ZERO ) THEN RESULT( 4 ) = RESID / (EPS*MAX(1,N2)*CNORM) ELSE RESULT( 4 ) = ZERO - END IF + END IF * * Generate random m-by-n matrix D and a copy DF * @@ -269,8 +269,8 @@ * Apply Q to D as D*QT * CALL CTPMLQT('R','C',M,N,K,L,NB,AF(1,NP1),M,T,LDT,DF,M, - $ DF(1,NP1),M,WORK,INFO) - + $ DF(1,NP1),M,WORK,INFO) + * * Compute |D*QT - D*QT| / |D| * @@ -286,4 +286,4 @@ * DEALLOCATE ( A, AF, Q, R, RWORK, WORK, T, C, D, CF, DF) RETURN - END \ No newline at end of file + END diff --git a/TESTING/LIN/ctsqr01.f b/TESTING/LIN/ctsqr01.f index a94f89f..a437386 100644 --- a/TESTING/LIN/ctsqr01.f +++ b/TESTING/LIN/ctsqr01.f @@ -2,19 +2,19 @@ * * =========== 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/ * * Definition: * =========== * * SUBROUTINE CTSQR01(TSSW, M,N, MB, NB, RESULT) -* +* * .. Scalar Arguments .. * INTEGER M, N, MB * .. Return values .. * REAL RESULT(6) -* +* * *> \par Purpose: * ============= @@ -65,17 +65,17 @@ *> RESULT(2) = | I - Q^H Q | or | I - Q Q^H | *> RESULT(3) = | Q C - Q C | *> RESULT(4) = | Q^H C - Q^H C | -*> RESULT(5) = | C Q - C Q | +*> RESULT(5) = | C Q - C Q | *> RESULT(6) = | C Q^H - C Q^H | *> \endverbatim * * Authors: * ======== * -*> \author Univ. of Tennessee -*> \author Univ. of California Berkeley -*> \author Univ. of Colorado Denver -*> \author NAG Ltd. +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. * *> \date April 2012 * @@ -97,9 +97,9 @@ * ===================================================================== * * .. -* .. Local allocatable arrays +* .. Local allocatable arrays COMPLEX, ALLOCATABLE :: AF(:,:), Q(:,:), - $ R(:,:), RWORK(:), WORK( : ), T(:), + $ R(:,:), RWORK(:), WORK( : ), T(:), $ CF(:,:), DF(:,:), A(:,:), C(:,:), D(:,:), LQ(:,:) * * .. Parameters .. @@ -122,24 +122,24 @@ EXTERNAL SLAMCH, CLANGE, CLANSY, LSAME, ILAENV * .. * .. Intrinsic Functions .. - INTRINSIC MAX, MIN + INTRINSIC MAX, MIN * .. Scalars in Common .. CHARACTER*32 srnamt * .. * .. Common blocks .. - COMMON / srnamc / srnamt + COMMON / srnamc / srnamt * .. * .. Data statements .. - DATA ISEED / 1988, 1989, 1990, 1991 / + DATA ISEED / 1988, 1989, 1990, 1991 / * * TEST TALL SKINNY OR SHORT WIDE * - TS = LSAME(TSSW, 'TS') -* + TS = LSAME(TSSW, 'TS') +* * TEST MATRICES WITH HALF OF MATRIX BEING ZEROS * TESTZEROS = .FALSE. -* +* EPS = SLAMCH( 'Epsilon' ) K = MIN(M,N) L = MAX(M,N,1) @@ -148,14 +148,14 @@ IF((K.GE.MNB).OR.(MNB.GE.L))THEN LT=MAX(1,L)*MNB+5 ELSE - LT=MAX(1,(L-K)/(MNB-K)+1)*L*MNB+5 + LT=MAX(1,(L-K)/(MNB-K)+1)*L*MNB+5 END IF * * Dynamically allocate local arrays * - ALLOCATE ( A(M,N), AF(M,N), Q(L,L), R(M,L), RWORK(L), - $ WORK(LWORK), T(LT), C(M,N), CF(M,N), + ALLOCATE ( A(M,N), AF(M,N), Q(L,L), R(M,L), RWORK(L), + $ WORK(LWORK), T(LT), C(M,N), CF(M,N), $ D(N,M), DF(N,M), LQ(L,N) ) * * Put random numbers into A and copy to AF @@ -183,7 +183,7 @@ * CALL CLASET( 'Full', M, M, CZERO, ONE, Q, M ) srnamt = 'CGEMQR' - CALL CGEMQR( 'L', 'N', M, M, K, AF, M, T, LT, Q, M, + CALL CGEMQR( 'L', 'N', M, M, K, AF, M, T, LT, Q, M, $ WORK, LWORK, INFO ) * * Copy R @@ -220,7 +220,7 @@ * Apply Q to C as Q*C * srnamt = 'CGEMQR' - CALL CGEMQR( 'L', 'N', M, N, K, AF, M, T, LT, CF, M, + CALL CGEMQR( 'L', 'N', M, N, K, AF, M, T, LT, CF, M, $ WORK, LWORK, INFO) * * Compute |Q*C - Q*C| / |C| @@ -240,7 +240,7 @@ * Apply Q to C as QT*C * srnamt = 'CGEMQR' - CALL CGEMQR( 'L', 'C', M, N, K, AF, M, T, LT, CF, M, + CALL CGEMQR( 'L', 'C', M, N, K, AF, M, T, LT, CF, M, $ WORK, LWORK, INFO) * * Compute |QT*C - QT*C| / |C| @@ -251,7 +251,7 @@ RESULT( 4 ) = RESID / (EPS*MAX(1,M)*CNORM) ELSE RESULT( 4 ) = ZERO - END IF + END IF * * Generate random n-by-m matrix D and a copy DF * @@ -264,8 +264,8 @@ * Apply Q to D as D*Q * srnamt = 'CGEMQR' - CALL CGEMQR( 'R', 'N', N, M, K, AF, M, T, LT, DF, N, - $ WORK, LWORK, INFO) + CALL CGEMQR( 'R', 'N', N, M, K, AF, M, T, LT, DF, N, + $ WORK, LWORK, INFO) * * Compute |D*Q - D*Q| / |D| * @@ -283,8 +283,8 @@ * * Apply Q to D as D*QT * - CALL CGEMQR( 'R', 'C', N, M, K, AF, M, T, LT, DF, N, - $ WORK, LWORK, INFO) + CALL CGEMQR( 'R', 'C', N, M, K, AF, M, T, LT, DF, N, + $ WORK, LWORK, INFO) * * Compute |D*QT - D*QT| / |D| * @@ -307,7 +307,7 @@ * CALL CLASET( 'Full', N, N, CZERO, ONE, Q, N ) srnamt = 'CGEMLQ' - CALL CGEMLQ( 'R', 'N', N, N, K, AF, M, T, LT, Q, N, + CALL CGEMLQ( 'R', 'N', N, N, K, AF, M, T, LT, Q, N, $ WORK, LWORK, INFO ) * * Copy R @@ -343,7 +343,7 @@ * * Apply Q to C as Q*C * - CALL CGEMLQ( 'L', 'N', N, M, K, AF, M, T, LT, DF, N, + CALL CGEMLQ( 'L', 'N', N, M, K, AF, M, T, LT, DF, N, $ WORK, LWORK, INFO) * * Compute |Q*D - Q*D| / |D| @@ -362,7 +362,7 @@ * * Apply Q to D as QT*D * - CALL CGEMLQ( 'L', 'C', N, M, K, AF, M, T, LT, DF, N, + CALL CGEMLQ( 'L', 'C', N, M, K, AF, M, T, LT, DF, N, $ WORK, LWORK, INFO) * * Compute |QT*D - QT*D| / |D| @@ -373,7 +373,7 @@ RESULT( 4 ) = RESID / (EPS*MAX(1,N)*DNORM) ELSE RESULT( 4 ) = ZERO - END IF + END IF * * Generate random n-by-m matrix D and a copy DF * @@ -385,8 +385,8 @@ * * Apply Q to C as C*Q * - CALL CGEMLQ( 'R', 'N', M, N, K, AF, M, T, LT, CF, M, - $ WORK, LWORK, INFO) + CALL CGEMLQ( 'R', 'N', M, N, K, AF, M, T, LT, CF, M, + $ WORK, LWORK, INFO) * * Compute |C*Q - C*Q| / |C| * @@ -404,8 +404,8 @@ * * Apply Q to D as D*QT * - CALL CGEMLQ( 'R', 'C', M, N, K, AF, M, T, LT, CF, M, - $ WORK, LWORK, INFO) + CALL CGEMLQ( 'R', 'C', M, N, K, AF, M, T, LT, CF, M, + $ WORK, LWORK, INFO) * * Compute |C*QT - C*QT| / |C| * @@ -424,4 +424,4 @@ DEALLOCATE ( A, AF, Q, R, RWORK, WORK, T, C, D, CF, DF) * RETURN - END \ No newline at end of file + END diff --git a/TESTING/LIN/dchkaa.f b/TESTING/LIN/dchkaa.f index 2e38bb5..68a748c 100644 --- a/TESTING/LIN/dchkaa.f +++ b/TESTING/LIN/dchkaa.f @@ -676,9 +676,9 @@ CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT ) * IF( TSTCHK ) THEN - CALL DCHKSY_AASEN( DOTYPE, NN, NVAL, NNB2, NBVAL2, NNS, + CALL DCHKSY_AASEN( DOTYPE, NN, NVAL, NNB2, NBVAL2, NNS, $ NSVAL, THRESH, TSTERR, LDA, - $ A( 1, 1 ), A( 1, 2 ), A( 1, 3 ), + $ A( 1, 1 ), A( 1, 2 ), A( 1, 3 ), $ B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), $ WORK, RWORK, IWORK, NOUT ) ELSE @@ -910,7 +910,7 @@ * QX: QRT routines for triangular-pentagonal matrices * IF( TSTCHK ) THEN - CALL DCHKQRTP( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, + CALL DCHKQRTP( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, $ NBVAL, NOUT ) ELSE WRITE( NOUT, FMT = 9989 )PATH @@ -921,7 +921,7 @@ * TQ: LQT routines for general matrices * IF( TSTCHK ) THEN - CALL DCHKLQT( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, + CALL DCHKLQT( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, $ NBVAL, NOUT ) ELSE WRITE( NOUT, FMT = 9989 )PATH @@ -932,7 +932,7 @@ * XQ: LQT routines for triangular-pentagonal matrices * IF( TSTCHK ) THEN - CALL DCHKLQTP( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, + CALL DCHKLQTP( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, $ NBVAL, NOUT ) ELSE WRITE( NOUT, FMT = 9989 )PATH @@ -943,7 +943,7 @@ * TS: QR routines for tall-skinny matrices * IF( TSTCHK ) THEN - CALL DCHKTSQR( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, + CALL DCHKTSQR( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, $ NBVAL, NOUT ) ELSE WRITE( NOUT, FMT = 9989 )PATH diff --git a/TESTING/LIN/dchklqt.f b/TESTING/LIN/dchklqt.f index 1726090..9a9ba65 100644 --- a/TESTING/LIN/dchklqt.f +++ b/TESTING/LIN/dchklqt.f @@ -2,15 +2,15 @@ * * =========== 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/ * * Definition: * =========== * -* SUBROUTINE DCHKLQT( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, +* SUBROUTINE DCHKLQT( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, * NBVAL, NOUT ) -* +* * .. Scalar Arguments .. * LOGICAL TSTERR * INTEGER NM, NN, NNB, NOUT @@ -89,17 +89,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 2011 * *> \ingroup double_lin * * ===================================================================== - SUBROUTINE DCHKLQT( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, + SUBROUTINE DCHKLQT( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, $ NBVAL, NOUT ) IMPLICIT NONE * @@ -175,7 +175,7 @@ NB = NBVAL( K ) * * Test DGELQT and DGEMLQT -* +* IF( (NB.LE.MINMN).AND.(NB.GT.0) ) THEN CALL DLQT04( M, N, NB, RESULT ) * diff --git a/TESTING/LIN/dchklqtp.f b/TESTING/LIN/dchklqtp.f index 1cc82ec..d4b486c 100644 --- a/TESTING/LIN/dchklqtp.f +++ b/TESTING/LIN/dchklqtp.f @@ -2,13 +2,13 @@ * * =========== 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/ * * Definition: * =========== * -* SUBROUTINE DCHKLQTP( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, +* SUBROUTINE DCHKLQTP( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, * NBVAL, NOUT ) * * .. Scalar Arguments .. @@ -89,17 +89,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 2011 * *> \ingroup double_lin * * ===================================================================== - SUBROUTINE DCHKLQTP( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, + SUBROUTINE DCHKLQTP( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, $ NBVAL, NOUT ) IMPLICIT NONE * @@ -172,14 +172,14 @@ * MINMN = MIN( M, N ) DO L = 0, MINMN, MAX( MINMN, 1 ) -* +* * Do for each possible value of NB * DO K = 1, NNB NB = NBVAL( K ) * * Test DTPLQT and DTPMLQT -* +* IF( (NB.LE.M).AND.(NB.GT.0) ) THEN CALL DLQT05( M, N, L, NB, RESULT ) * diff --git a/TESTING/LIN/dchksy_aasen.f b/TESTING/LIN/dchksy_aasen.f index 041ef75..bd8e4fb 100644 --- a/TESTING/LIN/dchksy_aasen.f +++ b/TESTING/LIN/dchksy_aasen.f @@ -430,7 +430,7 @@ * SRNAMT = 'DSYTRF_AASEN' LWORK = N*NB + N - CALL DSYTRF_AASEN( UPLO, N, AFAC, LDA, IWORK, AINV, + CALL DSYTRF_AASEN( UPLO, N, AFAC, LDA, IWORK, AINV, $ LWORK, INFO ) * * Adjust the expected value of INFO to account for @@ -456,8 +456,8 @@ * Check error code from DSYTRF and handle error. * IF( INFO.NE.K ) THEN - CALL ALAERH( PATH, 'DSYTRF_AASEN', INFO, K, UPLO, - $ N, N, -1, -1, NB, IMAT, NFAIL, NERRS, + CALL ALAERH( PATH, 'DSYTRF_AASEN', INFO, K, UPLO, + $ N, N, -1, -1, NB, IMAT, NFAIL, NERRS, $ NOUT ) END IF * @@ -517,7 +517,7 @@ * SRNAMT = 'DSYTRS_AASEN' LWORK = 3*N-2 - CALL DSYTRS_AASEN( UPLO, N, NRHS, AFAC, LDA, + CALL DSYTRS_AASEN( UPLO, N, NRHS, AFAC, LDA, $ IWORK, X, LDA, WORK, LWORK, $ INFO ) * diff --git a/TESTING/LIN/dchktsqr.f b/TESTING/LIN/dchktsqr.f index 0c3de46..0e2d0ef 100644 --- a/TESTING/LIN/dchktsqr.f +++ b/TESTING/LIN/dchktsqr.f @@ -2,15 +2,15 @@ * * =========== 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/ * * Definition: * =========== * -* SUBROUTINE DCHKTSQR( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, +* SUBROUTINE DCHKTSQR( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, * NBVAL, NOUT ) -* +* * .. Scalar Arguments .. * LOGICAL TSTERR * INTEGER NM, NN, NNB, NOUT @@ -89,17 +89,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 2011 * *> \ingroup double_lin * * ===================================================================== - SUBROUTINE DCHKTSQR( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, + SUBROUTINE DCHKTSQR( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, $ NBVAL, NOUT ) IMPLICIT NONE * @@ -132,11 +132,11 @@ DOUBLE PRECISION RESULT( NTESTS ) * .. * .. External Subroutines .. - EXTERNAL ALAERH, ALAHD, ALASUM, DERRTSQR, + EXTERNAL ALAERH, ALAHD, ALASUM, DERRTSQR, $ DTSQR01, XLAENV * .. * .. Intrinsic Functions .. - INTRINSIC MAX, MIN + INTRINSIC MAX, MIN * .. * .. Scalars in Common .. LOGICAL LERR, OK @@ -172,7 +172,7 @@ DO J = 1, NN N = NVAL( J ) IF (MIN(M,N).NE.0) THEN - DO INB = 1, NNB + DO INB = 1, NNB MB = NBVAL( INB ) CALL XLAENV( 1, MB ) DO IMB = 1, NNB @@ -180,7 +180,7 @@ CALL XLAENV( 2, NB ) * * Test DGEQR and DGEMQR -* +* CALL DTSQR01( 'TS', M, N, MB, NB, RESULT ) * * Print information about the tests that did not @@ -196,9 +196,9 @@ END IF END DO NRUN = NRUN + NTESTS - END DO - END DO - END IF + END DO + END DO + END IF END DO END DO * @@ -212,7 +212,7 @@ DO J = 1, NN N = NVAL( J ) IF (MIN(M,N).NE.0) THEN - DO INB = 1, NNB + DO INB = 1, NNB MB = NBVAL( INB ) CALL XLAENV( 1, MB ) DO IMB = 1, NNB @@ -220,7 +220,7 @@ CALL XLAENV( 2, NB ) * * Test DGEQR and DGEMQR -* +* CALL DTSQR01( 'SW', M, N, MB, NB, RESULT ) * * Print information about the tests that did not @@ -236,9 +236,9 @@ END IF END DO NRUN = NRUN + NTESTS - END DO - END DO - END IF + END DO + END DO + END IF END DO END DO * @@ -254,4 +254,4 @@ * * End of DCHKQRT * - END \ No newline at end of file + END diff --git a/TESTING/LIN/ddrvls.f b/TESTING/LIN/ddrvls.f index 2a19455..d11f910 100644 --- a/TESTING/LIN/ddrvls.f +++ b/TESTING/LIN/ddrvls.f @@ -234,9 +234,9 @@ * .. Local Scalars .. CHARACTER TRANS CHARACTER*3 PATH - INTEGER CRANK, I, IM, IMB, IN, INB, INFO, INS, IRANK, - $ ISCALE, ITRAN, ITYPE, J, K, LDA, LDB, LDWORK, - $ LWLSY, LWORK, M, MNMIN, N, NB, NCOLS, NERRS, + INTEGER CRANK, I, IM, IMB, IN, INB, INFO, INS, IRANK, + $ ISCALE, ITRAN, ITYPE, J, K, LDA, LDB, LDWORK, + $ LWLSY, LWORK, M, MNMIN, N, NB, NCOLS, NERRS, $ NFAIL, NLVL, NRHS, NROWS, NRUN, RANK, MB, LWTS DOUBLE PRECISION EPS, NORMA, NORMB, RCOND * .. @@ -324,7 +324,7 @@ LWORK = MAX( 1, ( M+NRHS )*( N+2 ), ( N+NRHS )*( M+2 ), $ M*N+4*MNMIN+MAX( M, N ), 12*MNMIN+2*MNMIN*SMLSIZ+ $ 8*MNMIN*NLVL+MNMIN*NRHS+(SMLSIZ+1)**2,LWTS) - $ + $ * DO 120 IRANK = 1, 2 DO 110 ISCALE = 1, 3 @@ -484,7 +484,7 @@ $ COPYB, LDB, B, LDB ) END IF SRNAMT = 'DGETSLS ' - CALL DGETSLS( TRANS, M, N, NRHS, A, + CALL DGETSLS( TRANS, M, N, NRHS, A, $ LDA, B, LDB, WORK, LWORK, INFO ) IF( INFO.NE.0 ) $ CALL ALAERH( PATH, 'DGETSLS ', INFO, 0, @@ -765,8 +765,8 @@ $ ', NB=', I4, ', type', I2, ', test(', I2, ')=', G12.5 ) 9998 FORMAT( ' M=', I5, ', N=', I5, ', NRHS=', I4, ', NB=', I4, $ ', type', I2, ', test(', I2, ')=', G12.5 ) - 9997 FORMAT( ' TRANS=''', A1,' M=', I5, ', N=', I5, ', NRHS=', I4, - $ ', MB=', I4,', NB=', I4,', type', I2, + 9997 FORMAT( ' TRANS=''', A1,' M=', I5, ', N=', I5, ', NRHS=', I4, + $ ', MB=', I4,', NB=', I4,', type', I2, $ ', test(', I2, ')=', G12.5 ) RETURN * diff --git a/TESTING/LIN/ddrvsy_aasen.f b/TESTING/LIN/ddrvsy_aasen.f index a3520cb..ab8b136 100644 --- a/TESTING/LIN/ddrvsy_aasen.f +++ b/TESTING/LIN/ddrvsy_aasen.f @@ -467,7 +467,7 @@ c END IF * residual. * CALL DSYT01_AASEN( UPLO, N, A, LDA, AFAC, LDA, - $ IWORK, AINV, LDA, RWORK, + $ IWORK, AINV, LDA, RWORK, $ RESULT( 1 ) ) * * Compute residual of the computed solution. diff --git a/TESTING/LIN/derrlqt.f b/TESTING/LIN/derrlqt.f index 5a768f0..926f419 100644 --- a/TESTING/LIN/derrlqt.f +++ b/TESTING/LIN/derrlqt.f @@ -2,19 +2,19 @@ * * =========== 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/ * * Definition: * =========== * * SUBROUTINE DERRLQT( PATH, NUNIT ) -* +* * .. Scalar Arguments .. * CHARACTER*3 PATH * INTEGER NUNIT * .. -* +* * *> \par Purpose: * ============= @@ -43,10 +43,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 * @@ -81,7 +81,7 @@ * .. * .. External Subroutines .. EXTERNAL ALAESM, CHKXER, DGELQT3, DGELQT, - $ DGEMLQT + $ DGEMLQT * .. * .. Scalars in Common .. LOGICAL LERR, OK diff --git a/TESTING/LIN/derrlqtp.f b/TESTING/LIN/derrlqtp.f index ae118af..b642c34 100644 --- a/TESTING/LIN/derrlqtp.f +++ b/TESTING/LIN/derrlqtp.f @@ -2,19 +2,19 @@ * * =========== 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/ * * Definition: * =========== * * SUBROUTINE DERRLQTP( PATH, NUNIT ) -* +* * .. Scalar Arguments .. * CHARACTER*3 PATH * INTEGER NUNIT * .. -* +* * *> \par Purpose: * ============= @@ -43,10 +43,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 * @@ -81,7 +81,7 @@ * .. * .. External Subroutines .. EXTERNAL ALAESM, CHKXER, DTPLQT2, DTPLQT, - $ DTPMLQT + $ DTPMLQT * .. * .. Scalars in Common .. LOGICAL LERR, OK @@ -171,46 +171,46 @@ * SRNAMT = 'DTPMLQT' INFOT = 1 - CALL DTPMLQT( '/', 'N', 0, 0, 0, 0, 1, A, 1, T, 1, B, 1, C, 1, + CALL DTPMLQT( '/', 'N', 0, 0, 0, 0, 1, A, 1, T, 1, B, 1, C, 1, $ W, INFO ) CALL CHKXER( 'DTPMLQT', INFOT, NOUT, LERR, OK ) INFOT = 2 - CALL DTPMLQT( 'L', '/', 0, 0, 0, 0, 1, A, 1, T, 1, B, 1, C, 1, + CALL DTPMLQT( 'L', '/', 0, 0, 0, 0, 1, A, 1, T, 1, B, 1, C, 1, $ W, INFO ) CALL CHKXER( 'DTPMLQT', INFOT, NOUT, LERR, OK ) INFOT = 3 - CALL DTPMLQT( 'L', 'N', -1, 0, 0, 0, 1, A, 1, T, 1, B, 1, C, 1, + CALL DTPMLQT( 'L', 'N', -1, 0, 0, 0, 1, A, 1, T, 1, B, 1, C, 1, $ W, INFO ) CALL CHKXER( 'DTPMLQT', INFOT, NOUT, LERR, OK ) INFOT = 4 - CALL DTPMLQT( 'L', 'N', 0, -1, 0, 0, 1, A, 1, T, 1, B, 1, C, 1, + CALL DTPMLQT( 'L', 'N', 0, -1, 0, 0, 1, A, 1, T, 1, B, 1, C, 1, $ W, INFO ) CALL CHKXER( 'DTPMLQT', INFOT, NOUT, LERR, OK ) INFOT = 5 - CALL DTPMLQT( 'L', 'N', 0, 0, -1, 0, 1, A, 1, T, 1, B, 1, C, 1, + CALL DTPMLQT( 'L', 'N', 0, 0, -1, 0, 1, A, 1, T, 1, B, 1, C, 1, $ W, INFO ) INFOT = 6 - CALL DTPMLQT( 'L', 'N', 0, 0, 0, -1, 1, A, 1, T, 1, B, 1, C, 1, + CALL DTPMLQT( 'L', 'N', 0, 0, 0, -1, 1, A, 1, T, 1, B, 1, C, 1, $ W, INFO ) CALL CHKXER( 'DTPMLQT', INFOT, NOUT, LERR, OK ) INFOT = 7 - CALL DTPMLQT( 'L', 'N', 0, 0, 0, 0, 0, A, 1, T, 1, B, 1, C, 1, + CALL DTPMLQT( 'L', 'N', 0, 0, 0, 0, 0, A, 1, T, 1, B, 1, C, 1, $ W, INFO ) CALL CHKXER( 'DTPMLQT', INFOT, NOUT, LERR, OK ) INFOT = 9 - CALL DTPMLQT( 'R', 'N', 2, 2, 2, 1, 1, A, 1, T, 1, B, 1, C, 1, + CALL DTPMLQT( 'R', 'N', 2, 2, 2, 1, 1, A, 1, T, 1, B, 1, C, 1, $ W, INFO ) CALL CHKXER( 'DTPMLQT', INFOT, NOUT, LERR, OK ) INFOT = 11 - CALL DTPMLQT( 'R', 'N', 1, 1, 1, 1, 1, A, 1, T, 0, B, 1, C, 1, + CALL DTPMLQT( 'R', 'N', 1, 1, 1, 1, 1, A, 1, T, 0, B, 1, C, 1, $ W, INFO ) CALL CHKXER( 'DTPMLQT', INFOT, NOUT, LERR, OK ) INFOT = 13 - CALL DTPMLQT( 'L', 'N', 1, 1, 1, 1, 1, A, 1, T, 1, B, 0, C, 1, + CALL DTPMLQT( 'L', 'N', 1, 1, 1, 1, 1, A, 1, T, 1, B, 0, C, 1, $ W, INFO ) CALL CHKXER( 'DTPMLQT', INFOT, NOUT, LERR, OK ) INFOT = 15 - CALL DTPMLQT( 'L', 'N', 1, 1, 1, 1, 1, A, 1, T, 1, B, 1, C, 0, + CALL DTPMLQT( 'L', 'N', 1, 1, 1, 1, 1, A, 1, T, 1, B, 1, C, 0, $ W, INFO ) CALL CHKXER( 'DTPMLQT', INFOT, NOUT, LERR, OK ) * diff --git a/TESTING/LIN/derrtsqr.f b/TESTING/LIN/derrtsqr.f index aa9f367..4a5ad5e 100644 --- a/TESTING/LIN/derrtsqr.f +++ b/TESTING/LIN/derrtsqr.f @@ -2,19 +2,19 @@ * * =========== 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/ * * Definition: * =========== * * SUBROUTINE DERRTSQR( PATH, NUNIT ) -* +* * .. Scalar Arguments .. * CHARACTER*3 PATH * INTEGER NUNIT * .. -* +* * *> \par Purpose: * ============= @@ -43,10 +43,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 * diff --git a/TESTING/LIN/dlqt04.f b/TESTING/LIN/dlqt04.f index 216ef3e..9e6e11c 100644 --- a/TESTING/LIN/dlqt04.f +++ b/TESTING/LIN/dlqt04.f @@ -2,19 +2,19 @@ * * =========== 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/ * * Definition: * =========== * * SUBROUTINE DLQT04(M,N,NB,RESULT) -* +* * .. Scalar Arguments .. * INTEGER M, N, NB, LDT * .. Return values .. * DOUBLE PRECISION RESULT(6) -* +* * *> \par Purpose: * ============= @@ -54,17 +54,17 @@ *> RESULT(2) = | I - Q Q^H | *> RESULT(3) = | Q C - Q C | *> RESULT(4) = | Q^H C - Q^H C | -*> RESULT(5) = | C Q - C Q | +*> RESULT(5) = | C Q - C Q | *> RESULT(6) = | C Q^H - C Q^H | *> \endverbatim * * Authors: * ======== * -*> \author Univ. of Tennessee -*> \author Univ. of California Berkeley -*> \author Univ. of Colorado Denver -*> \author NAG Ltd. +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. * *> \date April 2012 * @@ -87,9 +87,9 @@ * ===================================================================== * * .. -* .. Local allocatable arrays +* .. Local allocatable arrays DOUBLE PRECISION, ALLOCATABLE :: AF(:,:), Q(:,:), - $ L(:,:), RWORK(:), WORK( : ), T(:,:), + $ L(:,:), RWORK(:), WORK( : ), T(:,:), $ CF(:,:), DF(:,:), A(:,:), C(:,:), D(:,:) * * .. Parameters .. @@ -109,11 +109,11 @@ EXTERNAL DLAMCH, DLANGE, DLANSY, LSAME * .. * .. Intrinsic Functions .. - INTRINSIC MAX, MIN + INTRINSIC MAX, MIN * .. * .. Data statements .. - DATA ISEED / 1988, 1989, 1990, 1991 / -* + DATA ISEED / 1988, 1989, 1990, 1991 / +* EPS = DLAMCH( 'Epsilon' ) K = MIN(M,N) LL = MAX(M,N) @@ -121,8 +121,8 @@ * * Dynamically allocate local arrays * - ALLOCATE ( A(M,N), AF(M,N), Q(N,N), L(LL,N), RWORK(LL), - $ WORK(LWORK), T(NB,N), C(M,N), CF(M,N), + ALLOCATE ( A(M,N), AF(M,N), Q(N,N), L(LL,N), RWORK(LL), + $ WORK(LWORK), T(NB,N), C(M,N), CF(M,N), $ D(N,M), DF(N,M) ) * * Put random numbers into A and copy to AF @@ -140,7 +140,7 @@ * Generate the n-by-n matrix Q * CALL DLASET( 'Full', N, N, ZERO, ONE, Q, N ) - CALL DGEMLQT( 'R', 'N', N, N, K, NB, AF, M, T, LDT, Q, N, + CALL DGEMLQT( 'R', 'N', N, N, K, NB, AF, M, T, LDT, Q, N, $ WORK, INFO ) * * Copy R @@ -176,7 +176,7 @@ * * Apply Q to C as Q*C * - CALL DGEMLQT( 'L', 'N', N, M, K, NB, AF, M, T, NB, DF, N, + CALL DGEMLQT( 'L', 'N', N, M, K, NB, AF, M, T, NB, DF, N, $ WORK, INFO) * * Compute |Q*D - Q*D| / |D| @@ -195,7 +195,7 @@ * * Apply Q to D as QT*D * - CALL DGEMLQT( 'L', 'T', N, M, K, NB, AF, M, T, NB, DF, N, + CALL DGEMLQT( 'L', 'T', N, M, K, NB, AF, M, T, NB, DF, N, $ WORK, INFO) * * Compute |QT*D - QT*D| / |D| @@ -206,7 +206,7 @@ RESULT( 4 ) = RESID / (EPS*MAX(1,M)*DNORM) ELSE RESULT( 4 ) = ZERO - END IF + END IF * * Generate random n-by-m matrix D and a copy DF * @@ -218,8 +218,8 @@ * * Apply Q to C as C*Q * - CALL DGEMLQT( 'R', 'N', M, N, K, NB, AF, M, T, NB, CF, M, - $ WORK, INFO) + CALL DGEMLQT( 'R', 'N', M, N, K, NB, AF, M, T, NB, CF, M, + $ WORK, INFO) * * Compute |C*Q - C*Q| / |C| * @@ -237,8 +237,8 @@ * * Apply Q to D as D*QT * - CALL DGEMLQT( 'R', 'T', M, N, K, NB, AF, M, T, NB, CF, M, - $ WORK, INFO) + CALL DGEMLQT( 'R', 'T', M, N, K, NB, AF, M, T, NB, CF, M, + $ WORK, INFO) * * Compute |C*QT - C*QT| / |C| * diff --git a/TESTING/LIN/dlqt05.f b/TESTING/LIN/dlqt05.f index b357dcb..88681eb 100644 --- a/TESTING/LIN/dlqt05.f +++ b/TESTING/LIN/dlqt05.f @@ -2,19 +2,19 @@ * * =========== 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/ * * Definition: * =========== * * SUBROUTINE DLQT05(M,N,L,NB,RESULT) -* +* * .. Scalar Arguments .. * INTEGER LWORK, M, N, L, NB, LDT * .. Return values .. * DOUBLE PRECISION RESULT(6) -* +* * *> \par Purpose: * ============= @@ -45,7 +45,7 @@ *> The number of rows of the upper trapezoidal part the *> lower test matrix. 0 <= L <= M. *> \endverbatim -*> +*> *> \param[in] NB *> \verbatim *> NB is INTEGER @@ -61,17 +61,17 @@ *> RESULT(2) = | I - Q^H Q | *> RESULT(3) = | Q C - Q C | *> RESULT(4) = | Q^H C - Q^H C | -*> RESULT(5) = | C Q - C Q | +*> RESULT(5) = | C Q - C Q | *> RESULT(6) = | C Q^H - C Q^H | *> \endverbatim * * Authors: * ======== * -*> \author Univ. of Tennessee -*> \author Univ. of California Berkeley -*> \author Univ. of Colorado Denver -*> \author NAG Ltd. +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. * *> \date April 2012 * @@ -92,11 +92,11 @@ DOUBLE PRECISION RESULT(6) * * ===================================================================== -* +* * .. -* .. Local allocatable arrays +* .. Local allocatable arrays DOUBLE PRECISION, ALLOCATABLE :: AF(:,:), Q(:,:), - $ R(:,:), RWORK(:), WORK( : ), T(:,:), + $ R(:,:), RWORK(:), WORK( : ), T(:,:), $ CF(:,:), DF(:,:), A(:,:), C(:,:), D(:,:) * * .. Parameters .. @@ -117,7 +117,7 @@ * .. * .. Data statements .. DATA ISEED / 1988, 1989, 1990, 1991 / -* +* EPS = DLAMCH( 'Epsilon' ) K = M N2 = M+N @@ -131,7 +131,7 @@ * Dynamically allocate all arrays * ALLOCATE(A(M,N2),AF(M,N2),Q(N2,N2),R(N2,N2),RWORK(N2), - $ WORK(LWORK),T(NB,M),C(N2,M),CF(N2,M), + $ WORK(LWORK),T(NB,M),C(N2,M),CF(N2,M), $ D(M,N2),DF(M,N2) ) * * Put random stuff into A @@ -149,7 +149,7 @@ END IF IF( L.GT.0 ) THEN DO J=1,L - CALL DLARNV( 2, ISEED, M-J+1, A( J, MIN(N+M,N+M-L+1) + CALL DLARNV( 2, ISEED, M-J+1, A( J, MIN(N+M,N+M-L+1) $ + J - 1 ) ) END DO END IF @@ -201,7 +201,7 @@ CALL DLACPY( 'Full', N2, M, C, N2, CF, N2 ) * * Apply Q to C as Q*C -* +* CALL DTPMLQT( 'L','N', N,M,K,L,NB,AF(1, NP1),M,T,LDT,CF,N2, $ CF(NP1,1),N2,WORK,INFO) * @@ -223,18 +223,18 @@ * Apply Q to C as QT*C * CALL DTPMLQT( 'L','T',N,M,K,L,NB,AF(1,NP1),M,T,LDT,CF,N2, - $ CF(NP1,1),N2,WORK,INFO) + $ CF(NP1,1),N2,WORK,INFO) * * Compute |QT*C - QT*C| / |C| * CALL DGEMM('T','N',N2,M,N2,-ONE,Q,N2,C,N2,ONE,CF,N2) RESID = DLANGE( '1', N2, M, CF, N2, RWORK ) - + IF( CNORM.GT.ZERO ) THEN RESULT( 4 ) = RESID / (EPS*MAX(1,N2)*CNORM) ELSE RESULT( 4 ) = ZERO - END IF + END IF * * Generate random m-by-n matrix D and a copy DF * @@ -266,8 +266,8 @@ * Apply Q to D as D*QT * CALL DTPMLQT('R','T',M,N,K,L,NB,AF(1,NP1),M,T,LDT,DF,M, - $ DF(1,NP1),M,WORK,INFO) - + $ DF(1,NP1),M,WORK,INFO) + * * Compute |D*QT - D*QT| / |D| * @@ -283,4 +283,4 @@ * DEALLOCATE ( A, AF, Q, R, RWORK, WORK, T, C, D, CF, DF) RETURN - END \ No newline at end of file + END diff --git a/TESTING/LIN/dtplqt.f b/TESTING/LIN/dtplqt.f index 2796544..a233eb1 100644 --- a/TESTING/LIN/dtplqt.f +++ b/TESTING/LIN/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 -*> -*> [TGZ] -*> -*> [ZIP] -*> +*> Download DTPQRT + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> *> [TXT] -*> \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/TESTING/LIN/dtsqr01.f b/TESTING/LIN/dtsqr01.f index 29d4b63..a9ac163 100644 --- a/TESTING/LIN/dtsqr01.f +++ b/TESTING/LIN/dtsqr01.f @@ -2,19 +2,19 @@ * * =========== 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/ * * Definition: * =========== * * SUBROUTINE DTSQR01(TSSW, M,N, MB, NB, RESULT) -* +* * .. Scalar Arguments .. * INTEGER M, N, MB * .. Return values .. * DOUBLE PRECISION RESULT(6) -* +* * *> \par Purpose: * ============= @@ -65,17 +65,17 @@ *> RESULT(2) = | I - Q^H Q | or | I - Q Q^H | *> RESULT(3) = | Q C - Q C | *> RESULT(4) = | Q^H C - Q^H C | -*> RESULT(5) = | C Q - C Q | +*> RESULT(5) = | C Q - C Q | *> RESULT(6) = | C Q^H - C Q^H | *> \endverbatim * * Authors: * ======== * -*> \author Univ. of Tennessee -*> \author Univ. of California Berkeley -*> \author Univ. of Colorado Denver -*> \author NAG Ltd. +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. * *> \date April 2012 * @@ -99,9 +99,9 @@ * ===================================================================== * * .. -* .. Local allocatable arrays +* .. Local allocatable arrays DOUBLE PRECISION, ALLOCATABLE :: AF(:,:), Q(:,:), - $ R(:,:), RWORK(:), WORK( : ), T(:), + $ R(:,:), RWORK(:), WORK( : ), T(:), $ CF(:,:), DF(:,:), A(:,:), C(:,:), D(:,:), LQ(:,:) * * .. Parameters .. @@ -123,24 +123,24 @@ EXTERNAL DLAMCH, DLANGE, DLANSY, LSAME, ILAENV * .. * .. Intrinsic Functions .. - INTRINSIC MAX, MIN + INTRINSIC MAX, MIN * .. Scalars in Common .. CHARACTER*32 srnamt * .. * .. Common blocks .. - COMMON / srnamc / srnamt + COMMON / srnamc / srnamt * .. * .. Data statements .. - DATA ISEED / 1988, 1989, 1990, 1991 / + DATA ISEED / 1988, 1989, 1990, 1991 / * * TEST TALL SKINNY OR SHORT WIDE * TS = LSAME(TSSW, 'TS') -* +* * TEST MATRICES WITH HALF OF MATRIX BEING ZEROS * TESTZEROS = .FALSE. -* +* EPS = DLAMCH( 'Epsilon' ) K = MIN(M,N) L = MAX(M,N,1) @@ -149,14 +149,14 @@ IF((K.GE.MNB).OR.(MNB.GE.L))THEN LT=MAX(1,L)*MNB+5 ELSE - LT=MAX(1,(L-K)/(MNB-K)+1)*L*MNB+5 + LT=MAX(1,(L-K)/(MNB-K)+1)*L*MNB+5 END IF * * Dynamically allocate local arrays * - ALLOCATE ( A(M,N), AF(M,N), Q(L,L), R(M,L), RWORK(L), - $ WORK(LWORK), T(LT), C(M,N), CF(M,N), + ALLOCATE ( A(M,N), AF(M,N), Q(L,L), R(M,L), RWORK(L), + $ WORK(LWORK), T(LT), C(M,N), CF(M,N), $ D(N,M), DF(N,M), LQ(L,N) ) * * Put random numbers into A and copy to AF @@ -184,7 +184,7 @@ * CALL DLASET( 'Full', M, M, ZERO, ONE, Q, M ) srnamt = 'DGEMQR' - CALL DGEMQR( 'L', 'N', M, M, K, AF, M, T, LT, Q, M, + CALL DGEMQR( 'L', 'N', M, M, K, AF, M, T, LT, Q, M, $ WORK, LWORK, INFO ) * * Copy R @@ -221,7 +221,7 @@ * Apply Q to C as Q*C * srnamt = 'DGEMQR' - CALL DGEMQR( 'L', 'N', M, N, K, AF, M, T, LT, CF, M, + CALL DGEMQR( 'L', 'N', M, N, K, AF, M, T, LT, CF, M, $ WORK, LWORK, INFO) * * Compute |Q*C - Q*C| / |C| @@ -241,7 +241,7 @@ * Apply Q to C as QT*C * srnamt = 'DGEMQR' - CALL DGEMQR( 'L', 'T', M, N, K, AF, M, T, LT, CF, M, + CALL DGEMQR( 'L', 'T', M, N, K, AF, M, T, LT, CF, M, $ WORK, LWORK, INFO) * * Compute |QT*C - QT*C| / |C| @@ -252,7 +252,7 @@ RESULT( 4 ) = RESID / (EPS*MAX(1,M)*CNORM) ELSE RESULT( 4 ) = ZERO - END IF + END IF * * Generate random n-by-m matrix D and a copy DF * @@ -265,8 +265,8 @@ * Apply Q to D as D*Q * srnamt = 'DGEMQR' - CALL DGEMQR( 'R', 'N', N, M, K, AF, M, T, LT, DF, N, - $ WORK, LWORK, INFO) + CALL DGEMQR( 'R', 'N', N, M, K, AF, M, T, LT, DF, N, + $ WORK, LWORK, INFO) * * Compute |D*Q - D*Q| / |D| * @@ -284,8 +284,8 @@ * * Apply Q to D as D*QT * - CALL DGEMQR( 'R', 'T', N, M, K, AF, M, T, LT, DF, N, - $ WORK, LWORK, INFO) + CALL DGEMQR( 'R', 'T', N, M, K, AF, M, T, LT, DF, N, + $ WORK, LWORK, INFO) * * Compute |D*QT - D*QT| / |D| * @@ -308,7 +308,7 @@ * CALL DLASET( 'Full', N, N, ZERO, ONE, Q, N ) srnamt = 'DGEMLQ' - CALL DGEMLQ( 'R', 'N', N, N, K, AF, M, T, LT, Q, N, + CALL DGEMLQ( 'R', 'N', N, N, K, AF, M, T, LT, Q, N, $ WORK, LWORK, INFO ) * * Copy R @@ -344,7 +344,7 @@ * * Apply Q to C as Q*C * - CALL DGEMLQ( 'L', 'N', N, M, K, AF, M, T, LT, DF, N, + CALL DGEMLQ( 'L', 'N', N, M, K, AF, M, T, LT, DF, N, $ WORK, LWORK, INFO) * * Compute |Q*D - Q*D| / |D| @@ -363,7 +363,7 @@ * * Apply Q to D as QT*D * - CALL DGEMLQ( 'L', 'T', N, M, K, AF, M, T, LT, DF, N, + CALL DGEMLQ( 'L', 'T', N, M, K, AF, M, T, LT, DF, N, $ WORK, LWORK, INFO) * * Compute |QT*D - QT*D| / |D| @@ -374,7 +374,7 @@ RESULT( 4 ) = RESID / (EPS*MAX(1,N)*DNORM) ELSE RESULT( 4 ) = ZERO - END IF + END IF * * Generate random n-by-m matrix D and a copy DF * @@ -386,8 +386,8 @@ * * Apply Q to C as C*Q * - CALL DGEMLQ( 'R', 'N', M, N, K, AF, M, T, LT, CF, M, - $ WORK, LWORK, INFO) + CALL DGEMLQ( 'R', 'N', M, N, K, AF, M, T, LT, CF, M, + $ WORK, LWORK, INFO) * * Compute |C*Q - C*Q| / |C| * @@ -405,8 +405,8 @@ * * Apply Q to D as D*QT * - CALL DGEMLQ( 'R', 'T', M, N, K, AF, M, T, LT, CF, M, - $ WORK, LWORK, INFO) + CALL DGEMLQ( 'R', 'T', M, N, K, AF, M, T, LT, CF, M, + $ WORK, LWORK, INFO) * * Compute |C*QT - C*QT| / |C| * @@ -425,4 +425,4 @@ DEALLOCATE ( A, AF, Q, R, RWORK, WORK, T, C, D, CF, DF) * RETURN - END \ No newline at end of file + END diff --git a/TESTING/LIN/schkaa.f b/TESTING/LIN/schkaa.f index b58a3a6..de4efb6 100644 --- a/TESTING/LIN/schkaa.f +++ b/TESTING/LIN/schkaa.f @@ -906,7 +906,7 @@ * QX: QRT routines for triangular-pentagonal matrices * IF( TSTCHK ) THEN - CALL SCHKQRTP( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, + CALL SCHKQRTP( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, $ NBVAL, NOUT ) ELSE WRITE( NOUT, FMT = 9989 )PATH @@ -917,7 +917,7 @@ * TQ: LQT routines for general matrices * IF( TSTCHK ) THEN - CALL SCHKLQT( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, + CALL SCHKLQT( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, $ NBVAL, NOUT ) ELSE WRITE( NOUT, FMT = 9989 )PATH @@ -928,7 +928,7 @@ * XQ: LQT routines for triangular-pentagonal matrices * IF( TSTCHK ) THEN - CALL SCHKLQTP( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, + CALL SCHKLQTP( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, $ NBVAL, NOUT ) ELSE WRITE( NOUT, FMT = 9989 )PATH @@ -939,7 +939,7 @@ * TS: QR routines for tall-skinny matrices * IF( TSTCHK ) THEN - CALL SCHKTSQR( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, + CALL SCHKTSQR( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, $ NBVAL, NOUT ) ELSE WRITE( NOUT, FMT = 9989 )PATH diff --git a/TESTING/LIN/schklqt.f b/TESTING/LIN/schklqt.f index fd449b1..5e96546 100644 --- a/TESTING/LIN/schklqt.f +++ b/TESTING/LIN/schklqt.f @@ -2,15 +2,15 @@ * * =========== 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/ * * Definition: * =========== * -* SUBROUTINE SCHKLQT( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, +* SUBROUTINE SCHKLQT( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, * NBVAL, NOUT ) -* +* * .. Scalar Arguments .. * LOGICAL TSTERR * INTEGER NM, NN, NNB, NOUT @@ -89,17 +89,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 2011 * *> \ingroup double_lin * * ===================================================================== - SUBROUTINE SCHKLQT( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, + SUBROUTINE SCHKLQT( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, $ NBVAL, NOUT ) IMPLICIT NONE * @@ -175,7 +175,7 @@ NB = NBVAL( K ) * * Test DGELQT and DGEMLQT -* +* IF( (NB.LE.MINMN).AND.(NB.GT.0) ) THEN CALL SLQT04( M, N, NB, RESULT ) * diff --git a/TESTING/LIN/schklqtp.f b/TESTING/LIN/schklqtp.f index d85ef8d..be6b84b 100644 --- a/TESTING/LIN/schklqtp.f +++ b/TESTING/LIN/schklqtp.f @@ -2,13 +2,13 @@ * * =========== 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/ * * Definition: * =========== * -* SUBROUTINE SCHKLQTP( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, +* SUBROUTINE SCHKLQTP( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, * NBVAL, NOUT ) * * .. Scalar Arguments .. @@ -89,17 +89,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 2011 * *> \ingroup double_lin * * ===================================================================== - SUBROUTINE SCHKLQTP( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, + SUBROUTINE SCHKLQTP( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, $ NBVAL, NOUT ) IMPLICIT NONE * @@ -172,14 +172,14 @@ * MINMN = MIN( M, N ) DO L = 0, MINMN, MAX( MINMN, 1 ) -* +* * Do for each possible value of NB * DO K = 1, NNB NB = NBVAL( K ) * * Test DTPLQT and DTPMLQT -* +* IF( (NB.LE.M).AND.(NB.GT.0) ) THEN CALL SLQT05( M, N, L, NB, RESULT ) * diff --git a/TESTING/LIN/schksy_aasen.f b/TESTING/LIN/schksy_aasen.f index 659e3fd..949f811 100644 --- a/TESTING/LIN/schksy_aasen.f +++ b/TESTING/LIN/schksy_aasen.f @@ -431,7 +431,7 @@ * SRNAMT = 'SSYTRF_AASEN' LWORK = N*NB + N - CALL SSYTRF_AASEN( UPLO, N, AFAC, LDA, IWORK, AINV, + CALL SSYTRF_AASEN( UPLO, N, AFAC, LDA, IWORK, AINV, $ LWORK, INFO ) * * Adjust the expected value of INFO to account for @@ -457,8 +457,8 @@ * Check error code from SSYTRF and handle error. * IF( INFO.NE.K ) THEN - CALL ALAERH( PATH, 'SSYTRF_AASEN', INFO, K, UPLO, - $ N, N, -1, -1, NB, IMAT, NFAIL, NERRS, + CALL ALAERH( PATH, 'SSYTRF_AASEN', INFO, K, UPLO, + $ N, N, -1, -1, NB, IMAT, NFAIL, NERRS, $ NOUT ) END IF * @@ -518,7 +518,7 @@ * SRNAMT = 'SSYTRS_AASEN' LWORK = 3*N-2 - CALL SSYTRS_AASEN( UPLO, N, NRHS, AFAC, LDA, + CALL SSYTRS_AASEN( UPLO, N, NRHS, AFAC, LDA, $ IWORK, X, LDA, WORK, LWORK, $ INFO ) * @@ -526,7 +526,7 @@ * IF( INFO.NE.0 ) THEN CALL ALAERH( PATH, 'SSYTRS_AASEN', INFO, 0, - $ UPLO, N, N, -1, -1, NRHS, IMAT, + $ UPLO, N, N, -1, -1, NRHS, IMAT, $ NFAIL, NERRS, NOUT ) END IF * diff --git a/TESTING/LIN/schktsqr.f b/TESTING/LIN/schktsqr.f index a430314..3bb238f 100644 --- a/TESTING/LIN/schktsqr.f +++ b/TESTING/LIN/schktsqr.f @@ -2,15 +2,15 @@ * * =========== 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/ * * Definition: * =========== * -* SUBROUTINE SCHKTSQR( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, +* SUBROUTINE SCHKTSQR( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, * NBVAL, NOUT ) -* +* * .. Scalar Arguments .. * LOGICAL TSTERR * INTEGER NM, NN, NNB, NOUT @@ -89,17 +89,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 2011 * *> \ingroup double_lin * * ===================================================================== - SUBROUTINE SCHKTSQR( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, + SUBROUTINE SCHKTSQR( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, $ NBVAL, NOUT ) IMPLICIT NONE * @@ -132,11 +132,11 @@ REAL RESULT( NTESTS ) * .. * .. External Subroutines .. - EXTERNAL ALAERH, ALAHD, ALASUM, SERRTSQR, + EXTERNAL ALAERH, ALAHD, ALASUM, SERRTSQR, $ STSQR01, XLAENV * .. * .. Intrinsic Functions .. - INTRINSIC MAX, MIN + INTRINSIC MAX, MIN * .. * .. Scalars in Common .. LOGICAL LERR, OK @@ -172,7 +172,7 @@ DO J = 1, NN N = NVAL( J ) IF (MIN(M,N).NE.0) THEN - DO INB = 1, NNB + DO INB = 1, NNB MB = NBVAL( INB ) CALL XLAENV( 1, MB ) DO IMB = 1, NNB @@ -180,7 +180,7 @@ CALL XLAENV( 2, NB ) * * Test SGEQR and SGEMQR -* +* CALL STSQR01('TS', M, N, MB, NB, RESULT ) * * Print information about the tests that did not @@ -197,7 +197,7 @@ END DO NRUN = NRUN + NTESTS END DO - END DO + END DO END IF END DO END DO @@ -212,7 +212,7 @@ DO J = 1, NN N = NVAL( J ) IF (MIN(M,N).NE.0) THEN - DO INB = 1, NNB + DO INB = 1, NNB MB = NBVAL( INB ) CALL XLAENV( 1, MB ) DO IMB = 1, NNB @@ -220,7 +220,7 @@ CALL XLAENV( 2, NB ) * * Test SGEQR and SGEMQR -* +* CALL STSQR01('SW', M, N, MB, NB, RESULT ) * * Print information about the tests that did not @@ -236,9 +236,9 @@ END IF END DO NRUN = NRUN + NTESTS - END DO - END DO - END IF + END DO + END DO + END IF END DO END DO * diff --git a/TESTING/LIN/sdrvls.f b/TESTING/LIN/sdrvls.f index 372ec9f..0359893 100644 --- a/TESTING/LIN/sdrvls.f +++ b/TESTING/LIN/sdrvls.f @@ -234,9 +234,9 @@ * .. Local Scalars .. CHARACTER TRANS CHARACTER*3 PATH - INTEGER CRANK, I, IM, IMB, IN, INB, INFO, INS, IRANK, - $ ISCALE, ITRAN, ITYPE, J, K, LDA, LDB, LDWORK, - $ LWLSY, LWORK, M, MNMIN, N, NB, NCOLS, NERRS, + INTEGER CRANK, I, IM, IMB, IN, INB, INFO, INS, IRANK, + $ ISCALE, ITRAN, ITYPE, J, K, LDA, LDB, LDWORK, + $ LWLSY, LWORK, M, MNMIN, N, NB, NCOLS, NERRS, $ NFAIL, NLVL, NRHS, NROWS, NRUN, RANK, MB, LWTS REAL EPS, NORMA, NORMB, RCOND * .. @@ -324,7 +324,7 @@ LWORK = MAX( 1, ( M+NRHS )*( N+2 ), ( N+NRHS )*( M+2 ), $ M*N+4*MNMIN+MAX( M, N ), 12*MNMIN+2*MNMIN*SMLSIZ+ $ 8*MNMIN*NLVL+MNMIN*NRHS+(SMLSIZ+1)**2,LWTS) - $ + $ * DO 120 IRANK = 1, 2 DO 110 ISCALE = 1, 3 @@ -446,7 +446,7 @@ CALL XLAENV( 1, MB ) DO 62 IMB = 1, NNB NB = NBVAL( IMB ) - CALL XLAENV( 2, NB ) + CALL XLAENV( 2, NB ) * DO 60 ITRAN = 1, 2 IF( ITRAN.EQ.1 ) THEN @@ -484,7 +484,7 @@ $ COPYB, LDB, B, LDB ) END IF SRNAMT = 'SGETSLS ' - CALL SGETSLS( TRANS, M, N, NRHS, A, + CALL SGETSLS( TRANS, M, N, NRHS, A, $ LDA, B, LDB, WORK, LWORK, INFO ) IF( INFO.NE.0 ) $ CALL ALAERH( PATH, 'SGETSLS ', INFO, 0, @@ -765,8 +765,8 @@ $ ', NB=', I4, ', type', I2, ', test(', I2, ')=', G12.5 ) 9998 FORMAT( ' M=', I5, ', N=', I5, ', NRHS=', I4, ', NB=', I4, $ ', type', I2, ', test(', I2, ')=', G12.5 ) - 9997 FORMAT( ' TRANS=''', A1,' M=', I5, ', N=', I5, ', NRHS=', I4, - $ ', MB=', I4,', NB=', I4,', type', I2, + 9997 FORMAT( ' TRANS=''', A1,' M=', I5, ', N=', I5, ', NRHS=', I4, + $ ', MB=', I4,', NB=', I4,', type', I2, $ ', test(', I2, ')=', G12.5 ) RETURN * diff --git a/TESTING/LIN/sdrvsy_aasen.f b/TESTING/LIN/sdrvsy_aasen.f index afa5dc4..6de06fd 100644 --- a/TESTING/LIN/sdrvsy_aasen.f +++ b/TESTING/LIN/sdrvsy_aasen.f @@ -455,8 +455,8 @@ c END IF * Check error code from SSYSV_AASEN . * IF( INFO.NE.K ) THEN - CALL ALAERH( PATH, 'SSYSV_AASEN ', INFO, K, - $ UPLO, N, N, -1, -1, NRHS, + CALL ALAERH( PATH, 'SSYSV_AASEN ', INFO, K, + $ UPLO, N, N, -1, -1, NRHS, $ IMAT, NFAIL, NERRS, NOUT ) GO TO 120 ELSE IF( INFO.NE.0 ) THEN @@ -467,7 +467,7 @@ c END IF * residual. * CALL SSYT01_AASEN( UPLO, N, A, LDA, AFAC, LDA, - $ IWORK, AINV, LDA, RWORK, + $ IWORK, AINV, LDA, RWORK, $ RESULT( 1 ) ) * * Compute residual of the computed solution. diff --git a/TESTING/LIN/serrlqt.f b/TESTING/LIN/serrlqt.f index 2c2c575..d73f990 100644 --- a/TESTING/LIN/serrlqt.f +++ b/TESTING/LIN/serrlqt.f @@ -2,19 +2,19 @@ * * =========== 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/ * * Definition: * =========== * * SUBROUTINE SERRLQT( PATH, NUNIT ) -* +* * .. Scalar Arguments .. * CHARACTER*3 PATH * INTEGER NUNIT * .. -* +* * *> \par Purpose: * ============= @@ -43,10 +43,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 * @@ -81,7 +81,7 @@ * .. * .. External Subroutines .. EXTERNAL ALAESM, CHKXER, SGELQT3, SGELQT, - $ SGEMLQT + $ SGEMLQT * .. * .. Scalars in Common .. LOGICAL LERR, OK diff --git a/TESTING/LIN/serrlqtp.f b/TESTING/LIN/serrlqtp.f index 319ee91..782de11 100644 --- a/TESTING/LIN/serrlqtp.f +++ b/TESTING/LIN/serrlqtp.f @@ -2,19 +2,19 @@ * * =========== 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/ * * Definition: * =========== * * SUBROUTINE SERRLQTP( PATH, NUNIT ) -* +* * .. Scalar Arguments .. * CHARACTER*3 PATH * INTEGER NUNIT * .. -* +* * *> \par Purpose: * ============= @@ -43,10 +43,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 * @@ -81,7 +81,7 @@ * .. * .. External Subroutines .. EXTERNAL ALAESM, CHKXER, STPLQT2, STPLQT, - $ STPMLQT + $ STPMLQT * .. * .. Scalars in Common .. LOGICAL LERR, OK @@ -171,46 +171,46 @@ * SRNAMT = 'STPMLQT' INFOT = 1 - CALL STPMLQT( '/', 'N', 0, 0, 0, 0, 1, A, 1, T, 1, B, 1, C, 1, + CALL STPMLQT( '/', 'N', 0, 0, 0, 0, 1, A, 1, T, 1, B, 1, C, 1, $ W, INFO ) CALL CHKXER( 'STPMLQT', INFOT, NOUT, LERR, OK ) INFOT = 2 - CALL STPMLQT( 'L', '/', 0, 0, 0, 0, 1, A, 1, T, 1, B, 1, C, 1, + CALL STPMLQT( 'L', '/', 0, 0, 0, 0, 1, A, 1, T, 1, B, 1, C, 1, $ W, INFO ) CALL CHKXER( 'STPMLQT', INFOT, NOUT, LERR, OK ) INFOT = 3 - CALL STPMLQT( 'L', 'N', -1, 0, 0, 0, 1, A, 1, T, 1, B, 1, C, 1, + CALL STPMLQT( 'L', 'N', -1, 0, 0, 0, 1, A, 1, T, 1, B, 1, C, 1, $ W, INFO ) CALL CHKXER( 'STPMLQT', INFOT, NOUT, LERR, OK ) INFOT = 4 - CALL STPMLQT( 'L', 'N', 0, -1, 0, 0, 1, A, 1, T, 1, B, 1, C, 1, + CALL STPMLQT( 'L', 'N', 0, -1, 0, 0, 1, A, 1, T, 1, B, 1, C, 1, $ W, INFO ) CALL CHKXER( 'STPMLQT', INFOT, NOUT, LERR, OK ) INFOT = 5 - CALL STPMLQT( 'L', 'N', 0, 0, -1, 0, 1, A, 1, T, 1, B, 1, C, 1, + CALL STPMLQT( 'L', 'N', 0, 0, -1, 0, 1, A, 1, T, 1, B, 1, C, 1, $ W, INFO ) INFOT = 6 - CALL STPMLQT( 'L', 'N', 0, 0, 0, -1, 1, A, 1, T, 1, B, 1, C, 1, + CALL STPMLQT( 'L', 'N', 0, 0, 0, -1, 1, A, 1, T, 1, B, 1, C, 1, $ W, INFO ) CALL CHKXER( 'STPMLQT', INFOT, NOUT, LERR, OK ) INFOT = 7 - CALL STPMLQT( 'L', 'N', 0, 0, 0, 0, 0, A, 1, T, 1, B, 1, C, 1, + CALL STPMLQT( 'L', 'N', 0, 0, 0, 0, 0, A, 1, T, 1, B, 1, C, 1, $ W, INFO ) CALL CHKXER( 'STPMLQT', INFOT, NOUT, LERR, OK ) INFOT = 9 - CALL STPMLQT( 'R', 'N', 2, 2, 2, 1, 1, A, 1, T, 1, B, 1, C, 1, + CALL STPMLQT( 'R', 'N', 2, 2, 2, 1, 1, A, 1, T, 1, B, 1, C, 1, $ W, INFO ) CALL CHKXER( 'STPMLQT', INFOT, NOUT, LERR, OK ) INFOT = 11 - CALL STPMLQT( 'R', 'N', 1, 1, 1, 1, 1, A, 1, T, 0, B, 1, C, 1, + CALL STPMLQT( 'R', 'N', 1, 1, 1, 1, 1, A, 1, T, 0, B, 1, C, 1, $ W, INFO ) CALL CHKXER( 'STPMLQT', INFOT, NOUT, LERR, OK ) INFOT = 13 - CALL STPMLQT( 'L', 'N', 1, 1, 1, 1, 1, A, 1, T, 1, B, 0, C, 1, + CALL STPMLQT( 'L', 'N', 1, 1, 1, 1, 1, A, 1, T, 1, B, 0, C, 1, $ W, INFO ) CALL CHKXER( 'STPMLQT', INFOT, NOUT, LERR, OK ) INFOT = 15 - CALL STPMLQT( 'L', 'N', 1, 1, 1, 1, 1, A, 1, T, 1, B, 1, C, 0, + CALL STPMLQT( 'L', 'N', 1, 1, 1, 1, 1, A, 1, T, 1, B, 1, C, 0, $ W, INFO ) CALL CHKXER( 'STPMLQT', INFOT, NOUT, LERR, OK ) * diff --git a/TESTING/LIN/serrtsqr.f b/TESTING/LIN/serrtsqr.f index 0ba3797..eddadbe 100644 --- a/TESTING/LIN/serrtsqr.f +++ b/TESTING/LIN/serrtsqr.f @@ -2,19 +2,19 @@ * * =========== 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/ * * Definition: * =========== * * SUBROUTINE SERRTSQR( PATH, NUNIT ) -* +* * .. Scalar Arguments .. * CHARACTER*3 PATH * INTEGER NUNIT * .. -* +* * *> \par Purpose: * ============= @@ -43,10 +43,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 * diff --git a/TESTING/LIN/slqt04.f b/TESTING/LIN/slqt04.f index debae5c..2f4637b 100644 --- a/TESTING/LIN/slqt04.f +++ b/TESTING/LIN/slqt04.f @@ -2,19 +2,19 @@ * * =========== 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/ * * Definition: * =========== * * SUBROUTINE SLQT04(M,N,NB,RESULT) -* +* * .. Scalar Arguments .. * INTEGER M, N, NB, LDT * .. Return values .. * REAL RESULT(6) -* +* * *> \par Purpose: * ============= @@ -54,17 +54,17 @@ *> RESULT(2) = | I - Q Q^H | *> RESULT(3) = | Q C - Q C | *> RESULT(4) = | Q^H C - Q^H C | -*> RESULT(5) = | C Q - C Q | +*> RESULT(5) = | C Q - C Q | *> RESULT(6) = | C Q^H - C Q^H | *> \endverbatim * * Authors: * ======== * -*> \author Univ. of Tennessee -*> \author Univ. of California Berkeley -*> \author Univ. of Colorado Denver -*> \author NAG Ltd. +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. * *> \date April 2012 * @@ -87,9 +87,9 @@ * ===================================================================== * * .. -* .. Local allocatable arrays +* .. Local allocatable arrays REAL, ALLOCATABLE :: AF(:,:), Q(:,:), - $ L(:,:), RWORK(:), WORK( : ), T(:,:), + $ L(:,:), RWORK(:), WORK( : ), T(:,:), $ CF(:,:), DF(:,:), A(:,:), C(:,:), D(:,:) * * .. Parameters .. @@ -109,11 +109,11 @@ EXTERNAL SLAMCH, SLANGE, SLANSY, LSAME * .. * .. Intrinsic Functions .. - INTRINSIC MAX, MIN + INTRINSIC MAX, MIN * .. * .. Data statements .. - DATA ISEED / 1988, 1989, 1990, 1991 / -* + DATA ISEED / 1988, 1989, 1990, 1991 / +* EPS = SLAMCH( 'Epsilon' ) K = MIN(M,N) LL = MAX(M,N) @@ -121,8 +121,8 @@ * * Dynamically allocate local arrays * - ALLOCATE ( A(M,N), AF(M,N), Q(N,N), L(LL,N), RWORK(LL), - $ WORK(LWORK), T(NB,N), C(M,N), CF(M,N), + ALLOCATE ( A(M,N), AF(M,N), Q(N,N), L(LL,N), RWORK(LL), + $ WORK(LWORK), T(NB,N), C(M,N), CF(M,N), $ D(N,M), DF(N,M) ) * * Put random numbers into A and copy to AF @@ -140,7 +140,7 @@ * Generate the n-by-n matrix Q * CALL SLASET( 'Full', N, N, ZERO, ONE, Q, N ) - CALL SGEMLQT( 'R', 'N', N, N, K, NB, AF, M, T, LDT, Q, N, + CALL SGEMLQT( 'R', 'N', N, N, K, NB, AF, M, T, LDT, Q, N, $ WORK, INFO ) * * Copy R @@ -176,7 +176,7 @@ * * Apply Q to C as Q*C * - CALL SGEMLQT( 'L', 'N', N, M, K, NB, AF, M, T, NB, DF, N, + CALL SGEMLQT( 'L', 'N', N, M, K, NB, AF, M, T, NB, DF, N, $ WORK, INFO) * * Compute |Q*D - Q*D| / |D| @@ -195,7 +195,7 @@ * * Apply Q to D as QT*D * - CALL SGEMLQT( 'L', 'T', N, M, K, NB, AF, M, T, NB, DF, N, + CALL SGEMLQT( 'L', 'T', N, M, K, NB, AF, M, T, NB, DF, N, $ WORK, INFO) * * Compute |QT*D - QT*D| / |D| @@ -206,7 +206,7 @@ RESULT( 4 ) = RESID / (EPS*MAX(1,M)*DNORM) ELSE RESULT( 4 ) = ZERO - END IF + END IF * * Generate random n-by-m matrix D and a copy DF * @@ -218,8 +218,8 @@ * * Apply Q to C as C*Q * - CALL SGEMLQT( 'R', 'N', M, N, K, NB, AF, M, T, NB, CF, M, - $ WORK, INFO) + CALL SGEMLQT( 'R', 'N', M, N, K, NB, AF, M, T, NB, CF, M, + $ WORK, INFO) * * Compute |C*Q - C*Q| / |C| * @@ -237,8 +237,8 @@ * * Apply Q to D as D*QT * - CALL SGEMLQT( 'R', 'T', M, N, K, NB, AF, M, T, NB, CF, M, - $ WORK, INFO) + CALL SGEMLQT( 'R', 'T', M, N, K, NB, AF, M, T, NB, CF, M, + $ WORK, INFO) * * Compute |C*QT - C*QT| / |C| * diff --git a/TESTING/LIN/slqt05.f b/TESTING/LIN/slqt05.f index 5ad3a4b..7ce36c7 100644 --- a/TESTING/LIN/slqt05.f +++ b/TESTING/LIN/slqt05.f @@ -2,12 +2,12 @@ * =========== * * SUBROUTINE SLQT05(M,N,L,NB,RESULT) -* +* * .. Scalar Arguments .. * INTEGER LWORK, M, N, L, NB, LDT * .. Return values .. * REAL RESULT(6) -* +* * *> \par Purpose: * ============= @@ -38,7 +38,7 @@ *> The number of rows of the upper trapezoidal part the *> lower test matrix. 0 <= L <= M. *> \endverbatim -*> +*> *> \param[in] NB *> \verbatim *> NB is INTEGER @@ -54,17 +54,17 @@ *> RESULT(2) = | I - Q^H Q | *> RESULT(3) = | Q C - Q C | *> RESULT(4) = | Q^H C - Q^H C | -*> RESULT(5) = | C Q - C Q | +*> RESULT(5) = | C Q - C Q | *> RESULT(6) = | C Q^H - C Q^H | *> \endverbatim * * Authors: * ======== * -*> \author Univ. of Tennessee -*> \author Univ. of California Berkeley -*> \author Univ. of Colorado Denver -*> \author NAG Ltd. +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. * *> \date April 2012 * @@ -85,11 +85,11 @@ REAL RESULT(6) * * ===================================================================== -* +* * .. -* .. Local allocatable arrays +* .. Local allocatable arrays REAL, ALLOCATABLE :: AF(:,:), Q(:,:), - $ R(:,:), RWORK(:), WORK( : ), T(:,:), + $ R(:,:), RWORK(:), WORK( : ), T(:,:), $ CF(:,:), DF(:,:), A(:,:), C(:,:), D(:,:) * * .. Parameters .. @@ -110,7 +110,7 @@ * .. * .. Data statements .. DATA ISEED / 1988, 1989, 1990, 1991 / -* +* EPS = SLAMCH( 'Epsilon' ) K = M N2 = M+N @@ -124,7 +124,7 @@ * Dynamically allocate all arrays * ALLOCATE(A(M,N2),AF(M,N2),Q(N2,N2),R(N2,N2),RWORK(N2), - $ WORK(LWORK),T(NB,M),C(N2,M),CF(N2,M), + $ WORK(LWORK),T(NB,M),C(N2,M),CF(N2,M), $ D(M,N2),DF(M,N2) ) * * Put random stuff into A @@ -142,7 +142,7 @@ END IF IF( L.GT.0 ) THEN DO J=1,L - CALL SLARNV( 2, ISEED, M-J+1, A( J, MIN(N+M,N+M-L+1) + CALL SLARNV( 2, ISEED, M-J+1, A( J, MIN(N+M,N+M-L+1) $ + J - 1 ) ) END DO END IF @@ -194,7 +194,7 @@ CALL SLACPY( 'Full', N2, M, C, N2, CF, N2 ) * * Apply Q to C as Q*C -* +* CALL STPMLQT( 'L','N', N,M,K,L,NB,AF(1, NP1),M,T,LDT,CF,N2, $ CF(NP1,1),N2,WORK,INFO) * @@ -216,18 +216,18 @@ * Apply Q to C as QT*C * CALL STPMLQT( 'L','T',N,M,K,L,NB,AF(1,NP1),M,T,LDT,CF,N2, - $ CF(NP1,1),N2,WORK,INFO) + $ CF(NP1,1),N2,WORK,INFO) * * Compute |QT*C - QT*C| / |C| * CALL SGEMM('T','N',N2,M,N2,-ONE,Q,N2,C,N2,ONE,CF,N2) RESID = SLANGE( '1', N2, M, CF, N2, RWORK ) - + IF( CNORM.GT.ZERO ) THEN RESULT( 4 ) = RESID / (EPS*MAX(1,N2)*CNORM) ELSE RESULT( 4 ) = ZERO - END IF + END IF * * Generate random m-by-n matrix D and a copy DF * @@ -259,8 +259,8 @@ * Apply Q to D as D*QT * CALL STPMLQT('R','T',M,N,K,L,NB,AF(1,NP1),M,T,LDT,DF,M, - $ DF(1,NP1),M,WORK,INFO) - + $ DF(1,NP1),M,WORK,INFO) + * * Compute |D*QT - D*QT| / |D| * @@ -276,4 +276,4 @@ * DEALLOCATE ( A, AF, Q, R, RWORK, WORK, T, C, D, CF, DF) RETURN - END \ No newline at end of file + END diff --git a/TESTING/LIN/stplqt.f b/TESTING/LIN/stplqt.f index adbbfe8..4e03ae6 100644 --- a/TESTING/LIN/stplqt.f +++ b/TESTING/LIN/stplqt.f @@ -3,23 +3,23 @@ * * 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 *> -*> STPLQT 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 +*> STPLQT 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 * @@ -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 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 @@ -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 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/TESTING/LIN/stsqr01.f b/TESTING/LIN/stsqr01.f index dbaf3aa..4cebfc8 100644 --- a/TESTING/LIN/stsqr01.f +++ b/TESTING/LIN/stsqr01.f @@ -2,19 +2,19 @@ * * =========== 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/ * * Definition: * =========== * * SUBROUTINE STSQR01(TSSW, M,N, MB, NB, RESULT) -* +* * .. Scalar Arguments .. * INTEGER M, N, MB * .. Return values .. * REAL RESULT(6) -* +* * *> \par Purpose: * ============= @@ -65,17 +65,17 @@ *> RESULT(2) = | I - Q^H Q | or | I - Q Q^H | *> RESULT(3) = | Q C - Q C | *> RESULT(4) = | Q^H C - Q^H C | -*> RESULT(5) = | C Q - C Q | +*> RESULT(5) = | C Q - C Q | *> RESULT(6) = | C Q^H - C Q^H | *> \endverbatim * * Authors: * ======== * -*> \author Univ. of Tennessee -*> \author Univ. of California Berkeley -*> \author Univ. of Colorado Denver -*> \author NAG Ltd. +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. * *> \date April 2012 * @@ -99,9 +99,9 @@ * ===================================================================== * * .. -* .. Local allocatable arrays +* .. Local allocatable arrays REAL, ALLOCATABLE :: AF(:,:), Q(:,:), - $ R(:,:), RWORK(:), WORK( : ), T(:), + $ R(:,:), RWORK(:), WORK( : ), T(:), $ CF(:,:), DF(:,:), A(:,:), C(:,:), D(:,:), LQ(:,:) * * .. Parameters .. @@ -123,24 +123,24 @@ EXTERNAL SLAMCH, SLARNV, SLANGE, SLANSY, LSAME, ILAENV * .. * .. Intrinsic Functions .. - INTRINSIC MAX, MIN + INTRINSIC MAX, MIN * .. Scalars in Common .. CHARACTER*32 srnamt * .. * .. Common blocks .. - COMMON / srnamc / srnamt + COMMON / srnamc / srnamt * .. * .. Data statements .. - DATA ISEED / 1988, 1989, 1990, 1991 / + DATA ISEED / 1988, 1989, 1990, 1991 / * * TEST TALL SKINNY OR SHORT WIDE * - TS = LSAME(TSSW, 'TS') -* + TS = LSAME(TSSW, 'TS') +* * TEST MATRICES WITH HALF OF MATRIX BEING ZEROS * TESTZEROS = .FALSE. -* +* EPS = SLAMCH( 'Epsilon' ) K = MIN(M,N) L = MAX(M,N,1) @@ -149,14 +149,14 @@ IF((K.GE.MNB).OR.(MNB.GE.L))THEN LT=MAX(1,L)*MNB+5 ELSE - LT=MAX(1,(L-K)/(MNB-K)+1)*L*MNB+5 + LT=MAX(1,(L-K)/(MNB-K)+1)*L*MNB+5 END IF * * Dynamically allocate local arrays * - ALLOCATE ( A(M,N), AF(M,N), Q(L,L), R(M,L), RWORK(L), - $ WORK(LWORK), T(LT), C(M,N), CF(M,N), + ALLOCATE ( A(M,N), AF(M,N), Q(L,L), R(M,L), RWORK(L), + $ WORK(LWORK), T(LT), C(M,N), CF(M,N), $ D(N,M), DF(N,M), LQ(L,N) ) * * Put random numbers into A and copy to AF @@ -184,7 +184,7 @@ * CALL SLASET( 'Full', M, M, ZERO, ONE, Q, M ) srnamt = 'SGEMQR' - CALL SGEMQR( 'L', 'N', M, M, K, AF, M, T, LT, Q, M, + CALL SGEMQR( 'L', 'N', M, M, K, AF, M, T, LT, Q, M, $ WORK, LWORK, INFO ) * * Copy R @@ -221,7 +221,7 @@ * Apply Q to C as Q*C * srnamt = 'DGEQR' - CALL SGEMQR( 'L', 'N', M, N, K, AF, M, T, LT, CF, M, + CALL SGEMQR( 'L', 'N', M, N, K, AF, M, T, LT, CF, M, $ WORK, LWORK, INFO) * * Compute |Q*C - Q*C| / |C| @@ -241,7 +241,7 @@ * Apply Q to C as QT*C * srnamt = 'DGEQR' - CALL SGEMQR( 'L', 'T', M, N, K, AF, M, T, LT, CF, M, + CALL SGEMQR( 'L', 'T', M, N, K, AF, M, T, LT, CF, M, $ WORK, LWORK, INFO) * * Compute |QT*C - QT*C| / |C| @@ -252,7 +252,7 @@ RESULT( 4 ) = RESID / (EPS*MAX(1,M)*CNORM) ELSE RESULT( 4 ) = ZERO - END IF + END IF * * Generate random n-by-m matrix D and a copy DF * @@ -265,8 +265,8 @@ * Apply Q to D as D*Q * srnamt = 'DGEQR' - CALL SGEMQR( 'R', 'N', N, M, K, AF, M, T, LT, DF, N, - $ WORK, LWORK, INFO) + CALL SGEMQR( 'R', 'N', N, M, K, AF, M, T, LT, DF, N, + $ WORK, LWORK, INFO) * * Compute |D*Q - D*Q| / |D| * @@ -284,8 +284,8 @@ * * Apply Q to D as D*QT * - CALL SGEMQR( 'R', 'T', N, M, K, AF, M, T, LT, DF, N, - $ WORK, LWORK, INFO) + CALL SGEMQR( 'R', 'T', N, M, K, AF, M, T, LT, DF, N, + $ WORK, LWORK, INFO) * * Compute |D*QT - D*QT| / |D| * @@ -308,7 +308,7 @@ * CALL SLASET( 'Full', N, N, ZERO, ONE, Q, N ) srnamt = 'SGEMQR' - CALL SGEMLQ( 'R', 'N', N, N, K, AF, M, T, LT, Q, N, + CALL SGEMLQ( 'R', 'N', N, N, K, AF, M, T, LT, Q, N, $ WORK, LWORK, INFO ) * * Copy R @@ -344,7 +344,7 @@ * * Apply Q to C as Q*C * - CALL SGEMLQ( 'L', 'N', N, M, K, AF, M, T, LT, DF, N, + CALL SGEMLQ( 'L', 'N', N, M, K, AF, M, T, LT, DF, N, $ WORK, LWORK, INFO) * * Compute |Q*D - Q*D| / |D| @@ -363,7 +363,7 @@ * * Apply Q to D as QT*D * - CALL SGEMLQ( 'L', 'T', N, M, K, AF, M, T, LT, DF, N, + CALL SGEMLQ( 'L', 'T', N, M, K, AF, M, T, LT, DF, N, $ WORK, LWORK, INFO) * * Compute |QT*D - QT*D| / |D| @@ -374,7 +374,7 @@ RESULT( 4 ) = RESID / (EPS*MAX(1,N)*DNORM) ELSE RESULT( 4 ) = ZERO - END IF + END IF * * Generate random n-by-m matrix D and a copy DF * @@ -386,8 +386,8 @@ * * Apply Q to C as C*Q * - CALL SGEMLQ( 'R', 'N', M, N, K, AF, M, T, LT, CF, M, - $ WORK, LWORK, INFO) + CALL SGEMLQ( 'R', 'N', M, N, K, AF, M, T, LT, CF, M, + $ WORK, LWORK, INFO) * * Compute |C*Q - C*Q| / |C| * @@ -405,8 +405,8 @@ * * Apply Q to D as D*QT * - CALL SGEMLQ( 'R', 'T', M, N, K, AF, M, T, LT, CF, M, - $ WORK, LWORK, INFO) + CALL SGEMLQ( 'R', 'T', M, N, K, AF, M, T, LT, CF, M, + $ WORK, LWORK, INFO) * * Compute |C*QT - C*QT| / |C| * @@ -425,4 +425,4 @@ DEALLOCATE ( A, AF, Q, R, RWORK, WORK, T, C, D, CF, DF) * RETURN - END \ No newline at end of file + END diff --git a/TESTING/LIN/zchkaa.f b/TESTING/LIN/zchkaa.f index b583061..9787249 100644 --- a/TESTING/LIN/zchkaa.f +++ b/TESTING/LIN/zchkaa.f @@ -651,7 +651,7 @@ * IF( TSTCHK ) THEN CALL ZCHKHE_AASEN( DOTYPE, NN, NVAL, NNB2, NBVAL2, NNS, - $ NSVAL, THRESH, TSTERR, LDA, + $ NSVAL, THRESH, TSTERR, LDA, $ A( 1, 1 ), A( 1, 2 ), A( 1, 3 ), $ B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), $ WORK, RWORK, IWORK, NOUT ) @@ -661,8 +661,8 @@ * IF( TSTDRV ) THEN CALL ZDRVHE_AASEN( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, - $ LDA, A( 1, 1 ), A( 1, 2 ), A( 1, 3 ), - $ B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), + $ LDA, A( 1, 1 ), A( 1, 2 ), A( 1, 3 ), + $ B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), $ WORK, RWORK, IWORK, NOUT ) ELSE WRITE( NOUT, FMT = 9988 )PATH @@ -1042,7 +1042,7 @@ * XQ: LQT routines for triangular-pentagonal matrices * IF( TSTCHK ) THEN - CALL ZCHKLQTP( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, + CALL ZCHKLQTP( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, $ NBVAL, NOUT ) ELSE WRITE( NOUT, FMT = 9989 )PATH @@ -1053,7 +1053,7 @@ * TS: QR routines for tall-skinny matrices * IF( TSTCHK ) THEN - CALL ZCHKTSQR( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, + CALL ZCHKTSQR( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, $ NBVAL, NOUT ) ELSE WRITE( NOUT, FMT = 9989 )PATH diff --git a/TESTING/LIN/zchkhe_aasen.f b/TESTING/LIN/zchkhe_aasen.f index 1ebe5ef..64423d8 100644 --- a/TESTING/LIN/zchkhe_aasen.f +++ b/TESTING/LIN/zchkhe_aasen.f @@ -225,7 +225,7 @@ * .. External Subroutines .. EXTERNAL ALAERH, ALAHD, ALASUM, XLAENV, ZERRHE, ZGET04, $ ZHECON, ZHERFS, ZHET01, ZHETRF_AASEN, ZHETRI2, - $ ZHETRS_AASEN, ZLACPY, ZLAIPD, ZLARHS, ZLATB4, + $ ZHETRS_AASEN, ZLACPY, ZLAIPD, ZLARHS, ZLATB4, $ ZLATMS, ZPOT02, ZPOT03, ZPOT05 * .. * .. Intrinsic Functions .. @@ -432,7 +432,7 @@ * LWORK = ( NB+1 )*LDA SRNAMT = 'ZHETRF_AASEN' - CALL ZHETRF_AASEN( UPLO, N, AFAC, LDA, IWORK, AINV, + CALL ZHETRF_AASEN( UPLO, N, AFAC, LDA, IWORK, AINV, $ LWORK, INFO ) * * Adjust the expected value of INFO to account for @@ -458,8 +458,8 @@ * Check error code from ZHETRF and handle error. * IF( INFO.NE.K ) THEN - CALL ALAERH( PATH, 'ZHETRF_AASEN', INFO, K, UPLO, - $ N, N, -1, -1, NB, IMAT, NFAIL, NERRS, + CALL ALAERH( PATH, 'ZHETRF_AASEN', INFO, K, UPLO, + $ N, N, -1, -1, NB, IMAT, NFAIL, NERRS, $ NOUT ) END IF * @@ -513,7 +513,7 @@ * SRNAMT = 'ZLARHS' CALL ZLARHS( MATPATH, XTYPE, UPLO, ' ', N, N, - $ KL, KU, NRHS, A, LDA, XACT, LDA, + $ KL, KU, NRHS, A, LDA, XACT, LDA, $ B, LDA, ISEED, INFO ) CALL ZLACPY( 'Full', N, NRHS, B, LDA, X, LDA ) * diff --git a/TESTING/LIN/zchklqt.f b/TESTING/LIN/zchklqt.f index e15793b..31c885b 100644 --- a/TESTING/LIN/zchklqt.f +++ b/TESTING/LIN/zchklqt.f @@ -2,15 +2,15 @@ * * =========== 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/ * * Definition: * =========== * -* SUBROUTINE ZCHKLQT( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, +* SUBROUTINE ZCHKLQT( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, * NBVAL, NOUT ) -* +* * .. Scalar Arguments .. * LOGICAL TSTERR * INTEGER NM, NN, NNB, NOUT @@ -89,17 +89,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 2011 * *> \ingroup double_lin * * ===================================================================== - SUBROUTINE ZCHKLQT( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, + SUBROUTINE ZCHKLQT( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, $ NBVAL, NOUT ) IMPLICIT NONE * @@ -175,7 +175,7 @@ NB = NBVAL( K ) * * Test ZGELQT and ZUNMLQT -* +* IF( (NB.LE.MINMN).AND.(NB.GT.0) ) THEN CALL ZLQT04( M, N, NB, RESULT ) * diff --git a/TESTING/LIN/zchklqtp.f b/TESTING/LIN/zchklqtp.f index 10f7363..efde54b 100644 --- a/TESTING/LIN/zchklqtp.f +++ b/TESTING/LIN/zchklqtp.f @@ -2,13 +2,13 @@ * * =========== 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/ * * Definition: * =========== * -* SUBROUTINE ZCHKLQTP( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, +* SUBROUTINE ZCHKLQTP( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, * NBVAL, NOUT ) * * .. Scalar Arguments .. @@ -89,17 +89,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 2011 * *> \ingroup double_lin * * ===================================================================== - SUBROUTINE ZCHKLQTP( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, + SUBROUTINE ZCHKLQTP( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, $ NBVAL, NOUT ) IMPLICIT NONE * @@ -172,14 +172,14 @@ * MINMN = MIN( M, N ) DO L = 0, MINMN, MAX( MINMN, 1 ) -* +* * Do for each possible value of NB * DO K = 1, NNB NB = NBVAL( K ) * * Test DTPLQT and DTPMLQT -* +* IF( (NB.LE.M).AND.(NB.GT.0) ) THEN CALL ZLQT05( M, N, L, NB, RESULT ) * @@ -212,4 +212,4 @@ * * End of ZCHKLQTP * - END \ No newline at end of file + END diff --git a/TESTING/LIN/zchktsqr.f b/TESTING/LIN/zchktsqr.f index c79a92b..6d8fc99 100644 --- a/TESTING/LIN/zchktsqr.f +++ b/TESTING/LIN/zchktsqr.f @@ -2,15 +2,15 @@ * * =========== 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/ * * Definition: * =========== * -* SUBROUTINE ZCHKTSQR( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, +* SUBROUTINE ZCHKTSQR( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, * NBVAL, NOUT ) -* +* * .. Scalar Arguments .. * LOGICAL TSTERR * INTEGER NM, NN, NNB, NOUT @@ -89,17 +89,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 2011 * *> \ingroup double_lin * * ===================================================================== - SUBROUTINE ZCHKTSQR( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, + SUBROUTINE ZCHKTSQR( THRESH, TSTERR, NM, MVAL, NN, NVAL, NNB, $ NBVAL, NOUT ) IMPLICIT NONE * @@ -132,11 +132,11 @@ DOUBLE PRECISION RESULT( NTESTS ) * .. * .. External Subroutines .. - EXTERNAL ALAERH, ALAHD, ALASUM, DERRTSQR, + EXTERNAL ALAERH, ALAHD, ALASUM, DERRTSQR, $ DTSQR01, XLAENV * .. * .. Intrinsic Functions .. - INTRINSIC MAX, MIN + INTRINSIC MAX, MIN * .. * .. Scalars in Common .. LOGICAL LERR, OK @@ -172,7 +172,7 @@ DO J = 1, NN N = NVAL( J ) IF (MIN(M,N).NE.0) THEN - DO INB = 1, NNB + DO INB = 1, NNB MB = NBVAL( INB ) CALL XLAENV( 1, MB ) DO IMB = 1, NNB @@ -180,7 +180,7 @@ CALL XLAENV( 2, NB ) * * Test ZGEQR and ZGEMQR -* +* CALL ZTSQR01( 'TS', M, N, MB, NB, RESULT ) * * Print information about the tests that did not @@ -196,9 +196,9 @@ END IF END DO NRUN = NRUN + NTESTS - END DO - END DO - END IF + END DO + END DO + END IF END DO END DO * @@ -212,7 +212,7 @@ DO J = 1, NN N = NVAL( J ) IF (MIN(M,N).NE.0) THEN - DO INB = 1, NNB + DO INB = 1, NNB MB = NBVAL( INB ) CALL XLAENV( 1, MB ) DO IMB = 1, NNB @@ -220,7 +220,7 @@ CALL XLAENV( 2, NB ) * * Test ZGELQ and ZGEMLQ -* +* CALL ZTSQR01( 'SW', M, N, MB, NB, RESULT ) * * Print information about the tests that did not @@ -236,9 +236,9 @@ END IF END DO NRUN = NRUN + NTESTS - END DO - END DO - END IF + END DO + END DO + END IF END DO END DO * diff --git a/TESTING/LIN/zdrvhe_aasen.f b/TESTING/LIN/zdrvhe_aasen.f index 0170873..4e28356 100644 --- a/TESTING/LIN/zdrvhe_aasen.f +++ b/TESTING/LIN/zdrvhe_aasen.f @@ -150,7 +150,7 @@ * * ===================================================================== SUBROUTINE ZDRVHE_AASEN( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, - $ NMAX, A, AFAC, AINV, B, X, XACT, WORK, + $ NMAX, A, AFAC, AINV, B, X, XACT, WORK, $ RWORK, IWORK, NOUT ) * * -- LAPACK test routine (version 3.7.0) -- @@ -201,7 +201,7 @@ * .. * .. External Subroutines .. EXTERNAL ALADHD, ALAERH, ALASVM, XLAENV, ZERRVX, ZGET04, - $ ZHESV_AASEN, ZHET01_AASEN, ZHETRF_AASEN, + $ ZHESV_AASEN, ZHET01_AASEN, ZHETRF_AASEN, $ ZHETRI2, ZLACPY, ZLAIPD, ZLARHS, ZLATB4, ZLATMS, $ ZPOT02 * .. @@ -475,7 +475,7 @@ c END IF * residual. * CALL ZHET01_AASEN( UPLO, N, A, LDA, AFAC, LDA, - $ IWORK, AINV, LDA, RWORK, + $ IWORK, AINV, LDA, RWORK, $ RESULT( 1 ) ) * * Compute residual of the computed solution. diff --git a/TESTING/LIN/zdrvls.f b/TESTING/LIN/zdrvls.f index 1ffa585..63fcc69 100644 --- a/TESTING/LIN/zdrvls.f +++ b/TESTING/LIN/zdrvls.f @@ -488,7 +488,7 @@ $ COPYB, LDB, B, LDB ) END IF SRNAMT = 'DGETSLS ' - CALL ZGETSLS( TRANS, M, N, NRHS, A, + CALL ZGETSLS( TRANS, M, N, NRHS, A, $ LDA, B, LDB, WORK, LWORK, INFO ) IF( INFO.NE.0 ) $ CALL ALAERH( PATH, 'ZGETSLS ', INFO, 0, @@ -771,8 +771,8 @@ $ ', NB=', I4, ', type', I2, ', test(', I2, ')=', G12.5 ) 9998 FORMAT( ' M=', I5, ', N=', I5, ', NRHS=', I4, ', NB=', I4, $ ', type', I2, ', test(', I2, ')=', G12.5 ) - 9997 FORMAT( ' TRANS=''', A1,' M=', I5, ', N=', I5, ', NRHS=', I4, - $ ', MB=', I4,', NB=', I4,', type', I2, + 9997 FORMAT( ' TRANS=''', A1,' M=', I5, ', N=', I5, ', NRHS=', I4, + $ ', MB=', I4,', NB=', I4,', type', I2, $ ', test(', I2, ')=', G12.5 ) RETURN * diff --git a/TESTING/LIN/zerrlqt.f b/TESTING/LIN/zerrlqt.f index fd6b452..f65f895 100644 --- a/TESTING/LIN/zerrlqt.f +++ b/TESTING/LIN/zerrlqt.f @@ -2,19 +2,19 @@ * * =========== 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/ * * Definition: * =========== * * SUBROUTINE ZERRLQT( PATH, NUNIT ) -* +* * .. Scalar Arguments .. * CHARACTER*3 PATH * INTEGER NUNIT * .. -* +* * *> \par Purpose: * ============= @@ -43,10 +43,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 * @@ -81,7 +81,7 @@ * .. * .. External Subroutines .. EXTERNAL ALAESM, CHKXER, ZGELQT3, ZGELQT, - $ ZGEMLQT + $ ZGEMLQT * .. * .. Scalars in Common .. LOGICAL LERR, OK diff --git a/TESTING/LIN/zerrlqtp.f b/TESTING/LIN/zerrlqtp.f index 25a079e..6e00e4f 100644 --- a/TESTING/LIN/zerrlqtp.f +++ b/TESTING/LIN/zerrlqtp.f @@ -2,19 +2,19 @@ * * =========== 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/ * * Definition: * =========== * * SUBROUTINE ZERRLQTP( PATH, NUNIT ) -* +* * .. Scalar Arguments .. * CHARACTER*3 PATH * INTEGER NUNIT * .. -* +* * *> \par Purpose: * ============= @@ -43,10 +43,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 * @@ -81,7 +81,7 @@ * .. * .. External Subroutines .. EXTERNAL ALAESM, CHKXER, ZTPLQT2, ZTPLQT, - $ ZTPMLQT + $ ZTPMLQT * .. * .. Scalars in Common .. LOGICAL LERR, OK @@ -171,46 +171,46 @@ * SRNAMT = 'ZTPMLQT' INFOT = 1 - CALL ZTPMLQT( '/', 'N', 0, 0, 0, 0, 1, A, 1, T, 1, B, 1, C, 1, + CALL ZTPMLQT( '/', 'N', 0, 0, 0, 0, 1, A, 1, T, 1, B, 1, C, 1, $ W, INFO ) CALL CHKXER( 'ZTPMLQT', INFOT, NOUT, LERR, OK ) INFOT = 2 - CALL ZTPMLQT( 'L', '/', 0, 0, 0, 0, 1, A, 1, T, 1, B, 1, C, 1, + CALL ZTPMLQT( 'L', '/', 0, 0, 0, 0, 1, A, 1, T, 1, B, 1, C, 1, $ W, INFO ) CALL CHKXER( 'ZTPMLQT', INFOT, NOUT, LERR, OK ) INFOT = 3 - CALL ZTPMLQT( 'L', 'N', -1, 0, 0, 0, 1, A, 1, T, 1, B, 1, C, 1, + CALL ZTPMLQT( 'L', 'N', -1, 0, 0, 0, 1, A, 1, T, 1, B, 1, C, 1, $ W, INFO ) CALL CHKXER( 'ZTPMLQT', INFOT, NOUT, LERR, OK ) INFOT = 4 - CALL ZTPMLQT( 'L', 'N', 0, -1, 0, 0, 1, A, 1, T, 1, B, 1, C, 1, + CALL ZTPMLQT( 'L', 'N', 0, -1, 0, 0, 1, A, 1, T, 1, B, 1, C, 1, $ W, INFO ) CALL CHKXER( 'ZTPMLQT', INFOT, NOUT, LERR, OK ) INFOT = 5 - CALL ZTPMLQT( 'L', 'N', 0, 0, -1, 0, 1, A, 1, T, 1, B, 1, C, 1, + CALL ZTPMLQT( 'L', 'N', 0, 0, -1, 0, 1, A, 1, T, 1, B, 1, C, 1, $ W, INFO ) INFOT = 6 - CALL ZTPMLQT( 'L', 'N', 0, 0, 0, -1, 1, A, 1, T, 1, B, 1, C, 1, + CALL ZTPMLQT( 'L', 'N', 0, 0, 0, -1, 1, A, 1, T, 1, B, 1, C, 1, $ W, INFO ) CALL CHKXER( 'ZTPMLQT', INFOT, NOUT, LERR, OK ) INFOT = 7 - CALL ZTPMLQT( 'L', 'N', 0, 0, 0, 0, 0, A, 1, T, 1, B, 1, C, 1, + CALL ZTPMLQT( 'L', 'N', 0, 0, 0, 0, 0, A, 1, T, 1, B, 1, C, 1, $ W, INFO ) CALL CHKXER( 'ZTPMLQT', INFOT, NOUT, LERR, OK ) INFOT = 9 - CALL ZTPMLQT( 'R', 'N', 2, 2, 2, 1, 1, A, 1, T, 1, B, 1, C, 1, + CALL ZTPMLQT( 'R', 'N', 2, 2, 2, 1, 1, A, 1, T, 1, B, 1, C, 1, $ W, INFO ) CALL CHKXER( 'ZTPMLQT', INFOT, NOUT, LERR, OK ) INFOT = 11 - CALL ZTPMLQT( 'R', 'N', 1, 1, 1, 1, 1, A, 1, T, 0, B, 1, C, 1, + CALL ZTPMLQT( 'R', 'N', 1, 1, 1, 1, 1, A, 1, T, 0, B, 1, C, 1, $ W, INFO ) CALL CHKXER( 'ZTPMLQT', INFOT, NOUT, LERR, OK ) INFOT = 13 - CALL ZTPMLQT( 'L', 'N', 1, 1, 1, 1, 1, A, 1, T, 1, B, 0, C, 1, + CALL ZTPMLQT( 'L', 'N', 1, 1, 1, 1, 1, A, 1, T, 1, B, 0, C, 1, $ W, INFO ) CALL CHKXER( 'ZTPMLQT', INFOT, NOUT, LERR, OK ) INFOT = 15 - CALL ZTPMLQT( 'L', 'N', 1, 1, 1, 1, 1, A, 1, T, 1, B, 1, C, 0, + CALL ZTPMLQT( 'L', 'N', 1, 1, 1, 1, 1, A, 1, T, 1, B, 1, C, 0, $ W, INFO ) CALL CHKXER( 'ZTPMLQT', INFOT, NOUT, LERR, OK ) * diff --git a/TESTING/LIN/zerrtsqr.f b/TESTING/LIN/zerrtsqr.f index 19c9980..3aa3e4a 100644 --- a/TESTING/LIN/zerrtsqr.f +++ b/TESTING/LIN/zerrtsqr.f @@ -2,19 +2,19 @@ * * =========== 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/ * * Definition: * =========== * * SUBROUTINE ZERRTSQR( PATH, NUNIT ) -* +* * .. Scalar Arguments .. * CHARACTER*3 PATH * INTEGER NUNIT * .. -* +* * *> \par Purpose: * ============= @@ -43,10 +43,10 @@ * Authors: * ======== * -*> \author Univ. of Tennessee -*> \author Univ. of California Berkeley -*> \author Univ. of Colorado Zenver -*> \author NAG Ltd. +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Zenver +*> \author NAG Ltd. * *> \date November 2011 * diff --git a/TESTING/LIN/zhet01_aasen.f b/TESTING/LIN/zhet01_aasen.f index 89b8799..f658029 100644 --- a/TESTING/LIN/zhet01_aasen.f +++ b/TESTING/LIN/zhet01_aasen.f @@ -145,7 +145,7 @@ * * .. Parameters .. COMPLEX*16 CZERO, CONE - PARAMETER ( CZERO = ( 0.0D+0, 0.0D+0 ), + PARAMETER ( CZERO = ( 0.0D+0, 0.0D+0 ), $ CONE = ( 1.0D+0, 0.0D+0 ) ) DOUBLE PRECISION ZERO, ONE PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 ) diff --git a/TESTING/LIN/zlqt04.f b/TESTING/LIN/zlqt04.f index a1aff90..4571215 100644 --- a/TESTING/LIN/zlqt04.f +++ b/TESTING/LIN/zlqt04.f @@ -2,19 +2,19 @@ * * =========== 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/ * * Definition: * =========== * * SUBROUTINE ZLQT04(M,N,NB,RESULT) -* +* * .. Scalar Arguments .. * INTEGER M, N, NB * .. Return values .. * DOUBLE PRECISION RESULT(6) -* +* * *> \par Purpose: * ============= @@ -54,17 +54,17 @@ *> RESULT(2) = | I - Q Q^H | *> RESULT(3) = | Q C - Q C | *> RESULT(4) = | Q^H C - Q^H C | -*> RESULT(5) = | C Q - C Q | +*> RESULT(5) = | C Q - C Q | *> RESULT(6) = | C Q^H - C Q^H | *> \endverbatim * * Authors: * ======== * -*> \author Univ. of Tennessee -*> \author Univ. of California Berkeley -*> \author Univ. of Colorado Denver -*> \author NAG Ltd. +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. * *> \date April 2012 * @@ -87,9 +87,9 @@ * ===================================================================== * * .. -* .. Local allocatable arrays +* .. Local allocatable arrays COMPLEX*16, ALLOCATABLE :: AF(:,:), Q(:,:), - $ L(:,:), RWORK(:), WORK( : ), T(:,:), + $ L(:,:), RWORK(:), WORK( : ), T(:,:), $ CF(:,:), DF(:,:), A(:,:), C(:,:), D(:,:) * * .. Parameters .. @@ -112,11 +112,11 @@ EXTERNAL DLAMCH, ZLANGE, ZLANSY, LSAME * .. * .. Intrinsic Functions .. - INTRINSIC MAX, MIN + INTRINSIC MAX, MIN * .. * .. Data statements .. - DATA ISEED / 1988, 1989, 1990, 1991 / -* + DATA ISEED / 1988, 1989, 1990, 1991 / +* EPS = DLAMCH( 'Epsilon' ) K = MIN(M,N) LL = MAX(M,N) @@ -124,8 +124,8 @@ * * Dynamically allocate local arrays * - ALLOCATE ( A(M,N), AF(M,N), Q(N,N), L(LL,N), RWORK(LL), - $ WORK(LWORK), T(NB,N), C(M,N), CF(M,N), + ALLOCATE ( A(M,N), AF(M,N), Q(N,N), L(LL,N), RWORK(LL), + $ WORK(LWORK), T(NB,N), C(M,N), CF(M,N), $ D(N,M), DF(N,M) ) * * Put random numbers into A and copy to AF @@ -143,7 +143,7 @@ * Generate the n-by-n matrix Q * CALL ZLASET( 'Full', N, N, CZERO, ONE, Q, N ) - CALL ZGEMLQT( 'R', 'N', N, N, K, NB, AF, M, T, LDT, Q, N, + CALL ZGEMLQT( 'R', 'N', N, N, K, NB, AF, M, T, LDT, Q, N, $ WORK, INFO ) * * Copy L @@ -179,7 +179,7 @@ * * Apply Q to C as Q*C * - CALL ZGEMLQT( 'L', 'N', N, M, K, NB, AF, M, T, NB, DF, N, + CALL ZGEMLQT( 'L', 'N', N, M, K, NB, AF, M, T, NB, DF, N, $ WORK, INFO) * * Compute |Q*D - Q*D| / |D| @@ -198,7 +198,7 @@ * * Apply Q to D as QT*D * - CALL ZGEMLQT( 'L', 'C', N, M, K, NB, AF, M, T, NB, DF, N, + CALL ZGEMLQT( 'L', 'C', N, M, K, NB, AF, M, T, NB, DF, N, $ WORK, INFO) * * Compute |QT*D - QT*D| / |D| @@ -209,7 +209,7 @@ RESULT( 4 ) = RESID / (EPS*MAX(1,M)*DNORM) ELSE RESULT( 4 ) = ZERO - END IF + END IF * * Generate random n-by-m matrix D and a copy DF * @@ -221,8 +221,8 @@ * * Apply Q to C as C*Q * - CALL ZGEMLQT( 'R', 'N', M, N, K, NB, AF, M, T, NB, CF, M, - $ WORK, INFO) + CALL ZGEMLQT( 'R', 'N', M, N, K, NB, AF, M, T, NB, CF, M, + $ WORK, INFO) * * Compute |C*Q - C*Q| / |C| * @@ -240,8 +240,8 @@ * * Apply Q to D as D*QT * - CALL ZGEMLQT( 'R', 'C', M, N, K, NB, AF, M, T, NB, CF, M, - $ WORK, INFO) + CALL ZGEMLQT( 'R', 'C', M, N, K, NB, AF, M, T, NB, CF, M, + $ WORK, INFO) * * Compute |C*QT - C*QT| / |C| * diff --git a/TESTING/LIN/zlqt05.f b/TESTING/LIN/zlqt05.f index 676c95b..196750f 100644 --- a/TESTING/LIN/zlqt05.f +++ b/TESTING/LIN/zlqt05.f @@ -2,19 +2,19 @@ * * =========== 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/ * * Definition: * =========== * * SUBROUTINE ZLQT05(M,N,L,NB,RESULT) -* +* * .. Scalar Arguments .. * INTEGER LWORK, M, N, L, NB, LDT * .. Return values .. * DOUBLE PRECISION RESULT(6) -* +* * *> \par Purpose: * ============= @@ -45,7 +45,7 @@ *> The number of rows of the upper trapezoidal part the *> lower test matrix. 0 <= L <= M. *> \endverbatim -*> +*> *> \param[in] NB *> \verbatim *> NB is INTEGER @@ -61,17 +61,17 @@ *> RESULT(2) = | I - Q^H Q | *> RESULT(3) = | Q C - Q C | *> RESULT(4) = | Q^H C - Q^H C | -*> RESULT(5) = | C Q - C Q | +*> RESULT(5) = | C Q - C Q | *> RESULT(6) = | C Q^H - C Q^H | *> \endverbatim * * Authors: * ======== * -*> \author Univ. of Tennessee -*> \author Univ. of California Berkeley -*> \author Univ. of Colorado Denver -*> \author NAG Ltd. +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. * *> \date April 2012 * @@ -92,11 +92,11 @@ DOUBLE PRECISION RESULT(6) * * ===================================================================== -* +* * .. -* .. Local allocatable arrays +* .. Local allocatable arrays COMPLEX*16, ALLOCATABLE :: AF(:,:), Q(:,:), - $ R(:,:), RWORK(:), WORK( : ), T(:,:), + $ R(:,:), RWORK(:), WORK( : ), T(:,:), $ CF(:,:), DF(:,:), A(:,:), C(:,:), D(:,:) * * .. Parameters .. @@ -119,7 +119,7 @@ * .. * .. Data statements .. DATA ISEED / 1988, 1989, 1990, 1991 / -* +* EPS = DLAMCH( 'Epsilon' ) K = M N2 = M+N @@ -133,7 +133,7 @@ * Dynamically allocate all arrays * ALLOCATE(A(M,N2),AF(M,N2),Q(N2,N2),R(N2,N2),RWORK(N2), - $ WORK(LWORK),T(NB,M),C(N2,M),CF(N2,M), + $ WORK(LWORK),T(NB,M),C(N2,M),CF(N2,M), $ D(M,N2),DF(M,N2) ) * * Put random stuff into A @@ -151,7 +151,7 @@ END IF IF( L.GT.0 ) THEN DO J=1,L - CALL ZLARNV( 2, ISEED, M-J+1, A( J, MIN(N+M,N+M-L+1) + CALL ZLARNV( 2, ISEED, M-J+1, A( J, MIN(N+M,N+M-L+1) $ + J - 1 ) ) END DO END IF @@ -204,7 +204,7 @@ CALL ZLACPY( 'Full', N2, M, C, N2, CF, N2 ) * * Apply Q to C as Q*C -* +* CALL ZTPMLQT( 'L','N', N,M,K,L,NB,AF(1, NP1),M,T,LDT,CF,N2, $ CF(NP1,1),N2,WORK,INFO) * @@ -226,18 +226,18 @@ * Apply Q to C as QT*C * CALL ZTPMLQT( 'L','C',N,M,K,L,NB,AF(1,NP1),M,T,LDT,CF,N2, - $ CF(NP1,1),N2,WORK,INFO) + $ CF(NP1,1),N2,WORK,INFO) * * Compute |QT*C - QT*C| / |C| * CALL ZGEMM('C','N',N2,M,N2,-ONE,Q,N2,C,N2,ONE,CF,N2) RESID = ZLANGE( '1', N2, M, CF, N2, RWORK ) - + IF( CNORM.GT.ZERO ) THEN RESULT( 4 ) = RESID / (EPS*MAX(1,N2)*CNORM) ELSE RESULT( 4 ) = ZERO - END IF + END IF * * Generate random m-by-n matrix D and a copy DF * @@ -269,8 +269,8 @@ * Apply Q to D as D*QT * CALL ZTPMLQT('R','C',M,N,K,L,NB,AF(1,NP1),M,T,LDT,DF,M, - $ DF(1,NP1),M,WORK,INFO) - + $ DF(1,NP1),M,WORK,INFO) + * * Compute |D*QT - D*QT| / |D| * @@ -286,4 +286,4 @@ * DEALLOCATE ( A, AF, Q, R, RWORK, WORK, T, C, D, CF, DF) RETURN - END \ No newline at end of file + END diff --git a/TESTING/LIN/ztsqr01.f b/TESTING/LIN/ztsqr01.f index 5f39ae7..38ace9c 100644 --- a/TESTING/LIN/ztsqr01.f +++ b/TESTING/LIN/ztsqr01.f @@ -2,19 +2,19 @@ * * =========== 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/ * * Definition: * =========== * * SUBROUTINE ZTSQR01(TSSW, M,N, MB, NB, RESULT) -* +* * .. Scalar Arguments .. * INTEGER M, N, MB * .. Return values .. * DOUBLE PRECISION RESULT(6) -* +* * *> \par Purpose: * ============= @@ -65,17 +65,17 @@ *> RESULT(2) = | I - Q^H Q | or | I - Q Q^H | *> RESULT(3) = | Q C - Q C | *> RESULT(4) = | Q^H C - Q^H C | -*> RESULT(5) = | C Q - C Q | +*> RESULT(5) = | C Q - C Q | *> RESULT(6) = | C Q^H - C Q^H | *> \endverbatim * * Authors: * ======== * -*> \author Univ. of Tennessee -*> \author Univ. of California Berkeley -*> \author Univ. of Colorado Denver -*> \author NAG Ltd. +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. * *> \date April 2012 * @@ -97,9 +97,9 @@ * ===================================================================== * * .. -* .. Local allocatable arrays +* .. Local allocatable arrays COMPLEX*16, ALLOCATABLE :: AF(:,:), Q(:,:), - $ R(:,:), RWORK(:), WORK( : ), T(:), + $ R(:,:), RWORK(:), WORK( : ), T(:), $ CF(:,:), DF(:,:), A(:,:), C(:,:), D(:,:), LQ(:,:) * * .. Parameters .. @@ -122,24 +122,24 @@ EXTERNAL DLAMCH, ZLANGE, ZLANSY, LSAME, ILAENV * .. * .. Intrinsic Functions .. - INTRINSIC MAX, MIN + INTRINSIC MAX, MIN * .. Scalars in Common .. CHARACTER*32 srnamt * .. * .. Common blocks .. - COMMON / srnamc / srnamt + COMMON / srnamc / srnamt * .. * .. Data statements .. - DATA ISEED / 1988, 1989, 1990, 1991 / + DATA ISEED / 1988, 1989, 1990, 1991 / * * TEST TALL SKINNY OR SHORT WIDE * - TS = LSAME(TSSW, 'TS') -* + TS = LSAME(TSSW, 'TS') +* * TEST MATRICES WITH HALF OF MATRIX BEING ZEROS * TESTZEROS = .FALSE. -* +* EPS = DLAMCH( 'Epsilon' ) K = MIN(M,N) L = MAX(M,N,1) @@ -148,14 +148,14 @@ IF((K.GE.MNB).OR.(MNB.GE.L))THEN LT=MAX(1,L)*MNB+5 ELSE - LT=MAX(1,(L-K)/(MNB-K)+1)*L*MNB+5 + LT=MAX(1,(L-K)/(MNB-K)+1)*L*MNB+5 END IF * * Dynamically allocate local arrays * - ALLOCATE ( A(M,N), AF(M,N), Q(L,L), R(M,L), RWORK(L), - $ WORK(LWORK), T(LT), C(M,N), CF(M,N), + ALLOCATE ( A(M,N), AF(M,N), Q(L,L), R(M,L), RWORK(L), + $ WORK(LWORK), T(LT), C(M,N), CF(M,N), $ D(N,M), DF(N,M), LQ(L,N) ) * * Put random numbers into A and copy to AF @@ -183,7 +183,7 @@ * CALL ZLASET( 'Full', M, M, CZERO, ONE, Q, M ) srnamt = 'ZGEMQR' - CALL ZGEMQR( 'L', 'N', M, M, K, AF, M, T, LT, Q, M, + CALL ZGEMQR( 'L', 'N', M, M, K, AF, M, T, LT, Q, M, $ WORK, LWORK, INFO ) * * Copy R @@ -220,7 +220,7 @@ * Apply Q to C as Q*C * srnamt = 'ZGEMQR' - CALL ZGEMQR( 'L', 'N', M, N, K, AF, M, T, LT, CF, M, + CALL ZGEMQR( 'L', 'N', M, N, K, AF, M, T, LT, CF, M, $ WORK, LWORK, INFO) * * Compute |Q*C - Q*C| / |C| @@ -240,7 +240,7 @@ * Apply Q to C as QT*C * srnamt = 'ZGEMQR' - CALL ZGEMQR( 'L', 'C', M, N, K, AF, M, T, LT, CF, M, + CALL ZGEMQR( 'L', 'C', M, N, K, AF, M, T, LT, CF, M, $ WORK, LWORK, INFO) * * Compute |QT*C - QT*C| / |C| @@ -251,7 +251,7 @@ RESULT( 4 ) = RESID / (EPS*MAX(1,M)*CNORM) ELSE RESULT( 4 ) = ZERO - END IF + END IF * * Generate random n-by-m matrix D and a copy DF * @@ -264,8 +264,8 @@ * Apply Q to D as D*Q * srnamt = 'ZGEMQR' - CALL ZGEMQR( 'R', 'N', N, M, K, AF, M, T, LT, DF, N, - $ WORK, LWORK, INFO) + CALL ZGEMQR( 'R', 'N', N, M, K, AF, M, T, LT, DF, N, + $ WORK, LWORK, INFO) * * Compute |D*Q - D*Q| / |D| * @@ -283,8 +283,8 @@ * * Apply Q to D as D*QT * - CALL ZGEMQR( 'R', 'C', N, M, K, AF, M, T, LT, DF, N, - $ WORK, LWORK, INFO) + CALL ZGEMQR( 'R', 'C', N, M, K, AF, M, T, LT, DF, N, + $ WORK, LWORK, INFO) * * Compute |D*QT - D*QT| / |D| * @@ -307,7 +307,7 @@ * CALL ZLASET( 'Full', N, N, CZERO, ONE, Q, N ) srnamt = 'ZGEMLQ' - CALL ZGEMLQ( 'R', 'N', N, N, K, AF, M, T, LT, Q, N, + CALL ZGEMLQ( 'R', 'N', N, N, K, AF, M, T, LT, Q, N, $ WORK, LWORK, INFO ) * * Copy R @@ -343,7 +343,7 @@ * * Apply Q to C as Q*C * - CALL ZGEMLQ( 'L', 'N', N, M, K, AF, M, T, LT, DF, N, + CALL ZGEMLQ( 'L', 'N', N, M, K, AF, M, T, LT, DF, N, $ WORK, LWORK, INFO) * * Compute |Q*D - Q*D| / |D| @@ -362,7 +362,7 @@ * * Apply Q to D as QT*D * - CALL ZGEMLQ( 'L', 'C', N, M, K, AF, M, T, LT, DF, N, + CALL ZGEMLQ( 'L', 'C', N, M, K, AF, M, T, LT, DF, N, $ WORK, LWORK, INFO) * * Compute |QT*D - QT*D| / |D| @@ -373,7 +373,7 @@ RESULT( 4 ) = RESID / (EPS*MAX(1,N)*DNORM) ELSE RESULT( 4 ) = ZERO - END IF + END IF * * Generate random n-by-m matrix D and a copy DF * @@ -385,8 +385,8 @@ * * Apply Q to C as C*Q * - CALL ZGEMLQ( 'R', 'N', M, N, K, AF, M, T, LT, CF, M, - $ WORK, LWORK, INFO) + CALL ZGEMLQ( 'R', 'N', M, N, K, AF, M, T, LT, CF, M, + $ WORK, LWORK, INFO) * * Compute |C*Q - C*Q| / |C| * @@ -404,8 +404,8 @@ * * Apply Q to D as D*QT * - CALL ZGEMLQ( 'R', 'C', M, N, K, AF, M, T, LT, CF, M, - $ WORK, LWORK, INFO) + CALL ZGEMLQ( 'R', 'C', M, N, K, AF, M, T, LT, CF, M, + $ WORK, LWORK, INFO) * * Compute |C*QT - C*QT| / |C| * @@ -424,4 +424,4 @@ DEALLOCATE ( A, AF, Q, R, RWORK, WORK, T, C, D, CF, DF) * RETURN - END \ No newline at end of file + END -- 2.7.4