version 1.10, 2011/11/21 22:19:58
|
version 1.18, 2023/08/07 08:39:40
|
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 ZTGSJA + dependencies |
*> Download ZTGSJA + dependencies |
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ztgsja.f"> |
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ztgsja.f"> |
*> [TGZ]</a> |
*> [TGZ]</a> |
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ztgsja.f"> |
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ztgsja.f"> |
*> [ZIP]</a> |
*> [ZIP]</a> |
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ztgsja.f"> |
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ztgsja.f"> |
*> [TXT]</a> |
*> [TXT]</a> |
*> \endhtmlonly |
*> \endhtmlonly |
* |
* |
* Definition: |
* Definition: |
* =========== |
* =========== |
Line 21
|
Line 21
|
* SUBROUTINE ZTGSJA( JOBU, JOBV, JOBQ, M, P, N, K, L, A, LDA, B, |
* SUBROUTINE ZTGSJA( 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
|
* COMPLEX*16 A( LDA, * ), B( LDB, * ), Q( LDQ, * ), |
* COMPLEX*16 A( LDA, * ), B( LDB, * ), Q( LDQ, * ), |
* $ U( LDU, * ), V( LDV, * ), WORK( * ) |
* $ U( LDU, * ), V( LDV, * ), WORK( * ) |
* .. |
* .. |
* |
* |
* |
* |
*> \par Purpose: |
*> \par Purpose: |
* ============= |
* ============= |
Line 346
|
Line 346
|
* 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 complex16OTHERcomputational |
*> \ingroup complex16OTHERcomputational |
* |
* |
Line 379
|
Line 377
|
$ 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 401
|
Line 398
|
* .. 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 ) |
COMPLEX*16 CZERO, CONE |
COMPLEX*16 CZERO, CONE |
PARAMETER ( CZERO = ( 0.0D+0, 0.0D+0 ), |
PARAMETER ( CZERO = ( 0.0D+0, 0.0D+0 ), |
Line 424
|
Line 421
|
$ ZLASET, ZROT |
$ ZLASET, ZROT |
* .. |
* .. |
* .. Intrinsic Functions .. |
* .. Intrinsic Functions .. |
INTRINSIC ABS, DBLE, DCONJG, MAX, MIN |
INTRINSIC ABS, DBLE, DCONJG, MAX, MIN, HUGE |
|
PARAMETER ( HUGENUM = HUGE(ZERO) ) |
* .. |
* .. |
* .. Executable Statements .. |
* .. Executable Statements .. |
* |
* |
Line 610
|
Line 608
|
* |
* |
A1 = DBLE( A( K+I, N-L+I ) ) |
A1 = DBLE( A( K+I, N-L+I ) ) |
B1 = DBLE( B( I, N-L+I ) ) |
B1 = DBLE( 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 |
|
* |
* |
IF( GAMMA.LT.ZERO ) THEN |
IF( GAMMA.LT.ZERO ) THEN |
CALL ZDSCAL( L-I+1, -ONE, B( I, N-L+I ), LDB ) |
CALL ZDSCAL( L-I+1, -ONE, B( I, N-L+I ), LDB ) |