version 1.4, 2011/11/21 20:43:00
|
version 1.11, 2015/11/26 11:44:18
|
Line 255
|
Line 255
|
*> \author Univ. of Colorado Denver |
*> \author Univ. of Colorado Denver |
*> \author NAG Ltd. |
*> \author NAG Ltd. |
* |
* |
*> \date November 2011 |
*> \date November 2015 |
* |
* |
*> \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.6.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 |
* November 2015 |
* |
* |
* .. 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 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) ) |
|
ELSE |
|
CALL DLARFGP( M-P-I+1, X21(I,I), X21(I,I+1), LDX21, |
$ TAUP2(I) ) |
$ 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 |
* |
* |