summaryrefslogtreecommitdiff
path: root/2.3-1/src/fortran/lapack/ztrti2.f
diff options
context:
space:
mode:
authoryash11122017-07-07 21:20:49 +0530
committeryash11122017-07-07 21:20:49 +0530
commit9e5793a7b05b23e6044a6d7a9ddd5db39ba375f0 (patch)
treef50d6e06d8fe6bc1a9053ef10d4b4d857800ab51 /2.3-1/src/fortran/lapack/ztrti2.f
downloadScilab2C-9e5793a7b05b23e6044a6d7a9ddd5db39ba375f0.tar.gz
Scilab2C-9e5793a7b05b23e6044a6d7a9ddd5db39ba375f0.tar.bz2
Scilab2C-9e5793a7b05b23e6044a6d7a9ddd5db39ba375f0.zip
sci2c arduino updated
Diffstat (limited to '2.3-1/src/fortran/lapack/ztrti2.f')
-rw-r--r--2.3-1/src/fortran/lapack/ztrti2.f146
1 files changed, 146 insertions, 0 deletions
diff --git a/2.3-1/src/fortran/lapack/ztrti2.f b/2.3-1/src/fortran/lapack/ztrti2.f
new file mode 100644
index 00000000..73c7bbc3
--- /dev/null
+++ b/2.3-1/src/fortran/lapack/ztrti2.f
@@ -0,0 +1,146 @@
+ SUBROUTINE ZTRTI2( UPLO, DIAG, N, A, LDA, INFO )
+*
+* -- LAPACK routine (version 3.1) --
+* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
+* November 2006
+*
+* .. Scalar Arguments ..
+ CHARACTER DIAG, UPLO
+ INTEGER INFO, LDA, N
+* ..
+* .. Array Arguments ..
+ COMPLEX*16 A( LDA, * )
+* ..
+*
+* Purpose
+* =======
+*
+* ZTRTI2 computes the inverse of a complex upper or lower triangular
+* matrix.
+*
+* This is the Level 2 BLAS version of the algorithm.
+*
+* Arguments
+* =========
+*
+* UPLO (input) CHARACTER*1
+* Specifies whether the matrix A is upper or lower triangular.
+* = 'U': Upper triangular
+* = 'L': Lower triangular
+*
+* DIAG (input) CHARACTER*1
+* Specifies whether or not the matrix A is unit triangular.
+* = 'N': Non-unit triangular
+* = 'U': Unit triangular
+*
+* N (input) INTEGER
+* The order of the matrix A. N >= 0.
+*
+* A (input/output) COMPLEX*16 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.
+*
+* LDA (input) INTEGER
+* The leading dimension of the array A. LDA >= max(1,N).
+*
+* INFO (output) INTEGER
+* = 0: successful exit
+* < 0: if INFO = -k, the k-th argument had an illegal value
+*
+* =====================================================================
+*
+* .. Parameters ..
+ COMPLEX*16 ONE
+ PARAMETER ( ONE = ( 1.0D+0, 0.0D+0 ) )
+* ..
+* .. Local Scalars ..
+ LOGICAL NOUNIT, UPPER
+ INTEGER J
+ COMPLEX*16 AJJ
+* ..
+* .. External Functions ..
+ LOGICAL LSAME
+ EXTERNAL LSAME
+* ..
+* .. External Subroutines ..
+ EXTERNAL XERBLA, ZSCAL, ZTRMV
+* ..
+* .. 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( 'ZTRTI2', -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 ZTRMV( 'Upper', 'No transpose', DIAG, J-1, A, LDA,
+ $ A( 1, J ), 1 )
+ CALL ZSCAL( 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 ZTRMV( 'Lower', 'No transpose', DIAG, N-J,
+ $ A( J+1, J+1 ), LDA, A( J+1, J ), 1 )
+ CALL ZSCAL( N-J, AJJ, A( J+1, J ), 1 )
+ END IF
+ 20 CONTINUE
+ END IF
+*
+ RETURN
+*
+* End of ZTRTI2
+*
+ END