![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b CGESC2 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 *> \htmlonly 00009 *> Download CGESC2 + dependencies 00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cgesc2.f"> 00011 *> [TGZ]</a> 00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/cgesc2.f"> 00013 *> [ZIP]</a> 00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cgesc2.f"> 00015 *> [TXT]</a> 00016 *> \endhtmlonly 00017 * 00018 * Definition: 00019 * =========== 00020 * 00021 * SUBROUTINE CGESC2( N, A, LDA, RHS, IPIV, JPIV, SCALE ) 00022 * 00023 * .. Scalar Arguments .. 00024 * INTEGER LDA, N 00025 * REAL SCALE 00026 * .. 00027 * .. Array Arguments .. 00028 * INTEGER IPIV( * ), JPIV( * ) 00029 * COMPLEX A( LDA, * ), RHS( * ) 00030 * .. 00031 * 00032 * 00033 *> \par Purpose: 00034 * ============= 00035 *> 00036 *> \verbatim 00037 *> 00038 *> CGESC2 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 CGETC2. 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 array, dimension (LDA, N) 00059 *> On entry, the LU part of the factorization of the n-by-n 00060 *> matrix A computed by CGETC2: 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 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 REAL 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 complexGEauxiliary 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 CGESC2( 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 REAL SCALE 00126 * .. 00127 * .. Array Arguments .. 00128 INTEGER IPIV( * ), JPIV( * ) 00129 COMPLEX A( LDA, * ), RHS( * ) 00130 * .. 00131 * 00132 * ===================================================================== 00133 * 00134 * .. Parameters .. 00135 REAL ZERO, ONE, TWO 00136 PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0, TWO = 2.0E+0 ) 00137 * .. 00138 * .. Local Scalars .. 00139 INTEGER I, J 00140 REAL BIGNUM, EPS, SMLNUM 00141 COMPLEX TEMP 00142 * .. 00143 * .. External Subroutines .. 00144 EXTERNAL CLASWP, CSCAL, SLABAD 00145 * .. 00146 * .. External Functions .. 00147 INTEGER ICAMAX 00148 REAL SLAMCH 00149 EXTERNAL ICAMAX, SLAMCH 00150 * .. 00151 * .. Intrinsic Functions .. 00152 INTRINSIC ABS, CMPLX, REAL 00153 * .. 00154 * .. Executable Statements .. 00155 * 00156 * Set constant to control overflow 00157 * 00158 EPS = SLAMCH( 'P' ) 00159 SMLNUM = SLAMCH( 'S' ) / EPS 00160 BIGNUM = ONE / SMLNUM 00161 CALL SLABAD( SMLNUM, BIGNUM ) 00162 * 00163 * Apply permutations IPIV to RHS 00164 * 00165 CALL CLASWP( 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 = ICAMAX( N, RHS, 1 ) 00182 IF( TWO*SMLNUM*ABS( RHS( I ) ).GT.ABS( A( N, N ) ) ) THEN 00183 TEMP = CMPLX( ONE / TWO, ZERO ) / ABS( RHS( I ) ) 00184 CALL CSCAL( N, TEMP, RHS( 1 ), 1 ) 00185 SCALE = SCALE*REAL( TEMP ) 00186 END IF 00187 DO 40 I = N, 1, -1 00188 TEMP = CMPLX( 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 CLASWP( 1, RHS, LDA, 1, N-1, JPIV, -1 ) 00198 RETURN 00199 * 00200 * End of CGESC2 00201 * 00202 END