--- rpl/lapack/lapack/zunbdb.f 2012/12/14 14:22:57 1.8 +++ rpl/lapack/lapack/zunbdb.f 2014/01/27 09:24:37 1.9 @@ -255,7 +255,7 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date November 2013 * *> \ingroup complex16OTHERcomputational * @@ -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 @@ -314,7 +314,7 @@ * .. * .. Local Scalars .. LOGICAL COLMAJOR, LQUERY - INTEGER I, LWORKMIN, LWORKOPT + INTEGER I, LWORKMIN, LWORKOPT, PI1, QI1 DOUBLE PRECISION Z1, Z2, Z3, Z4 * .. * .. External Subroutines .. @@ -420,19 +420,33 @@ THETA(I) = ATAN2( DZNRM2( M-P-I+1, X21(I,I), 1 ), $ DZNRM2( P-I+1, X11(I,I), 1 ) ) * - CALL ZLARFGP( P-I+1, X11(I,I), X11(I+1,I), 1, TAUP1(I) ) + IF( P .GT. I ) THEN + CALL ZLARFGP( P-I+1, X11(I,I), X11(I+1,I), 1, TAUP1(I) ) + ELSE IF ( P .EQ. I ) THEN + CALL ZLARFGP( P-I+1, X11(I,I), X11(I,I), 1, TAUP1(I) ) + END IF X11(I,I) = ONE - CALL ZLARFGP( M-P-I+1, X21(I,I), X21(I+1,I), 1, TAUP2(I) ) + IF ( M-P .GT. I ) THEN + CALL ZLARFGP( M-P-I+1, X21(I,I), X21(I+1,I), 1, + $ TAUP2(I) ) + ELSE IF ( M-P .EQ. I ) THEN + CALL ZLARFGP( M-P-I+1, X21(I,I), X21(I,I), 1, + $ TAUP2(I) ) + END IF X21(I,I) = ONE * - CALL ZLARF( 'L', P-I+1, Q-I, X11(I,I), 1, DCONJG(TAUP1(I)), - $ X11(I,I+1), LDX11, WORK ) - CALL ZLARF( 'L', P-I+1, M-Q-I+1, X11(I,I), 1, - $ DCONJG(TAUP1(I)), X12(I,I), LDX12, WORK ) - CALL ZLARF( 'L', M-P-I+1, Q-I, X21(I,I), 1, - $ DCONJG(TAUP2(I)), X21(I,I+1), LDX21, WORK ) - CALL ZLARF( 'L', M-P-I+1, M-Q-I+1, X21(I,I), 1, - $ DCONJG(TAUP2(I)), X22(I,I), LDX22, WORK ) + IF ( Q .GT. I ) THEN + CALL ZLARF( 'L', P-I+1, Q-I, X11(I,I), 1, + $ DCONJG(TAUP1(I)), X11(I,I+1), LDX11, WORK ) + CALL ZLARF( 'L', M-P-I+1, Q-I, X21(I,I), 1, + $ DCONJG(TAUP2(I)), X21(I,I+1), LDX21, WORK ) + END IF + IF ( M-Q+1 .GT. I ) THEN + CALL ZLARF( 'L', P-I+1, M-Q-I+1, X11(I,I), 1, + $ DCONJG(TAUP1(I)), X12(I,I), LDX12, WORK ) + CALL ZLARF( 'L', M-P-I+1, M-Q-I+1, X21(I,I), 1, + $ DCONJG(TAUP2(I)), X22(I,I), LDX22, WORK ) + END IF * IF( I .LT. Q ) THEN CALL ZSCAL( Q-I, DCMPLX( -Z1*Z3*SIN(THETA(I)), 0.0D0 ), @@ -451,13 +465,25 @@ * IF( I .LT. Q ) THEN CALL ZLACGV( Q-I, X11(I,I+1), LDX11 ) - CALL ZLARFGP( Q-I, X11(I,I+1), X11(I,I+2), LDX11, - $ TAUQ1(I) ) + IF ( I .EQ. Q-1 ) THEN + CALL ZLARFGP( Q-I, X11(I,I+1), X11(I,I+1), LDX11, + $ TAUQ1(I) ) + ELSE + CALL ZLARFGP( Q-I, X11(I,I+1), X11(I,I+2), LDX11, + $ TAUQ1(I) ) + END IF X11(I,I+1) = ONE END IF - CALL ZLACGV( M-Q-I+1, X12(I,I), LDX12 ) - CALL ZLARFGP( M-Q-I+1, X12(I,I), X12(I,I+1), LDX12, - $ TAUQ2(I) ) + IF ( M-Q+1 .GT. I ) THEN + CALL ZLACGV( M-Q-I+1, X12(I,I), LDX12 ) + IF ( M-Q .EQ. I ) THEN + CALL ZLARFGP( M-Q-I+1, X12(I,I), X12(I,I), LDX12, + $ TAUQ2(I) ) + ELSE + CALL ZLARFGP( 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 @@ -466,10 +492,14 @@ CALL ZLARF( 'R', M-P-I, Q-I, X11(I,I+1), LDX11, TAUQ1(I), $ X21(I+1,I+1), LDX21, WORK ) END IF - CALL ZLARF( 'R', P-I, M-Q-I+1, X12(I,I), LDX12, TAUQ2(I), - $ X12(I+1,I), LDX12, WORK ) - CALL ZLARF( '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 ZLARF( '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 ZLARF( 'R', M-P-I, M-Q-I+1, X12(I,I), LDX12, + $ TAUQ2(I), X22(I+1,I), LDX22, WORK ) + END IF * IF( I .LT. Q ) $ CALL ZLACGV( Q-I, X11(I,I+1), LDX11 ) @@ -484,12 +514,19 @@ CALL ZSCAL( M-Q-I+1, DCMPLX( -Z1*Z4, 0.0D0 ), X12(I,I), $ LDX12 ) CALL ZLACGV( M-Q-I+1, X12(I,I), LDX12 ) - CALL ZLARFGP( M-Q-I+1, X12(I,I), X12(I,I+1), LDX12, - $ TAUQ2(I) ) + IF ( I .GE. M-Q ) THEN + CALL ZLARFGP( M-Q-I+1, X12(I,I), X12(I,I), LDX12, + $ TAUQ2(I) ) + ELSE + CALL ZLARFGP( M-Q-I+1, X12(I,I), X12(I,I+1), LDX12, + $ TAUQ2(I) ) + END IF X12(I,I) = ONE * - CALL ZLARF( '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 ZLARF( '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 ZLARF( 'R', M-P-Q, M-Q-I+1, X12(I,I), LDX12, $ TAUQ2(I), X22(Q+1,I), LDX22, WORK ) @@ -548,8 +585,13 @@ * CALL ZLARFGP( P-I+1, X11(I,I), X11(I,I+1), LDX11, TAUP1(I) ) X11(I,I) = ONE - CALL ZLARFGP( M-P-I+1, X21(I,I), X21(I,I+1), LDX21, - $ TAUP2(I) ) + IF ( I .EQ. M-P ) THEN + CALL ZLARFGP( M-P-I+1, X21(I,I), X21(I,I), LDX21, + $ TAUP2(I) ) + ELSE + CALL ZLARFGP( M-P-I+1, X21(I,I), X21(I,I+1), LDX21, + $ TAUP2(I) ) + END IF X21(I,I) = ONE * CALL ZLARF( 'R', Q-I, P-I+1, X11(I,I), LDX11, TAUP1(I), @@ -594,8 +636,10 @@ END IF CALL ZLARF( 'L', M-Q-I+1, P-I, X12(I,I), 1, $ DCONJG(TAUQ2(I)), X12(I,I+1), LDX12, WORK ) - CALL ZLARF( 'L', M-Q-I+1, M-P-I, X12(I,I), 1, - $ DCONJG(TAUQ2(I)), X22(I,I+1), LDX22, WORK ) + IF ( M-P .GT. I ) THEN + CALL ZLARF( 'L', M-Q-I+1, M-P-I, X12(I,I), 1, + $ DCONJG(TAUQ2(I)), X22(I,I+1), LDX22, WORK ) + END IF * END DO * @@ -607,8 +651,10 @@ CALL ZLARFGP( M-Q-I+1, X12(I,I), X12(I+1,I), 1, TAUQ2(I) ) X12(I,I) = ONE * - CALL ZLARF( 'L', M-Q-I+1, P-I, X12(I,I), 1, - $ DCONJG(TAUQ2(I)), X12(I,I+1), LDX12, WORK ) + IF ( P .GT. I ) THEN + CALL ZLARF( 'L', M-Q-I+1, P-I, X12(I,I), 1, + $ DCONJG(TAUQ2(I)), X12(I,I+1), LDX12, WORK ) + END IF IF( M-P-Q .GE. 1 ) $ CALL ZLARF( 'L', M-Q-I+1, M-P-Q, X12(I,I), 1, $ DCONJG(TAUQ2(I)), X22(I,Q+1), LDX22, WORK ) @@ -625,9 +671,11 @@ $ TAUQ2(P+I) ) X22(P+I,Q+I) = ONE * - CALL ZLARF( 'L', M-P-Q-I+1, M-P-Q-I, X22(P+I,Q+I), 1, - $ DCONJG(TAUQ2(P+I)), X22(P+I,Q+I+1), LDX22, - $ WORK ) + IF ( M-P-Q .NE. I ) THEN + CALL ZLARF( 'L', M-P-Q-I+1, M-P-Q-I, X22(P+I,Q+I), 1, + $ DCONJG(TAUQ2(P+I)), X22(P+I,Q+I+1), LDX22, + $ WORK ) + END IF * END DO *