mirror of
https://gitlab.com/libeigen/eigen.git
synced 2025-07-31 01:03:38 +08:00
Complete the lapack interface to make it complete enough for suitesparse QR.
This commit is contained in:
Gael Guennebaud
parent
76f4820560
commit
827843bbbd
@ -18,11 +18,17 @@ single.cpp double.cpp complex_single.cpp complex_double.cpp ../blas/xerbla.cpp
|
|||||||
|
|
||||||
if(EIGEN_Fortran_COMPILER_WORKS)
|
if(EIGEN_Fortran_COMPILER_WORKS)
|
||||||
|
|
||||||
set(EigenLapack_SRCS
|
set(EigenLapack_SRCS ${EigenLapack_SRCS}
|
||||||
slarft.f dlarft.f clarft.f zlarft.f
|
slarft.f dlarft.f clarft.f zlarft.f
|
||||||
slarfb.f dlarfb.f clarfb.f zlarfb.f
|
slarfb.f dlarfb.f clarfb.f zlarfb.f
|
||||||
slarfg.f dlarfg.f clarfg.f zlarfg.f
|
slarfg.f dlarfg.f clarfg.f zlarfg.f
|
||||||
slarf.f dlarf.f clarf.f zlarf.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)
|
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_static ${EigenLapack_SRCS})
|
||||||
add_library(eigen_lapack SHARED ${EigenLapack_SRCS})
|
add_library(eigen_lapack SHARED ${EigenLapack_SRCS})
|
||||||
|
|
||||||
|
target_link_libraries(eigen_lapack eigen_blas)
|
||||||
|
|
||||||
if(EIGEN_STANDARD_LIBRARIES_TO_LINK_TO)
|
if(EIGEN_STANDARD_LIBRARIES_TO_LINK_TO)
|
||||||
target_link_libraries(eigen_lapack_static ${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})
|
target_link_libraries(eigen_lapack ${EIGEN_STANDARD_LIBRARIES_TO_LINK_TO})
|
||||||
|
|||||||
116
lapack/clacgv.f
Normal file
116
lapack/clacgv.f
Normal 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
97
lapack/cladiv.f
Normal 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
128
lapack/dladiv.f
Normal 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
189
lapack/dlamch.f
Normal 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
104
lapack/dlapy2.f
Normal 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
111
lapack/dlapy3.f
Normal 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
118
lapack/ilaclc.f
Normal 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
121
lapack/ilaclr.f
Normal 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
118
lapack/iladlc.f
Normal 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
121
lapack/iladlr.f
Normal 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
118
lapack/ilaslc.f
Normal 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
121
lapack/ilaslr.f
Normal 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
118
lapack/ilazlc.f
Normal 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
121
lapack/ilazlr.f
Normal 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
128
lapack/sladiv.f
Normal 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
192
lapack/slamch.f
Normal 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
104
lapack/slapy2.f
Normal 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
111
lapack/slapy3.f
Normal 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
116
lapack/zlacgv.f
Normal 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
97
lapack/zladiv.f
Normal 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
|
||||||
Loading…
x
Reference in New Issue
Block a user