Replace the conditionally defined index variable INDIBL with a constant 1

This commit is contained in:
Martin Kroeker 2023-03-26 17:33:21 +02:00 committed by GitHub
parent 2d39e715e2
commit c48bbe93d4
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
10 changed files with 70 additions and 80 deletions

View File

@ -327,7 +327,7 @@
* .. Local Scalars .. * .. Local Scalars ..
LOGICAL ALLEIG, INDEIG, TEST, UPPER, VALEIG, WANTZ LOGICAL ALLEIG, INDEIG, TEST, UPPER, VALEIG, WANTZ
CHARACTER ORDER, VECT CHARACTER ORDER, VECT
INTEGER I, IINFO, INDD, INDE, INDEE, INDIBL, INDISP, INTEGER I, IINFO, INDD, INDE, INDEE, INDISP,
$ INDIWK, INDRWK, INDWRK, ITMP1, J, JJ, NSPLIT $ INDIWK, INDRWK, INDWRK, ITMP1, J, JJ, NSPLIT
REAL TMP1 REAL TMP1
* .. * ..
@ -470,17 +470,16 @@
ELSE ELSE
ORDER = 'E' ORDER = 'E'
END IF END IF
INDIBL = 1 INDISP = 1 + N
INDISP = INDIBL + N
INDIWK = INDISP + N INDIWK = INDISP + N
CALL SSTEBZ( RANGE, ORDER, N, VL, VU, IL, IU, ABSTOL, CALL SSTEBZ( RANGE, ORDER, N, VL, VU, IL, IU, ABSTOL,
$ RWORK( INDD ), RWORK( INDE ), M, NSPLIT, W, $ RWORK( INDD ), RWORK( INDE ), M, NSPLIT, W,
$ IWORK( INDIBL ), IWORK( INDISP ), RWORK( INDRWK ), $ IWORK( 1 ), IWORK( INDISP ), RWORK( INDRWK ),
$ IWORK( INDIWK ), INFO ) $ IWORK( INDIWK ), INFO )
* *
IF( WANTZ ) THEN IF( WANTZ ) THEN
CALL CSTEIN( N, RWORK( INDD ), RWORK( INDE ), M, W, CALL CSTEIN( N, RWORK( INDD ), RWORK( INDE ), M, W,
$ IWORK( INDIBL ), IWORK( INDISP ), Z, LDZ, $ IWORK( 1 ), IWORK( INDISP ), Z, LDZ,
$ RWORK( INDRWK ), IWORK( INDIWK ), IFAIL, INFO ) $ RWORK( INDRWK ), IWORK( INDIWK ), IFAIL, INFO )
* *
* Apply unitary matrix used in reduction to tridiagonal * Apply unitary matrix used in reduction to tridiagonal
@ -510,11 +509,11 @@
40 CONTINUE 40 CONTINUE
* *
IF( I.NE.0 ) THEN IF( I.NE.0 ) THEN
ITMP1 = IWORK( INDIBL+I-1 ) ITMP1 = IWORK( 1 + I-1 )
W( I ) = W( J ) W( I ) = W( J )
IWORK( INDIBL+I-1 ) = IWORK( INDIBL+J-1 ) IWORK( 1 + I-1 ) = IWORK( 1 + J-1 )
W( J ) = TMP1 W( J ) = TMP1
IWORK( INDIBL+J-1 ) = ITMP1 IWORK( 1 + J-1 ) = ITMP1
CALL CSWAP( N, Z( 1, I ), 1, Z( 1, J ), 1 ) CALL CSWAP( N, Z( 1, I ), 1, Z( 1, J ), 1 )
IF( INFO.NE.0 ) THEN IF( INFO.NE.0 ) THEN
ITMP1 = IFAIL( I ) ITMP1 = IFAIL( I )

View File

@ -264,7 +264,7 @@
* .. Local Scalars .. * .. Local Scalars ..
LOGICAL ALLEIG, INDEIG, TEST, VALEIG, WANTZ LOGICAL ALLEIG, INDEIG, TEST, VALEIG, WANTZ
CHARACTER ORDER CHARACTER ORDER
INTEGER I, IINFO, IMAX, INDD, INDE, INDEE, INDIBL, INTEGER I, IINFO, IMAX, INDD, INDE, INDEE,
$ INDISP, INDIWK, INDRWK, INDTAU, INDWRK, ISCALE, $ INDISP, INDIWK, INDRWK, INDTAU, INDWRK, ISCALE,
$ ITMP1, J, JJ, NSPLIT $ ITMP1, J, JJ, NSPLIT
REAL ABSTLL, ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, REAL ABSTLL, ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN,
@ -434,17 +434,16 @@
ELSE ELSE
ORDER = 'E' ORDER = 'E'
END IF END IF
INDIBL = 1 INDISP = 1 + N
INDISP = INDIBL + N
INDIWK = INDISP + N INDIWK = INDISP + N
CALL SSTEBZ( RANGE, ORDER, N, VLL, VUU, IL, IU, ABSTLL, CALL SSTEBZ( RANGE, ORDER, N, VLL, VUU, IL, IU, ABSTLL,
$ RWORK( INDD ), RWORK( INDE ), M, NSPLIT, W, $ RWORK( INDD ), RWORK( INDE ), M, NSPLIT, W,
$ IWORK( INDIBL ), IWORK( INDISP ), RWORK( INDRWK ), $ IWORK( 1 ), IWORK( INDISP ), RWORK( INDRWK ),
$ IWORK( INDIWK ), INFO ) $ IWORK( INDIWK ), INFO )
* *
IF( WANTZ ) THEN IF( WANTZ ) THEN
CALL CSTEIN( N, RWORK( INDD ), RWORK( INDE ), M, W, CALL CSTEIN( N, RWORK( INDD ), RWORK( INDE ), M, W,
$ IWORK( INDIBL ), IWORK( INDISP ), Z, LDZ, $ IWORK( 1 ), IWORK( INDISP ), Z, LDZ,
$ RWORK( INDRWK ), IWORK( INDIWK ), IFAIL, INFO ) $ RWORK( INDRWK ), IWORK( INDIWK ), IFAIL, INFO )
* *
* Apply unitary matrix used in reduction to tridiagonal * Apply unitary matrix used in reduction to tridiagonal
@ -482,11 +481,11 @@
30 CONTINUE 30 CONTINUE
* *
IF( I.NE.0 ) THEN IF( I.NE.0 ) THEN
ITMP1 = IWORK( INDIBL+I-1 ) ITMP1 = IWORK( 1 + I-1 )
W( I ) = W( J ) W( I ) = W( J )
IWORK( INDIBL+I-1 ) = IWORK( INDIBL+J-1 ) IWORK( 1 + I-1 ) = IWORK( 1 + J-1 )
W( J ) = TMP1 W( J ) = TMP1
IWORK( INDIBL+J-1 ) = ITMP1 IWORK( 1 + J-1 ) = ITMP1
CALL CSWAP( N, Z( 1, I ), 1, Z( 1, J ), 1 ) CALL CSWAP( N, Z( 1, I ), 1, Z( 1, J ), 1 )
IF( INFO.NE.0 ) THEN IF( INFO.NE.0 ) THEN
ITMP1 = IFAIL( I ) ITMP1 = IFAIL( I )

View File

@ -317,7 +317,7 @@
* .. Local Scalars .. * .. Local Scalars ..
LOGICAL ALLEIG, INDEIG, TEST, UPPER, VALEIG, WANTZ LOGICAL ALLEIG, INDEIG, TEST, UPPER, VALEIG, WANTZ
CHARACTER ORDER, VECT CHARACTER ORDER, VECT
INTEGER I, IINFO, INDD, INDE, INDEE, INDIBL, INDISP, INTEGER I, IINFO, INDD, INDE, INDEE, INDISP,
$ INDIWO, INDWRK, ITMP1, J, JJ, NSPLIT $ INDIWO, INDWRK, ITMP1, J, JJ, NSPLIT
DOUBLE PRECISION TMP1 DOUBLE PRECISION TMP1
* .. * ..
@ -457,17 +457,16 @@
ELSE ELSE
ORDER = 'E' ORDER = 'E'
END IF END IF
INDIBL = 1 INDISP = 1 + N
INDISP = INDIBL + N
INDIWO = INDISP + N INDIWO = INDISP + N
CALL DSTEBZ( RANGE, ORDER, N, VL, VU, IL, IU, ABSTOL, CALL DSTEBZ( RANGE, ORDER, N, VL, VU, IL, IU, ABSTOL,
$ WORK( INDD ), WORK( INDE ), M, NSPLIT, W, $ WORK( INDD ), WORK( INDE ), M, NSPLIT, W,
$ IWORK( INDIBL ), IWORK( INDISP ), WORK( INDWRK ), $ IWORK( 1 ), IWORK( INDISP ), WORK( INDWRK ),
$ IWORK( INDIWO ), INFO ) $ IWORK( INDIWO ), INFO )
* *
IF( WANTZ ) THEN IF( WANTZ ) THEN
CALL DSTEIN( N, WORK( INDD ), WORK( INDE ), M, W, CALL DSTEIN( N, WORK( INDD ), WORK( INDE ), M, W,
$ IWORK( INDIBL ), IWORK( INDISP ), Z, LDZ, $ IWORK( 1 ), IWORK( INDISP ), Z, LDZ,
$ WORK( INDWRK ), IWORK( INDIWO ), IFAIL, INFO ) $ WORK( INDWRK ), IWORK( INDIWO ), IFAIL, INFO )
* *
* Apply transformation matrix used in reduction to tridiagonal * Apply transformation matrix used in reduction to tridiagonal
@ -497,11 +496,11 @@
40 CONTINUE 40 CONTINUE
* *
IF( I.NE.0 ) THEN IF( I.NE.0 ) THEN
ITMP1 = IWORK( INDIBL+I-1 ) ITMP1 = IWORK( 1 + I-1 )
W( I ) = W( J ) W( I ) = W( J )
IWORK( INDIBL+I-1 ) = IWORK( INDIBL+J-1 ) IWORK( 1 + I-1 ) = IWORK( 1 + J-1 )
W( J ) = TMP1 W( J ) = TMP1
IWORK( INDIBL+J-1 ) = ITMP1 IWORK( 1 + J-1 ) = ITMP1
CALL DSWAP( N, Z( 1, I ), 1, Z( 1, J ), 1 ) CALL DSWAP( N, Z( 1, I ), 1, Z( 1, J ), 1 )
IF( INFO.NE.0 ) THEN IF( INFO.NE.0 ) THEN
ITMP1 = IFAIL( I ) ITMP1 = IFAIL( I )

View File

@ -255,7 +255,7 @@
* .. Local Scalars .. * .. Local Scalars ..
LOGICAL ALLEIG, INDEIG, TEST, VALEIG, WANTZ LOGICAL ALLEIG, INDEIG, TEST, VALEIG, WANTZ
CHARACTER ORDER CHARACTER ORDER
INTEGER I, IINFO, IMAX, INDD, INDE, INDEE, INDIBL, INTEGER I, IINFO, IMAX, INDD, INDE, INDEE,
$ INDISP, INDIWO, INDTAU, INDWRK, ISCALE, ITMP1, $ INDISP, INDIWO, INDTAU, INDWRK, ISCALE, ITMP1,
$ J, JJ, NSPLIT $ J, JJ, NSPLIT
DOUBLE PRECISION ABSTLL, ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, DOUBLE PRECISION ABSTLL, ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN,
@ -424,17 +424,16 @@
ELSE ELSE
ORDER = 'E' ORDER = 'E'
END IF END IF
INDIBL = 1 INDISP = 1 + N
INDISP = INDIBL + N
INDIWO = INDISP + N INDIWO = INDISP + N
CALL DSTEBZ( RANGE, ORDER, N, VLL, VUU, IL, IU, ABSTLL, CALL DSTEBZ( RANGE, ORDER, N, VLL, VUU, IL, IU, ABSTLL,
$ WORK( INDD ), WORK( INDE ), M, NSPLIT, W, $ WORK( INDD ), WORK( INDE ), M, NSPLIT, W,
$ IWORK( INDIBL ), IWORK( INDISP ), WORK( INDWRK ), $ IWORK( 1 ), IWORK( INDISP ), WORK( INDWRK ),
$ IWORK( INDIWO ), INFO ) $ IWORK( INDIWO ), INFO )
* *
IF( WANTZ ) THEN IF( WANTZ ) THEN
CALL DSTEIN( N, WORK( INDD ), WORK( INDE ), M, W, CALL DSTEIN( N, WORK( INDD ), WORK( INDE ), M, W,
$ IWORK( INDIBL ), IWORK( INDISP ), Z, LDZ, $ IWORK( 1 ), IWORK( INDISP ), Z, LDZ,
$ WORK( INDWRK ), IWORK( INDIWO ), IFAIL, INFO ) $ WORK( INDWRK ), IWORK( INDIWO ), IFAIL, INFO )
* *
* Apply orthogonal matrix used in reduction to tridiagonal * Apply orthogonal matrix used in reduction to tridiagonal
@ -471,11 +470,11 @@
30 CONTINUE 30 CONTINUE
* *
IF( I.NE.0 ) THEN IF( I.NE.0 ) THEN
ITMP1 = IWORK( INDIBL+I-1 ) ITMP1 = IWORK( 1 + I-1 )
W( I ) = W( J ) W( I ) = W( J )
IWORK( INDIBL+I-1 ) = IWORK( INDIBL+J-1 ) IWORK( 1 + I-1 ) = IWORK( 1 + J-1 )
W( J ) = TMP1 W( J ) = TMP1
IWORK( INDIBL+J-1 ) = ITMP1 IWORK( 1 + J-1 ) = ITMP1
CALL DSWAP( N, Z( 1, I ), 1, Z( 1, J ), 1 ) CALL DSWAP( N, Z( 1, I ), 1, Z( 1, J ), 1 )
IF( INFO.NE.0 ) THEN IF( INFO.NE.0 ) THEN
ITMP1 = IFAIL( I ) ITMP1 = IFAIL( I )

View File

@ -248,7 +248,7 @@
* .. Local Scalars .. * .. Local Scalars ..
LOGICAL ALLEIG, INDEIG, TEST, VALEIG, WANTZ LOGICAL ALLEIG, INDEIG, TEST, VALEIG, WANTZ
CHARACTER ORDER CHARACTER ORDER
INTEGER I, IMAX, INDIBL, INDISP, INDIWO, INDWRK, INTEGER I, IMAX, INDISP, INDIWO, INDWRK,
$ ISCALE, ITMP1, J, JJ, NSPLIT $ ISCALE, ITMP1, J, JJ, NSPLIT
DOUBLE PRECISION BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA, SMLNUM, DOUBLE PRECISION BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA, SMLNUM,
$ TMP1, TNRM, VLL, VUU $ TMP1, TNRM, VLL, VUU
@ -399,15 +399,14 @@
ORDER = 'E' ORDER = 'E'
END IF END IF
INDWRK = 1 INDWRK = 1
INDIBL = 1 INDISP = 1 + N
INDISP = INDIBL + N
INDIWO = INDISP + N INDIWO = INDISP + N
CALL DSTEBZ( RANGE, ORDER, N, VLL, VUU, IL, IU, ABSTOL, D, E, M, CALL DSTEBZ( RANGE, ORDER, N, VLL, VUU, IL, IU, ABSTOL, D, E, M,
$ NSPLIT, W, IWORK( INDIBL ), IWORK( INDISP ), $ NSPLIT, W, IWORK( 1 ), IWORK( INDISP ),
$ WORK( INDWRK ), IWORK( INDIWO ), INFO ) $ WORK( INDWRK ), IWORK( INDIWO ), INFO )
* *
IF( WANTZ ) THEN IF( WANTZ ) THEN
CALL DSTEIN( N, D, E, M, W, IWORK( INDIBL ), IWORK( INDISP ), CALL DSTEIN( N, D, E, M, W, IWORK( 1 ), IWORK( INDISP ),
$ Z, LDZ, WORK( INDWRK ), IWORK( INDIWO ), IFAIL, $ Z, LDZ, WORK( INDWRK ), IWORK( INDIWO ), IFAIL,
$ INFO ) $ INFO )
END IF END IF
@ -439,11 +438,11 @@
30 CONTINUE 30 CONTINUE
* *
IF( I.NE.0 ) THEN IF( I.NE.0 ) THEN
ITMP1 = IWORK( INDIBL+I-1 ) ITMP1 = IWORK( 1 + I-1 )
W( I ) = W( J ) W( I ) = W( J )
IWORK( INDIBL+I-1 ) = IWORK( INDIBL+J-1 ) IWORK( 1 + I-1 ) = IWORK( 1 + J-1 )
W( J ) = TMP1 W( J ) = TMP1
IWORK( INDIBL+J-1 ) = ITMP1 IWORK( 1 + J-1 ) = ITMP1
CALL DSWAP( N, Z( 1, I ), 1, Z( 1, J ), 1 ) CALL DSWAP( N, Z( 1, I ), 1, Z( 1, J ), 1 )
IF( INFO.NE.0 ) THEN IF( INFO.NE.0 ) THEN
ITMP1 = IFAIL( I ) ITMP1 = IFAIL( I )

View File

@ -317,7 +317,7 @@
* .. Local Scalars .. * .. Local Scalars ..
LOGICAL ALLEIG, INDEIG, TEST, UPPER, VALEIG, WANTZ LOGICAL ALLEIG, INDEIG, TEST, UPPER, VALEIG, WANTZ
CHARACTER ORDER, VECT CHARACTER ORDER, VECT
INTEGER I, IINFO, INDD, INDE, INDEE, INDIBL, INDISP, INTEGER I, IINFO, INDD, INDE, INDEE, INDISP,
$ INDIWO, INDWRK, ITMP1, J, JJ, NSPLIT $ INDIWO, INDWRK, ITMP1, J, JJ, NSPLIT
REAL TMP1 REAL TMP1
* .. * ..
@ -457,17 +457,16 @@
ELSE ELSE
ORDER = 'E' ORDER = 'E'
END IF END IF
INDIBL = 1 INDISP = 1 + N
INDISP = INDIBL + N
INDIWO = INDISP + N INDIWO = INDISP + N
CALL SSTEBZ( RANGE, ORDER, N, VL, VU, IL, IU, ABSTOL, CALL SSTEBZ( RANGE, ORDER, N, VL, VU, IL, IU, ABSTOL,
$ WORK( INDD ), WORK( INDE ), M, NSPLIT, W, $ WORK( INDD ), WORK( INDE ), M, NSPLIT, W,
$ IWORK( INDIBL ), IWORK( INDISP ), WORK( INDWRK ), $ IWORK( 1 ), IWORK( INDISP ), WORK( INDWRK ),
$ IWORK( INDIWO ), INFO ) $ IWORK( INDIWO ), INFO )
* *
IF( WANTZ ) THEN IF( WANTZ ) THEN
CALL SSTEIN( N, WORK( INDD ), WORK( INDE ), M, W, CALL SSTEIN( N, WORK( INDD ), WORK( INDE ), M, W,
$ IWORK( INDIBL ), IWORK( INDISP ), Z, LDZ, $ IWORK( 1 ), IWORK( INDISP ), Z, LDZ,
$ WORK( INDWRK ), IWORK( INDIWO ), IFAIL, INFO ) $ WORK( INDWRK ), IWORK( INDIWO ), IFAIL, INFO )
* *
* Apply transformation matrix used in reduction to tridiagonal * Apply transformation matrix used in reduction to tridiagonal
@ -497,11 +496,11 @@
40 CONTINUE 40 CONTINUE
* *
IF( I.NE.0 ) THEN IF( I.NE.0 ) THEN
ITMP1 = IWORK( INDIBL+I-1 ) ITMP1 = IWORK( 1 + I-1 )
W( I ) = W( J ) W( I ) = W( J )
IWORK( INDIBL+I-1 ) = IWORK( INDIBL+J-1 ) IWORK( 1 + I-1 ) = IWORK( 1 + J-1 )
W( J ) = TMP1 W( J ) = TMP1
IWORK( INDIBL+J-1 ) = ITMP1 IWORK( 1 + J-1 ) = ITMP1
CALL SSWAP( N, Z( 1, I ), 1, Z( 1, J ), 1 ) CALL SSWAP( N, Z( 1, I ), 1, Z( 1, J ), 1 )
IF( INFO.NE.0 ) THEN IF( INFO.NE.0 ) THEN
ITMP1 = IFAIL( I ) ITMP1 = IFAIL( I )

View File

@ -255,7 +255,7 @@
* .. Local Scalars .. * .. Local Scalars ..
LOGICAL ALLEIG, INDEIG, TEST, VALEIG, WANTZ LOGICAL ALLEIG, INDEIG, TEST, VALEIG, WANTZ
CHARACTER ORDER CHARACTER ORDER
INTEGER I, IINFO, IMAX, INDD, INDE, INDEE, INDIBL, INTEGER I, IINFO, IMAX, INDD, INDE, INDEE,
$ INDISP, INDIWO, INDTAU, INDWRK, ISCALE, ITMP1, $ INDISP, INDIWO, INDTAU, INDWRK, ISCALE, ITMP1,
$ J, JJ, NSPLIT $ J, JJ, NSPLIT
REAL ABSTLL, ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, REAL ABSTLL, ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN,
@ -424,17 +424,16 @@
ELSE ELSE
ORDER = 'E' ORDER = 'E'
END IF END IF
INDIBL = 1 INDISP = 1 + N
INDISP = INDIBL + N
INDIWO = INDISP + N INDIWO = INDISP + N
CALL SSTEBZ( RANGE, ORDER, N, VLL, VUU, IL, IU, ABSTLL, CALL SSTEBZ( RANGE, ORDER, N, VLL, VUU, IL, IU, ABSTLL,
$ WORK( INDD ), WORK( INDE ), M, NSPLIT, W, $ WORK( INDD ), WORK( INDE ), M, NSPLIT, W,
$ IWORK( INDIBL ), IWORK( INDISP ), WORK( INDWRK ), $ IWORK( 1 ), IWORK( INDISP ), WORK( INDWRK ),
$ IWORK( INDIWO ), INFO ) $ IWORK( INDIWO ), INFO )
* *
IF( WANTZ ) THEN IF( WANTZ ) THEN
CALL SSTEIN( N, WORK( INDD ), WORK( INDE ), M, W, CALL SSTEIN( N, WORK( INDD ), WORK( INDE ), M, W,
$ IWORK( INDIBL ), IWORK( INDISP ), Z, LDZ, $ IWORK( 1 ), IWORK( INDISP ), Z, LDZ,
$ WORK( INDWRK ), IWORK( INDIWO ), IFAIL, INFO ) $ WORK( INDWRK ), IWORK( INDIWO ), IFAIL, INFO )
* *
* Apply orthogonal matrix used in reduction to tridiagonal * Apply orthogonal matrix used in reduction to tridiagonal
@ -471,11 +470,11 @@
30 CONTINUE 30 CONTINUE
* *
IF( I.NE.0 ) THEN IF( I.NE.0 ) THEN
ITMP1 = IWORK( INDIBL+I-1 ) ITMP1 = IWORK( 1 + I-1 )
W( I ) = W( J ) W( I ) = W( J )
IWORK( INDIBL+I-1 ) = IWORK( INDIBL+J-1 ) IWORK( 1 + I-1 ) = IWORK( 1 + J-1 )
W( J ) = TMP1 W( J ) = TMP1
IWORK( INDIBL+J-1 ) = ITMP1 IWORK( 1 + J-1 ) = ITMP1
CALL SSWAP( N, Z( 1, I ), 1, Z( 1, J ), 1 ) CALL SSWAP( N, Z( 1, I ), 1, Z( 1, J ), 1 )
IF( INFO.NE.0 ) THEN IF( INFO.NE.0 ) THEN
ITMP1 = IFAIL( I ) ITMP1 = IFAIL( I )

View File

@ -248,7 +248,7 @@
* .. Local Scalars .. * .. Local Scalars ..
LOGICAL ALLEIG, INDEIG, TEST, VALEIG, WANTZ LOGICAL ALLEIG, INDEIG, TEST, VALEIG, WANTZ
CHARACTER ORDER CHARACTER ORDER
INTEGER I, IMAX, INDIBL, INDISP, INDIWO, INDWRK, INTEGER I, IMAX, INDISP, INDIWO, INDWRK,
$ ISCALE, ITMP1, J, JJ, NSPLIT $ ISCALE, ITMP1, J, JJ, NSPLIT
REAL BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA, SMLNUM, REAL BIGNUM, EPS, RMAX, RMIN, SAFMIN, SIGMA, SMLNUM,
$ TMP1, TNRM, VLL, VUU $ TMP1, TNRM, VLL, VUU
@ -399,15 +399,14 @@
ORDER = 'E' ORDER = 'E'
END IF END IF
INDWRK = 1 INDWRK = 1
INDIBL = 1 INDISP = 1 + N
INDISP = INDIBL + N
INDIWO = INDISP + N INDIWO = INDISP + N
CALL SSTEBZ( RANGE, ORDER, N, VLL, VUU, IL, IU, ABSTOL, D, E, M, CALL SSTEBZ( RANGE, ORDER, N, VLL, VUU, IL, IU, ABSTOL, D, E, M,
$ NSPLIT, W, IWORK( INDIBL ), IWORK( INDISP ), $ NSPLIT, W, IWORK( 1 ), IWORK( INDISP ),
$ WORK( INDWRK ), IWORK( INDIWO ), INFO ) $ WORK( INDWRK ), IWORK( INDIWO ), INFO )
* *
IF( WANTZ ) THEN IF( WANTZ ) THEN
CALL SSTEIN( N, D, E, M, W, IWORK( INDIBL ), IWORK( INDISP ), CALL SSTEIN( N, D, E, M, W, IWORK( 1 ), IWORK( INDISP ),
$ Z, LDZ, WORK( INDWRK ), IWORK( INDIWO ), IFAIL, $ Z, LDZ, WORK( INDWRK ), IWORK( INDIWO ), IFAIL,
$ INFO ) $ INFO )
END IF END IF
@ -439,11 +438,11 @@
30 CONTINUE 30 CONTINUE
* *
IF( I.NE.0 ) THEN IF( I.NE.0 ) THEN
ITMP1 = IWORK( INDIBL+I-1 ) ITMP1 = IWORK( 1 + I-1 )
W( I ) = W( J ) W( I ) = W( J )
IWORK( INDIBL+I-1 ) = IWORK( INDIBL+J-1 ) IWORK( 1 + I-1 ) = IWORK( 1 + J-1 )
W( J ) = TMP1 W( J ) = TMP1
IWORK( INDIBL+J-1 ) = ITMP1 IWORK( 1 + J-1 ) = ITMP1
CALL SSWAP( N, Z( 1, I ), 1, Z( 1, J ), 1 ) CALL SSWAP( N, Z( 1, I ), 1, Z( 1, J ), 1 )
IF( INFO.NE.0 ) THEN IF( INFO.NE.0 ) THEN
ITMP1 = IFAIL( I ) ITMP1 = IFAIL( I )

View File

@ -327,7 +327,7 @@
* .. Local Scalars .. * .. Local Scalars ..
LOGICAL ALLEIG, INDEIG, TEST, UPPER, VALEIG, WANTZ LOGICAL ALLEIG, INDEIG, TEST, UPPER, VALEIG, WANTZ
CHARACTER ORDER, VECT CHARACTER ORDER, VECT
INTEGER I, IINFO, INDD, INDE, INDEE, INDIBL, INDISP, INTEGER I, IINFO, INDD, INDE, INDEE, INDISP,
$ INDIWK, INDRWK, INDWRK, ITMP1, J, JJ, NSPLIT $ INDIWK, INDRWK, INDWRK, ITMP1, J, JJ, NSPLIT
DOUBLE PRECISION TMP1 DOUBLE PRECISION TMP1
* .. * ..
@ -470,17 +470,16 @@
ELSE ELSE
ORDER = 'E' ORDER = 'E'
END IF END IF
INDIBL = 1 INDISP = 1 + N
INDISP = INDIBL + N
INDIWK = INDISP + N INDIWK = INDISP + N
CALL DSTEBZ( RANGE, ORDER, N, VL, VU, IL, IU, ABSTOL, CALL DSTEBZ( RANGE, ORDER, N, VL, VU, IL, IU, ABSTOL,
$ RWORK( INDD ), RWORK( INDE ), M, NSPLIT, W, $ RWORK( INDD ), RWORK( INDE ), M, NSPLIT, W,
$ IWORK( INDIBL ), IWORK( INDISP ), RWORK( INDRWK ), $ IWORK( 1 ), IWORK( INDISP ), RWORK( INDRWK ),
$ IWORK( INDIWK ), INFO ) $ IWORK( INDIWK ), INFO )
* *
IF( WANTZ ) THEN IF( WANTZ ) THEN
CALL ZSTEIN( N, RWORK( INDD ), RWORK( INDE ), M, W, CALL ZSTEIN( N, RWORK( INDD ), RWORK( INDE ), M, W,
$ IWORK( INDIBL ), IWORK( INDISP ), Z, LDZ, $ IWORK( 1 ), IWORK( INDISP ), Z, LDZ,
$ RWORK( INDRWK ), IWORK( INDIWK ), IFAIL, INFO ) $ RWORK( INDRWK ), IWORK( INDIWK ), IFAIL, INFO )
* *
* Apply unitary matrix used in reduction to tridiagonal * Apply unitary matrix used in reduction to tridiagonal
@ -510,11 +509,11 @@
40 CONTINUE 40 CONTINUE
* *
IF( I.NE.0 ) THEN IF( I.NE.0 ) THEN
ITMP1 = IWORK( INDIBL+I-1 ) ITMP1 = IWORK( 1 + I-1 )
W( I ) = W( J ) W( I ) = W( J )
IWORK( INDIBL+I-1 ) = IWORK( INDIBL+J-1 ) IWORK( 1 + I-1 ) = IWORK( 1 + J-1 )
W( J ) = TMP1 W( J ) = TMP1
IWORK( INDIBL+J-1 ) = ITMP1 IWORK( 1 + J-1 ) = ITMP1
CALL ZSWAP( N, Z( 1, I ), 1, Z( 1, J ), 1 ) CALL ZSWAP( N, Z( 1, I ), 1, Z( 1, J ), 1 )
IF( INFO.NE.0 ) THEN IF( INFO.NE.0 ) THEN
ITMP1 = IFAIL( I ) ITMP1 = IFAIL( I )

View File

@ -264,7 +264,7 @@
* .. Local Scalars .. * .. Local Scalars ..
LOGICAL ALLEIG, INDEIG, TEST, VALEIG, WANTZ LOGICAL ALLEIG, INDEIG, TEST, VALEIG, WANTZ
CHARACTER ORDER CHARACTER ORDER
INTEGER I, IINFO, IMAX, INDD, INDE, INDEE, INDIBL, INTEGER I, IINFO, IMAX, INDD, INDE, INDEE,
$ INDISP, INDIWK, INDRWK, INDTAU, INDWRK, ISCALE, $ INDISP, INDIWK, INDRWK, INDTAU, INDWRK, ISCALE,
$ ITMP1, J, JJ, NSPLIT $ ITMP1, J, JJ, NSPLIT
DOUBLE PRECISION ABSTLL, ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN, DOUBLE PRECISION ABSTLL, ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN,
@ -434,17 +434,16 @@
ELSE ELSE
ORDER = 'E' ORDER = 'E'
END IF END IF
INDIBL = 1 INDISP = 1 + N
INDISP = INDIBL + N
INDIWK = INDISP + N INDIWK = INDISP + N
CALL DSTEBZ( RANGE, ORDER, N, VLL, VUU, IL, IU, ABSTLL, CALL DSTEBZ( RANGE, ORDER, N, VLL, VUU, IL, IU, ABSTLL,
$ RWORK( INDD ), RWORK( INDE ), M, NSPLIT, W, $ RWORK( INDD ), RWORK( INDE ), M, NSPLIT, W,
$ IWORK( INDIBL ), IWORK( INDISP ), RWORK( INDRWK ), $ IWORK( 1 ), IWORK( INDISP ), RWORK( INDRWK ),
$ IWORK( INDIWK ), INFO ) $ IWORK( INDIWK ), INFO )
* *
IF( WANTZ ) THEN IF( WANTZ ) THEN
CALL ZSTEIN( N, RWORK( INDD ), RWORK( INDE ), M, W, CALL ZSTEIN( N, RWORK( INDD ), RWORK( INDE ), M, W,
$ IWORK( INDIBL ), IWORK( INDISP ), Z, LDZ, $ IWORK( 1 ), IWORK( INDISP ), Z, LDZ,
$ RWORK( INDRWK ), IWORK( INDIWK ), IFAIL, INFO ) $ RWORK( INDRWK ), IWORK( INDIWK ), IFAIL, INFO )
* *
* Apply unitary matrix used in reduction to tridiagonal * Apply unitary matrix used in reduction to tridiagonal
@ -482,11 +481,11 @@
30 CONTINUE 30 CONTINUE
* *
IF( I.NE.0 ) THEN IF( I.NE.0 ) THEN
ITMP1 = IWORK( INDIBL+I-1 ) ITMP1 = IWORK( 1 + I-1 )
W( I ) = W( J ) W( I ) = W( J )
IWORK( INDIBL+I-1 ) = IWORK( INDIBL+J-1 ) IWORK( 1 + I-1 ) = IWORK( 1 + J-1 )
W( J ) = TMP1 W( J ) = TMP1
IWORK( INDIBL+J-1 ) = ITMP1 IWORK( 1 + J-1 ) = ITMP1
CALL ZSWAP( N, Z( 1, I ), 1, Z( 1, J ), 1 ) CALL ZSWAP( N, Z( 1, I ), 1, Z( 1, J ), 1 )
IF( INFO.NE.0 ) THEN IF( INFO.NE.0 ) THEN
ITMP1 = IFAIL( I ) ITMP1 = IFAIL( I )