[BACK]Return to dtpmqrt.f CVS log [TXT] [DIR] Up to [local] / rpl / lapack / lapack

Diff for /rpl/lapack/lapack/dtpmqrt.f between versions 1.7 and 1.8

version 1.7, 2016/08/27 15:34:41 version 1.8, 2017/06/17 10:54:06
Line 2 Line 2
 *  *
 *  =========== DOCUMENTATION ===========  *  =========== DOCUMENTATION ===========
 *  *
 * Online html documentation available at   * Online html documentation available at
 *            http://www.netlib.org/lapack/explore-html/   *            http://www.netlib.org/lapack/explore-html/
 *  *
 *> \htmlonly  *> \htmlonly
 *> Download DTPMQRT + dependencies   *> Download DTPMQRT + dependencies
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dtpmqrt.f">   *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dtpmqrt.f">
 *> [TGZ]</a>   *> [TGZ]</a>
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dtpmqrt.f">   *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dtpmqrt.f">
 *> [ZIP]</a>   *> [ZIP]</a>
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dtpmqrt.f">   *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dtpmqrt.f">
 *> [TXT]</a>  *> [TXT]</a>
 *> \endhtmlonly   *> \endhtmlonly
 *  *
 *  Definition:  *  Definition:
 *  ===========  *  ===========
 *  *
 *       SUBROUTINE DTPMQRT( SIDE, TRANS, M, N, K, L, NB, V, LDV, T, LDT,  *       SUBROUTINE DTPMQRT( SIDE, TRANS, M, N, K, L, NB, V, LDV, T, LDT,
 *                           A, LDA, B, LDB, WORK, INFO )  *                           A, LDA, B, LDB, WORK, INFO )
 *   *
 *       .. Scalar Arguments ..  *       .. Scalar Arguments ..
 *       CHARACTER SIDE, TRANS  *       CHARACTER SIDE, TRANS
 *       INTEGER   INFO, K, LDV, LDA, LDB, M, N, L, NB, LDT  *       INTEGER   INFO, K, LDV, LDA, LDB, M, N, L, NB, LDT
 *       ..  *       ..
 *       .. Array Arguments ..  *       .. Array Arguments ..
 *       DOUBLE PRECISION   V( LDV, * ), A( LDA, * ), B( LDB, * ),   *       DOUBLE PRECISION   V( LDV, * ), A( LDA, * ), B( LDB, * ),
 *      $                   T( LDT, * ), WORK( * )  *      $                   T( LDT, * ), WORK( * )
 *       ..  *       ..
 *    *
 *  *
 *> \par Purpose:  *> \par Purpose:
 *  =============  *  =============
 *>  *>
 *> \verbatim  *> \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  *> "triangular-pentagonal" real block reflector H to a general
 *> real matrix C, which consists of two blocks A and B.  *> real matrix C, which consists of two blocks A and B.
 *> \endverbatim  *> \endverbatim
Line 69 Line 69
 *>          N is INTEGER  *>          N is INTEGER
 *>          The number of columns of the matrix B. N >= 0.  *>          The number of columns of the matrix B. N >= 0.
 *> \endverbatim  *> \endverbatim
 *>   *>
 *> \param[in] K  *> \param[in] K
 *> \verbatim  *> \verbatim
 *>          K is INTEGER  *>          K is INTEGER
Line 80 Line 80
 *> \param[in] L  *> \param[in] L
 *> \verbatim  *> \verbatim
 *>          L is INTEGER  *>          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.  *>          K >= L >= 0.  See Further Details.
 *> \endverbatim  *> \endverbatim
 *>  *>
Line 124 Line 124
 *> \param[in,out] A  *> \param[in,out] A
 *> \verbatim  *> \verbatim
 *>          A is DOUBLE PRECISION array, dimension  *>          A is DOUBLE PRECISION array, dimension
 *>          (LDA,N) if SIDE = 'L' or   *>          (LDA,N) if SIDE = 'L' or
 *>          (LDA,K) if SIDE = 'R'  *>          (LDA,K) if SIDE = 'R'
 *>          On entry, the K-by-N or M-by-K matrix A.  *>          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.  *>          Q*C or Q**T*C or C*Q or C*Q**T.  See Further Details.
 *> \endverbatim  *> \endverbatim
 *>  *>
 *> \param[in] LDA  *> \param[in] LDA
 *> \verbatim  *> \verbatim
 *>          LDA is INTEGER  *>          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 = 'L', LDC >= max(1,K);
 *>          If SIDE = 'R', LDC >= max(1,M).   *>          If SIDE = 'R', LDC >= max(1,M).
 *> \endverbatim  *> \endverbatim
 *>  *>
 *> \param[in,out] B  *> \param[in,out] B
Line 150 Line 150
 *> \param[in] LDB  *> \param[in] LDB
 *> \verbatim  *> \verbatim
 *>          LDB is INTEGER  *>          LDB is INTEGER
 *>          The leading dimension of the array B.   *>          The leading dimension of the array B.
 *>          LDB >= max(1,M).  *>          LDB >= max(1,M).
 *> \endverbatim  *> \endverbatim
 *>  *>
Line 170 Line 170
 *  Authors:  *  Authors:
 *  ========  *  ========
 *  *
 *> \author Univ. of Tennessee   *> \author Univ. of Tennessee
 *> \author Univ. of California Berkeley   *> \author Univ. of California Berkeley
 *> \author Univ. of Colorado Denver   *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.   *> \author NAG Ltd.
 *  *
 *> \date November 2015  *> \date December 2016
 *  *
 *> \ingroup doubleOTHERcomputational  *> \ingroup doubleOTHERcomputational
 *  *
Line 185 Line 185
 *> \verbatim  *> \verbatim
 *>  *>
 *>  The columns of the pentagonal matrix V contain the elementary reflectors  *>  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:  *>  trapezoidal block V2:
 *>  *>
 *>        V = [V1]  *>        V = [V1]
 *>            [V2].  *>            [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 upper trapezoidal, consisting of the first L  *>  where 0 <= L <= K; V2 is upper trapezoidal, consisting of the first L
 *>  rows of a K-by-K upper triangular matrix.  If L=K, V2 is upper triangular;  *>  rows of a K-by-K upper triangular matrix.  If L=K, V2 is upper triangular;
 *>  if L=0, there is no trapezoidal block, hence V = V1 is rectangular.  *>  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 M-by-K.   *>  If SIDE = 'L':  C = [A]  where A is K-by-N,  B is M-by-N and V is M-by-K.
 *>                      [B]     *>                      [B]
 *>    *>
 *>  If SIDE = 'R':  C = [A B]  where A is M-by-K, B is M-by-N and V is N-by-K.  *>  If SIDE = 'R':  C = [A B]  where A is M-by-K, B is M-by-N and V is N-by-K.
 *>  *>
 *>  The real orthogonal matrix Q is formed from V and T.  *>  The real orthogonal matrix Q is formed from V and T.
Line 216 Line 216
       SUBROUTINE DTPMQRT( SIDE, TRANS, M, N, K, L, NB, V, LDV, T, LDT,        SUBROUTINE DTPMQRT( SIDE, TRANS, M, N, K, L, NB, V, LDV, T, LDT,
      $                    A, LDA, B, LDB, WORK, INFO )       $                    A, LDA, B, LDB, WORK, INFO )
 *  *
 *  -- LAPACK computational routine (version 3.6.0) --  *  -- LAPACK computational routine (version 3.7.0) --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --  *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--  *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 *     November 2015  *     December 2016
 *  *
 *     .. Scalar Arguments ..  *     .. Scalar Arguments ..
       CHARACTER SIDE, TRANS        CHARACTER SIDE, TRANS
       INTEGER   INFO, K, LDV, LDA, LDB, M, N, L, NB, LDT        INTEGER   INFO, K, LDV, LDA, LDB, M, N, L, NB, LDT
 *     ..  *     ..
 *     .. Array Arguments ..  *     .. Array Arguments ..
       DOUBLE PRECISION   V( LDV, * ), A( LDA, * ), B( LDB, * ),         DOUBLE PRECISION   V( LDV, * ), A( LDA, * ), B( LDB, * ),
      $                   T( LDT, * ), WORK( * )       $                   T( LDT, * ), WORK( * )
 *     ..  *     ..
 *  *
Line 242 Line 242
       EXTERNAL           LSAME        EXTERNAL           LSAME
 *     ..  *     ..
 *     .. External Subroutines ..  *     .. External Subroutines ..
       EXTERNAL           XERBLA, DLARFB        EXTERNAL           XERBLA
 *     ..  *     ..
 *     .. Intrinsic Functions ..  *     .. Intrinsic Functions ..
       INTRINSIC          MAX, MIN        INTRINSIC          MAX, MIN
Line 256 Line 256
       RIGHT  = LSAME( SIDE,  'R' )        RIGHT  = LSAME( SIDE,  'R' )
       TRAN   = LSAME( TRANS, 'T' )        TRAN   = LSAME( TRANS, 'T' )
       NOTRAN = LSAME( TRANS, 'N' )        NOTRAN = LSAME( TRANS, 'N' )
 *        *
       IF ( LEFT ) THEN        IF ( LEFT ) THEN
          LDVQ = MAX( 1, M )           LDVQ = MAX( 1, M )
          LDAQ = MAX( 1, K )           LDAQ = MAX( 1, K )
Line 275 Line 275
       ELSE IF( K.LT.0 ) THEN        ELSE IF( K.LT.0 ) THEN
          INFO = -5           INFO = -5
       ELSE IF( L.LT.0 .OR. L.GT.K ) THEN        ELSE IF( L.LT.0 .OR. L.GT.K ) THEN
          INFO = -6                    INFO = -6
       ELSE IF( NB.LT.1 .OR. (NB.GT.K .AND. K.GT.0) ) THEN        ELSE IF( NB.LT.1 .OR. (NB.GT.K .AND. K.GT.0) ) THEN
          INFO = -7           INFO = -7
       ELSE IF( LDV.LT.LDVQ ) THEN        ELSE IF( LDV.LT.LDVQ ) THEN
Line 307 Line 307
             ELSE              ELSE
                LB = MB-M+L-I+1                 LB = MB-M+L-I+1
             END IF              END IF
             CALL DTPRFB( 'L', 'T', 'F', 'C', MB, N, IB, LB,               CALL DTPRFB( 'L', 'T', 'F', 'C', MB, N, IB, LB,
      $                   V( 1, I ), LDV, T( 1, I ), LDT,        $                   V( 1, I ), LDV, T( 1, I ), LDT,
      $                   A( I, 1 ), LDA, B, LDB, WORK, IB )       $                   A( I, 1 ), LDA, B, LDB, WORK, IB )
          END DO           END DO
 *           *
       ELSE IF( RIGHT .AND. NOTRAN ) THEN        ELSE IF( RIGHT .AND. NOTRAN ) THEN
 *  *
          DO I = 1, K, NB           DO I = 1, K, NB
Line 322 Line 322
             ELSE              ELSE
                LB = MB-N+L-I+1                 LB = MB-N+L-I+1
             END IF              END IF
             CALL DTPRFB( 'R', 'N', 'F', 'C', M, MB, IB, LB,               CALL DTPRFB( 'R', 'N', 'F', 'C', M, MB, IB, LB,
      $                   V( 1, I ), LDV, T( 1, I ), LDT,        $                   V( 1, I ), LDV, T( 1, I ), LDT,
      $                   A( 1, I ), LDA, B, LDB, WORK, M )       $                   A( 1, I ), LDA, B, LDB, WORK, M )
          END DO           END DO
 *  *
Line 331 Line 331
 *  *
          KF = ((K-1)/NB)*NB+1           KF = ((K-1)/NB)*NB+1
          DO I = KF, 1, -NB           DO I = KF, 1, -NB
             IB = MIN( NB, K-I+1 )                IB = MIN( NB, K-I+1 )
             MB = MIN( M-L+I+IB-1, M )              MB = MIN( M-L+I+IB-1, M )
             IF( I.GE.L ) THEN              IF( I.GE.L ) THEN
                LB = 0                 LB = 0
             ELSE              ELSE
                LB = MB-M+L-I+1                 LB = MB-M+L-I+1
             END IF                                 END IF
             CALL DTPRFB( 'L', 'N', 'F', 'C', MB, N, IB, LB,              CALL DTPRFB( 'L', 'N', 'F', 'C', MB, N, IB, LB,
      $                   V( 1, I ), LDV, T( 1, I ), LDT,        $                   V( 1, I ), LDV, T( 1, I ), LDT,
      $                   A( I, 1 ), LDA, B, LDB, WORK, IB )       $                   A( I, 1 ), LDA, B, LDB, WORK, IB )
          END DO           END DO
 *  *
Line 347 Line 347
 *  *
          KF = ((K-1)/NB)*NB+1           KF = ((K-1)/NB)*NB+1
          DO I = KF, 1, -NB           DO I = KF, 1, -NB
             IB = MIN( NB, K-I+1 )                       IB = MIN( NB, K-I+1 )
             MB = MIN( N-L+I+IB-1, N )              MB = MIN( N-L+I+IB-1, N )
             IF( I.GE.L ) THEN              IF( I.GE.L ) THEN
                LB = 0                 LB = 0
Line 355 Line 355
                LB = MB-N+L-I+1                 LB = MB-N+L-I+1
             END IF              END IF
             CALL DTPRFB( 'R', 'T', 'F', 'C', M, MB, IB, LB,              CALL DTPRFB( 'R', 'T', 'F', 'C', M, MB, IB, LB,
      $                   V( 1, I ), LDV, T( 1, I ), LDT,        $                   V( 1, I ), LDV, T( 1, I ), LDT,
      $                   A( 1, I ), LDA, B, LDB, WORK, M )       $                   A( 1, I ), LDA, B, LDB, WORK, M )
          END DO           END DO
 *  *
Removed from v.1.7  
changed lines
  Added in v.1.8

CVSweb interface <joel.bertrand@systella.fr>