convert linalg library from Fortran to C++
This commit is contained in:
Axel Kohlmeyer
209
lib/linalg/fortran/dtrti2.f
Normal file
209
lib/linalg/fortran/dtrti2.f
Normal file
@ -0,0 +1,209 @@
|
||||
*> \brief \b DTRTI2 computes the inverse of a triangular matrix (unblocked algorithm).
|
||||
*
|
||||
* =========== DOCUMENTATION ===========
|
||||
*
|
||||
* Online html documentation available at
|
||||
* http://www.netlib.org/lapack/explore-html/
|
||||
*
|
||||
*> \htmlonly
|
||||
*> Download DTRTI2 + dependencies
|
||||
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dtrti2.f">
|
||||
*> [TGZ]</a>
|
||||
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dtrti2.f">
|
||||
*> [ZIP]</a>
|
||||
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dtrti2.f">
|
||||
*> [TXT]</a>
|
||||
*> \endhtmlonly
|
||||
*
|
||||
* Definition:
|
||||
* ===========
|
||||
*
|
||||
* SUBROUTINE DTRTI2( UPLO, DIAG, N, A, LDA, INFO )
|
||||
*
|
||||
* .. Scalar Arguments ..
|
||||
* CHARACTER DIAG, UPLO
|
||||
* INTEGER INFO, LDA, N
|
||||
* ..
|
||||
* .. Array Arguments ..
|
||||
* DOUBLE PRECISION A( LDA, * )
|
||||
* ..
|
||||
*
|
||||
*
|
||||
*> \par Purpose:
|
||||
* =============
|
||||
*>
|
||||
*> \verbatim
|
||||
*>
|
||||
*> DTRTI2 computes the inverse of a real upper or lower triangular
|
||||
*> matrix.
|
||||
*>
|
||||
*> This is the Level 2 BLAS version of the algorithm.
|
||||
*> \endverbatim
|
||||
*
|
||||
* Arguments:
|
||||
* ==========
|
||||
*
|
||||
*> \param[in] UPLO
|
||||
*> \verbatim
|
||||
*> UPLO is CHARACTER*1
|
||||
*> Specifies whether the matrix A is upper or lower triangular.
|
||||
*> = 'U': Upper triangular
|
||||
*> = 'L': Lower triangular
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] DIAG
|
||||
*> \verbatim
|
||||
*> DIAG is CHARACTER*1
|
||||
*> Specifies whether or not the matrix A is unit triangular.
|
||||
*> = 'N': Non-unit triangular
|
||||
*> = 'U': Unit triangular
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] N
|
||||
*> \verbatim
|
||||
*> N is INTEGER
|
||||
*> The order of the matrix A. N >= 0.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in,out] A
|
||||
*> \verbatim
|
||||
*> A is DOUBLE PRECISION array, dimension (LDA,N)
|
||||
*> On entry, the triangular matrix A. If UPLO = 'U', the
|
||||
*> leading n by n upper triangular part of the array A contains
|
||||
*> the upper triangular matrix, and the strictly lower
|
||||
*> triangular part of A is not referenced. If UPLO = 'L', the
|
||||
*> leading n by n lower triangular part of the array A contains
|
||||
*> the lower triangular matrix, and the strictly upper
|
||||
*> triangular part of A is not referenced. If DIAG = 'U', the
|
||||
*> diagonal elements of A are also not referenced and are
|
||||
*> assumed to be 1.
|
||||
*>
|
||||
*> On exit, the (triangular) inverse of the original matrix, in
|
||||
*> the same storage format.
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[in] LDA
|
||||
*> \verbatim
|
||||
*> LDA is INTEGER
|
||||
*> The leading dimension of the array A. LDA >= max(1,N).
|
||||
*> \endverbatim
|
||||
*>
|
||||
*> \param[out] INFO
|
||||
*> \verbatim
|
||||
*> INFO is INTEGER
|
||||
*> = 0: successful exit
|
||||
*> < 0: if INFO = -k, the k-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.
|
||||
*
|
||||
*> \ingroup doubleOTHERcomputational
|
||||
*
|
||||
* =====================================================================
|
||||
SUBROUTINE DTRTI2( UPLO, DIAG, N, A, LDA, INFO )
|
||||
*
|
||||
* -- LAPACK computational routine --
|
||||
* -- LAPACK is a software package provided by Univ. of Tennessee, --
|
||||
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
|
||||
*
|
||||
* .. Scalar Arguments ..
|
||||
CHARACTER DIAG, UPLO
|
||||
INTEGER INFO, LDA, N
|
||||
* ..
|
||||
* .. Array Arguments ..
|
||||
DOUBLE PRECISION A( LDA, * )
|
||||
* ..
|
||||
*
|
||||
* =====================================================================
|
||||
*
|
||||
* .. Parameters ..
|
||||
DOUBLE PRECISION ONE
|
||||
PARAMETER ( ONE = 1.0D+0 )
|
||||
* ..
|
||||
* .. Local Scalars ..
|
||||
LOGICAL NOUNIT, UPPER
|
||||
INTEGER J
|
||||
DOUBLE PRECISION AJJ
|
||||
* ..
|
||||
* .. External Functions ..
|
||||
LOGICAL LSAME
|
||||
EXTERNAL LSAME
|
||||
* ..
|
||||
* .. External Subroutines ..
|
||||
EXTERNAL DSCAL, DTRMV, XERBLA
|
||||
* ..
|
||||
* .. Intrinsic Functions ..
|
||||
INTRINSIC MAX
|
||||
* ..
|
||||
* .. Executable Statements ..
|
||||
*
|
||||
* Test the input parameters.
|
||||
*
|
||||
INFO = 0
|
||||
UPPER = LSAME( UPLO, 'U' )
|
||||
NOUNIT = LSAME( DIAG, 'N' )
|
||||
IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
|
||||
INFO = -1
|
||||
ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN
|
||||
INFO = -2
|
||||
ELSE IF( N.LT.0 ) THEN
|
||||
INFO = -3
|
||||
ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
|
||||
INFO = -5
|
||||
END IF
|
||||
IF( INFO.NE.0 ) THEN
|
||||
CALL XERBLA( 'DTRTI2', -INFO )
|
||||
RETURN
|
||||
END IF
|
||||
*
|
||||
IF( UPPER ) THEN
|
||||
*
|
||||
* Compute inverse of upper triangular matrix.
|
||||
*
|
||||
DO 10 J = 1, N
|
||||
IF( NOUNIT ) THEN
|
||||
A( J, J ) = ONE / A( J, J )
|
||||
AJJ = -A( J, J )
|
||||
ELSE
|
||||
AJJ = -ONE
|
||||
END IF
|
||||
*
|
||||
* Compute elements 1:j-1 of j-th column.
|
||||
*
|
||||
CALL DTRMV( 'Upper', 'No transpose', DIAG, J-1, A, LDA,
|
||||
$ A( 1, J ), 1 )
|
||||
CALL DSCAL( J-1, AJJ, A( 1, J ), 1 )
|
||||
10 CONTINUE
|
||||
ELSE
|
||||
*
|
||||
* Compute inverse of lower triangular matrix.
|
||||
*
|
||||
DO 20 J = N, 1, -1
|
||||
IF( NOUNIT ) THEN
|
||||
A( J, J ) = ONE / A( J, J )
|
||||
AJJ = -A( J, J )
|
||||
ELSE
|
||||
AJJ = -ONE
|
||||
END IF
|
||||
IF( J.LT.N ) THEN
|
||||
*
|
||||
* Compute elements j+1:n of j-th column.
|
||||
*
|
||||
CALL DTRMV( 'Lower', 'No transpose', DIAG, N-J,
|
||||
$ A( J+1, J+1 ), LDA, A( J+1, J ), 1 )
|
||||
CALL DSCAL( N-J, AJJ, A( J+1, J ), 1 )
|
||||
END IF
|
||||
20 CONTINUE
|
||||
END IF
|
||||
*
|
||||
RETURN
|
||||
*
|
||||
* End of DTRTI2
|
||||
*
|
||||
END
|
||||
Reference in New Issue
Block a user