version 1.9, 2011/11/21 20:43:06
|
version 1.18, 2023/08/07 08:39:12
|
Line 2
|
Line 2
|
* |
* |
* =========== DOCUMENTATION =========== |
* =========== DOCUMENTATION =========== |
* |
* |
* Online html documentation available at |
* Online html documentation available at |
* http://www.netlib.org/lapack/explore-html/ |
* http://www.netlib.org/lapack/explore-html/ |
* |
* |
*> \htmlonly |
*> \htmlonly |
*> Download DTGSJA + dependencies |
*> Download DTGSJA + dependencies |
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dtgsja.f"> |
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dtgsja.f"> |
*> [TGZ]</a> |
*> [TGZ]</a> |
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dtgsja.f"> |
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dtgsja.f"> |
*> [ZIP]</a> |
*> [ZIP]</a> |
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dtgsja.f"> |
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dtgsja.f"> |
*> [TXT]</a> |
*> [TXT]</a> |
*> \endhtmlonly |
*> \endhtmlonly |
* |
* |
* Definition: |
* Definition: |
* =========== |
* =========== |
Line 21
|
Line 21
|
* SUBROUTINE DTGSJA( JOBU, JOBV, JOBQ, M, P, N, K, L, A, LDA, B, |
* SUBROUTINE DTGSJA( JOBU, JOBV, JOBQ, M, P, N, K, L, A, LDA, B, |
* 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 ) |
* |
* |
* .. Scalar Arguments .. |
* .. Scalar Arguments .. |
* CHARACTER JOBQ, JOBU, JOBV |
* CHARACTER JOBQ, JOBU, JOBV |
* INTEGER INFO, K, L, LDA, LDB, LDQ, LDU, LDV, M, N, |
* INTEGER INFO, K, L, LDA, LDB, LDQ, LDU, LDV, M, N, |
Line 33
|
Line 33
|
* $ BETA( * ), Q( LDQ, * ), U( LDU, * ), |
* $ BETA( * ), Q( LDQ, * ), U( LDU, * ), |
* $ V( LDV, * ), WORK( * ) |
* $ V( LDV, * ), WORK( * ) |
* .. |
* .. |
* |
* |
* |
* |
*> \par Purpose: |
*> \par Purpose: |
* ============= |
* ============= |
Line 345
|
Line 345
|
* Authors: |
* Authors: |
* ======== |
* ======== |
* |
* |
*> \author Univ. of Tennessee |
*> \author Univ. of Tennessee |
*> \author Univ. of California Berkeley |
*> \author Univ. of California Berkeley |
*> \author Univ. of Colorado Denver |
*> \author Univ. of Colorado Denver |
*> \author NAG Ltd. |
*> \author NAG Ltd. |
* |
|
*> \date November 2011 |
|
* |
* |
*> \ingroup doubleOTHERcomputational |
*> \ingroup doubleOTHERcomputational |
* |
* |
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.4.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..-- |
* November 2011 |
|
* |
* |
* .. 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 |
* |
* |