--- rpl/lapack/lapack/dorbdb.f 2012/12/14 14:22:36 1.8 +++ rpl/lapack/lapack/dorbdb.f 2014/01/27 09:24:34 1.9 @@ -255,7 +255,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date November 2013 * *> \ingroup doubleOTHERcomputational * @@ -287,10 +287,10 @@ $ X21, LDX21, X22, LDX22, THETA, PHI, TAUP1, $ TAUP2, TAUQ1, TAUQ2, WORK, LWORK, INFO ) * -* -- LAPACK computational routine (version 3.4.0) -- +* -- LAPACK computational routine (version 3.5.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* November 2013 * * .. Scalar Arguments .. CHARACTER SIGNS, TRANS @@ -415,19 +415,36 @@ THETA(I) = ATAN2( DNRM2( M-P-I+1, X21(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 - 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 * - CALL DLARF( 'L', P-I+1, Q-I, X11(I,I), 1, TAUP1(I), - $ X11(I,I+1), LDX11, WORK ) - CALL DLARF( 'L', P-I+1, M-Q-I+1, X11(I,I), 1, TAUP1(I), - $ X12(I,I), LDX12, WORK ) - CALL DLARF( 'L', M-P-I+1, Q-I, X21(I,I), 1, TAUP2(I), - $ X21(I,I+1), LDX21, WORK ) - CALL DLARF( 'L', M-P-I+1, M-Q-I+1, X21(I,I), 1, TAUP2(I), - $ X22(I,I), LDX22, WORK ) + IF ( Q .GT. I ) THEN + CALL DLARF( 'L', P-I+1, Q-I, X11(I,I), 1, TAUP1(I), + $ X11(I,I+1), LDX11, WORK ) + END IF + IF ( M-Q+1 .GT. I ) THEN + CALL DLARF( 'L', P-I+1, M-Q-I+1, X11(I,I), 1, TAUP1(I), + $ X12(I,I), LDX12, 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 CALL DSCAL( Q-I, -Z1*Z3*SIN(THETA(I)), X11(I,I+1), @@ -444,12 +461,24 @@ $ DNRM2( M-Q-I+1, X12(I,I), LDX12 ) ) * IF( I .LT. Q ) THEN - CALL DLARFGP( Q-I, X11(I,I+1), X11(I,I+2), LDX11, - $ TAUQ1(I) ) + IF ( Q-I .EQ. 1 ) THEN + 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 END IF - CALL DLARFGP( M-Q-I+1, X12(I,I), X12(I,I+1), LDX12, - $ TAUQ2(I) ) + IF ( Q+I-1 .LT. M ) THEN + 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 * IF( I .LT. Q ) THEN @@ -458,10 +487,14 @@ CALL DLARF( 'R', M-P-I, Q-I, X11(I,I+1), LDX11, TAUQ1(I), $ X21(I+1,I+1), LDX21, WORK ) END IF - CALL DLARF( 'R', P-I, M-Q-I+1, X12(I,I), LDX12, TAUQ2(I), - $ X12(I+1,I), LDX12, WORK ) - CALL DLARF( 'R', M-P-I, M-Q-I+1, X12(I,I), LDX12, TAUQ2(I), - $ X22(I+1,I), LDX22, WORK ) + IF ( P .GT. I ) THEN + 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 .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 * @@ -470,12 +503,19 @@ DO I = Q + 1, P * 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, - $ TAUQ2(I) ) + IF ( I .GE. M-Q ) 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 X12(I,I) = ONE * - CALL DLARF( 'R', P-I, M-Q-I+1, X12(I,I), LDX12, TAUQ2(I), - $ X12(I+1,I), LDX12, WORK ) + IF ( P. GT. I ) THEN + 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 ) $ CALL DLARF( 'R', M-P-Q, M-Q-I+1, X12(I,I), LDX12, $ TAUQ2(I), X22(Q+1,I), LDX22, WORK ) @@ -487,11 +527,18 @@ DO I = 1, M - P - Q * 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), - $ LDX22, TAUQ2(P+I) ) + IF ( I .EQ. M-P-Q ) THEN + 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 - 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 ) + IF ( I .LT. M-P-Q ) THEN + 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 * @@ -521,18 +568,31 @@ * CALL DLARFGP( P-I+1, X11(I,I), X11(I,I+1), LDX11, TAUP1(I) ) 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) ) + END IF X21(I,I) = ONE * - CALL DLARF( 'R', Q-I, P-I+1, X11(I,I), LDX11, TAUP1(I), - $ X11(I+1,I), LDX11, WORK ) - CALL DLARF( 'R', M-Q-I+1, P-I+1, X11(I,I), LDX11, TAUP1(I), - $ X12(I,I), LDX12, WORK ) - CALL DLARF( 'R', Q-I, M-P-I+1, X21(I,I), LDX21, TAUP2(I), - $ X21(I+1,I), LDX21, WORK ) - CALL DLARF( 'R', M-Q-I+1, M-P-I+1, X21(I,I), LDX21, - $ TAUP2(I), X22(I,I), LDX22, WORK ) + IF ( Q .GT. I ) THEN + CALL DLARF( 'R', Q-I, P-I+1, X11(I,I), LDX11, TAUP1(I), + $ X11(I+1,I), LDX11, WORK ) + END IF + IF ( M-Q+1 .GT. I ) THEN + CALL DLARF( 'R', M-Q-I+1, P-I+1, X11(I,I), LDX11, + $ TAUP1(I), X12(I,I), LDX12, 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 CALL DSCAL( Q-I, -Z1*Z3*SIN(THETA(I)), X11(I+1,I), 1 ) @@ -548,10 +608,22 @@ $ DNRM2( M-Q-I+1, X12(I,I), 1 ) ) * 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 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 * IF( I .LT. Q ) THEN @@ -562,8 +634,10 @@ END IF CALL DLARF( 'L', M-Q-I+1, P-I, X12(I,I), 1, TAUQ2(I), $ X12(I,I+1), LDX12, WORK ) - CALL DLARF( 'L', M-Q-I+1, M-P-I, X12(I,I), 1, TAUQ2(I), - $ X22(I,I+1), LDX22, WORK ) + IF ( M-P-I .GT. 0 ) THEN + 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 * @@ -575,8 +649,10 @@ CALL DLARFGP( M-Q-I+1, X12(I,I), X12(I+1,I), 1, TAUQ2(I) ) 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 ) + END IF IF( M-P-Q .GE. 1 ) $ CALL DLARF( 'L', M-Q-I+1, M-P-Q, X12(I,I), 1, TAUQ2(I), $ X22(I,Q+1), LDX22, WORK ) @@ -588,12 +664,16 @@ DO I = 1, M - P - Q * 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, - $ TAUQ2(P+I) ) - X22(P+I,Q+I) = ONE -* - CALL DLARF( 'L', M-P-Q-I+1, M-P-Q-I, X22(P+I,Q+I), 1, + IF ( M-P-Q .EQ. I ) THEN + CALL DLARFGP( M-P-Q-I+1, X22(P+I,Q+I), X22(P+I,Q+I), 1, + $ TAUQ2(P+I) ) + ELSE + 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 ) + END IF + X22(P+I,Q+I) = ONE * END DO *