LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
zgesc2.f
Go to the documentation of this file.
00001 *> \brief \b ZGESC2
00002 *
00003 *  =========== DOCUMENTATION ===========
00004 *
00005 * Online html documentation available at 
00006 *            http://www.netlib.org/lapack/explore-html/ 
00007 *
00008 *> \htmlonly
00009 *> Download ZGESC2 + dependencies 
00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zgesc2.f"> 
00011 *> [TGZ]</a> 
00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zgesc2.f"> 
00013 *> [ZIP]</a> 
00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zgesc2.f"> 
00015 *> [TXT]</a>
00016 *> \endhtmlonly 
00017 *
00018 *  Definition:
00019 *  ===========
00020 *
00021 *       SUBROUTINE ZGESC2( N, A, LDA, RHS, IPIV, JPIV, SCALE )
00022 * 
00023 *       .. Scalar Arguments ..
00024 *       INTEGER            LDA, N
00025 *       DOUBLE PRECISION   SCALE
00026 *       ..
00027 *       .. Array Arguments ..
00028 *       INTEGER            IPIV( * ), JPIV( * )
00029 *       COMPLEX*16         A( LDA, * ), RHS( * )
00030 *       ..
00031 *  
00032 *
00033 *> \par Purpose:
00034 *  =============
00035 *>
00036 *> \verbatim
00037 *>
00038 *> ZGESC2 solves a system of linear equations
00039 *>
00040 *>           A * X = scale* RHS
00041 *>
00042 *> with a general N-by-N matrix A using the LU factorization with
00043 *> complete pivoting computed by ZGETC2.
00044 *>
00045 *> \endverbatim
00046 *
00047 *  Arguments:
00048 *  ==========
00049 *
00050 *> \param[in] N
00051 *> \verbatim
00052 *>          N is INTEGER
00053 *>          The number of columns of the matrix A.
00054 *> \endverbatim
00055 *>
00056 *> \param[in] A
00057 *> \verbatim
00058 *>          A is COMPLEX*16 array, dimension (LDA, N)
00059 *>          On entry, the  LU part of the factorization of the n-by-n
00060 *>          matrix A computed by ZGETC2:  A = P * L * U * Q
00061 *> \endverbatim
00062 *>
00063 *> \param[in] LDA
00064 *> \verbatim
00065 *>          LDA is INTEGER
00066 *>          The leading dimension of the array A.  LDA >= max(1, N).
00067 *> \endverbatim
00068 *>
00069 *> \param[in,out] RHS
00070 *> \verbatim
00071 *>          RHS is COMPLEX*16 array, dimension N.
00072 *>          On entry, the right hand side vector b.
00073 *>          On exit, the solution vector X.
00074 *> \endverbatim
00075 *>
00076 *> \param[in] IPIV
00077 *> \verbatim
00078 *>          IPIV is INTEGER array, dimension (N).
00079 *>          The pivot indices; for 1 <= i <= N, row i of the
00080 *>          matrix has been interchanged with row IPIV(i).
00081 *> \endverbatim
00082 *>
00083 *> \param[in] JPIV
00084 *> \verbatim
00085 *>          JPIV is INTEGER array, dimension (N).
00086 *>          The pivot indices; for 1 <= j <= N, column j of the
00087 *>          matrix has been interchanged with column JPIV(j).
00088 *> \endverbatim
00089 *>
00090 *> \param[out] SCALE
00091 *> \verbatim
00092 *>          SCALE is DOUBLE PRECISION
00093 *>           On exit, SCALE contains the scale factor. SCALE is chosen
00094 *>           0 <= SCALE <= 1 to prevent owerflow in the solution.
00095 *> \endverbatim
00096 *
00097 *  Authors:
00098 *  ========
00099 *
00100 *> \author Univ. of Tennessee 
00101 *> \author Univ. of California Berkeley 
00102 *> \author Univ. of Colorado Denver 
00103 *> \author NAG Ltd. 
00104 *
00105 *> \date November 2011
00106 *
00107 *> \ingroup complex16GEauxiliary
00108 *
00109 *> \par Contributors:
00110 *  ==================
00111 *>
00112 *>     Bo Kagstrom and Peter Poromaa, Department of Computing Science,
00113 *>     Umea University, S-901 87 Umea, Sweden.
00114 *
00115 *  =====================================================================
00116       SUBROUTINE ZGESC2( N, A, LDA, RHS, IPIV, JPIV, SCALE )
00117 *
00118 *  -- LAPACK auxiliary routine (version 3.4.0) --
00119 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00120 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00121 *     November 2011
00122 *
00123 *     .. Scalar Arguments ..
00124       INTEGER            LDA, N
00125       DOUBLE PRECISION   SCALE
00126 *     ..
00127 *     .. Array Arguments ..
00128       INTEGER            IPIV( * ), JPIV( * )
00129       COMPLEX*16         A( LDA, * ), RHS( * )
00130 *     ..
00131 *
00132 *  =====================================================================
00133 *
00134 *     .. Parameters ..
00135       DOUBLE PRECISION   ZERO, ONE, TWO
00136       PARAMETER          ( ZERO = 0.0D+0, ONE = 1.0D+0, TWO = 2.0D+0 )
00137 *     ..
00138 *     .. Local Scalars ..
00139       INTEGER            I, J
00140       DOUBLE PRECISION   BIGNUM, EPS, SMLNUM
00141       COMPLEX*16         TEMP
00142 *     ..
00143 *     .. External Subroutines ..
00144       EXTERNAL           ZLASWP, ZSCAL
00145 *     ..
00146 *     .. External Functions ..
00147       INTEGER            IZAMAX
00148       DOUBLE PRECISION   DLAMCH
00149       EXTERNAL           IZAMAX, DLAMCH
00150 *     ..
00151 *     .. Intrinsic Functions ..
00152       INTRINSIC          ABS, DBLE, DCMPLX
00153 *     ..
00154 *     .. Executable Statements ..
00155 *
00156 *     Set constant to control overflow
00157 *
00158       EPS = DLAMCH( 'P' )
00159       SMLNUM = DLAMCH( 'S' ) / EPS
00160       BIGNUM = ONE / SMLNUM
00161       CALL DLABAD( SMLNUM, BIGNUM )
00162 *
00163 *     Apply permutations IPIV to RHS
00164 *
00165       CALL ZLASWP( 1, RHS, LDA, 1, N-1, IPIV, 1 )
00166 *
00167 *     Solve for L part
00168 *
00169       DO 20 I = 1, N - 1
00170          DO 10 J = I + 1, N
00171             RHS( J ) = RHS( J ) - A( J, I )*RHS( I )
00172    10    CONTINUE
00173    20 CONTINUE
00174 *
00175 *     Solve for U part
00176 *
00177       SCALE = ONE
00178 *
00179 *     Check for scaling
00180 *
00181       I = IZAMAX( N, RHS, 1 )
00182       IF( TWO*SMLNUM*ABS( RHS( I ) ).GT.ABS( A( N, N ) ) ) THEN
00183          TEMP = DCMPLX( ONE / TWO, ZERO ) / ABS( RHS( I ) )
00184          CALL ZSCAL( N, TEMP, RHS( 1 ), 1 )
00185          SCALE = SCALE*DBLE( TEMP )
00186       END IF
00187       DO 40 I = N, 1, -1
00188          TEMP = DCMPLX( ONE, ZERO ) / A( I, I )
00189          RHS( I ) = RHS( I )*TEMP
00190          DO 30 J = I + 1, N
00191             RHS( I ) = RHS( I ) - RHS( J )*( A( I, J )*TEMP )
00192    30    CONTINUE
00193    40 CONTINUE
00194 *
00195 *     Apply permutations JPIV to the solution (RHS)
00196 *
00197       CALL ZLASWP( 1, RHS, LDA, 1, N-1, JPIV, -1 )
00198       RETURN
00199 *
00200 *     End of ZGESC2
00201 *
00202       END
 All Files Functions