GitHub-Proxy/eigen
1
0
Fork 0
mirror of https://gitlab.com/libeigen/eigen.git synced 2025-04-18 15:49:37 +08:00
Code Issues Packages Projects Releases Wiki Activity

Complete the lapack interface to make it complete enough for suitesparse QR.

Browse Source
This commit is contained in:
Gael Guennebaud 2013-06-12 10:12:50 +02:00
parent 76f4820560
commit 827843bbbd
21 changed files with 2462 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
lapack/CMakeLists.txt
View File

@ -18,11 +18,17 @@ single.cpp double.cpp complex_single.cpp complex_double.cpp ../blas/xerbla.cpp
if(EIGEN_Fortran_COMPILER_WORKS)
set(EigenLapack_SRCS
slarft.f dlarft.f clarft.f zlarft.f
slarfb.f dlarfb.f clarfb.f zlarfb.f
slarfg.f dlarfg.f clarfg.f zlarfg.f
slarf.f dlarf.f clarf.f zlarf.f
set(EigenLapack_SRCS ${EigenLapack_SRCS}
slarft.f dlarft.f clarft.f zlarft.f
slarfb.f dlarfb.f clarfb.f zlarfb.f
slarfg.f dlarfg.f clarfg.f zlarfg.f
slarf.f dlarf.f clarf.f zlarf.f
sladiv.f dladiv.f cladiv.f zladiv.f
ilaslr.f iladlr.f ilaclr.f ilazlr.f
ilaslc.f iladlc.f ilaclc.f ilazlc.f
dlapy2.f dlapy3.f slapy2.f slapy3.f
clacgv.f zlacgv.f
slamch.f dlamch.f
)
get_filename_component(eigen_full_path_to_reference_to_reference_lapack "./reference/" ABSOLUTE)
@ -364,6 +370,8 @@ endif(EIGEN_Fortran_COMPILER_WORKS)
add_library(eigen_lapack_static ${EigenLapack_SRCS})
add_library(eigen_lapack SHARED ${EigenLapack_SRCS})
target_link_libraries(eigen_lapack eigen_blas)
if(EIGEN_STANDARD_LIBRARIES_TO_LINK_TO)
target_link_libraries(eigen_lapack_static ${EIGEN_STANDARD_LIBRARIES_TO_LINK_TO})
target_link_libraries(eigen_lapack ${EIGEN_STANDARD_LIBRARIES_TO_LINK_TO})

116
lapack/clacgv.f Normal file
View File

@ -0,0 +1,116 @@
*> \brief \b CLACGV
*
* =========== DOCUMENTATION ===========
*
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download CLACGV + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/clacgv.f">
*> [TGZ]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/clacgv.f">
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/clacgv.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
*
* SUBROUTINE CLACGV( N, X, INCX )
*
* .. Scalar Arguments ..
* INTEGER INCX, N
* ..
* .. Array Arguments ..
* COMPLEX X( * )
* ..
*
*
*> \par Purpose:
* =============
*>
*> \verbatim
*>
*> CLACGV conjugates a complex vector of length N.
*> \endverbatim
*
* Arguments:
* ==========
*
*> \param[in] N
*> \verbatim
*> N is INTEGER
*> The length of the vector X. N >= 0.
*> \endverbatim
*>
*> \param[in,out] X
*> \verbatim
*> X is COMPLEX array, dimension
*> (1+(N-1)*abs(INCX))
*> On entry, the vector of length N to be conjugated.
*> On exit, X is overwritten with conjg(X).
*> \endverbatim
*>
*> \param[in] INCX
*> \verbatim
*> INCX is INTEGER
*> The spacing between successive elements of X.
*> \endverbatim
*
* Authors:
* ========
*
*> \author Univ. of Tennessee
*> \author Univ. of California Berkeley
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date November 2011
*
*> \ingroup complexOTHERauxiliary
*
* =====================================================================
SUBROUTINE CLACGV( N, X, INCX )
*
* -- LAPACK auxiliary routine (version 3.4.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* November 2011
*
* .. Scalar Arguments ..
INTEGER INCX, N
* ..
* .. Array Arguments ..
COMPLEX X( * )
* ..
*
* =====================================================================
*
* .. Local Scalars ..
INTEGER I, IOFF
* ..
* .. Intrinsic Functions ..
INTRINSIC CONJG
* ..
* .. Executable Statements ..
*
IF( INCX.EQ.1 ) THEN
DO 10 I = 1, N
X( I ) = CONJG( X( I ) )
10 CONTINUE
ELSE
IOFF = 1
IF( INCX.LT.0 )
$ IOFF = 1 - ( N-1 )*INCX
DO 20 I = 1, N
X( IOFF ) = CONJG( X( IOFF ) )
IOFF = IOFF + INCX
20 CONTINUE
END IF
RETURN
*
* End of CLACGV
*
END

97
lapack/cladiv.f Normal file
View File

@ -0,0 +1,97 @@
*> \brief \b CLADIV
*
* =========== DOCUMENTATION ===========
*
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download CLADIV + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cladiv.f">
*> [TGZ]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/cladiv.f">
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cladiv.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
*
* COMPLEX FUNCTION CLADIV( X, Y )
*
* .. Scalar Arguments ..
* COMPLEX X, Y
* ..
*
*
*> \par Purpose:
* =============
*>
*> \verbatim
*>
*> CLADIV := X / Y, where X and Y are complex. The computation of X / Y
*> will not overflow on an intermediary step unless the results
*> overflows.
*> \endverbatim
*
* Arguments:
* ==========
*
*> \param[in] X
*> \verbatim
*> X is COMPLEX
*> \endverbatim
*>
*> \param[in] Y
*> \verbatim
*> Y is COMPLEX
*> The complex scalars X and Y.
*> \endverbatim
*
* Authors:
* ========
*
*> \author Univ. of Tennessee
*> \author Univ. of California Berkeley
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date November 2011
*
*> \ingroup complexOTHERauxiliary
*
* =====================================================================
COMPLEX FUNCTION CLADIV( X, Y )
*
* -- LAPACK auxiliary routine (version 3.4.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* November 2011
*
* .. Scalar Arguments ..
COMPLEX X, Y
* ..
*
* =====================================================================
*
* .. Local Scalars ..
REAL ZI, ZR
* ..
* .. External Subroutines ..
EXTERNAL SLADIV
* ..
* .. Intrinsic Functions ..
INTRINSIC AIMAG, CMPLX, REAL
* ..
* .. Executable Statements ..
*
CALL SLADIV( REAL( X ), AIMAG( X ), REAL( Y ), AIMAG( Y ), ZR,
$ ZI )
CLADIV = CMPLX( ZR, ZI )
*
RETURN
*
* End of CLADIV
*
END

128
lapack/dladiv.f Normal file
View File

@ -0,0 +1,128 @@
*> \brief \b DLADIV
*
* =========== DOCUMENTATION ===========
*
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download DLADIV + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dladiv.f">
*> [TGZ]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dladiv.f">
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dladiv.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
*
* SUBROUTINE DLADIV( A, B, C, D, P, Q )
*
* .. Scalar Arguments ..
* DOUBLE PRECISION A, B, C, D, P, Q
* ..
*
*
*> \par Purpose:
* =============
*>
*> \verbatim
*>
*> DLADIV performs complex division in real arithmetic
*>
*> a + i*b
*> p + i*q = ---------
*> c + i*d
*>
*> The algorithm is due to Robert L. Smith and can be found
*> in D. Knuth, The art of Computer Programming, Vol.2, p.195
*> \endverbatim
*
* Arguments:
* ==========
*
*> \param[in] A
*> \verbatim
*> A is DOUBLE PRECISION
*> \endverbatim
*>
*> \param[in] B
*> \verbatim
*> B is DOUBLE PRECISION
*> \endverbatim
*>
*> \param[in] C
*> \verbatim
*> C is DOUBLE PRECISION
*> \endverbatim
*>
*> \param[in] D
*> \verbatim
*> D is DOUBLE PRECISION
*> The scalars a, b, c, and d in the above expression.
*> \endverbatim
*>
*> \param[out] P
*> \verbatim
*> P is DOUBLE PRECISION
*> \endverbatim
*>
*> \param[out] Q
*> \verbatim
*> Q is DOUBLE PRECISION
*> The scalars p and q in the above expression.
*> \endverbatim
*
* Authors:
* ========
*
*> \author Univ. of Tennessee
*> \author Univ. of California Berkeley
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date November 2011
*
*> \ingroup auxOTHERauxiliary
*
* =====================================================================
SUBROUTINE DLADIV( A, B, C, D, P, Q )
*
* -- LAPACK auxiliary routine (version 3.4.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* November 2011
*
* .. Scalar Arguments ..
DOUBLE PRECISION A, B, C, D, P, Q
* ..
*
* =====================================================================
*
* .. Local Scalars ..
DOUBLE PRECISION E, F
* ..
* .. Intrinsic Functions ..
INTRINSIC ABS
* ..
* .. Executable Statements ..
*
IF( ABS( D ).LT.ABS( C ) ) THEN
E = D / C
F = C + D*E
P = ( A+B*E ) / F
Q = ( B-A*E ) / F
ELSE
E = C / D
F = D + C*E
P = ( B+A*E ) / F
Q = ( -A+B*E ) / F
END IF
*
RETURN
*
* End of DLADIV
*
END

189
lapack/dlamch.f Normal file
View File

@ -0,0 +1,189 @@
*> \brief \b DLAMCH
*
* =========== DOCUMENTATION ===========
*
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
* Definition:
* ===========
*
* DOUBLE PRECISION FUNCTION DLAMCH( CMACH )
*
*
*> \par Purpose:
* =============
*>
*> \verbatim
*>
*> DLAMCH determines double precision machine parameters.
*> \endverbatim
*
* Arguments:
* ==========
*
*> \param[in] CMACH
*> \verbatim
*> Specifies the value to be returned by DLAMCH:
*> = 'E' or 'e', DLAMCH := eps
*> = 'S' or 's , DLAMCH := sfmin
*> = 'B' or 'b', DLAMCH := base
*> = 'P' or 'p', DLAMCH := eps*base
*> = 'N' or 'n', DLAMCH := t
*> = 'R' or 'r', DLAMCH := rnd
*> = 'M' or 'm', DLAMCH := emin
*> = 'U' or 'u', DLAMCH := rmin
*> = 'L' or 'l', DLAMCH := emax
*> = 'O' or 'o', DLAMCH := rmax
*> where
*> eps = relative machine precision
*> sfmin = safe minimum, such that 1/sfmin does not overflow
*> base = base of the machine
*> prec = eps*base
*> t = number of (base) digits in the mantissa
*> rnd = 1.0 when rounding occurs in addition, 0.0 otherwise
*> emin = minimum exponent before (gradual) underflow
*> rmin = underflow threshold - base**(emin-1)
*> emax = largest exponent before overflow
*> rmax = overflow threshold - (base**emax)*(1-eps)
*> \endverbatim
*
* Authors:
* ========
*
*> \author Univ. of Tennessee
*> \author Univ. of California Berkeley
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date November 2011
*
*> \ingroup auxOTHERauxiliary
*
* =====================================================================
DOUBLE PRECISION FUNCTION DLAMCH( CMACH )
*
* -- LAPACK auxiliary routine (version 3.4.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* November 2011
*
* .. Scalar Arguments ..
CHARACTER CMACH
* ..
*
* =====================================================================
*
* .. Parameters ..
DOUBLE PRECISION ONE, ZERO
PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
* ..
* .. Local Scalars ..
DOUBLE PRECISION RND, EPS, SFMIN, SMALL, RMACH
* ..
* .. External Functions ..
LOGICAL LSAME
EXTERNAL LSAME
* ..
* .. Intrinsic Functions ..
INTRINSIC DIGITS, EPSILON, HUGE, MAXEXPONENT,
$ MINEXPONENT, RADIX, TINY
* ..
* .. Executable Statements ..
*
*
* Assume rounding, not chopping. Always.
*
RND = ONE
*
IF( ONE.EQ.RND ) THEN
EPS = EPSILON(ZERO) * 0.5
ELSE
EPS = EPSILON(ZERO)
END IF
*
IF( LSAME( CMACH, 'E' ) ) THEN
RMACH = EPS
ELSE IF( LSAME( CMACH, 'S' ) ) THEN
SFMIN = TINY(ZERO)
SMALL = ONE / HUGE(ZERO)
IF( SMALL.GE.SFMIN ) THEN
*
* Use SMALL plus a bit, to avoid the possibility of rounding
* causing overflow when computing 1/sfmin.
*
SFMIN = SMALL*( ONE+EPS )
END IF
RMACH = SFMIN
ELSE IF( LSAME( CMACH, 'B' ) ) THEN
RMACH = RADIX(ZERO)
ELSE IF( LSAME( CMACH, 'P' ) ) THEN
RMACH = EPS * RADIX(ZERO)
ELSE IF( LSAME( CMACH, 'N' ) ) THEN
RMACH = DIGITS(ZERO)
ELSE IF( LSAME( CMACH, 'R' ) ) THEN
RMACH = RND
ELSE IF( LSAME( CMACH, 'M' ) ) THEN
RMACH = MINEXPONENT(ZERO)
ELSE IF( LSAME( CMACH, 'U' ) ) THEN
RMACH = tiny(zero)
ELSE IF( LSAME( CMACH, 'L' ) ) THEN
RMACH = MAXEXPONENT(ZERO)
ELSE IF( LSAME( CMACH, 'O' ) ) THEN
RMACH = HUGE(ZERO)
ELSE
RMACH = ZERO
END IF
*
DLAMCH = RMACH
RETURN
*
* End of DLAMCH
*
END
************************************************************************
*> \brief \b DLAMC3
*> \details
*> \b Purpose:
*> \verbatim
*> DLAMC3 is intended to force A and B to be stored prior to doing
*> the addition of A and B , for use in situations where optimizers
*> might hold one of these in a register.
*> \endverbatim
*> \author LAPACK is a software package provided by Univ. of Tennessee, Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..
*> \date November 2011
*> \ingroup auxOTHERauxiliary
*>
*> \param[in] A
*> \verbatim
*> A is a DOUBLE PRECISION
*> \endverbatim
*>
*> \param[in] B
*> \verbatim
*> B is a DOUBLE PRECISION
*> The values A and B.
*> \endverbatim
*>
DOUBLE PRECISION FUNCTION DLAMC3( A, B )
*
* -- LAPACK auxiliary routine (version 3.4.0) --
* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
* November 2010
*
* .. Scalar Arguments ..
DOUBLE PRECISION A, B
* ..
* =====================================================================
*
* .. Executable Statements ..
*
DLAMC3 = A + B
*
RETURN
*
* End of DLAMC3
*
END
*
************************************************************************

104
lapack/dlapy2.f Normal file
View File

@ -0,0 +1,104 @@
*> \brief \b DLAPY2
*
* =========== DOCUMENTATION ===========
*
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download DLAPY2 + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlapy2.f">
*> [TGZ]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlapy2.f">
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlapy2.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
*
* DOUBLE PRECISION FUNCTION DLAPY2( X, Y )
*
* .. Scalar Arguments ..
* DOUBLE PRECISION X, Y
* ..
*
*
*> \par Purpose:
* =============
*>
*> \verbatim
*>
*> DLAPY2 returns sqrt(x**2+y**2), taking care not to cause unnecessary
*> overflow.
*> \endverbatim
*
* Arguments:
* ==========
*
*> \param[in] X
*> \verbatim
*> X is DOUBLE PRECISION
*> \endverbatim
*>
*> \param[in] Y
*> \verbatim
*> Y is DOUBLE PRECISION
*> X and Y specify the values x and y.
*> \endverbatim
*
* Authors:
* ========
*
*> \author Univ. of Tennessee
*> \author Univ. of California Berkeley
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date November 2011
*
*> \ingroup auxOTHERauxiliary
*
* =====================================================================
DOUBLE PRECISION FUNCTION DLAPY2( X, Y )
*
* -- LAPACK auxiliary routine (version 3.4.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* November 2011
*
* .. Scalar Arguments ..
DOUBLE PRECISION X, Y
* ..
*
* =====================================================================
*
* .. Parameters ..
DOUBLE PRECISION ZERO
PARAMETER ( ZERO = 0.0D0 )
DOUBLE PRECISION ONE
PARAMETER ( ONE = 1.0D0 )
* ..
* .. Local Scalars ..
DOUBLE PRECISION W, XABS, YABS, Z
* ..
* .. Intrinsic Functions ..
INTRINSIC ABS, MAX, MIN, SQRT
* ..
* .. Executable Statements ..
*
XABS = ABS( X )
YABS = ABS( Y )
W = MAX( XABS, YABS )
Z = MIN( XABS, YABS )
IF( Z.EQ.ZERO ) THEN
DLAPY2 = W
ELSE
DLAPY2 = W*SQRT( ONE+( Z / W )**2 )
END IF
RETURN
*
* End of DLAPY2
*
END

111
lapack/dlapy3.f Normal file
View File

@ -0,0 +1,111 @@
*> \brief \b DLAPY3
*
* =========== DOCUMENTATION ===========
*
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download DLAPY3 + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlapy3.f">
*> [TGZ]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlapy3.f">
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlapy3.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
*
* DOUBLE PRECISION FUNCTION DLAPY3( X, Y, Z )
*
* .. Scalar Arguments ..
* DOUBLE PRECISION X, Y, Z
* ..
*
*
*> \par Purpose:
* =============
*>
*> \verbatim
*>
*> DLAPY3 returns sqrt(x**2+y**2+z**2), taking care not to cause
*> unnecessary overflow.
*> \endverbatim
*
* Arguments:
* ==========
*
*> \param[in] X
*> \verbatim
*> X is DOUBLE PRECISION
*> \endverbatim
*>
*> \param[in] Y
*> \verbatim
*> Y is DOUBLE PRECISION
*> \endverbatim
*>
*> \param[in] Z
*> \verbatim
*> Z is DOUBLE PRECISION
*> X, Y and Z specify the values x, y and z.
*> \endverbatim
*
* Authors:
* ========
*
*> \author Univ. of Tennessee
*> \author Univ. of California Berkeley
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date November 2011
*
*> \ingroup auxOTHERauxiliary
*
* =====================================================================
DOUBLE PRECISION FUNCTION DLAPY3( X, Y, Z )
*
* -- LAPACK auxiliary routine (version 3.4.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* November 2011
*
* .. Scalar Arguments ..
DOUBLE PRECISION X, Y, Z
* ..
*
* =====================================================================
*
* .. Parameters ..
DOUBLE PRECISION ZERO
PARAMETER ( ZERO = 0.0D0 )
* ..
* .. Local Scalars ..
DOUBLE PRECISION W, XABS, YABS, ZABS
* ..
* .. Intrinsic Functions ..
INTRINSIC ABS, MAX, SQRT
* ..
* .. Executable Statements ..
*
XABS = ABS( X )
YABS = ABS( Y )
ZABS = ABS( Z )
W = MAX( XABS, YABS, ZABS )
IF( W.EQ.ZERO ) THEN
* W can be zero for max(0,nan,0)
* adding all three entries together will make sure
* NaN will not disappear.
DLAPY3 = XABS + YABS + ZABS
ELSE
DLAPY3 = W*SQRT( ( XABS / W )**2+( YABS / W )**2+
$ ( ZABS / W )**2 )
END IF
RETURN
*
* End of DLAPY3
*
END

118
lapack/ilaclc.f Normal file
View File

@ -0,0 +1,118 @@
*> \brief \b ILACLC
*
* =========== DOCUMENTATION ===========
*
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download ILACLC + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ilaclc.f">
*> [TGZ]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ilaclc.f">
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ilaclc.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
*
* INTEGER FUNCTION ILACLC( M, N, A, LDA )
*
* .. Scalar Arguments ..
* INTEGER M, N, LDA
* ..
* .. Array Arguments ..
* COMPLEX A( LDA, * )
* ..
*
*
*> \par Purpose:
* =============
*>
*> \verbatim
*>
*> ILACLC scans A for its last non-zero column.
*> \endverbatim
*
* Arguments:
* ==========
*
*> \param[in] M
*> \verbatim
*> M is INTEGER
*> The number of rows of the matrix A.
*> \endverbatim
*>
*> \param[in] N
*> \verbatim
*> N is INTEGER
*> The number of columns of the matrix A.
*> \endverbatim
*>
*> \param[in] A
*> \verbatim
*> A is COMPLEX array, dimension (LDA,N)
*> The m by n matrix A.
*> \endverbatim
*>
*> \param[in] LDA
*> \verbatim
*> LDA is INTEGER
*> The leading dimension of the array A. LDA >= max(1,M).
*> \endverbatim
*
* Authors:
* ========
*
*> \author Univ. of Tennessee
*> \author Univ. of California Berkeley
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date November 2011
*
*> \ingroup complexOTHERauxiliary
*
* =====================================================================
INTEGER FUNCTION ILACLC( M, N, A, LDA )
*
* -- LAPACK auxiliary routine (version 3.4.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* November 2011
*
* .. Scalar Arguments ..
INTEGER M, N, LDA
* ..
* .. Array Arguments ..
COMPLEX A( LDA, * )
* ..
*
* =====================================================================
*
* .. Parameters ..
COMPLEX ZERO
PARAMETER ( ZERO = (0.0E+0, 0.0E+0) )
* ..
* .. Local Scalars ..
INTEGER I
* ..
* .. Executable Statements ..
*
* Quick test for the common case where one corner is non-zero.
IF( N.EQ.0 ) THEN
ILACLC = N
ELSE IF( A(1, N).NE.ZERO .OR. A(M, N).NE.ZERO ) THEN
ILACLC = N
ELSE
* Now scan each column from the end, returning with the first non-zero.
DO ILACLC = N, 1, -1
DO I = 1, M
IF( A(I, ILACLC).NE.ZERO ) RETURN
END DO
END DO
END IF
RETURN
END

121
lapack/ilaclr.f Normal file
View File

@ -0,0 +1,121 @@
*> \brief \b ILACLR
*
* =========== DOCUMENTATION ===========
*
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download ILACLR + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ilaclr.f">
*> [TGZ]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ilaclr.f">
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ilaclr.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
*
* INTEGER FUNCTION ILACLR( M, N, A, LDA )
*
* .. Scalar Arguments ..
* INTEGER M, N, LDA
* ..
* .. Array Arguments ..
* COMPLEX A( LDA, * )
* ..
*
*
*> \par Purpose:
* =============
*>
*> \verbatim
*>
*> ILACLR scans A for its last non-zero row.
*> \endverbatim
*
* Arguments:
* ==========
*
*> \param[in] M
*> \verbatim
*> M is INTEGER
*> The number of rows of the matrix A.
*> \endverbatim
*>
*> \param[in] N
*> \verbatim
*> N is INTEGER
*> The number of columns of the matrix A.
*> \endverbatim
*>
*> \param[in] A
*> \verbatim
*> A is array, dimension (LDA,N)
*> The m by n matrix A.
*> \endverbatim
*>
*> \param[in] LDA
*> \verbatim
*> LDA is INTEGER
*> The leading dimension of the array A. LDA >= max(1,M).
*> \endverbatim
*
* Authors:
* ========
*
*> \author Univ. of Tennessee
*> \author Univ. of California Berkeley
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date April 2012
*
*> \ingroup complexOTHERauxiliary
*
* =====================================================================
INTEGER FUNCTION ILACLR( M, N, A, LDA )
*
* -- LAPACK auxiliary routine (version 3.4.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* April 2012
*
* .. Scalar Arguments ..
INTEGER M, N, LDA
* ..
* .. Array Arguments ..
COMPLEX A( LDA, * )
* ..
*
* =====================================================================
*
* .. Parameters ..
COMPLEX ZERO
PARAMETER ( ZERO = (0.0E+0, 0.0E+0) )
* ..
* .. Local Scalars ..
INTEGER I, J
* ..
* .. Executable Statements ..
*
* Quick test for the common case where one corner is non-zero.
IF( M.EQ.0 ) THEN
ILACLR = M
ELSE IF( A(M, 1).NE.ZERO .OR. A(M, N).NE.ZERO ) THEN
ILACLR = M
ELSE
* Scan up each column tracking the last zero row seen.
ILACLR = 0
DO J = 1, N
I=M
DO WHILE((A(MAX(I,1),J).EQ.ZERO).AND.(I.GE.1))
I=I-1
ENDDO
ILACLR = MAX( ILACLR, I )
END DO
END IF
RETURN
END

118
lapack/iladlc.f Normal file
View File

@ -0,0 +1,118 @@
*> \brief \b ILADLC
*
* =========== DOCUMENTATION ===========
*
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download ILADLC + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/iladlc.f">
*> [TGZ]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/iladlc.f">
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/iladlc.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
*
* INTEGER FUNCTION ILADLC( M, N, A, LDA )
*
* .. Scalar Arguments ..
* INTEGER M, N, LDA
* ..
* .. Array Arguments ..
* DOUBLE PRECISION A( LDA, * )
* ..
*
*
*> \par Purpose:
* =============
*>
*> \verbatim
*>
*> ILADLC scans A for its last non-zero column.
*> \endverbatim
*
* Arguments:
* ==========
*
*> \param[in] M
*> \verbatim
*> M is INTEGER
*> The number of rows of the matrix A.
*> \endverbatim
*>
*> \param[in] N
*> \verbatim
*> N is INTEGER
*> The number of columns of the matrix A.
*> \endverbatim
*>
*> \param[in] A
*> \verbatim
*> A is DOUBLE PRECISION array, dimension (LDA,N)
*> The m by n matrix A.
*> \endverbatim
*>
*> \param[in] LDA
*> \verbatim
*> LDA is INTEGER
*> The leading dimension of the array A. LDA >= max(1,M).
*> \endverbatim
*
* Authors:
* ========
*
*> \author Univ. of Tennessee
*> \author Univ. of California Berkeley
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date November 2011
*
*> \ingroup auxOTHERauxiliary
*
* =====================================================================
INTEGER FUNCTION ILADLC( M, N, A, LDA )
*
* -- LAPACK auxiliary routine (version 3.4.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* November 2011
*
* .. Scalar Arguments ..
INTEGER M, N, LDA
* ..
* .. Array Arguments ..
DOUBLE PRECISION A( LDA, * )
* ..
*
* =====================================================================
*
* .. Parameters ..
DOUBLE PRECISION ZERO
PARAMETER ( ZERO = 0.0D+0 )
* ..
* .. Local Scalars ..
INTEGER I
* ..
* .. Executable Statements ..
*
* Quick test for the common case where one corner is non-zero.
IF( N.EQ.0 ) THEN
ILADLC = N
ELSE IF( A(1, N).NE.ZERO .OR. A(M, N).NE.ZERO ) THEN
ILADLC = N
ELSE
* Now scan each column from the end, returning with the first non-zero.
DO ILADLC = N, 1, -1
DO I = 1, M
IF( A(I, ILADLC).NE.ZERO ) RETURN
END DO
END DO
END IF
RETURN
END

121
lapack/iladlr.f Normal file
View File

@ -0,0 +1,121 @@
*> \brief \b ILADLR
*
* =========== DOCUMENTATION ===========
*
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download ILADLR + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/iladlr.f">
*> [TGZ]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/iladlr.f">
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/iladlr.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
*
* INTEGER FUNCTION ILADLR( M, N, A, LDA )
*
* .. Scalar Arguments ..
* INTEGER M, N, LDA
* ..
* .. Array Arguments ..
* DOUBLE PRECISION A( LDA, * )
* ..
*
*
*> \par Purpose:
* =============
*>
*> \verbatim
*>
*> ILADLR scans A for its last non-zero row.
*> \endverbatim
*
* Arguments:
* ==========
*
*> \param[in] M
*> \verbatim
*> M is INTEGER
*> The number of rows of the matrix A.
*> \endverbatim
*>
*> \param[in] N
*> \verbatim
*> N is INTEGER
*> The number of columns of the matrix A.
*> \endverbatim
*>
*> \param[in] A
*> \verbatim
*> A is DOUBLE PRECISION array, dimension (LDA,N)
*> The m by n matrix A.
*> \endverbatim
*>
*> \param[in] LDA
*> \verbatim
*> LDA is INTEGER
*> The leading dimension of the array A. LDA >= max(1,M).
*> \endverbatim
*
* Authors:
* ========
*
*> \author Univ. of Tennessee
*> \author Univ. of California Berkeley
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date April 2012
*
*> \ingroup auxOTHERauxiliary
*
* =====================================================================
INTEGER FUNCTION ILADLR( M, N, A, LDA )
*
* -- LAPACK auxiliary routine (version 3.4.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* April 2012
*
* .. Scalar Arguments ..
INTEGER M, N, LDA
* ..
* .. Array Arguments ..
DOUBLE PRECISION A( LDA, * )
* ..
*
* =====================================================================
*
* .. Parameters ..
DOUBLE PRECISION ZERO
PARAMETER ( ZERO = 0.0D+0 )
* ..
* .. Local Scalars ..
INTEGER I, J
* ..
* .. Executable Statements ..
*
* Quick test for the common case where one corner is non-zero.
IF( M.EQ.0 ) THEN
ILADLR = M
ELSE IF( A(M, 1).NE.ZERO .OR. A(M, N).NE.ZERO ) THEN
ILADLR = M
ELSE
* Scan up each column tracking the last zero row seen.
ILADLR = 0
DO J = 1, N
I=M
DO WHILE((A(MAX(I,1),J).EQ.ZERO).AND.(I.GE.1))
I=I-1
ENDDO
ILADLR = MAX( ILADLR, I )
END DO
END IF
RETURN
END

118
lapack/ilaslc.f Normal file
View File

@ -0,0 +1,118 @@
*> \brief \b ILASLC
*
* =========== DOCUMENTATION ===========
*
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download ILASLC + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ilaslc.f">
*> [TGZ]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ilaslc.f">
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ilaslc.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
*
* INTEGER FUNCTION ILASLC( M, N, A, LDA )
*
* .. Scalar Arguments ..
* INTEGER M, N, LDA
* ..
* .. Array Arguments ..
* REAL A( LDA, * )
* ..
*
*
*> \par Purpose:
* =============
*>
*> \verbatim
*>
*> ILASLC scans A for its last non-zero column.
*> \endverbatim
*
* Arguments:
* ==========
*
*> \param[in] M
*> \verbatim
*> M is INTEGER
*> The number of rows of the matrix A.
*> \endverbatim
*>
*> \param[in] N
*> \verbatim
*> N is INTEGER
*> The number of columns of the matrix A.
*> \endverbatim
*>
*> \param[in] A
*> \verbatim
*> A is REAL array, dimension (LDA,N)
*> The m by n matrix A.
*> \endverbatim
*>
*> \param[in] LDA
*> \verbatim
*> LDA is INTEGER
*> The leading dimension of the array A. LDA >= max(1,M).
*> \endverbatim
*
* Authors:
* ========
*
*> \author Univ. of Tennessee
*> \author Univ. of California Berkeley
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date November 2011
*
*> \ingroup realOTHERauxiliary
*
* =====================================================================
INTEGER FUNCTION ILASLC( M, N, A, LDA )
*
* -- LAPACK auxiliary routine (version 3.4.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* November 2011
*
* .. Scalar Arguments ..
INTEGER M, N, LDA
* ..
* .. Array Arguments ..
REAL A( LDA, * )
* ..
*
* =====================================================================
*
* .. Parameters ..
REAL ZERO
PARAMETER ( ZERO = 0.0D+0 )
* ..
* .. Local Scalars ..
INTEGER I
* ..
* .. Executable Statements ..
*
* Quick test for the common case where one corner is non-zero.
IF( N.EQ.0 ) THEN
ILASLC = N
ELSE IF( A(1, N).NE.ZERO .OR. A(M, N).NE.ZERO ) THEN
ILASLC = N
ELSE
* Now scan each column from the end, returning with the first non-zero.
DO ILASLC = N, 1, -1
DO I = 1, M
IF( A(I, ILASLC).NE.ZERO ) RETURN
END DO
END DO
END IF
RETURN
END

121
lapack/ilaslr.f Normal file
View File

@ -0,0 +1,121 @@
*> \brief \b ILASLR
*
* =========== DOCUMENTATION ===========
*
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download ILASLR + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ilaslr.f">
*> [TGZ]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ilaslr.f">
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ilaslr.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
*
* INTEGER FUNCTION ILASLR( M, N, A, LDA )
*
* .. Scalar Arguments ..
* INTEGER M, N, LDA
* ..
* .. Array Arguments ..
* REAL A( LDA, * )
* ..
*
*
*> \par Purpose:
* =============
*>
*> \verbatim
*>
*> ILASLR scans A for its last non-zero row.
*> \endverbatim
*
* Arguments:
* ==========
*
*> \param[in] M
*> \verbatim
*> M is INTEGER
*> The number of rows of the matrix A.
*> \endverbatim
*>
*> \param[in] N
*> \verbatim
*> N is INTEGER
*> The number of columns of the matrix A.
*> \endverbatim
*>
*> \param[in] A
*> \verbatim
*> A is REAL array, dimension (LDA,N)
*> The m by n matrix A.
*> \endverbatim
*>
*> \param[in] LDA
*> \verbatim
*> LDA is INTEGER
*> The leading dimension of the array A. LDA >= max(1,M).
*> \endverbatim
*
* Authors:
* ========
*
*> \author Univ. of Tennessee
*> \author Univ. of California Berkeley
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date April 2012
*
*> \ingroup realOTHERauxiliary
*
* =====================================================================
INTEGER FUNCTION ILASLR( M, N, A, LDA )
*
* -- LAPACK auxiliary routine (version 3.4.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* April 2012
*
* .. Scalar Arguments ..
INTEGER M, N, LDA
* ..
* .. Array Arguments ..
REAL A( LDA, * )
* ..
*
* =====================================================================
*
* .. Parameters ..
REAL ZERO
PARAMETER ( ZERO = 0.0E+0 )
* ..
* .. Local Scalars ..
INTEGER I, J
* ..
* .. Executable Statements ..
*
* Quick test for the common case where one corner is non-zero.
IF( M.EQ.0 ) THEN
ILASLR = M
ELSEIF( A(M, 1).NE.ZERO .OR. A(M, N).NE.ZERO ) THEN
ILASLR = M
ELSE
* Scan up each column tracking the last zero row seen.
ILASLR = 0
DO J = 1, N
I=M
DO WHILE((A(MAX(I,1),J).EQ.ZERO).AND.(I.GE.1))
I=I-1
ENDDO
ILASLR = MAX( ILASLR, I )
END DO
END IF
RETURN
END

118
lapack/ilazlc.f Normal file
View File

@ -0,0 +1,118 @@
*> \brief \b ILAZLC
*
* =========== DOCUMENTATION ===========
*
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download ILAZLC + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ilazlc.f">
*> [TGZ]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ilazlc.f">
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ilazlc.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
*
* INTEGER FUNCTION ILAZLC( M, N, A, LDA )
*
* .. Scalar Arguments ..
* INTEGER M, N, LDA
* ..
* .. Array Arguments ..
* COMPLEX*16 A( LDA, * )
* ..
*
*
*> \par Purpose:
* =============
*>
*> \verbatim
*>
*> ILAZLC scans A for its last non-zero column.
*> \endverbatim
*
* Arguments:
* ==========
*
*> \param[in] M
*> \verbatim
*> M is INTEGER
*> The number of rows of the matrix A.
*> \endverbatim
*>
*> \param[in] N
*> \verbatim
*> N is INTEGER
*> The number of columns of the matrix A.
*> \endverbatim
*>
*> \param[in] A
*> \verbatim
*> A is COMPLEX*16 array, dimension (LDA,N)
*> The m by n matrix A.
*> \endverbatim
*>
*> \param[in] LDA
*> \verbatim
*> LDA is INTEGER
*> The leading dimension of the array A. LDA >= max(1,M).
*> \endverbatim
*
* Authors:
* ========
*
*> \author Univ. of Tennessee
*> \author Univ. of California Berkeley
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date November 2011
*
*> \ingroup complex16OTHERauxiliary
*
* =====================================================================
INTEGER FUNCTION ILAZLC( M, N, A, LDA )
*
* -- LAPACK auxiliary routine (version 3.4.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* November 2011
*
* .. Scalar Arguments ..
INTEGER M, N, LDA
* ..
* .. Array Arguments ..
COMPLEX*16 A( LDA, * )
* ..
*
* =====================================================================
*
* .. Parameters ..
COMPLEX*16 ZERO
PARAMETER ( ZERO = (0.0D+0, 0.0D+0) )
* ..
* .. Local Scalars ..
INTEGER I
* ..
* .. Executable Statements ..
*
* Quick test for the common case where one corner is non-zero.
IF( N.EQ.0 ) THEN
ILAZLC = N
ELSE IF( A(1, N).NE.ZERO .OR. A(M, N).NE.ZERO ) THEN
ILAZLC = N
ELSE
* Now scan each column from the end, returning with the first non-zero.
DO ILAZLC = N, 1, -1
DO I = 1, M
IF( A(I, ILAZLC).NE.ZERO ) RETURN
END DO
END DO
END IF
RETURN
END

121
lapack/ilazlr.f Normal file
View File

@ -0,0 +1,121 @@
*> \brief \b ILAZLR
*
* =========== DOCUMENTATION ===========
*
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download ILAZLR + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ilazlr.f">
*> [TGZ]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ilazlr.f">
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ilazlr.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
*
* INTEGER FUNCTION ILAZLR( M, N, A, LDA )
*
* .. Scalar Arguments ..
* INTEGER M, N, LDA
* ..
* .. Array Arguments ..
* COMPLEX*16 A( LDA, * )
* ..
*
*
*> \par Purpose:
* =============
*>
*> \verbatim
*>
*> ILAZLR scans A for its last non-zero row.
*> \endverbatim
*
* Arguments:
* ==========
*
*> \param[in] M
*> \verbatim
*> M is INTEGER
*> The number of rows of the matrix A.
*> \endverbatim
*>
*> \param[in] N
*> \verbatim
*> N is INTEGER
*> The number of columns of the matrix A.
*> \endverbatim
*>
*> \param[in] A
*> \verbatim
*> A is COMPLEX*16 array, dimension (LDA,N)
*> The m by n matrix A.
*> \endverbatim
*>
*> \param[in] LDA
*> \verbatim
*> LDA is INTEGER
*> The leading dimension of the array A. LDA >= max(1,M).
*> \endverbatim
*
* Authors:
* ========
*
*> \author Univ. of Tennessee
*> \author Univ. of California Berkeley
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date April 2012
*
*> \ingroup complex16OTHERauxiliary
*
* =====================================================================
INTEGER FUNCTION ILAZLR( M, N, A, LDA )
*
* -- LAPACK auxiliary routine (version 3.4.1) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* April 2012
*
* .. Scalar Arguments ..
INTEGER M, N, LDA
* ..
* .. Array Arguments ..
COMPLEX*16 A( LDA, * )
* ..
*
* =====================================================================
*
* .. Parameters ..
COMPLEX*16 ZERO
PARAMETER ( ZERO = (0.0D+0, 0.0D+0) )
* ..
* .. Local Scalars ..
INTEGER I, J
* ..
* .. Executable Statements ..
*
* Quick test for the common case where one corner is non-zero.
IF( M.EQ.0 ) THEN
ILAZLR = M
ELSE IF( A(M, 1).NE.ZERO .OR. A(M, N).NE.ZERO ) THEN
ILAZLR = M
ELSE
* Scan up each column tracking the last zero row seen.
ILAZLR = 0
DO J = 1, N
I=M
DO WHILE((A(MAX(I,1),J).EQ.ZERO).AND.(I.GE.1))
I=I-1
ENDDO
ILAZLR = MAX( ILAZLR, I )
END DO
END IF
RETURN
END

128
lapack/sladiv.f Normal file
View File

@ -0,0 +1,128 @@
*> \brief \b SLADIV
*
* =========== DOCUMENTATION ===========
*
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download SLADIV + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sladiv.f">
*> [TGZ]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sladiv.f">
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sladiv.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
*
* SUBROUTINE SLADIV( A, B, C, D, P, Q )
*
* .. Scalar Arguments ..
* REAL A, B, C, D, P, Q
* ..
*
*
*> \par Purpose:
* =============
*>
*> \verbatim
*>
*> SLADIV performs complex division in real arithmetic
*>
*> a + i*b
*> p + i*q = ---------
*> c + i*d
*>
*> The algorithm is due to Robert L. Smith and can be found
*> in D. Knuth, The art of Computer Programming, Vol.2, p.195
*> \endverbatim
*
* Arguments:
* ==========
*
*> \param[in] A
*> \verbatim
*> A is REAL
*> \endverbatim
*>
*> \param[in] B
*> \verbatim
*> B is REAL
*> \endverbatim
*>
*> \param[in] C
*> \verbatim
*> C is REAL
*> \endverbatim
*>
*> \param[in] D
*> \verbatim
*> D is REAL
*> The scalars a, b, c, and d in the above expression.
*> \endverbatim
*>
*> \param[out] P
*> \verbatim
*> P is REAL
*> \endverbatim
*>
*> \param[out] Q
*> \verbatim
*> Q is REAL
*> The scalars p and q in the above expression.
*> \endverbatim
*
* Authors:
* ========
*
*> \author Univ. of Tennessee
*> \author Univ. of California Berkeley
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date November 2011
*
*> \ingroup auxOTHERauxiliary
*
* =====================================================================
SUBROUTINE SLADIV( A, B, C, D, P, Q )
*
* -- LAPACK auxiliary routine (version 3.4.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* November 2011
*
* .. Scalar Arguments ..
REAL A, B, C, D, P, Q
* ..
*
* =====================================================================
*
* .. Local Scalars ..
REAL E, F
* ..
* .. Intrinsic Functions ..
INTRINSIC ABS
* ..
* .. Executable Statements ..
*
IF( ABS( D ).LT.ABS( C ) ) THEN
E = D / C
F = C + D*E
P = ( A+B*E ) / F
Q = ( B-A*E ) / F
ELSE
E = C / D
F = D + C*E
P = ( B+A*E ) / F
Q = ( -A+B*E ) / F
END IF
*
RETURN
*
* End of SLADIV
*
END

192
lapack/slamch.f Normal file
View File

@ -0,0 +1,192 @@
*> \brief \b SLAMCH
*
* =========== DOCUMENTATION ===========
*
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
* Definition:
* ===========
*
* REAL FUNCTION SLAMCH( CMACH )
*
* .. Scalar Arguments ..
* CHARACTER CMACH
* ..
*
*
*> \par Purpose:
* =============
*>
*> \verbatim
*>
*> SLAMCH determines single precision machine parameters.
*> \endverbatim
*
* Arguments:
* ==========
*
*> \param[in] CMACH
*> \verbatim
*> Specifies the value to be returned by SLAMCH:
*> = 'E' or 'e', SLAMCH := eps
*> = 'S' or 's , SLAMCH := sfmin
*> = 'B' or 'b', SLAMCH := base
*> = 'P' or 'p', SLAMCH := eps*base
*> = 'N' or 'n', SLAMCH := t
*> = 'R' or 'r', SLAMCH := rnd
*> = 'M' or 'm', SLAMCH := emin
*> = 'U' or 'u', SLAMCH := rmin
*> = 'L' or 'l', SLAMCH := emax
*> = 'O' or 'o', SLAMCH := rmax
*> where
*> eps = relative machine precision
*> sfmin = safe minimum, such that 1/sfmin does not overflow
*> base = base of the machine
*> prec = eps*base
*> t = number of (base) digits in the mantissa
*> rnd = 1.0 when rounding occurs in addition, 0.0 otherwise
*> emin = minimum exponent before (gradual) underflow
*> rmin = underflow threshold - base**(emin-1)
*> emax = largest exponent before overflow
*> rmax = overflow threshold - (base**emax)*(1-eps)
*> \endverbatim
*
* Authors:
* ========
*
*> \author Univ. of Tennessee
*> \author Univ. of California Berkeley
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date November 2011
*
*> \ingroup auxOTHERauxiliary
*
* =====================================================================
REAL FUNCTION SLAMCH( CMACH )
*
* -- LAPACK auxiliary routine (version 3.4.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* November 2011
*
* .. Scalar Arguments ..
CHARACTER CMACH
* ..
*
* =====================================================================
*
* .. Parameters ..
REAL ONE, ZERO
PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
* ..
* .. Local Scalars ..
REAL RND, EPS, SFMIN, SMALL, RMACH
* ..
* .. External Functions ..
LOGICAL LSAME
EXTERNAL LSAME
* ..
* .. Intrinsic Functions ..
INTRINSIC DIGITS, EPSILON, HUGE, MAXEXPONENT,
$ MINEXPONENT, RADIX, TINY
* ..
* .. Executable Statements ..
*
*
* Assume rounding, not chopping. Always.
*
RND = ONE
*
IF( ONE.EQ.RND ) THEN
EPS = EPSILON(ZERO) * 0.5
ELSE
EPS = EPSILON(ZERO)
END IF
*
IF( LSAME( CMACH, 'E' ) ) THEN
RMACH = EPS
ELSE IF( LSAME( CMACH, 'S' ) ) THEN
SFMIN = TINY(ZERO)
SMALL = ONE / HUGE(ZERO)
IF( SMALL.GE.SFMIN ) THEN
*
* Use SMALL plus a bit, to avoid the possibility of rounding
* causing overflow when computing 1/sfmin.
*
SFMIN = SMALL*( ONE+EPS )
END IF
RMACH = SFMIN
ELSE IF( LSAME( CMACH, 'B' ) ) THEN
RMACH = RADIX(ZERO)
ELSE IF( LSAME( CMACH, 'P' ) ) THEN
RMACH = EPS * RADIX(ZERO)
ELSE IF( LSAME( CMACH, 'N' ) ) THEN
RMACH = DIGITS(ZERO)
ELSE IF( LSAME( CMACH, 'R' ) ) THEN
RMACH = RND
ELSE IF( LSAME( CMACH, 'M' ) ) THEN
RMACH = MINEXPONENT(ZERO)
ELSE IF( LSAME( CMACH, 'U' ) ) THEN
RMACH = tiny(zero)
ELSE IF( LSAME( CMACH, 'L' ) ) THEN
RMACH = MAXEXPONENT(ZERO)
ELSE IF( LSAME( CMACH, 'O' ) ) THEN
RMACH = HUGE(ZERO)
ELSE
RMACH = ZERO
END IF
*
SLAMCH = RMACH
RETURN
*
* End of SLAMCH
*
END
************************************************************************
*> \brief \b SLAMC3
*> \details
*> \b Purpose:
*> \verbatim
*> SLAMC3 is intended to force A and B to be stored prior to doing
*> the addition of A and B , for use in situations where optimizers
*> might hold one of these in a register.
*> \endverbatim
*> \author LAPACK is a software package provided by Univ. of Tennessee, Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..
*> \date November 2011
*> \ingroup auxOTHERauxiliary
*>
*> \param[in] A
*> \verbatim
*> \endverbatim
*>
*> \param[in] B
*> \verbatim
*> The values A and B.
*> \endverbatim
*>
*
REAL FUNCTION SLAMC3( A, B )
*
* -- LAPACK auxiliary routine (version 3.4.0) --
* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
* November 2010
*
* .. Scalar Arguments ..
REAL A, B
* ..
* =====================================================================
*
* .. Executable Statements ..
*
SLAMC3 = A + B
*
RETURN
*
* End of SLAMC3
*
END
*
************************************************************************

104
lapack/slapy2.f Normal file
View File

@ -0,0 +1,104 @@
*> \brief \b SLAPY2
*
* =========== DOCUMENTATION ===========
*
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download SLAPY2 + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slapy2.f">
*> [TGZ]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slapy2.f">
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slapy2.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
*
* REAL FUNCTION SLAPY2( X, Y )
*
* .. Scalar Arguments ..
* REAL X, Y
* ..
*
*
*> \par Purpose:
* =============
*>
*> \verbatim
*>
*> SLAPY2 returns sqrt(x**2+y**2), taking care not to cause unnecessary
*> overflow.
*> \endverbatim
*
* Arguments:
* ==========
*
*> \param[in] X
*> \verbatim
*> X is REAL
*> \endverbatim
*>
*> \param[in] Y
*> \verbatim
*> Y is REAL
*> X and Y specify the values x and y.
*> \endverbatim
*
* Authors:
* ========
*
*> \author Univ. of Tennessee
*> \author Univ. of California Berkeley
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date November 2011
*
*> \ingroup auxOTHERauxiliary
*
* =====================================================================
REAL FUNCTION SLAPY2( X, Y )
*
* -- LAPACK auxiliary routine (version 3.4.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* November 2011
*
* .. Scalar Arguments ..
REAL X, Y
* ..
*
* =====================================================================
*
* .. Parameters ..
REAL ZERO
PARAMETER ( ZERO = 0.0E0 )
REAL ONE
PARAMETER ( ONE = 1.0E0 )
* ..
* .. Local Scalars ..
REAL W, XABS, YABS, Z
* ..
* .. Intrinsic Functions ..
INTRINSIC ABS, MAX, MIN, SQRT
* ..
* .. Executable Statements ..
*
XABS = ABS( X )
YABS = ABS( Y )
W = MAX( XABS, YABS )
Z = MIN( XABS, YABS )
IF( Z.EQ.ZERO ) THEN
SLAPY2 = W
ELSE
SLAPY2 = W*SQRT( ONE+( Z / W )**2 )
END IF
RETURN
*
* End of SLAPY2
*
END

111
lapack/slapy3.f Normal file
View File

@ -0,0 +1,111 @@
*> \brief \b SLAPY3
*
* =========== DOCUMENTATION ===========
*
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download SLAPY3 + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slapy3.f">
*> [TGZ]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slapy3.f">
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slapy3.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
*
* REAL FUNCTION SLAPY3( X, Y, Z )
*
* .. Scalar Arguments ..
* REAL X, Y, Z
* ..
*
*
*> \par Purpose:
* =============
*>
*> \verbatim
*>
*> SLAPY3 returns sqrt(x**2+y**2+z**2), taking care not to cause
*> unnecessary overflow.
*> \endverbatim
*
* Arguments:
* ==========
*
*> \param[in] X
*> \verbatim
*> X is REAL
*> \endverbatim
*>
*> \param[in] Y
*> \verbatim
*> Y is REAL
*> \endverbatim
*>
*> \param[in] Z
*> \verbatim
*> Z is REAL
*> X, Y and Z specify the values x, y and z.
*> \endverbatim
*
* Authors:
* ========
*
*> \author Univ. of Tennessee
*> \author Univ. of California Berkeley
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date November 2011
*
*> \ingroup auxOTHERauxiliary
*
* =====================================================================
REAL FUNCTION SLAPY3( X, Y, Z )
*
* -- LAPACK auxiliary routine (version 3.4.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* November 2011
*
* .. Scalar Arguments ..
REAL X, Y, Z
* ..
*
* =====================================================================
*
* .. Parameters ..
REAL ZERO
PARAMETER ( ZERO = 0.0E0 )
* ..
* .. Local Scalars ..
REAL W, XABS, YABS, ZABS
* ..
* .. Intrinsic Functions ..
INTRINSIC ABS, MAX, SQRT
* ..
* .. Executable Statements ..
*
XABS = ABS( X )
YABS = ABS( Y )
ZABS = ABS( Z )
W = MAX( XABS, YABS, ZABS )
IF( W.EQ.ZERO ) THEN
* W can be zero for max(0,nan,0)
* adding all three entries together will make sure
* NaN will not disappear.
SLAPY3 = XABS + YABS + ZABS
ELSE
SLAPY3 = W*SQRT( ( XABS / W )**2+( YABS / W )**2+
$ ( ZABS / W )**2 )
END IF
RETURN
*
* End of SLAPY3
*
END

116
lapack/zlacgv.f Normal file
View File

@ -0,0 +1,116 @@
*> \brief \b ZLACGV
*
* =========== DOCUMENTATION ===========
*
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download ZLACGV + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zlacgv.f">
*> [TGZ]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zlacgv.f">
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zlacgv.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
*
* SUBROUTINE ZLACGV( N, X, INCX )
*
* .. Scalar Arguments ..
* INTEGER INCX, N
* ..
* .. Array Arguments ..
* COMPLEX*16 X( * )
* ..
*
*
*> \par Purpose:
* =============
*>
*> \verbatim
*>
*> ZLACGV conjugates a complex vector of length N.
*> \endverbatim
*
* Arguments:
* ==========
*
*> \param[in] N
*> \verbatim
*> N is INTEGER
*> The length of the vector X. N >= 0.
*> \endverbatim
*>
*> \param[in,out] X
*> \verbatim
*> X is COMPLEX*16 array, dimension
*> (1+(N-1)*abs(INCX))
*> On entry, the vector of length N to be conjugated.
*> On exit, X is overwritten with conjg(X).
*> \endverbatim
*>
*> \param[in] INCX
*> \verbatim
*> INCX is INTEGER
*> The spacing between successive elements of X.
*> \endverbatim
*
* Authors:
* ========
*
*> \author Univ. of Tennessee
*> \author Univ. of California Berkeley
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date November 2011
*
*> \ingroup complex16OTHERauxiliary
*
* =====================================================================
SUBROUTINE ZLACGV( N, X, INCX )
*
* -- LAPACK auxiliary routine (version 3.4.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* November 2011
*
* .. Scalar Arguments ..
INTEGER INCX, N
* ..
* .. Array Arguments ..
COMPLEX*16 X( * )
* ..
*
* =====================================================================
*
* .. Local Scalars ..
INTEGER I, IOFF
* ..
* .. Intrinsic Functions ..
INTRINSIC DCONJG
* ..
* .. Executable Statements ..
*
IF( INCX.EQ.1 ) THEN
DO 10 I = 1, N
X( I ) = DCONJG( X( I ) )
10 CONTINUE
ELSE
IOFF = 1
IF( INCX.LT.0 )
$ IOFF = 1 - ( N-1 )*INCX
DO 20 I = 1, N
X( IOFF ) = DCONJG( X( IOFF ) )
IOFF = IOFF + INCX
20 CONTINUE
END IF
RETURN
*
* End of ZLACGV
*
END

97
lapack/zladiv.f Normal file
View File

@ -0,0 +1,97 @@
*> \brief \b ZLADIV
*
* =========== DOCUMENTATION ===========
*
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
*> Download ZLADIV + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zladiv.f">
*> [TGZ]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zladiv.f">
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zladiv.f">
*> [TXT]</a>
*> \endhtmlonly
*
* Definition:
* ===========
*
* COMPLEX*16 FUNCTION ZLADIV( X, Y )
*
* .. Scalar Arguments ..
* COMPLEX*16 X, Y
* ..
*
*
*> \par Purpose:
* =============
*>
*> \verbatim
*>
*> ZLADIV := X / Y, where X and Y are complex. The computation of X / Y
*> will not overflow on an intermediary step unless the results
*> overflows.
*> \endverbatim
*
* Arguments:
* ==========
*
*> \param[in] X
*> \verbatim
*> X is COMPLEX*16
*> \endverbatim
*>
*> \param[in] Y
*> \verbatim
*> Y is COMPLEX*16
*> The complex scalars X and Y.
*> \endverbatim
*
* Authors:
* ========
*
*> \author Univ. of Tennessee
*> \author Univ. of California Berkeley
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \date November 2011
*
*> \ingroup complex16OTHERauxiliary
*
* =====================================================================
COMPLEX*16 FUNCTION ZLADIV( X, Y )
*
* -- LAPACK auxiliary routine (version 3.4.0) --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
* November 2011
*
* .. Scalar Arguments ..
COMPLEX*16 X, Y
* ..
*
* =====================================================================
*
* .. Local Scalars ..
DOUBLE PRECISION ZI, ZR
* ..
* .. External Subroutines ..
EXTERNAL DLADIV
* ..
* .. Intrinsic Functions ..
INTRINSIC DBLE, DCMPLX, DIMAG
* ..
* .. Executable Statements ..
*
CALL DLADIV( DBLE( X ), DIMAG( X ), DBLE( Y ), DIMAG( Y ), ZR,
$ ZI )
ZLADIV = DCMPLX( ZR, ZI )
*
RETURN
*
* End of ZLADIV
*
END