diff options
author | jofret | 2009-04-28 07:17:00 +0000 |
---|---|---|
committer | jofret | 2009-04-28 07:17:00 +0000 |
commit | 8c8d2f518968ce7057eec6aa5cd5aec8faab861a (patch) | |
tree | 3dd1788b71d6a3ce2b73d2d475a3133580e17530 /src/lib/lapack/zgesc2.f | |
parent | 9f652ffc16a310ac6641a9766c5b9e2671e0e9cb (diff) | |
download | scilab2c-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.f | 133 |
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 |