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

Diff for /rpl/lapack/lapack/dorbdb.f between versions 1.4 and 1.14

version 1.4, 2011/11/21 20:43:00 version 1.14, 2017/06/17 11:06:28
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 DORBDB + dependencies   *> Download DORBDB + dependencies
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dorbdb.f">   *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dorbdb.f">
 *> [TGZ]</a>   *> [TGZ]</a>
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dorbdb.f">   *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dorbdb.f">
 *> [ZIP]</a>   *> [ZIP]</a>
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dorbdb.f">   *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dorbdb.f">
 *> [TXT]</a>  *> [TXT]</a>
 *> \endhtmlonly   *> \endhtmlonly
 *  *
 *  Definition:  *  Definition:
 *  ===========  *  ===========
Line 21 Line 21
 *       SUBROUTINE DORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12,  *       SUBROUTINE DORBDB( TRANS, SIGNS, M, P, Q, X11, LDX11, X12, LDX12,
 *                          X21, LDX21, X22, LDX22, THETA, PHI, TAUP1,  *                          X21, LDX21, X22, LDX22, THETA, PHI, TAUP1,
 *                          TAUP2, TAUQ1, TAUQ2, WORK, LWORK, INFO )  *                          TAUP2, TAUQ1, TAUQ2, WORK, LWORK, INFO )
 *   *
 *       .. Scalar Arguments ..  *       .. Scalar Arguments ..
 *       CHARACTER          SIGNS, TRANS  *       CHARACTER          SIGNS, TRANS
 *       INTEGER            INFO, LDX11, LDX12, LDX21, LDX22, LWORK, M, P,  *       INTEGER            INFO, LDX11, LDX12, LDX21, LDX22, LWORK, M, P,
Line 33 Line 33
 *      $                   WORK( * ), X11( LDX11, * ), X12( LDX12, * ),  *      $                   WORK( * ), X11( LDX11, * ), X12( LDX12, * ),
 *      $                   X21( LDX21, * ), X22( LDX22, * )  *      $                   X21( LDX21, * ), X22( LDX22, * )
 *       ..  *       ..
 *    *
 *  *
 *> \par Purpose:  *> \par Purpose:
 *  =============  *  =============
Line 250 Line 250
 *  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 2011  *> \date December 2016
 *  *
 *> \ingroup doubleOTHERcomputational  *> \ingroup doubleOTHERcomputational
 *  *
Line 287 Line 287
      $                   X21, LDX21, X22, LDX22, THETA, PHI, TAUP1,       $                   X21, LDX21, X22, LDX22, THETA, PHI, TAUP1,
      $                   TAUP2, TAUQ1, TAUQ2, WORK, LWORK, INFO )       $                   TAUP2, TAUQ1, TAUQ2, WORK, LWORK, INFO )
 *  *
 *  -- LAPACK computational routine (version 3.4.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 2011  *     December 2016
 *  *
 *     .. Scalar Arguments ..  *     .. Scalar Arguments ..
       CHARACTER          SIGNS, TRANS        CHARACTER          SIGNS, TRANS
Line 309 Line 309
 *     .. Parameters ..  *     .. Parameters ..
       DOUBLE PRECISION   REALONE        DOUBLE PRECISION   REALONE
       PARAMETER          ( REALONE = 1.0D0 )        PARAMETER          ( REALONE = 1.0D0 )
       DOUBLE PRECISION   NEGONE, ONE        DOUBLE PRECISION   ONE
       PARAMETER          ( NEGONE = -1.0D0, ONE = 1.0D0 )        PARAMETER          ( ONE = 1.0D0 )
 *     ..  *     ..
 *     .. Local Scalars ..  *     .. Local Scalars ..
       LOGICAL            COLMAJOR, LQUERY        LOGICAL            COLMAJOR, LQUERY
Line 393 Line 393
 *  *
       IF( COLMAJOR ) THEN        IF( COLMAJOR ) THEN
 *  *
 *        Reduce columns 1, ..., Q of X11, X12, X21, and X22   *        Reduce columns 1, ..., Q of X11, X12, X21, and X22
 *  *
          DO I = 1, Q           DO I = 1, Q
 *  *
Line 415 Line 415
             THETA(I) = ATAN2( DNRM2( M-P-I+1, X21(I,I), 1 ),              THETA(I) = ATAN2( DNRM2( M-P-I+1, X21(I,I), 1 ),
      $                 DNRM2( P-I+1, X11(I,I), 1 ) )       $                 DNRM2( P-I+1, X11(I,I), 1 ) )
 *  *
             CALL DLARFGP( P-I+1, X11(I,I), X11(I+1,I), 1, TAUP1(I) )              IF( P .GT. I ) THEN
                  CALL DLARFGP( P-I+1, X11(I,I), X11(I+1,I), 1, TAUP1(I) )
               ELSE IF( P .EQ. I ) THEN
                  CALL DLARFGP( P-I+1, X11(I,I), X11(I,I), 1, TAUP1(I) )
               END IF
             X11(I,I) = ONE              X11(I,I) = ONE
             CALL DLARFGP( M-P-I+1, X21(I,I), X21(I+1,I), 1, TAUP2(I) )              IF ( M-P .GT. I ) THEN
                  CALL DLARFGP( M-P-I+1, X21(I,I), X21(I+1,I), 1,
        $                       TAUP2(I) )
               ELSE IF ( M-P .EQ. I ) THEN
                  CALL DLARFGP( M-P-I+1, X21(I,I), X21(I,I), 1, TAUP2(I) )
               END IF
             X21(I,I) = ONE              X21(I,I) = ONE
 *  *
             CALL DLARF( 'L', P-I+1, Q-I, X11(I,I), 1, TAUP1(I),              IF ( Q .GT. I ) THEN
      $                  X11(I,I+1), LDX11, WORK )                 CALL DLARF( 'L', P-I+1, Q-I, X11(I,I), 1, TAUP1(I),
             CALL DLARF( 'L', P-I+1, M-Q-I+1, X11(I,I), 1, TAUP1(I),       $                     X11(I,I+1), LDX11, WORK )
      $                  X12(I,I), LDX12, WORK )              END IF
             CALL DLARF( 'L', M-P-I+1, Q-I, X21(I,I), 1, TAUP2(I),              IF ( M-Q+1 .GT. I ) THEN
      $                  X21(I,I+1), LDX21, WORK )                 CALL DLARF( 'L', P-I+1, M-Q-I+1, X11(I,I), 1, TAUP1(I),
             CALL DLARF( 'L', M-P-I+1, M-Q-I+1, X21(I,I), 1, TAUP2(I),       $                     X12(I,I), LDX12, WORK )
      $                  X22(I,I), LDX22, WORK )              END IF
               IF ( Q .GT. I ) THEN
                  CALL DLARF( 'L', M-P-I+1, Q-I, X21(I,I), 1, TAUP2(I),
        $                     X21(I,I+1), LDX21, WORK )
               END IF
               IF ( M-Q+1 .GT. I ) THEN
                  CALL DLARF( 'L', M-P-I+1, M-Q-I+1, X21(I,I), 1, TAUP2(I),
        $                     X22(I,I), LDX22, WORK )
               END IF
 *  *
             IF( I .LT. Q ) THEN              IF( I .LT. Q ) THEN
                CALL DSCAL( Q-I, -Z1*Z3*SIN(THETA(I)), X11(I,I+1),                 CALL DSCAL( Q-I, -Z1*Z3*SIN(THETA(I)), X11(I,I+1),
Line 444 Line 461
      $                  DNRM2( M-Q-I+1, X12(I,I), LDX12 ) )       $                  DNRM2( M-Q-I+1, X12(I,I), LDX12 ) )
 *  *
             IF( I .LT. Q ) THEN              IF( I .LT. Q ) THEN
                CALL DLARFGP( Q-I, X11(I,I+1), X11(I,I+2), LDX11,                 IF ( Q-I .EQ. 1 ) THEN
      $                       TAUQ1(I) )                    CALL DLARFGP( Q-I, X11(I,I+1), X11(I,I+1), LDX11,
        $                          TAUQ1(I) )
                  ELSE
                     CALL DLARFGP( Q-I, X11(I,I+1), X11(I,I+2), LDX11,
        $                          TAUQ1(I) )
                  END IF
                X11(I,I+1) = ONE                 X11(I,I+1) = ONE
             END IF              END IF
             CALL DLARFGP( M-Q-I+1, X12(I,I), X12(I,I+1), LDX12,              IF ( Q+I-1 .LT. M ) THEN
      $                    TAUQ2(I) )                 IF ( M-Q .EQ. I ) THEN
                     CALL DLARFGP( M-Q-I+1, X12(I,I), X12(I,I), LDX12,
        $                          TAUQ2(I) )
                  ELSE
                     CALL DLARFGP( M-Q-I+1, X12(I,I), X12(I,I+1), LDX12,
        $                          TAUQ2(I) )
                  END IF
               END IF
             X12(I,I) = ONE              X12(I,I) = ONE
 *  *
             IF( I .LT. Q ) THEN              IF( I .LT. Q ) THEN
Line 458 Line 487
                CALL DLARF( 'R', M-P-I, Q-I, X11(I,I+1), LDX11, TAUQ1(I),                 CALL DLARF( 'R', M-P-I, Q-I, X11(I,I+1), LDX11, TAUQ1(I),
      $                     X21(I+1,I+1), LDX21, WORK )       $                     X21(I+1,I+1), LDX21, WORK )
             END IF              END IF
             CALL DLARF( 'R', P-I, M-Q-I+1, X12(I,I), LDX12, TAUQ2(I),              IF ( P .GT. I ) THEN
      $                  X12(I+1,I), LDX12, WORK )                 CALL DLARF( 'R', P-I, M-Q-I+1, X12(I,I), LDX12, TAUQ2(I),
             CALL DLARF( 'R', M-P-I, M-Q-I+1, X12(I,I), LDX12, TAUQ2(I),       $                     X12(I+1,I), LDX12, WORK )
      $                  X22(I+1,I), LDX22, WORK )              END IF
               IF ( M-P .GT. I ) THEN
                  CALL DLARF( 'R', M-P-I, M-Q-I+1, X12(I,I), LDX12,
        $                     TAUQ2(I), X22(I+1,I), LDX22, WORK )
               END IF
 *  *
          END DO           END DO
 *  *
Line 470 Line 503
          DO I = Q + 1, P           DO I = Q + 1, P
 *  *
             CALL DSCAL( M-Q-I+1, -Z1*Z4, X12(I,I), LDX12 )              CALL DSCAL( M-Q-I+1, -Z1*Z4, X12(I,I), LDX12 )
             CALL DLARFGP( M-Q-I+1, X12(I,I), X12(I,I+1), LDX12,              IF ( I .GE. M-Q ) THEN
      $                    TAUQ2(I) )                 CALL DLARFGP( M-Q-I+1, X12(I,I), X12(I,I), LDX12,
        $                       TAUQ2(I) )
               ELSE
                  CALL DLARFGP( M-Q-I+1, X12(I,I), X12(I,I+1), LDX12,
        $                       TAUQ2(I) )
               END IF
             X12(I,I) = ONE              X12(I,I) = ONE
 *  *
             CALL DLARF( 'R', P-I, M-Q-I+1, X12(I,I), LDX12, TAUQ2(I),              IF ( P .GT. I ) THEN
      $                  X12(I+1,I), LDX12, WORK )                 CALL DLARF( 'R', P-I, M-Q-I+1, X12(I,I), LDX12, TAUQ2(I),
        $                     X12(I+1,I), LDX12, WORK )
               END IF
             IF( M-P-Q .GE. 1 )              IF( M-P-Q .GE. 1 )
      $         CALL DLARF( 'R', M-P-Q, M-Q-I+1, X12(I,I), LDX12,       $         CALL DLARF( 'R', M-P-Q, M-Q-I+1, X12(I,I), LDX12,
      $                     TAUQ2(I), X22(Q+1,I), LDX22, WORK )       $                     TAUQ2(I), X22(Q+1,I), LDX22, WORK )
Line 487 Line 527
          DO I = 1, M - P - Q           DO I = 1, M - P - Q
 *  *
             CALL DSCAL( M-P-Q-I+1, Z2*Z4, X22(Q+I,P+I), LDX22 )              CALL DSCAL( M-P-Q-I+1, Z2*Z4, X22(Q+I,P+I), LDX22 )
             CALL DLARFGP( M-P-Q-I+1, X22(Q+I,P+I), X22(Q+I,P+I+1),              IF ( I .EQ. M-P-Q ) THEN
      $                    LDX22, TAUQ2(P+I) )                 CALL DLARFGP( M-P-Q-I+1, X22(Q+I,P+I), X22(Q+I,P+I),
        $                       LDX22, TAUQ2(P+I) )
               ELSE
                  CALL DLARFGP( M-P-Q-I+1, X22(Q+I,P+I), X22(Q+I,P+I+1),
        $                       LDX22, TAUQ2(P+I) )
               END IF
             X22(Q+I,P+I) = ONE              X22(Q+I,P+I) = ONE
             CALL DLARF( 'R', M-P-Q-I, M-P-Q-I+1, X22(Q+I,P+I), LDX22,              IF ( I .LT. M-P-Q ) THEN
      $                  TAUQ2(P+I), X22(Q+I+1,P+I), LDX22, WORK )                 CALL DLARF( 'R', M-P-Q-I, M-P-Q-I+1, X22(Q+I,P+I), LDX22,
        $                     TAUQ2(P+I), X22(Q+I+1,P+I), LDX22, WORK )
               END IF
 *  *
          END DO           END DO
 *  *
Line 521 Line 568
 *  *
             CALL DLARFGP( P-I+1, X11(I,I), X11(I,I+1), LDX11, TAUP1(I) )              CALL DLARFGP( P-I+1, X11(I,I), X11(I,I+1), LDX11, TAUP1(I) )
             X11(I,I) = ONE              X11(I,I) = ONE
             CALL DLARFGP( M-P-I+1, X21(I,I), X21(I,I+1), LDX21,              IF ( I .EQ. M-P ) THEN
                  CALL DLARFGP( M-P-I+1, X21(I,I), X21(I,I), LDX21,
      $                    TAUP2(I) )       $                    TAUP2(I) )
               ELSE
                  CALL DLARFGP( M-P-I+1, X21(I,I), X21(I,I+1), LDX21,
        $                    TAUP2(I) )
               END IF
             X21(I,I) = ONE              X21(I,I) = ONE
 *  *
             CALL DLARF( 'R', Q-I, P-I+1, X11(I,I), LDX11, TAUP1(I),              IF ( Q .GT. I ) THEN
      $                  X11(I+1,I), LDX11, WORK )                 CALL DLARF( 'R', Q-I, P-I+1, X11(I,I), LDX11, TAUP1(I),
             CALL DLARF( 'R', M-Q-I+1, P-I+1, X11(I,I), LDX11, TAUP1(I),       $                     X11(I+1,I), LDX11, WORK )
      $                  X12(I,I), LDX12, WORK )              END IF
             CALL DLARF( 'R', Q-I, M-P-I+1, X21(I,I), LDX21, TAUP2(I),              IF ( M-Q+1 .GT. I ) THEN
      $                  X21(I+1,I), LDX21, WORK )                 CALL DLARF( 'R', M-Q-I+1, P-I+1, X11(I,I), LDX11,
             CALL DLARF( 'R', M-Q-I+1, M-P-I+1, X21(I,I), LDX21,       $                     TAUP1(I), X12(I,I), LDX12, WORK )
      $                  TAUP2(I), X22(I,I), LDX22, WORK )              END IF
               IF ( Q .GT. I ) THEN
                  CALL DLARF( 'R', Q-I, M-P-I+1, X21(I,I), LDX21, TAUP2(I),
        $                     X21(I+1,I), LDX21, WORK )
               END IF
               IF ( M-Q+1 .GT. I ) THEN
                  CALL DLARF( 'R', M-Q-I+1, M-P-I+1, X21(I,I), LDX21,
        $                     TAUP2(I), X22(I,I), LDX22, WORK )
               END IF
 *  *
             IF( I .LT. Q ) THEN              IF( I .LT. Q ) THEN
                CALL DSCAL( Q-I, -Z1*Z3*SIN(THETA(I)), X11(I+1,I), 1 )                 CALL DSCAL( Q-I, -Z1*Z3*SIN(THETA(I)), X11(I+1,I), 1 )
Line 548 Line 608
      $                  DNRM2( M-Q-I+1, X12(I,I), 1 ) )       $                  DNRM2( M-Q-I+1, X12(I,I), 1 ) )
 *  *
             IF( I .LT. Q ) THEN              IF( I .LT. Q ) THEN
                CALL DLARFGP( Q-I, X11(I+1,I), X11(I+2,I), 1, TAUQ1(I) )                 IF ( Q-I .EQ. 1) THEN
                     CALL DLARFGP( Q-I, X11(I+1,I), X11(I+1,I), 1,
        $                          TAUQ1(I) )
                  ELSE
                     CALL DLARFGP( Q-I, X11(I+1,I), X11(I+2,I), 1,
        $                          TAUQ1(I) )
                  END IF
                X11(I+1,I) = ONE                 X11(I+1,I) = ONE
             END IF              END IF
             CALL DLARFGP( M-Q-I+1, X12(I,I), X12(I+1,I), 1, TAUQ2(I) )              IF ( M-Q .GT. I ) THEN
                  CALL DLARFGP( M-Q-I+1, X12(I,I), X12(I+1,I), 1,
        $                       TAUQ2(I) )
               ELSE
                  CALL DLARFGP( M-Q-I+1, X12(I,I), X12(I,I), 1,
        $                       TAUQ2(I) )
               END IF
             X12(I,I) = ONE              X12(I,I) = ONE
 *  *
             IF( I .LT. Q ) THEN              IF( I .LT. Q ) THEN
Line 562 Line 634
             END IF              END IF
             CALL DLARF( 'L', M-Q-I+1, P-I, X12(I,I), 1, TAUQ2(I),              CALL DLARF( 'L', M-Q-I+1, P-I, X12(I,I), 1, TAUQ2(I),
      $                  X12(I,I+1), LDX12, WORK )       $                  X12(I,I+1), LDX12, WORK )
             CALL DLARF( 'L', M-Q-I+1, M-P-I, X12(I,I), 1, TAUQ2(I),              IF ( M-P-I .GT. 0 ) THEN
      $                  X22(I,I+1), LDX22, WORK )                 CALL DLARF( 'L', M-Q-I+1, M-P-I, X12(I,I), 1, TAUQ2(I),
        $                     X22(I,I+1), LDX22, WORK )
               END IF
 *  *
          END DO           END DO
 *  *
Line 575 Line 649
             CALL DLARFGP( M-Q-I+1, X12(I,I), X12(I+1,I), 1, TAUQ2(I) )              CALL DLARFGP( M-Q-I+1, X12(I,I), X12(I+1,I), 1, TAUQ2(I) )
             X12(I,I) = ONE              X12(I,I) = ONE
 *  *
             CALL DLARF( 'L', M-Q-I+1, P-I, X12(I,I), 1, TAUQ2(I),              IF ( P .GT. I ) THEN
                  CALL DLARF( 'L', M-Q-I+1, P-I, X12(I,I), 1, TAUQ2(I),
      $                  X12(I,I+1), LDX12, WORK )       $                  X12(I,I+1), LDX12, WORK )
               END IF
             IF( M-P-Q .GE. 1 )              IF( M-P-Q .GE. 1 )
      $         CALL DLARF( 'L', M-Q-I+1, M-P-Q, X12(I,I), 1, TAUQ2(I),       $         CALL DLARF( 'L', M-Q-I+1, M-P-Q, X12(I,I), 1, TAUQ2(I),
      $                     X22(I,Q+1), LDX22, WORK )       $                     X22(I,Q+1), LDX22, WORK )
Line 588 Line 664
          DO I = 1, M - P - Q           DO I = 1, M - P - Q
 *  *
             CALL DSCAL( M-P-Q-I+1, Z2*Z4, X22(P+I,Q+I), 1 )              CALL DSCAL( M-P-Q-I+1, Z2*Z4, X22(P+I,Q+I), 1 )
             CALL DLARFGP( M-P-Q-I+1, X22(P+I,Q+I), X22(P+I+1,Q+I), 1,              IF ( M-P-Q .EQ. I ) THEN
      $                    TAUQ2(P+I) )                 CALL DLARFGP( M-P-Q-I+1, X22(P+I,Q+I), X22(P+I,Q+I), 1,
             X22(P+I,Q+I) = ONE       $                       TAUQ2(P+I) )
 *              ELSE
             CALL DLARF( 'L', M-P-Q-I+1, M-P-Q-I, X22(P+I,Q+I), 1,                 CALL DLARFGP( M-P-Q-I+1, X22(P+I,Q+I), X22(P+I+1,Q+I), 1,
        $                       TAUQ2(P+I) )
                  CALL DLARF( 'L', M-P-Q-I+1, M-P-Q-I, X22(P+I,Q+I), 1,
      $                  TAUQ2(P+I), X22(P+I,Q+I+1), LDX22, WORK )       $                  TAUQ2(P+I), X22(P+I,Q+I+1), LDX22, WORK )
               END IF
               X22(P+I,Q+I) = ONE
 *  *
          END DO           END DO
 *  *
Removed from v.1.4  
changed lines
  Added in v.1.14

CVSweb interface <joel.bertrand@systella.fr>