version 1.17, 2018/05/29 07:18:10
|
version 1.18, 2023/08/07 08:39:12
|
Line 350
|
Line 350
|
*> \author Univ. of Colorado Denver |
*> \author Univ. of Colorado Denver |
*> \author NAG Ltd. |
*> \author NAG Ltd. |
* |
* |
*> \date December 2016 |
|
* |
|
*> \ingroup doubleOTHERcomputational |
*> \ingroup doubleOTHERcomputational |
* |
* |
*> \par Further Details: |
*> \par Further Details: |
Line 378
|
Line 376
|
$ LDB, TOLA, TOLB, ALPHA, BETA, U, LDU, V, LDV, |
$ LDB, TOLA, TOLB, ALPHA, BETA, U, LDU, V, LDV, |
$ Q, LDQ, WORK, NCYCLE, INFO ) |
$ Q, LDQ, WORK, NCYCLE, INFO ) |
* |
* |
* -- LAPACK computational routine (version 3.7.0) -- |
* -- LAPACK computational routine -- |
* -- 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..-- |
* December 2016 |
|
* |
* |
* .. Scalar Arguments .. |
* .. Scalar Arguments .. |
CHARACTER JOBQ, JOBU, JOBV |
CHARACTER JOBQ, JOBU, JOBV |
Line 400
|
Line 397
|
* .. Parameters .. |
* .. Parameters .. |
INTEGER MAXIT |
INTEGER MAXIT |
PARAMETER ( MAXIT = 40 ) |
PARAMETER ( MAXIT = 40 ) |
DOUBLE PRECISION ZERO, ONE |
DOUBLE PRECISION ZERO, ONE, HUGENUM |
PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 ) |
PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 ) |
* .. |
* .. |
* .. Local Scalars .. |
* .. Local Scalars .. |
Line 419
|
Line 416
|
$ DSCAL, XERBLA |
$ DSCAL, XERBLA |
* .. |
* .. |
* .. Intrinsic Functions .. |
* .. Intrinsic Functions .. |
INTRINSIC ABS, MAX, MIN |
INTRINSIC ABS, MAX, MIN, HUGE |
|
PARAMETER ( HUGENUM = HUGE(ZERO) ) |
* .. |
* .. |
* .. Executable Statements .. |
* .. Executable Statements .. |
* |
* |
Line 596
|
Line 594
|
* |
* |
A1 = A( K+I, N-L+I ) |
A1 = A( K+I, N-L+I ) |
B1 = B( I, N-L+I ) |
B1 = B( I, N-L+I ) |
|
GAMMA = B1 / A1 |
* |
* |
IF( A1.NE.ZERO ) THEN |
IF( (GAMMA.LE.HUGENUM).AND.(GAMMA.GE.-HUGENUM) ) THEN |
GAMMA = B1 / A1 |
|
* |
* |
* change sign if necessary |
* change sign if necessary |
* |
* |