diff options
-rw-r--r-- | SRC/chb2st_kernels.f | 227 | ||||
-rw-r--r-- | SRC/chetrd_hb2st.F | 17 | ||||
-rw-r--r-- | SRC/chetrd_he2hb.f | 4 | ||||
-rw-r--r-- | SRC/dsb2st_kernels.f | 227 | ||||
-rw-r--r-- | SRC/dsytrd_sb2st.F | 17 | ||||
-rw-r--r-- | SRC/dsytrd_sy2sb.f | 4 | ||||
-rw-r--r-- | SRC/ssb2st_kernels.f | 227 | ||||
-rw-r--r-- | SRC/ssytrd_sb2st.F | 17 | ||||
-rw-r--r-- | SRC/ssytrd_sy2sb.f | 4 | ||||
-rw-r--r-- | SRC/zhb2st_kernels.f | 225 | ||||
-rw-r--r-- | SRC/zhetrd_hb2st.F | 24 | ||||
-rw-r--r-- | SRC/zhetrd_he2hb.f | 2 |
12 files changed, 533 insertions, 462 deletions
diff --git a/SRC/chb2st_kernels.f b/SRC/chb2st_kernels.f index 8b0a4b28..9e08a275 100644 --- a/SRC/chb2st_kernels.f +++ b/SRC/chb2st_kernels.f @@ -1,6 +1,6 @@ *> \brief \b CHB2ST_KERNELS * -* @generated from zhb2st_kernels.f, fortran z -> c, Sun Nov 6 19:34:06 2016 +* @generated from zhb2st_kernels.f, fortran z -> c, Wed Dec 7 08:22:40 2016 * * =========== DOCUMENTATION =========== * @@ -128,7 +128,7 @@ * IMPLICIT NONE * -* -- LAPACK computational routine (version 3.4.0) -- +* -- LAPACK computational routine (version 3.7.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * November 2016 @@ -181,9 +181,9 @@ * * Upper case -* +* IF( UPPER ) THEN -* +* IF( WANTZ ) THEN VPOS = MOD( SWEEP-1, 2 ) * N + ST TAUPOS = MOD( SWEEP-1, 2 ) * N + ST @@ -191,59 +191,67 @@ VPOS = MOD( SWEEP-1, 2 ) * N + ST TAUPOS = MOD( SWEEP-1, 2 ) * N + ST ENDIF - GO TO ( 101, 102, 103 ) TTYPE -* - 101 CONTINUE - LM = ED - ST + 1 -* - V( VPOS ) = ONE - DO 10 I = 1, LM-1 - V( VPOS+I ) = CONJG( A( OFDPOS-I, ST+I ) ) - A( OFDPOS-I, ST+I ) = ZERO - 10 CONTINUE - CTMP = CONJG( A( OFDPOS, ST ) ) - CALL CLARFG( LM, CTMP, V( VPOS+1 ), 1, - $ TAU( TAUPOS ) ) - A( OFDPOS, ST ) = CTMP -* - 103 CONTINUE - LM = ED - ST + 1 - CALL CLARFY( UPLO, LM, V( VPOS ), 1, CONJG( TAU( TAUPOS ) ), - $ A( DPOS, ST ), LDA-1, WORK) - GOTO 300 -* - 102 CONTINUE - J1 = ED+1 - J2 = MIN( ED+NB, N ) - LN = ED-ST+1 - LM = J2-J1+1 - IF( LM.GT.0) THEN - CALL CLARFX( 'Left', LN, LM, V( VPOS ), - $ CONJG( TAU( TAUPOS ) ), A( DPOS-NB, J1 ), - $ LDA-1, WORK) -* - IF( WANTZ ) THEN - VPOS = MOD( SWEEP-1, 2 ) * N + J1 - TAUPOS = MOD( SWEEP-1, 2 ) * N + J1 - ELSE - VPOS = MOD( SWEEP-1, 2 ) * N + J1 - TAUPOS = MOD( SWEEP-1, 2 ) * N + J1 - ENDIF +* + IF( TTYPE.EQ.1 ) THEN + LM = ED - ST + 1 * V( VPOS ) = ONE - DO 30 I = 1, LM-1 - V( VPOS+I ) = CONJG( A( DPOS-NB-I, J1+I ) ) - A( DPOS-NB-I, J1+I ) = ZERO - 30 CONTINUE - CTMP = CONJG( A( DPOS-NB, J1 ) ) - CALL CLARFG( LM, CTMP, V( VPOS+1 ), 1, TAU( TAUPOS ) ) - A( DPOS-NB, J1 ) = CTMP -* - CALL CLARFX( 'Right', LN-1, LM, V( VPOS ), - $ TAU( TAUPOS ), - $ A( DPOS-NB+1, J1 ), LDA-1, WORK) + DO 10 I = 1, LM-1 + V( VPOS+I ) = CONJG( A( OFDPOS-I, ST+I ) ) + A( OFDPOS-I, ST+I ) = ZERO + 10 CONTINUE + CTMP = CONJG( A( OFDPOS, ST ) ) + CALL CLARFG( LM, CTMP, V( VPOS+1 ), 1, + $ TAU( TAUPOS ) ) + A( OFDPOS, ST ) = CTMP +* + LM = ED - ST + 1 + CALL CLARFY( UPLO, LM, V( VPOS ), 1, + $ CONJG( TAU( TAUPOS ) ), + $ A( DPOS, ST ), LDA-1, WORK) + ENDIF +* + IF( TTYPE.EQ.3 ) THEN +* + LM = ED - ST + 1 + CALL CLARFY( UPLO, LM, V( VPOS ), 1, + $ CONJG( TAU( TAUPOS ) ), + $ A( DPOS, ST ), LDA-1, WORK) + ENDIF +* + IF( TTYPE.EQ.2 ) THEN + J1 = ED+1 + J2 = MIN( ED+NB, N ) + LN = ED-ST+1 + LM = J2-J1+1 + IF( LM.GT.0) THEN + CALL CLARFX( 'Left', LN, LM, V( VPOS ), + $ CONJG( TAU( TAUPOS ) ), + $ A( DPOS-NB, J1 ), LDA-1, WORK) +* + IF( WANTZ ) THEN + VPOS = MOD( SWEEP-1, 2 ) * N + J1 + TAUPOS = MOD( SWEEP-1, 2 ) * N + J1 + ELSE + VPOS = MOD( SWEEP-1, 2 ) * N + J1 + TAUPOS = MOD( SWEEP-1, 2 ) * N + J1 + ENDIF +* + V( VPOS ) = ONE + DO 30 I = 1, LM-1 + V( VPOS+I ) = + $ CONJG( A( DPOS-NB-I, J1+I ) ) + A( DPOS-NB-I, J1+I ) = ZERO + 30 CONTINUE + CTMP = CONJG( A( DPOS-NB, J1 ) ) + CALL CLARFG( LM, CTMP, V( VPOS+1 ), 1, TAU( TAUPOS ) ) + A( DPOS-NB, J1 ) = CTMP +* + CALL CLARFX( 'Right', LN-1, LM, V( VPOS ), + $ TAU( TAUPOS ), + $ A( DPOS-NB+1, J1 ), LDA-1, WORK) + ENDIF ENDIF - GOTO 300 * * Lower case * @@ -256,63 +264,70 @@ VPOS = MOD( SWEEP-1, 2 ) * N + ST TAUPOS = MOD( SWEEP-1, 2 ) * N + ST ENDIF - GO TO ( 201, 202, 203 ) TTYPE -* - 201 CONTINUE - LM = ED - ST + 1 -* - V( VPOS ) = ONE - DO 20 I = 1, LM-1 - V( VPOS+I ) = A( OFDPOS+I, ST-1 ) - A( OFDPOS+I, ST-1 ) = ZERO - 20 CONTINUE - CALL CLARFG( LM, A( OFDPOS, ST-1 ), V( VPOS+1 ), 1, - $ TAU( TAUPOS ) ) -* - 203 CONTINUE - LM = ED - ST + 1 -* - CALL CLARFY( UPLO, LM, V( VPOS ), 1, CONJG( TAU( TAUPOS ) ), - $ A( DPOS, ST ), LDA-1, WORK) - - GOTO 300 -* - 202 CONTINUE - J1 = ED+1 - J2 = MIN( ED+NB, N ) - LN = ED-ST+1 - LM = J2-J1+1 -* - IF( LM.GT.0) THEN - CALL CLARFX( 'Right', LM, LN, V( VPOS ), - $ TAU( TAUPOS ), A( DPOS+NB, ST ), - $ LDA-1, WORK) -* - IF( WANTZ ) THEN - VPOS = MOD( SWEEP-1, 2 ) * N + J1 - TAUPOS = MOD( SWEEP-1, 2 ) * N + J1 - ELSE - VPOS = MOD( SWEEP-1, 2 ) * N + J1 - TAUPOS = MOD( SWEEP-1, 2 ) * N + J1 - ENDIF -* +* + IF( TTYPE.EQ.1 ) THEN + LM = ED - ST + 1 +* V( VPOS ) = ONE - DO 40 I = 1, LM-1 - V( VPOS+I ) = A( DPOS+NB+I, ST ) - A( DPOS+NB+I, ST ) = ZERO - 40 CONTINUE - CALL CLARFG( LM, A( DPOS+NB, ST ), V( VPOS+1 ), 1, - $ TAU( TAUPOS ) ) -* - CALL CLARFX( 'Left', LM, LN-1, V( VPOS ), + DO 20 I = 1, LM-1 + V( VPOS+I ) = A( OFDPOS+I, ST-1 ) + A( OFDPOS+I, ST-1 ) = ZERO + 20 CONTINUE + CALL CLARFG( LM, A( OFDPOS, ST-1 ), V( VPOS+1 ), 1, + $ TAU( TAUPOS ) ) +* + LM = ED - ST + 1 +* + CALL CLARFY( UPLO, LM, V( VPOS ), 1, $ CONJG( TAU( TAUPOS ) ), - $ A( DPOS+NB-1, ST+1 ), LDA-1, WORK) + $ A( DPOS, ST ), LDA-1, WORK) ENDIF - GOTO 300 - ENDIF +* + IF( TTYPE.EQ.3 ) THEN + LM = ED - ST + 1 +* + CALL CLARFY( UPLO, LM, V( VPOS ), 1, + $ CONJG( TAU( TAUPOS ) ), + $ A( DPOS, ST ), LDA-1, WORK) - 300 CONTINUE + ENDIF +* + IF( TTYPE.EQ.2 ) THEN + J1 = ED+1 + J2 = MIN( ED+NB, N ) + LN = ED-ST+1 + LM = J2-J1+1 +* + IF( LM.GT.0) THEN + CALL CLARFX( 'Right', LM, LN, V( VPOS ), + $ TAU( TAUPOS ), A( DPOS+NB, ST ), + $ LDA-1, WORK) +* + IF( WANTZ ) THEN + VPOS = MOD( SWEEP-1, 2 ) * N + J1 + TAUPOS = MOD( SWEEP-1, 2 ) * N + J1 + ELSE + VPOS = MOD( SWEEP-1, 2 ) * N + J1 + TAUPOS = MOD( SWEEP-1, 2 ) * N + J1 + ENDIF +* + V( VPOS ) = ONE + DO 40 I = 1, LM-1 + V( VPOS+I ) = A( DPOS+NB+I, ST ) + A( DPOS+NB+I, ST ) = ZERO + 40 CONTINUE + CALL CLARFG( LM, A( DPOS+NB, ST ), V( VPOS+1 ), 1, + $ TAU( TAUPOS ) ) +* + CALL CLARFX( 'Left', LM, LN-1, V( VPOS ), + $ CONJG( TAU( TAUPOS ) ), + $ A( DPOS+NB-1, ST+1 ), LDA-1, WORK) + + ENDIF + ENDIF + ENDIF +* RETURN * * END OF CHB2ST_KERNELS diff --git a/SRC/chetrd_hb2st.F b/SRC/chetrd_hb2st.F index c4d44803..85bffa08 100644 --- a/SRC/chetrd_hb2st.F +++ b/SRC/chetrd_hb2st.F @@ -334,8 +334,9 @@ * Quick return if possible * IF( N.EQ.0 ) THEN - WORK( 1 ) = 1 - RETURN + HOUS( 1 ) = 1 + WORK( 1 ) = 1 + RETURN END IF * * Determine pointer position @@ -382,7 +383,10 @@ DO 40 I = 1, N-1 E( I ) = RZERO 40 CONTINUE - RETURN +* + HOUS( 1 ) = 1 + WORK( 1 ) = 1 + RETURN END IF * * Case KD=1: @@ -437,6 +441,9 @@ C CALL CSCAL( N, TMP, Q( 1, I+1 ), 1 ) C END IF 70 CONTINUE ENDIF +* + HOUS( 1 ) = 1 + WORK( 1 ) = 1 RETURN END IF * @@ -473,7 +480,7 @@ C END IF THED = MIN( (STT + THGRSIZ -1), (N-1)) DO 110 I = STT, N-1 ED = MIN( I, THED ) - IF( STT.GT.ED ) GOTO 100 + IF( STT.GT.ED ) EXIT DO 120 M = 1, STEPERCOL ST = STT DO 130 SWEEPID = ST, ED @@ -537,7 +544,7 @@ C END IF #endif IF ( BLKLASTIND.GE.(N-1) ) THEN STT = STT + 1 - GOTO 130 + EXIT ENDIF 140 CONTINUE 130 CONTINUE diff --git a/SRC/chetrd_he2hb.f b/SRC/chetrd_he2hb.f index 28f5dc60..c6be3459 100644 --- a/SRC/chetrd_he2hb.f +++ b/SRC/chetrd_he2hb.f @@ -1,6 +1,6 @@ *> \brief \b CHETRD_HE2HB * -* @generated from zhetrd_he2hb.f, fortran z -> c, Sun Nov 6 19:34:06 2016 +* @generated from zhetrd_he2hb.f, fortran z -> c, Wed Dec 7 08:22:40 2016 * * =========== DOCUMENTATION =========== * @@ -245,7 +245,7 @@ * IMPLICIT NONE * -* -- LAPACK computational routine (version 3.4.0) -- +* -- LAPACK computational routine (version 3.7.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * November 2016 diff --git a/SRC/dsb2st_kernels.f b/SRC/dsb2st_kernels.f index 15d1186e..1eab415d 100644 --- a/SRC/dsb2st_kernels.f +++ b/SRC/dsb2st_kernels.f @@ -1,6 +1,6 @@ *> \brief \b DSB2ST_KERNELS * -* @generated from zhb2st_kernels.f, fortran z -> d, Sun Nov 6 19:34:06 2016 +* @generated from zhb2st_kernels.f, fortran z -> d, Wed Dec 7 08:22:39 2016 * * =========== DOCUMENTATION =========== * @@ -128,7 +128,7 @@ * IMPLICIT NONE * -* -- LAPACK computational routine (version 3.4.0) -- +* -- LAPACK computational routine (version 3.7.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * November 2016 @@ -181,9 +181,9 @@ * * Upper case -* +* IF( UPPER ) THEN -* +* IF( WANTZ ) THEN VPOS = MOD( SWEEP-1, 2 ) * N + ST TAUPOS = MOD( SWEEP-1, 2 ) * N + ST @@ -191,59 +191,67 @@ VPOS = MOD( SWEEP-1, 2 ) * N + ST TAUPOS = MOD( SWEEP-1, 2 ) * N + ST ENDIF - GO TO ( 101, 102, 103 ) TTYPE -* - 101 CONTINUE - LM = ED - ST + 1 -* - V( VPOS ) = ONE - DO 10 I = 1, LM-1 - V( VPOS+I ) = ( A( OFDPOS-I, ST+I ) ) - A( OFDPOS-I, ST+I ) = ZERO - 10 CONTINUE - CTMP = ( A( OFDPOS, ST ) ) - CALL DLARFG( LM, CTMP, V( VPOS+1 ), 1, - $ TAU( TAUPOS ) ) - A( OFDPOS, ST ) = CTMP -* - 103 CONTINUE - LM = ED - ST + 1 - CALL DLARFY( UPLO, LM, V( VPOS ), 1, ( TAU( TAUPOS ) ), - $ A( DPOS, ST ), LDA-1, WORK) - GOTO 300 -* - 102 CONTINUE - J1 = ED+1 - J2 = MIN( ED+NB, N ) - LN = ED-ST+1 - LM = J2-J1+1 - IF( LM.GT.0) THEN - CALL DLARFX( 'Left', LN, LM, V( VPOS ), - $ ( TAU( TAUPOS ) ), A( DPOS-NB, J1 ), - $ LDA-1, WORK) -* - IF( WANTZ ) THEN - VPOS = MOD( SWEEP-1, 2 ) * N + J1 - TAUPOS = MOD( SWEEP-1, 2 ) * N + J1 - ELSE - VPOS = MOD( SWEEP-1, 2 ) * N + J1 - TAUPOS = MOD( SWEEP-1, 2 ) * N + J1 - ENDIF +* + IF( TTYPE.EQ.1 ) THEN + LM = ED - ST + 1 * V( VPOS ) = ONE - DO 30 I = 1, LM-1 - V( VPOS+I ) = ( A( DPOS-NB-I, J1+I ) ) - A( DPOS-NB-I, J1+I ) = ZERO - 30 CONTINUE - CTMP = ( A( DPOS-NB, J1 ) ) - CALL DLARFG( LM, CTMP, V( VPOS+1 ), 1, TAU( TAUPOS ) ) - A( DPOS-NB, J1 ) = CTMP -* - CALL DLARFX( 'Right', LN-1, LM, V( VPOS ), - $ TAU( TAUPOS ), - $ A( DPOS-NB+1, J1 ), LDA-1, WORK) + DO 10 I = 1, LM-1 + V( VPOS+I ) = ( A( OFDPOS-I, ST+I ) ) + A( OFDPOS-I, ST+I ) = ZERO + 10 CONTINUE + CTMP = ( A( OFDPOS, ST ) ) + CALL DLARFG( LM, CTMP, V( VPOS+1 ), 1, + $ TAU( TAUPOS ) ) + A( OFDPOS, ST ) = CTMP +* + LM = ED - ST + 1 + CALL DLARFY( UPLO, LM, V( VPOS ), 1, + $ ( TAU( TAUPOS ) ), + $ A( DPOS, ST ), LDA-1, WORK) + ENDIF +* + IF( TTYPE.EQ.3 ) THEN +* + LM = ED - ST + 1 + CALL DLARFY( UPLO, LM, V( VPOS ), 1, + $ ( TAU( TAUPOS ) ), + $ A( DPOS, ST ), LDA-1, WORK) + ENDIF +* + IF( TTYPE.EQ.2 ) THEN + J1 = ED+1 + J2 = MIN( ED+NB, N ) + LN = ED-ST+1 + LM = J2-J1+1 + IF( LM.GT.0) THEN + CALL DLARFX( 'Left', LN, LM, V( VPOS ), + $ ( TAU( TAUPOS ) ), + $ A( DPOS-NB, J1 ), LDA-1, WORK) +* + IF( WANTZ ) THEN + VPOS = MOD( SWEEP-1, 2 ) * N + J1 + TAUPOS = MOD( SWEEP-1, 2 ) * N + J1 + ELSE + VPOS = MOD( SWEEP-1, 2 ) * N + J1 + TAUPOS = MOD( SWEEP-1, 2 ) * N + J1 + ENDIF +* + V( VPOS ) = ONE + DO 30 I = 1, LM-1 + V( VPOS+I ) = + $ ( A( DPOS-NB-I, J1+I ) ) + A( DPOS-NB-I, J1+I ) = ZERO + 30 CONTINUE + CTMP = ( A( DPOS-NB, J1 ) ) + CALL DLARFG( LM, CTMP, V( VPOS+1 ), 1, TAU( TAUPOS ) ) + A( DPOS-NB, J1 ) = CTMP +* + CALL DLARFX( 'Right', LN-1, LM, V( VPOS ), + $ TAU( TAUPOS ), + $ A( DPOS-NB+1, J1 ), LDA-1, WORK) + ENDIF ENDIF - GOTO 300 * * Lower case * @@ -256,63 +264,70 @@ VPOS = MOD( SWEEP-1, 2 ) * N + ST TAUPOS = MOD( SWEEP-1, 2 ) * N + ST ENDIF - GO TO ( 201, 202, 203 ) TTYPE -* - 201 CONTINUE - LM = ED - ST + 1 -* - V( VPOS ) = ONE - DO 20 I = 1, LM-1 - V( VPOS+I ) = A( OFDPOS+I, ST-1 ) - A( OFDPOS+I, ST-1 ) = ZERO - 20 CONTINUE - CALL DLARFG( LM, A( OFDPOS, ST-1 ), V( VPOS+1 ), 1, - $ TAU( TAUPOS ) ) -* - 203 CONTINUE - LM = ED - ST + 1 -* - CALL DLARFY( UPLO, LM, V( VPOS ), 1, ( TAU( TAUPOS ) ), - $ A( DPOS, ST ), LDA-1, WORK) - - GOTO 300 -* - 202 CONTINUE - J1 = ED+1 - J2 = MIN( ED+NB, N ) - LN = ED-ST+1 - LM = J2-J1+1 -* - IF( LM.GT.0) THEN - CALL DLARFX( 'Right', LM, LN, V( VPOS ), - $ TAU( TAUPOS ), A( DPOS+NB, ST ), - $ LDA-1, WORK) -* - IF( WANTZ ) THEN - VPOS = MOD( SWEEP-1, 2 ) * N + J1 - TAUPOS = MOD( SWEEP-1, 2 ) * N + J1 - ELSE - VPOS = MOD( SWEEP-1, 2 ) * N + J1 - TAUPOS = MOD( SWEEP-1, 2 ) * N + J1 - ENDIF -* +* + IF( TTYPE.EQ.1 ) THEN + LM = ED - ST + 1 +* V( VPOS ) = ONE - DO 40 I = 1, LM-1 - V( VPOS+I ) = A( DPOS+NB+I, ST ) - A( DPOS+NB+I, ST ) = ZERO - 40 CONTINUE - CALL DLARFG( LM, A( DPOS+NB, ST ), V( VPOS+1 ), 1, - $ TAU( TAUPOS ) ) -* - CALL DLARFX( 'Left', LM, LN-1, V( VPOS ), + DO 20 I = 1, LM-1 + V( VPOS+I ) = A( OFDPOS+I, ST-1 ) + A( OFDPOS+I, ST-1 ) = ZERO + 20 CONTINUE + CALL DLARFG( LM, A( OFDPOS, ST-1 ), V( VPOS+1 ), 1, + $ TAU( TAUPOS ) ) +* + LM = ED - ST + 1 +* + CALL DLARFY( UPLO, LM, V( VPOS ), 1, $ ( TAU( TAUPOS ) ), - $ A( DPOS+NB-1, ST+1 ), LDA-1, WORK) + $ A( DPOS, ST ), LDA-1, WORK) ENDIF - GOTO 300 - ENDIF +* + IF( TTYPE.EQ.3 ) THEN + LM = ED - ST + 1 +* + CALL DLARFY( UPLO, LM, V( VPOS ), 1, + $ ( TAU( TAUPOS ) ), + $ A( DPOS, ST ), LDA-1, WORK) - 300 CONTINUE + ENDIF +* + IF( TTYPE.EQ.2 ) THEN + J1 = ED+1 + J2 = MIN( ED+NB, N ) + LN = ED-ST+1 + LM = J2-J1+1 +* + IF( LM.GT.0) THEN + CALL DLARFX( 'Right', LM, LN, V( VPOS ), + $ TAU( TAUPOS ), A( DPOS+NB, ST ), + $ LDA-1, WORK) +* + IF( WANTZ ) THEN + VPOS = MOD( SWEEP-1, 2 ) * N + J1 + TAUPOS = MOD( SWEEP-1, 2 ) * N + J1 + ELSE + VPOS = MOD( SWEEP-1, 2 ) * N + J1 + TAUPOS = MOD( SWEEP-1, 2 ) * N + J1 + ENDIF +* + V( VPOS ) = ONE + DO 40 I = 1, LM-1 + V( VPOS+I ) = A( DPOS+NB+I, ST ) + A( DPOS+NB+I, ST ) = ZERO + 40 CONTINUE + CALL DLARFG( LM, A( DPOS+NB, ST ), V( VPOS+1 ), 1, + $ TAU( TAUPOS ) ) +* + CALL DLARFX( 'Left', LM, LN-1, V( VPOS ), + $ ( TAU( TAUPOS ) ), + $ A( DPOS+NB-1, ST+1 ), LDA-1, WORK) + + ENDIF + ENDIF + ENDIF +* RETURN * * END OF DSB2ST_KERNELS diff --git a/SRC/dsytrd_sb2st.F b/SRC/dsytrd_sb2st.F index 6925b525..7b5abc93 100644 --- a/SRC/dsytrd_sb2st.F +++ b/SRC/dsytrd_sb2st.F @@ -331,8 +331,9 @@ * Quick return if possible * IF( N.EQ.0 ) THEN - WORK( 1 ) = 1 - RETURN + HOUS( 1 ) = 1 + WORK( 1 ) = 1 + RETURN END IF * * Determine pointer position @@ -379,7 +380,10 @@ DO 40 I = 1, N-1 E( I ) = RZERO 40 CONTINUE - RETURN +* + HOUS( 1 ) = 1 + WORK( 1 ) = 1 + RETURN END IF * * Case KD=1: @@ -406,6 +410,9 @@ E( I ) = ( AB( ABOFDPOS, I ) ) 70 CONTINUE ENDIF +* + HOUS( 1 ) = 1 + WORK( 1 ) = 1 RETURN END IF * @@ -442,7 +449,7 @@ THED = MIN( (STT + THGRSIZ -1), (N-1)) DO 110 I = STT, N-1 ED = MIN( I, THED ) - IF( STT.GT.ED ) GOTO 100 + IF( STT.GT.ED ) EXIT DO 120 M = 1, STEPERCOL ST = STT DO 130 SWEEPID = ST, ED @@ -506,7 +513,7 @@ #endif IF ( BLKLASTIND.GE.(N-1) ) THEN STT = STT + 1 - GOTO 130 + EXIT ENDIF 140 CONTINUE 130 CONTINUE diff --git a/SRC/dsytrd_sy2sb.f b/SRC/dsytrd_sy2sb.f index 8f0261df..e6e3fa46 100644 --- a/SRC/dsytrd_sy2sb.f +++ b/SRC/dsytrd_sy2sb.f @@ -1,6 +1,6 @@ *> \brief \b DSYTRD_SY2SB * -* @generated from zhetrd_he2hb.f, fortran z -> d, Sun Nov 6 19:34:06 2016 +* @generated from zhetrd_he2hb.f, fortran z -> d, Wed Dec 7 08:22:39 2016 * * =========== DOCUMENTATION =========== * @@ -245,7 +245,7 @@ * IMPLICIT NONE * -* -- LAPACK computational routine (version 3.4.0) -- +* -- LAPACK computational routine (version 3.7.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * November 2016 diff --git a/SRC/ssb2st_kernels.f b/SRC/ssb2st_kernels.f index 60058dda..75de2dff 100644 --- a/SRC/ssb2st_kernels.f +++ b/SRC/ssb2st_kernels.f @@ -1,6 +1,6 @@ *> \brief \b SSB2ST_KERNELS * -* @generated from zhb2st_kernels.f, fortran z -> s, Sun Nov 6 19:34:06 2016 +* @generated from zhb2st_kernels.f, fortran z -> s, Wed Dec 7 08:22:40 2016 * * =========== DOCUMENTATION =========== * @@ -128,7 +128,7 @@ * IMPLICIT NONE * -* -- LAPACK computational routine (version 3.4.0) -- +* -- LAPACK computational routine (version 3.7.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * November 2016 @@ -181,9 +181,9 @@ * * Upper case -* +* IF( UPPER ) THEN -* +* IF( WANTZ ) THEN VPOS = MOD( SWEEP-1, 2 ) * N + ST TAUPOS = MOD( SWEEP-1, 2 ) * N + ST @@ -191,59 +191,67 @@ VPOS = MOD( SWEEP-1, 2 ) * N + ST TAUPOS = MOD( SWEEP-1, 2 ) * N + ST ENDIF - GO TO ( 101, 102, 103 ) TTYPE -* - 101 CONTINUE - LM = ED - ST + 1 -* - V( VPOS ) = ONE - DO 10 I = 1, LM-1 - V( VPOS+I ) = ( A( OFDPOS-I, ST+I ) ) - A( OFDPOS-I, ST+I ) = ZERO - 10 CONTINUE - CTMP = ( A( OFDPOS, ST ) ) - CALL SLARFG( LM, CTMP, V( VPOS+1 ), 1, - $ TAU( TAUPOS ) ) - A( OFDPOS, ST ) = CTMP -* - 103 CONTINUE - LM = ED - ST + 1 - CALL SLARFY( UPLO, LM, V( VPOS ), 1, ( TAU( TAUPOS ) ), - $ A( DPOS, ST ), LDA-1, WORK) - GOTO 300 -* - 102 CONTINUE - J1 = ED+1 - J2 = MIN( ED+NB, N ) - LN = ED-ST+1 - LM = J2-J1+1 - IF( LM.GT.0) THEN - CALL SLARFX( 'Left', LN, LM, V( VPOS ), - $ ( TAU( TAUPOS ) ), A( DPOS-NB, J1 ), - $ LDA-1, WORK) -* - IF( WANTZ ) THEN - VPOS = MOD( SWEEP-1, 2 ) * N + J1 - TAUPOS = MOD( SWEEP-1, 2 ) * N + J1 - ELSE - VPOS = MOD( SWEEP-1, 2 ) * N + J1 - TAUPOS = MOD( SWEEP-1, 2 ) * N + J1 - ENDIF +* + IF( TTYPE.EQ.1 ) THEN + LM = ED - ST + 1 * V( VPOS ) = ONE - DO 30 I = 1, LM-1 - V( VPOS+I ) = ( A( DPOS-NB-I, J1+I ) ) - A( DPOS-NB-I, J1+I ) = ZERO - 30 CONTINUE - CTMP = ( A( DPOS-NB, J1 ) ) - CALL SLARFG( LM, CTMP, V( VPOS+1 ), 1, TAU( TAUPOS ) ) - A( DPOS-NB, J1 ) = CTMP -* - CALL SLARFX( 'Right', LN-1, LM, V( VPOS ), - $ TAU( TAUPOS ), - $ A( DPOS-NB+1, J1 ), LDA-1, WORK) + DO 10 I = 1, LM-1 + V( VPOS+I ) = ( A( OFDPOS-I, ST+I ) ) + A( OFDPOS-I, ST+I ) = ZERO + 10 CONTINUE + CTMP = ( A( OFDPOS, ST ) ) + CALL SLARFG( LM, CTMP, V( VPOS+1 ), 1, + $ TAU( TAUPOS ) ) + A( OFDPOS, ST ) = CTMP +* + LM = ED - ST + 1 + CALL SLARFY( UPLO, LM, V( VPOS ), 1, + $ ( TAU( TAUPOS ) ), + $ A( DPOS, ST ), LDA-1, WORK) + ENDIF +* + IF( TTYPE.EQ.3 ) THEN +* + LM = ED - ST + 1 + CALL SLARFY( UPLO, LM, V( VPOS ), 1, + $ ( TAU( TAUPOS ) ), + $ A( DPOS, ST ), LDA-1, WORK) + ENDIF +* + IF( TTYPE.EQ.2 ) THEN + J1 = ED+1 + J2 = MIN( ED+NB, N ) + LN = ED-ST+1 + LM = J2-J1+1 + IF( LM.GT.0) THEN + CALL SLARFX( 'Left', LN, LM, V( VPOS ), + $ ( TAU( TAUPOS ) ), + $ A( DPOS-NB, J1 ), LDA-1, WORK) +* + IF( WANTZ ) THEN + VPOS = MOD( SWEEP-1, 2 ) * N + J1 + TAUPOS = MOD( SWEEP-1, 2 ) * N + J1 + ELSE + VPOS = MOD( SWEEP-1, 2 ) * N + J1 + TAUPOS = MOD( SWEEP-1, 2 ) * N + J1 + ENDIF +* + V( VPOS ) = ONE + DO 30 I = 1, LM-1 + V( VPOS+I ) = + $ ( A( DPOS-NB-I, J1+I ) ) + A( DPOS-NB-I, J1+I ) = ZERO + 30 CONTINUE + CTMP = ( A( DPOS-NB, J1 ) ) + CALL SLARFG( LM, CTMP, V( VPOS+1 ), 1, TAU( TAUPOS ) ) + A( DPOS-NB, J1 ) = CTMP +* + CALL SLARFX( 'Right', LN-1, LM, V( VPOS ), + $ TAU( TAUPOS ), + $ A( DPOS-NB+1, J1 ), LDA-1, WORK) + ENDIF ENDIF - GOTO 300 * * Lower case * @@ -256,63 +264,70 @@ VPOS = MOD( SWEEP-1, 2 ) * N + ST TAUPOS = MOD( SWEEP-1, 2 ) * N + ST ENDIF - GO TO ( 201, 202, 203 ) TTYPE -* - 201 CONTINUE - LM = ED - ST + 1 -* - V( VPOS ) = ONE - DO 20 I = 1, LM-1 - V( VPOS+I ) = A( OFDPOS+I, ST-1 ) - A( OFDPOS+I, ST-1 ) = ZERO - 20 CONTINUE - CALL SLARFG( LM, A( OFDPOS, ST-1 ), V( VPOS+1 ), 1, - $ TAU( TAUPOS ) ) -* - 203 CONTINUE - LM = ED - ST + 1 -* - CALL SLARFY( UPLO, LM, V( VPOS ), 1, ( TAU( TAUPOS ) ), - $ A( DPOS, ST ), LDA-1, WORK) - - GOTO 300 -* - 202 CONTINUE - J1 = ED+1 - J2 = MIN( ED+NB, N ) - LN = ED-ST+1 - LM = J2-J1+1 -* - IF( LM.GT.0) THEN - CALL SLARFX( 'Right', LM, LN, V( VPOS ), - $ TAU( TAUPOS ), A( DPOS+NB, ST ), - $ LDA-1, WORK) -* - IF( WANTZ ) THEN - VPOS = MOD( SWEEP-1, 2 ) * N + J1 - TAUPOS = MOD( SWEEP-1, 2 ) * N + J1 - ELSE - VPOS = MOD( SWEEP-1, 2 ) * N + J1 - TAUPOS = MOD( SWEEP-1, 2 ) * N + J1 - ENDIF -* +* + IF( TTYPE.EQ.1 ) THEN + LM = ED - ST + 1 +* V( VPOS ) = ONE - DO 40 I = 1, LM-1 - V( VPOS+I ) = A( DPOS+NB+I, ST ) - A( DPOS+NB+I, ST ) = ZERO - 40 CONTINUE - CALL SLARFG( LM, A( DPOS+NB, ST ), V( VPOS+1 ), 1, - $ TAU( TAUPOS ) ) -* - CALL SLARFX( 'Left', LM, LN-1, V( VPOS ), + DO 20 I = 1, LM-1 + V( VPOS+I ) = A( OFDPOS+I, ST-1 ) + A( OFDPOS+I, ST-1 ) = ZERO + 20 CONTINUE + CALL SLARFG( LM, A( OFDPOS, ST-1 ), V( VPOS+1 ), 1, + $ TAU( TAUPOS ) ) +* + LM = ED - ST + 1 +* + CALL SLARFY( UPLO, LM, V( VPOS ), 1, $ ( TAU( TAUPOS ) ), - $ A( DPOS+NB-1, ST+1 ), LDA-1, WORK) + $ A( DPOS, ST ), LDA-1, WORK) ENDIF - GOTO 300 - ENDIF +* + IF( TTYPE.EQ.3 ) THEN + LM = ED - ST + 1 +* + CALL SLARFY( UPLO, LM, V( VPOS ), 1, + $ ( TAU( TAUPOS ) ), + $ A( DPOS, ST ), LDA-1, WORK) - 300 CONTINUE + ENDIF +* + IF( TTYPE.EQ.2 ) THEN + J1 = ED+1 + J2 = MIN( ED+NB, N ) + LN = ED-ST+1 + LM = J2-J1+1 +* + IF( LM.GT.0) THEN + CALL SLARFX( 'Right', LM, LN, V( VPOS ), + $ TAU( TAUPOS ), A( DPOS+NB, ST ), + $ LDA-1, WORK) +* + IF( WANTZ ) THEN + VPOS = MOD( SWEEP-1, 2 ) * N + J1 + TAUPOS = MOD( SWEEP-1, 2 ) * N + J1 + ELSE + VPOS = MOD( SWEEP-1, 2 ) * N + J1 + TAUPOS = MOD( SWEEP-1, 2 ) * N + J1 + ENDIF +* + V( VPOS ) = ONE + DO 40 I = 1, LM-1 + V( VPOS+I ) = A( DPOS+NB+I, ST ) + A( DPOS+NB+I, ST ) = ZERO + 40 CONTINUE + CALL SLARFG( LM, A( DPOS+NB, ST ), V( VPOS+1 ), 1, + $ TAU( TAUPOS ) ) +* + CALL SLARFX( 'Left', LM, LN-1, V( VPOS ), + $ ( TAU( TAUPOS ) ), + $ A( DPOS+NB-1, ST+1 ), LDA-1, WORK) + + ENDIF + ENDIF + ENDIF +* RETURN * * END OF SSB2ST_KERNELS diff --git a/SRC/ssytrd_sb2st.F b/SRC/ssytrd_sb2st.F index b3e5d69c..17cab977 100644 --- a/SRC/ssytrd_sb2st.F +++ b/SRC/ssytrd_sb2st.F @@ -331,8 +331,9 @@ * Quick return if possible * IF( N.EQ.0 ) THEN - WORK( 1 ) = 1 - RETURN + HOUS( 1 ) = 1 + WORK( 1 ) = 1 + RETURN END IF * * Determine pointer position @@ -379,7 +380,10 @@ DO 40 I = 1, N-1 E( I ) = RZERO 40 CONTINUE - RETURN +* + HOUS( 1 ) = 1 + WORK( 1 ) = 1 + RETURN END IF * * Case KD=1: @@ -406,6 +410,9 @@ E( I ) = ( AB( ABOFDPOS, I ) ) 70 CONTINUE ENDIF +* + HOUS( 1 ) = 1 + WORK( 1 ) = 1 RETURN END IF * @@ -442,7 +449,7 @@ THED = MIN( (STT + THGRSIZ -1), (N-1)) DO 110 I = STT, N-1 ED = MIN( I, THED ) - IF( STT.GT.ED ) GOTO 100 + IF( STT.GT.ED ) EXIT DO 120 M = 1, STEPERCOL ST = STT DO 130 SWEEPID = ST, ED @@ -506,7 +513,7 @@ #endif IF ( BLKLASTIND.GE.(N-1) ) THEN STT = STT + 1 - GOTO 130 + EXIT ENDIF 140 CONTINUE 130 CONTINUE diff --git a/SRC/ssytrd_sy2sb.f b/SRC/ssytrd_sy2sb.f index 3dbbaf1f..039c3f07 100644 --- a/SRC/ssytrd_sy2sb.f +++ b/SRC/ssytrd_sy2sb.f @@ -1,6 +1,6 @@ *> \brief \b SSYTRD_SY2SB * -* @generated from zhetrd_he2hb.f, fortran z -> s, Sun Nov 6 19:34:06 2016 +* @generated from zhetrd_he2hb.f, fortran z -> s, Wed Dec 7 08:22:40 2016 * * =========== DOCUMENTATION =========== * @@ -245,7 +245,7 @@ * IMPLICIT NONE * -* -- LAPACK computational routine (version 3.4.0) -- +* -- LAPACK computational routine (version 3.7.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * November 2016 diff --git a/SRC/zhb2st_kernels.f b/SRC/zhb2st_kernels.f index ab03b303..065ba925 100644 --- a/SRC/zhb2st_kernels.f +++ b/SRC/zhb2st_kernels.f @@ -128,7 +128,7 @@ * IMPLICIT NONE * -* -- LAPACK computational routine (version 3.4.0) -- +* -- LAPACK computational routine (version 3.7.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * November 2016 @@ -181,9 +181,9 @@ * * Upper case -* +* IF( UPPER ) THEN -* +* IF( WANTZ ) THEN VPOS = MOD( SWEEP-1, 2 ) * N + ST TAUPOS = MOD( SWEEP-1, 2 ) * N + ST @@ -191,59 +191,67 @@ VPOS = MOD( SWEEP-1, 2 ) * N + ST TAUPOS = MOD( SWEEP-1, 2 ) * N + ST ENDIF - GO TO ( 101, 102, 103 ) TTYPE -* - 101 CONTINUE - LM = ED - ST + 1 -* - V( VPOS ) = ONE - DO 10 I = 1, LM-1 - V( VPOS+I ) = DCONJG( A( OFDPOS-I, ST+I ) ) - A( OFDPOS-I, ST+I ) = ZERO - 10 CONTINUE - CTMP = DCONJG( A( OFDPOS, ST ) ) - CALL ZLARFG( LM, CTMP, V( VPOS+1 ), 1, - $ TAU( TAUPOS ) ) - A( OFDPOS, ST ) = CTMP -* - 103 CONTINUE - LM = ED - ST + 1 - CALL ZLARFY( UPLO, LM, V( VPOS ), 1, DCONJG( TAU( TAUPOS ) ), - $ A( DPOS, ST ), LDA-1, WORK) - GOTO 300 -* - 102 CONTINUE - J1 = ED+1 - J2 = MIN( ED+NB, N ) - LN = ED-ST+1 - LM = J2-J1+1 - IF( LM.GT.0) THEN - CALL ZLARFX( 'Left', LN, LM, V( VPOS ), - $ DCONJG( TAU( TAUPOS ) ), A( DPOS-NB, J1 ), - $ LDA-1, WORK) -* - IF( WANTZ ) THEN - VPOS = MOD( SWEEP-1, 2 ) * N + J1 - TAUPOS = MOD( SWEEP-1, 2 ) * N + J1 - ELSE - VPOS = MOD( SWEEP-1, 2 ) * N + J1 - TAUPOS = MOD( SWEEP-1, 2 ) * N + J1 - ENDIF +* + IF( TTYPE.EQ.1 ) THEN + LM = ED - ST + 1 * V( VPOS ) = ONE - DO 30 I = 1, LM-1 - V( VPOS+I ) = DCONJG( A( DPOS-NB-I, J1+I ) ) - A( DPOS-NB-I, J1+I ) = ZERO - 30 CONTINUE - CTMP = DCONJG( A( DPOS-NB, J1 ) ) - CALL ZLARFG( LM, CTMP, V( VPOS+1 ), 1, TAU( TAUPOS ) ) - A( DPOS-NB, J1 ) = CTMP -* - CALL ZLARFX( 'Right', LN-1, LM, V( VPOS ), - $ TAU( TAUPOS ), - $ A( DPOS-NB+1, J1 ), LDA-1, WORK) + DO 10 I = 1, LM-1 + V( VPOS+I ) = DCONJG( A( OFDPOS-I, ST+I ) ) + A( OFDPOS-I, ST+I ) = ZERO + 10 CONTINUE + CTMP = DCONJG( A( OFDPOS, ST ) ) + CALL ZLARFG( LM, CTMP, V( VPOS+1 ), 1, + $ TAU( TAUPOS ) ) + A( OFDPOS, ST ) = CTMP +* + LM = ED - ST + 1 + CALL ZLARFY( UPLO, LM, V( VPOS ), 1, + $ DCONJG( TAU( TAUPOS ) ), + $ A( DPOS, ST ), LDA-1, WORK) + ENDIF +* + IF( TTYPE.EQ.3 ) THEN +* + LM = ED - ST + 1 + CALL ZLARFY( UPLO, LM, V( VPOS ), 1, + $ DCONJG( TAU( TAUPOS ) ), + $ A( DPOS, ST ), LDA-1, WORK) + ENDIF +* + IF( TTYPE.EQ.2 ) THEN + J1 = ED+1 + J2 = MIN( ED+NB, N ) + LN = ED-ST+1 + LM = J2-J1+1 + IF( LM.GT.0) THEN + CALL ZLARFX( 'Left', LN, LM, V( VPOS ), + $ DCONJG( TAU( TAUPOS ) ), + $ A( DPOS-NB, J1 ), LDA-1, WORK) +* + IF( WANTZ ) THEN + VPOS = MOD( SWEEP-1, 2 ) * N + J1 + TAUPOS = MOD( SWEEP-1, 2 ) * N + J1 + ELSE + VPOS = MOD( SWEEP-1, 2 ) * N + J1 + TAUPOS = MOD( SWEEP-1, 2 ) * N + J1 + ENDIF +* + V( VPOS ) = ONE + DO 30 I = 1, LM-1 + V( VPOS+I ) = + $ DCONJG( A( DPOS-NB-I, J1+I ) ) + A( DPOS-NB-I, J1+I ) = ZERO + 30 CONTINUE + CTMP = DCONJG( A( DPOS-NB, J1 ) ) + CALL ZLARFG( LM, CTMP, V( VPOS+1 ), 1, TAU( TAUPOS ) ) + A( DPOS-NB, J1 ) = CTMP +* + CALL ZLARFX( 'Right', LN-1, LM, V( VPOS ), + $ TAU( TAUPOS ), + $ A( DPOS-NB+1, J1 ), LDA-1, WORK) + ENDIF ENDIF - GOTO 300 * * Lower case * @@ -256,63 +264,70 @@ VPOS = MOD( SWEEP-1, 2 ) * N + ST TAUPOS = MOD( SWEEP-1, 2 ) * N + ST ENDIF - GO TO ( 201, 202, 203 ) TTYPE -* - 201 CONTINUE - LM = ED - ST + 1 -* - V( VPOS ) = ONE - DO 20 I = 1, LM-1 - V( VPOS+I ) = A( OFDPOS+I, ST-1 ) - A( OFDPOS+I, ST-1 ) = ZERO - 20 CONTINUE - CALL ZLARFG( LM, A( OFDPOS, ST-1 ), V( VPOS+1 ), 1, - $ TAU( TAUPOS ) ) -* - 203 CONTINUE - LM = ED - ST + 1 -* - CALL ZLARFY( UPLO, LM, V( VPOS ), 1, DCONJG( TAU( TAUPOS ) ), - $ A( DPOS, ST ), LDA-1, WORK) - - GOTO 300 -* - 202 CONTINUE - J1 = ED+1 - J2 = MIN( ED+NB, N ) - LN = ED-ST+1 - LM = J2-J1+1 -* - IF( LM.GT.0) THEN - CALL ZLARFX( 'Right', LM, LN, V( VPOS ), - $ TAU( TAUPOS ), A( DPOS+NB, ST ), - $ LDA-1, WORK) -* - IF( WANTZ ) THEN - VPOS = MOD( SWEEP-1, 2 ) * N + J1 - TAUPOS = MOD( SWEEP-1, 2 ) * N + J1 - ELSE - VPOS = MOD( SWEEP-1, 2 ) * N + J1 - TAUPOS = MOD( SWEEP-1, 2 ) * N + J1 - ENDIF -* +* + IF( TTYPE.EQ.1 ) THEN + LM = ED - ST + 1 +* V( VPOS ) = ONE - DO 40 I = 1, LM-1 - V( VPOS+I ) = A( DPOS+NB+I, ST ) - A( DPOS+NB+I, ST ) = ZERO - 40 CONTINUE - CALL ZLARFG( LM, A( DPOS+NB, ST ), V( VPOS+1 ), 1, - $ TAU( TAUPOS ) ) -* - CALL ZLARFX( 'Left', LM, LN-1, V( VPOS ), + DO 20 I = 1, LM-1 + V( VPOS+I ) = A( OFDPOS+I, ST-1 ) + A( OFDPOS+I, ST-1 ) = ZERO + 20 CONTINUE + CALL ZLARFG( LM, A( OFDPOS, ST-1 ), V( VPOS+1 ), 1, + $ TAU( TAUPOS ) ) +* + LM = ED - ST + 1 +* + CALL ZLARFY( UPLO, LM, V( VPOS ), 1, $ DCONJG( TAU( TAUPOS ) ), - $ A( DPOS+NB-1, ST+1 ), LDA-1, WORK) + $ A( DPOS, ST ), LDA-1, WORK) ENDIF - GOTO 300 - ENDIF +* + IF( TTYPE.EQ.3 ) THEN + LM = ED - ST + 1 +* + CALL ZLARFY( UPLO, LM, V( VPOS ), 1, + $ DCONJG( TAU( TAUPOS ) ), + $ A( DPOS, ST ), LDA-1, WORK) - 300 CONTINUE + ENDIF +* + IF( TTYPE.EQ.2 ) THEN + J1 = ED+1 + J2 = MIN( ED+NB, N ) + LN = ED-ST+1 + LM = J2-J1+1 +* + IF( LM.GT.0) THEN + CALL ZLARFX( 'Right', LM, LN, V( VPOS ), + $ TAU( TAUPOS ), A( DPOS+NB, ST ), + $ LDA-1, WORK) +* + IF( WANTZ ) THEN + VPOS = MOD( SWEEP-1, 2 ) * N + J1 + TAUPOS = MOD( SWEEP-1, 2 ) * N + J1 + ELSE + VPOS = MOD( SWEEP-1, 2 ) * N + J1 + TAUPOS = MOD( SWEEP-1, 2 ) * N + J1 + ENDIF +* + V( VPOS ) = ONE + DO 40 I = 1, LM-1 + V( VPOS+I ) = A( DPOS+NB+I, ST ) + A( DPOS+NB+I, ST ) = ZERO + 40 CONTINUE + CALL ZLARFG( LM, A( DPOS+NB, ST ), V( VPOS+1 ), 1, + $ TAU( TAUPOS ) ) +* + CALL ZLARFX( 'Left', LM, LN-1, V( VPOS ), + $ DCONJG( TAU( TAUPOS ) ), + $ A( DPOS+NB-1, ST+1 ), LDA-1, WORK) + + ENDIF + ENDIF + ENDIF +* RETURN * * END OF ZHB2ST_KERNELS diff --git a/SRC/zhetrd_hb2st.F b/SRC/zhetrd_hb2st.F index 8fed56e8..9671e49c 100644 --- a/SRC/zhetrd_hb2st.F +++ b/SRC/zhetrd_hb2st.F @@ -334,8 +334,9 @@ * Quick return if possible * IF( N.EQ.0 ) THEN - WORK( 1 ) = 1 - RETURN + HOUS( 1 ) = 1 + WORK( 1 ) = 1 + RETURN END IF * * Determine pointer position @@ -383,8 +384,8 @@ E( I ) = RZERO 40 CONTINUE * - HOUS( 1 ) = LHMIN - WORK( 1 ) = LWMIN + HOUS( 1 ) = 1 + WORK( 1 ) = 1 RETURN END IF * @@ -440,20 +441,9 @@ C CALL ZSCAL( N, TMP, Q( 1, I+1 ), 1 ) C END IF 70 CONTINUE ENDIF -#else - IF( UPPER ) THEN - DO 60 I = 1, N-1 - E( I ) = DBLE( AB( ABOFDPOS, I+1 ) ) - 60 CONTINUE - ELSE - DO 70 I = 1, N-1 - E( I ) = DBLE( AB( ABOFDPOS, I ) ) - 70 CONTINUE - ENDIF -#endif * - HOUS( 1 ) = LHMIN - WORK( 1 ) = LWMIN + HOUS( 1 ) = 1 + WORK( 1 ) = 1 RETURN END IF * diff --git a/SRC/zhetrd_he2hb.f b/SRC/zhetrd_he2hb.f index 9403b73e..7a283c7b 100644 --- a/SRC/zhetrd_he2hb.f +++ b/SRC/zhetrd_he2hb.f @@ -245,7 +245,7 @@ * IMPLICIT NONE * -* -- LAPACK computational routine (version 3.4.0) -- +* -- LAPACK computational routine (version 3.7.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- * November 2016 |