add missing BLAS/LAPACK functions used by LATTE to linalg lib (d1630bbe) · Commits · 郑智淋 / lammps

lib/linalg/dcabs1.f

0 → 100644

+58 −0

Original line number	Diff line number	Diff line
		*> \brief \b DCABS1
		*
		* =========== DOCUMENTATION ===========
		*
		* Online html documentation available at
		* http://www.netlib.org/lapack/explore-html/
		*
		* Definition:
		* ===========
		*
		* DOUBLE PRECISION FUNCTION DCABS1(Z)
		*
		* .. Scalar Arguments ..
		* COMPLEX*16 Z
		* ..
		* ..
		*
		*
		*> \par Purpose:
		* =============
		*>
		*> \verbatim
		*>
		*> DCABS1 computes absolute value of a double complex number
		*> \endverbatim
		*
		* Authors:
		* ========
		*
		*> \author Univ. of Tennessee
		*> \author Univ. of California Berkeley
		*> \author Univ. of Colorado Denver
		*> \author NAG Ltd.
		*
		*> \date November 2011
		*
		*> \ingroup double_blas_level1
		*
		* =====================================================================
		DOUBLE PRECISION FUNCTION DCABS1(Z)
		*
		* -- Reference BLAS level1 routine (version 3.4.0) --
		* -- Reference BLAS 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 Z
		* ..
		* ..
		* =====================================================================
		*
		* .. Intrinsic Functions ..
		INTRINSIC ABS,DBLE,DIMAG
		*
		DCABS1 = ABS(DBLE(Z)) + ABS(DIMAG(Z))
		RETURN
		END

lib/linalg/dgesv.f

0 → 100644

+179 −0

Original line number	Diff line number	Diff line
		> \brief <b> DGESV computes the solution to system of linear equations A X = B for GE matrices</b>
		*
		* =========== DOCUMENTATION ===========
		*
		* Online html documentation available at
		* http://www.netlib.org/lapack/explore-html/
		*
		*> \htmlonly
		*> Download DGESV + dependencies
		*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgesv.f">
		*> [TGZ]</a>
		*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgesv.f">
		*> [ZIP]</a>
		*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgesv.f">
		*> [TXT]</a>
		*> \endhtmlonly
		*
		* Definition:
		* ===========
		*
		* SUBROUTINE DGESV( N, NRHS, A, LDA, IPIV, B, LDB, INFO )
		*
		* .. Scalar Arguments ..
		* INTEGER INFO, LDA, LDB, N, NRHS
		* ..
		* .. Array Arguments ..
		* INTEGER IPIV( * )
		* DOUBLE PRECISION A( LDA, * ), B( LDB, * )
		* ..
		*
		*
		*> \par Purpose:
		* =============
		*>
		*> \verbatim
		*>
		*> DGESV computes the solution to a real system of linear equations
		> A X = B,
		*> where A is an N-by-N matrix and X and B are N-by-NRHS matrices.
		*>
		*> The LU decomposition with partial pivoting and row interchanges is
		*> used to factor A as
		> A = P L * U,
		*> where P is a permutation matrix, L is unit lower triangular, and U is
		*> upper triangular. The factored form of A is then used to solve the
		> system of equations A X = B.
		*> \endverbatim
		*
		* Arguments:
		* ==========
		*
		*> \param[in] N
		*> \verbatim
		*> N is INTEGER
		*> The number of linear equations, i.e., the order of the
		*> matrix A. N >= 0.
		*> \endverbatim
		*>
		*> \param[in] NRHS
		*> \verbatim
		*> NRHS is INTEGER
		*> The number of right hand sides, i.e., the number of columns
		*> of the matrix B. NRHS >= 0.
		*> \endverbatim
		*>
		*> \param[in,out] A
		*> \verbatim
		*> A is DOUBLE PRECISION array, dimension (LDA,N)
		*> On entry, the N-by-N coefficient matrix A.
		*> On exit, the factors L and U from the factorization
		> A = PL*U; the unit diagonal elements of L are not stored.
		*> \endverbatim
		*>
		*> \param[in] LDA
		*> \verbatim
		*> LDA is INTEGER
		*> The leading dimension of the array A. LDA >= max(1,N).
		*> \endverbatim
		*>
		*> \param[out] IPIV
		*> \verbatim
		*> IPIV is INTEGER array, dimension (N)
		*> The pivot indices that define the permutation matrix P;
		*> row i of the matrix was interchanged with row IPIV(i).
		*> \endverbatim
		*>
		*> \param[in,out] B
		*> \verbatim
		*> B is DOUBLE PRECISION array, dimension (LDB,NRHS)
		*> On entry, the N-by-NRHS matrix of right hand side matrix B.
		*> On exit, if INFO = 0, the N-by-NRHS solution matrix X.
		*> \endverbatim
		*>
		*> \param[in] LDB
		*> \verbatim
		*> LDB is INTEGER
		*> The leading dimension of the array B. LDB >= max(1,N).
		*> \endverbatim
		*>
		*> \param[out] INFO
		*> \verbatim
		*> INFO is INTEGER
		*> = 0: successful exit
		*> < 0: if INFO = -i, the i-th argument had an illegal value
		*> > 0: if INFO = i, U(i,i) is exactly zero. The factorization
		*> has been completed, but the factor U is exactly
		*> singular, so the solution could not be computed.
		*> \endverbatim
		*
		* Authors:
		* ========
		*
		*> \author Univ. of Tennessee
		*> \author Univ. of California Berkeley
		*> \author Univ. of Colorado Denver
		*> \author NAG Ltd.
		*
		*> \date November 2011
		*
		*> \ingroup doubleGEsolve
		*
		* =====================================================================
		SUBROUTINE DGESV( N, NRHS, A, LDA, IPIV, B, LDB, INFO )
		*
		* -- LAPACK driver 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 INFO, LDA, LDB, N, NRHS
		* ..
		* .. Array Arguments ..
		INTEGER IPIV( * )
		DOUBLE PRECISION A( LDA, * ), B( LDB, * )
		* ..
		*
		* =====================================================================
		*
		* .. External Subroutines ..
		EXTERNAL DGETRF, DGETRS, XERBLA
		* ..
		* .. Intrinsic Functions ..
		INTRINSIC MAX
		* ..
		* .. Executable Statements ..
		*
		* Test the input parameters.
		*
		INFO = 0
		IF( N.LT.0 ) THEN
		INFO = -1
		ELSE IF( NRHS.LT.0 ) THEN
		INFO = -2
		ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
		INFO = -4
		ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
		INFO = -7
		END IF
		IF( INFO.NE.0 ) THEN
		CALL XERBLA( 'DGESV ', -INFO )
		RETURN
		END IF
		*
		* Compute the LU factorization of A.
		*
		CALL DGETRF( N, N, A, LDA, IPIV, INFO )
		IF( INFO.EQ.0 ) THEN
		*
		* Solve the system A*X = B, overwriting B with X.
		*
		CALL DGETRS( 'No transpose', N, NRHS, A, LDA, IPIV, B, LDB,
		$ INFO )
		END IF
		RETURN
		*
		* End of DGESV
		*
		END

lib/linalg/dgetrs.f

0 → 100644

+225 −0

Original line number	Diff line number	Diff line
		*> \brief \b DGETRS
		*
		* =========== DOCUMENTATION ===========
		*
		* Online html documentation available at
		* http://www.netlib.org/lapack/explore-html/
		*
		*> \htmlonly
		*> Download DGETRS + dependencies
		*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgetrs.f">
		*> [TGZ]</a>
		*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgetrs.f">
		*> [ZIP]</a>
		*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgetrs.f">
		*> [TXT]</a>
		*> \endhtmlonly
		*
		* Definition:
		* ===========
		*
		* SUBROUTINE DGETRS( TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO )
		*
		* .. Scalar Arguments ..
		* CHARACTER TRANS
		* INTEGER INFO, LDA, LDB, N, NRHS
		* ..
		* .. Array Arguments ..
		* INTEGER IPIV( * )
		* DOUBLE PRECISION A( LDA, * ), B( LDB, * )
		* ..
		*
		*
		*> \par Purpose:
		* =============
		*>
		*> \verbatim
		*>
		*> DGETRS solves a system of linear equations
		> A X = B or A*T X = B
		*> with a general N-by-N matrix A using the LU factorization computed
		*> by DGETRF.
		*> \endverbatim
		*
		* Arguments:
		* ==========
		*
		*> \param[in] TRANS
		*> \verbatim
		> TRANS is CHARACTER1
		*> Specifies the form of the system of equations:
		> = 'N': A X = B (No transpose)
		> = 'T': AT X = B (Transpose)
		> = 'C': AT X = B (Conjugate transpose = Transpose)
		*> \endverbatim
		*>
		*> \param[in] N
		*> \verbatim
		*> N is INTEGER
		*> The order of the matrix A. N >= 0.
		*> \endverbatim
		*>
		*> \param[in] NRHS
		*> \verbatim
		*> NRHS is INTEGER
		*> The number of right hand sides, i.e., the number of columns
		*> of the matrix B. NRHS >= 0.
		*> \endverbatim
		*>
		*> \param[in] A
		*> \verbatim
		*> A is DOUBLE PRECISION array, dimension (LDA,N)
		> The factors L and U from the factorization A = PL*U
		*> as computed by DGETRF.
		*> \endverbatim
		*>
		*> \param[in] LDA
		*> \verbatim
		*> LDA is INTEGER
		*> The leading dimension of the array A. LDA >= max(1,N).
		*> \endverbatim
		*>
		*> \param[in] IPIV
		*> \verbatim
		*> IPIV is INTEGER array, dimension (N)
		*> The pivot indices from DGETRF; for 1<=i<=N, row i of the
		*> matrix was interchanged with row IPIV(i).
		*> \endverbatim
		*>
		*> \param[in,out] B
		*> \verbatim
		*> B is DOUBLE PRECISION array, dimension (LDB,NRHS)
		*> On entry, the right hand side matrix B.
		*> On exit, the solution matrix X.
		*> \endverbatim
		*>
		*> \param[in] LDB
		*> \verbatim
		*> LDB is INTEGER
		*> The leading dimension of the array B. LDB >= max(1,N).
		*> \endverbatim
		*>
		*> \param[out] INFO
		*> \verbatim
		*> INFO is INTEGER
		*> = 0: successful exit
		*> < 0: if INFO = -i, the i-th argument had an illegal value
		*> \endverbatim
		*
		* Authors:
		* ========
		*
		*> \author Univ. of Tennessee
		*> \author Univ. of California Berkeley
		*> \author Univ. of Colorado Denver
		*> \author NAG Ltd.
		*
		*> \date November 2011
		*
		*> \ingroup doubleGEcomputational
		*
		* =====================================================================
		SUBROUTINE DGETRS( TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO )
		*
		* -- LAPACK computational 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 TRANS
		INTEGER INFO, LDA, LDB, N, NRHS
		* ..
		* .. Array Arguments ..
		INTEGER IPIV( * )
		DOUBLE PRECISION A( LDA, * ), B( LDB, * )
		* ..
		*
		* =====================================================================
		*
		* .. Parameters ..
		DOUBLE PRECISION ONE
		PARAMETER ( ONE = 1.0D+0 )
		* ..
		* .. Local Scalars ..
		LOGICAL NOTRAN
		* ..
		* .. External Functions ..
		LOGICAL LSAME
		EXTERNAL LSAME
		* ..
		* .. External Subroutines ..
		EXTERNAL DLASWP, DTRSM, XERBLA
		* ..
		* .. Intrinsic Functions ..
		INTRINSIC MAX
		* ..
		* .. Executable Statements ..
		*
		* Test the input parameters.
		*
		INFO = 0
		NOTRAN = LSAME( TRANS, 'N' )
		IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT.
		$ LSAME( TRANS, 'C' ) ) THEN
		INFO = -1
		ELSE IF( N.LT.0 ) THEN
		INFO = -2
		ELSE IF( NRHS.LT.0 ) THEN
		INFO = -3
		ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
		INFO = -5
		ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
		INFO = -8
		END IF
		IF( INFO.NE.0 ) THEN
		CALL XERBLA( 'DGETRS', -INFO )
		RETURN
		END IF
		*
		* Quick return if possible
		*
		IF( N.EQ.0 .OR. NRHS.EQ.0 )
		$ RETURN
		*
		IF( NOTRAN ) THEN
		*
		* Solve A * X = B.
		*
		* Apply row interchanges to the right hand sides.
		*
		CALL DLASWP( NRHS, B, LDB, 1, N, IPIV, 1 )
		*
		* Solve L*X = B, overwriting B with X.
		*
		CALL DTRSM( 'Left', 'Lower', 'No transpose', 'Unit', N, NRHS,
		$ ONE, A, LDA, B, LDB )
		*
		* Solve U*X = B, overwriting B with X.
		*
		CALL DTRSM( 'Left', 'Upper', 'No transpose', 'Non-unit', N,
		$ NRHS, ONE, A, LDA, B, LDB )
		ELSE
		*
		* Solve A*T X = B.
		*
		* Solve U*T X = B, overwriting B with X.
		*
		CALL DTRSM( 'Left', 'Upper', 'Transpose', 'Non-unit', N, NRHS,
		$ ONE, A, LDA, B, LDB )
		*
		* Solve L*T X = B, overwriting B with X.
		*
		CALL DTRSM( 'Left', 'Lower', 'Transpose', 'Unit', N, NRHS, ONE,
		$ A, LDA, B, LDB )
		*
		* Apply row interchanges to the solution vectors.
		*
		CALL DLASWP( NRHS, B, LDB, 1, N, IPIV, -1 )
		END IF
		*
		RETURN
		*
		* End of DGETRS
		*
		END

lib/linalg/dladiv.f

0 → 100644

+128 −0

Original line number	Diff line number	Diff line
		*> \brief \b DLADIV performs complex division in real arithmetic, avoiding unnecessary overflow.
		*
		* =========== 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 + ib
		> p + iq = ---------
		> c + id
		*>
		*> 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 September 2012
		*
		*> \ingroup auxOTHERauxiliary
		*
		* =====================================================================
		SUBROUTINE DLADIV( A, B, C, D, P, Q )
		*
		* -- LAPACK auxiliary routine (version 3.4.2) --
		* -- LAPACK is a software package provided by Univ. of Tennessee, --
		* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
		* September 2012
		*
		* .. 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

lib/linalg/dlapy3.f

0 → 100644

+111 −0

Original line number	Diff line number	Diff line
		*> \brief \b DLAPY3 returns sqrt(x2+y2+z2).
		*
		* =========== 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(x2+y2+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 September 2012
		*
		*> \ingroup auxOTHERauxiliary
		*
		* =====================================================================
		DOUBLE PRECISION FUNCTION DLAPY3( X, Y, Z )
		*
		* -- LAPACK auxiliary routine (version 3.4.2) --
		* -- LAPACK is a software package provided by Univ. of Tennessee, --
		* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
		* September 2012
		*
		* .. 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 = WSQRT( ( XABS / W )2+( YABS / W )*2+
		$ ( ZABS / W )**2 )
		END IF
		RETURN
		*
		* End of DLAPY3
		*
		END

Admin message