summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--SRC/chb2st_kernels.f227
-rw-r--r--SRC/chetrd_hb2st.F17
-rw-r--r--SRC/chetrd_he2hb.f4
-rw-r--r--SRC/dsb2st_kernels.f227
-rw-r--r--SRC/dsytrd_sb2st.F17
-rw-r--r--SRC/dsytrd_sy2sb.f4
-rw-r--r--SRC/ssb2st_kernels.f227
-rw-r--r--SRC/ssytrd_sb2st.F17
-rw-r--r--SRC/ssytrd_sy2sb.f4
-rw-r--r--SRC/zhb2st_kernels.f225
-rw-r--r--SRC/zhetrd_hb2st.F24
-rw-r--r--SRC/zhetrd_he2hb.f2
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
generated by cgit v1.2.3 (git 2.25.1) at 2024-10-31 21:04:57 +0000