version 1.1.1.1, 2010/01/26 15:22:46
|
version 1.5, 2010/08/07 13:18:06
|
Line 2
|
Line 2
|
$ CUTPNT, Z, DLAMDA, Q2, LDQ2, W, PERM, GIVPTR, |
$ CUTPNT, Z, DLAMDA, Q2, LDQ2, W, PERM, GIVPTR, |
$ GIVCOL, GIVNUM, INDXP, INDX, INFO ) |
$ GIVCOL, GIVNUM, INDXP, INDX, INFO ) |
* |
* |
* -- LAPACK routine (version 3.2) -- |
* -- LAPACK routine (version 3.2.2) -- |
* -- LAPACK is a software package provided by Univ. of Tennessee, -- |
* -- LAPACK is a software package provided by Univ. of Tennessee, -- |
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- |
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- |
* November 2006 |
* June 2010 |
* |
* |
* .. Scalar Arguments .. |
* .. Scalar Arguments .. |
INTEGER CUTPNT, GIVPTR, ICOMPQ, INFO, K, LDQ, LDQ2, N, |
INTEGER CUTPNT, GIVPTR, ICOMPQ, INFO, K, LDQ, LDQ2, N, |
Line 189
|
Line 189
|
RETURN |
RETURN |
END IF |
END IF |
* |
* |
|
* Need to initialize GIVPTR to O here in case of quick exit |
|
* to prevent an unspecified code behavior (usually sigfault) |
|
* when IWORK array on entry to *stedc is not zeroed |
|
* (or at least some IWORK entries which used in *laed7 for GIVPTR). |
|
* |
|
GIVPTR = 0 |
|
* |
* Quick return if possible |
* Quick return if possible |
* |
* |
IF( N.EQ.0 ) |
IF( N.EQ.0 ) |
Line 263
|
Line 270
|
* components of Z are zero in this new basis. |
* components of Z are zero in this new basis. |
* |
* |
K = 0 |
K = 0 |
GIVPTR = 0 |
|
K2 = N + 1 |
K2 = N + 1 |
DO 70 J = 1, N |
DO 70 J = 1, N |
IF( RHO*ABS( Z( J ) ).LE.TOL ) THEN |
IF( RHO*ABS( Z( J ) ).LE.TOL ) THEN |