Replace the conditionally defined index variable INDIBL with a constant 1
This commit is contained in:
parent
2d39e715e2
commit
c48bbe93d4
|
@ -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 )
|
||||||
|
|
|
@ -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 )
|
||||||
|
|
|
@ -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 )
|
||||||
|
|
|
@ -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 )
|
||||||
|
|
|
@ -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 )
|
||||||
|
|
|
@ -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 )
|
||||||
|
|
|
@ -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 )
|
||||||
|
|
|
@ -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 )
|
||||||
|
|
|
@ -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 )
|
||||||
|
|
|
@ -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 )
|
||||||
|
|
Loading…
Reference in New Issue