--- rpl/lapack/lapack/zgetc2.f 2014/01/27 09:24:36 1.13 +++ rpl/lapack/lapack/zgetc2.f 2023/08/07 08:39:20 1.21 @@ -2,24 +2,24 @@ * * =========== DOCUMENTATION =========== * -* Online html documentation available at -* http://www.netlib.org/lapack/explore-html/ +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ * *> \htmlonly -*> Download ZGETC2 + dependencies -*> -*> [TGZ] -*> -*> [ZIP] -*> +*> Download ZGETC2 + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> *> [TXT] -*> \endhtmlonly +*> \endhtmlonly * * Definition: * =========== * * SUBROUTINE ZGETC2( N, A, LDA, IPIV, JPIV, INFO ) -* +* * .. Scalar Arguments .. * INTEGER INFO, LDA, N * .. @@ -27,7 +27,7 @@ * INTEGER IPIV( * ), JPIV( * ) * COMPLEX*16 A( LDA, * ) * .. -* +* * *> \par Purpose: * ============= @@ -93,12 +93,10 @@ * Authors: * ======== * -*> \author Univ. of Tennessee -*> \author Univ. of California Berkeley -*> \author Univ. of Colorado Denver -*> \author NAG Ltd. -* -*> \date November 2013 +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. * *> \ingroup complex16GEauxiliary * @@ -111,10 +109,9 @@ * ===================================================================== SUBROUTINE ZGETC2( N, A, LDA, IPIV, JPIV, INFO ) * -* -- LAPACK auxiliary routine (version 3.5.0) -- +* -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2013 * * .. Scalar Arguments .. INTEGER INFO, LDA, N @@ -135,7 +132,7 @@ DOUBLE PRECISION BIGNUM, EPS, SMIN, SMLNUM, XMAX * .. * .. External Subroutines .. - EXTERNAL ZGERU, ZSWAP + EXTERNAL ZGERU, ZSWAP, DLABAD * .. * .. External Functions .. DOUBLE PRECISION DLAMCH @@ -146,14 +143,32 @@ * .. * .. Executable Statements .. * + INFO = 0 +* +* Quick return if possible +* + IF( N.EQ.0 ) + $ RETURN +* * Set constants to control overflow * - INFO = 0 EPS = DLAMCH( 'P' ) SMLNUM = DLAMCH( 'S' ) / EPS BIGNUM = ONE / SMLNUM CALL DLABAD( SMLNUM, BIGNUM ) * +* Handle the case N=1 by itself +* + IF( N.EQ.1 ) THEN + IPIV( 1 ) = 1 + JPIV( 1 ) = 1 + IF( ABS( A( 1, 1 ) ).LT.SMLNUM ) THEN + INFO = 1 + A( 1, 1 ) = DCMPLX( SMLNUM, ZERO ) + END IF + RETURN + END IF +* * Factorize A using complete pivoting. * Set pivots less than SMIN to SMIN *