summaryrefslogtreecommitdiff
path: root/src/lib/lapack/zgesc2.f
diff options
context:
space:
mode:
authorjofret2009-04-28 07:17:00 +0000
committerjofret2009-04-28 07:17:00 +0000
commit8c8d2f518968ce7057eec6aa5cd5aec8faab861a (patch)
tree3dd1788b71d6a3ce2b73d2d475a3133580e17530 /src/lib/lapack/zgesc2.f
parent9f652ffc16a310ac6641a9766c5b9e2671e0e9cb (diff)
downloadscilab2c-8c8d2f518968ce7057eec6aa5cd5aec8faab861a.tar.gz
scilab2c-8c8d2f518968ce7057eec6aa5cd5aec8faab861a.tar.bz2
scilab2c-8c8d2f518968ce7057eec6aa5cd5aec8faab861a.zip
Moving lapack to right place
Diffstat (limited to 'src/lib/lapack/zgesc2.f')
-rw-r--r--src/lib/lapack/zgesc2.f133
1 files changed, 0 insertions, 133 deletions
diff --git a/src/lib/lapack/zgesc2.f b/src/lib/lapack/zgesc2.f
deleted file mode 100644
index d4d51337..00000000
--- a/src/lib/lapack/zgesc2.f
+++ /dev/null
@@ -1,133 +0,0 @@
- SUBROUTINE ZGESC2( N, A, LDA, RHS, IPIV, JPIV, SCALE )
-*
-* -- LAPACK auxiliary routine (version 3.1) --
-* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
-* November 2006
-*
-* .. Scalar Arguments ..
- INTEGER LDA, N
- DOUBLE PRECISION SCALE
-* ..
-* .. Array Arguments ..
- INTEGER IPIV( * ), JPIV( * )
- COMPLEX*16 A( LDA, * ), RHS( * )
-* ..
-*
-* Purpose
-* =======
-*
-* ZGESC2 solves a system of linear equations
-*
-* A * X = scale* RHS
-*
-* with a general N-by-N matrix A using the LU factorization with
-* complete pivoting computed by ZGETC2.
-*
-*
-* Arguments
-* =========
-*
-* N (input) INTEGER
-* The number of columns of the matrix A.
-*
-* A (input) COMPLEX*16 array, dimension (LDA, N)
-* On entry, the LU part of the factorization of the n-by-n
-* matrix A computed by ZGETC2: A = P * L * U * Q
-*
-* LDA (input) INTEGER
-* The leading dimension of the array A. LDA >= max(1, N).
-*
-* RHS (input/output) COMPLEX*16 array, dimension N.
-* On entry, the right hand side vector b.
-* On exit, the solution vector X.
-*
-* IPIV (input) INTEGER array, dimension (N).
-* The pivot indices; for 1 <= i <= N, row i of the
-* matrix has been interchanged with row IPIV(i).
-*
-* JPIV (input) INTEGER array, dimension (N).
-* The pivot indices; for 1 <= j <= N, column j of the
-* matrix has been interchanged with column JPIV(j).
-*
-* SCALE (output) DOUBLE PRECISION
-* On exit, SCALE contains the scale factor. SCALE is chosen
-* 0 <= SCALE <= 1 to prevent owerflow in the solution.
-*
-* Further Details
-* ===============
-*
-* Based on contributions by
-* Bo Kagstrom and Peter Poromaa, Department of Computing Science,
-* Umea University, S-901 87 Umea, Sweden.
-*
-* =====================================================================
-*
-* .. Parameters ..
- DOUBLE PRECISION ZERO, ONE, TWO
- PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0, TWO = 2.0D+0 )
-* ..
-* .. Local Scalars ..
- INTEGER I, J
- DOUBLE PRECISION BIGNUM, EPS, SMLNUM
- COMPLEX*16 TEMP
-* ..
-* .. External Subroutines ..
- EXTERNAL ZLASWP, ZSCAL
-* ..
-* .. External Functions ..
- INTEGER IZAMAX
- DOUBLE PRECISION DLAMCH
- EXTERNAL IZAMAX, DLAMCH
-* ..
-* .. Intrinsic Functions ..
- INTRINSIC ABS, DBLE, DCMPLX
-* ..
-* .. Executable Statements ..
-*
-* Set constant to control overflow
-*
- EPS = DLAMCH( 'P' )
- SMLNUM = DLAMCH( 'S' ) / EPS
- BIGNUM = ONE / SMLNUM
- CALL DLABAD( SMLNUM, BIGNUM )
-*
-* Apply permutations IPIV to RHS
-*
- CALL ZLASWP( 1, RHS, LDA, 1, N-1, IPIV, 1 )
-*
-* Solve for L part
-*
- DO 20 I = 1, N - 1
- DO 10 J = I + 1, N
- RHS( J ) = RHS( J ) - A( J, I )*RHS( I )
- 10 CONTINUE
- 20 CONTINUE
-*
-* Solve for U part
-*
- SCALE = ONE
-*
-* Check for scaling
-*
- I = IZAMAX( N, RHS, 1 )
- IF( TWO*SMLNUM*ABS( RHS( I ) ).GT.ABS( A( N, N ) ) ) THEN
- TEMP = DCMPLX( ONE / TWO, ZERO ) / ABS( RHS( I ) )
- CALL ZSCAL( N, TEMP, RHS( 1 ), 1 )
- SCALE = SCALE*DBLE( TEMP )
- END IF
- DO 40 I = N, 1, -1
- TEMP = DCMPLX( ONE, ZERO ) / A( I, I )
- RHS( I ) = RHS( I )*TEMP
- DO 30 J = I + 1, N
- RHS( I ) = RHS( I ) - RHS( J )*( A( I, J )*TEMP )
- 30 CONTINUE
- 40 CONTINUE
-*
-* Apply permutations JPIV to the solution (RHS)
-*
- CALL ZLASWP( 1, RHS, LDA, 1, N-1, JPIV, -1 )
- RETURN
-*
-* End of ZGESC2
-*
- END