version 1.5, 2011/11/21 22:19:36
|
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 |
* |
* |