LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
sgesc2.f
Go to the documentation of this file.
1*> \brief \b SGESC2 solves a system of linear equations using the LU factorization with complete pivoting computed by sgetc2.
2*
3* =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6* http://www.netlib.org/lapack/explore-html/
7*
8*> \htmlonly
9*> Download SGESC2 + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgesc2.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgesc2.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgesc2.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18* Definition:
19* ===========
20*
21* SUBROUTINE SGESC2( N, A, LDA, RHS, IPIV, JPIV, SCALE )
22*
23* .. Scalar Arguments ..
24* INTEGER LDA, N
25* REAL SCALE
26* ..
27* .. Array Arguments ..
28* INTEGER IPIV( * ), JPIV( * )
29* REAL A( LDA, * ), RHS( * )
30* ..
31*
32*
33*> \par Purpose:
34* =============
35*>
36*> \verbatim
37*>
38*> SGESC2 solves a system of linear equations
39*>
40*> A * X = scale* RHS
41*>
42*> with a general N-by-N matrix A using the LU factorization with
43*> complete pivoting computed by SGETC2.
44*> \endverbatim
45*
46* Arguments:
47* ==========
48*
49*> \param[in] N
50*> \verbatim
51*> N is INTEGER
52*> The order of the matrix A.
53*> \endverbatim
54*>
55*> \param[in] A
56*> \verbatim
57*> A is REAL array, dimension (LDA,N)
58*> On entry, the LU part of the factorization of the n-by-n
59*> matrix A computed by SGETC2: A = P * L * U * Q
60*> \endverbatim
61*>
62*> \param[in] LDA
63*> \verbatim
64*> LDA is INTEGER
65*> The leading dimension of the array A. LDA >= max(1, N).
66*> \endverbatim
67*>
68*> \param[in,out] RHS
69*> \verbatim
70*> RHS is REAL array, dimension (N).
71*> On entry, the right hand side vector b.
72*> On exit, the solution vector X.
73*> \endverbatim
74*>
75*> \param[in] IPIV
76*> \verbatim
77*> IPIV is INTEGER array, dimension (N).
78*> The pivot indices; for 1 <= i <= N, row i of the
79*> matrix has been interchanged with row IPIV(i).
80*> \endverbatim
81*>
82*> \param[in] JPIV
83*> \verbatim
84*> JPIV is INTEGER array, dimension (N).
85*> The pivot indices; for 1 <= j <= N, column j of the
86*> matrix has been interchanged with column JPIV(j).
87*> \endverbatim
88*>
89*> \param[out] SCALE
90*> \verbatim
91*> SCALE is REAL
92*> On exit, SCALE contains the scale factor. SCALE is chosen
93*> 0 <= SCALE <= 1 to prevent overflow in the solution.
94*> \endverbatim
95*
96* Authors:
97* ========
98*
99*> \author Univ. of Tennessee
100*> \author Univ. of California Berkeley
101*> \author Univ. of Colorado Denver
102*> \author NAG Ltd.
103*
104*> \ingroup gesc2
105*
106*> \par Contributors:
107* ==================
108*>
109*> Bo Kagstrom and Peter Poromaa, Department of Computing Science,
110*> Umea University, S-901 87 Umea, Sweden.
111*
112* =====================================================================
113 SUBROUTINE sgesc2( N, A, LDA, RHS, IPIV, JPIV, SCALE )
114*
115* -- LAPACK auxiliary routine --
116* -- LAPACK is a software package provided by Univ. of Tennessee, --
117* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
118*
119* .. Scalar Arguments ..
120 INTEGER LDA, N
121 REAL SCALE
122* ..
123* .. Array Arguments ..
124 INTEGER IPIV( * ), JPIV( * )
125 REAL A( LDA, * ), RHS( * )
126* ..
127*
128* =====================================================================
129*
130* .. Parameters ..
131 REAL ONE, TWO
132 parameter( one = 1.0e+0, two = 2.0e+0 )
133* ..
134* .. Local Scalars ..
135 INTEGER I, J
136 REAL BIGNUM, EPS, SMLNUM, TEMP
137* ..
138* .. External Subroutines ..
139 EXTERNAL slaswp, sscal
140* ..
141* .. External Functions ..
142 INTEGER ISAMAX
143 REAL SLAMCH
144 EXTERNAL isamax, slamch
145* ..
146* .. Intrinsic Functions ..
147 INTRINSIC abs
148* ..
149* .. Executable Statements ..
150*
151* Set constant to control overflow
152*
153 eps = slamch( 'P' )
154 smlnum = slamch( 'S' ) / eps
155 bignum = one / smlnum
156*
157* Apply permutations IPIV to RHS
158*
159 CALL slaswp( 1, rhs, lda, 1, n-1, ipiv, 1 )
160*
161* Solve for L part
162*
163 DO 20 i = 1, n - 1
164 DO 10 j = i + 1, n
165 rhs( j ) = rhs( j ) - a( j, i )*rhs( i )
166 10 CONTINUE
167 20 CONTINUE
168*
169* Solve for U part
170*
171 scale = one
172*
173* Check for scaling
174*
175 i = isamax( n, rhs, 1 )
176 IF( two*smlnum*abs( rhs( i ) ).GT.abs( a( n, n ) ) ) THEN
177 temp = ( one / two ) / abs( rhs( i ) )
178 CALL sscal( n, temp, rhs( 1 ), 1 )
179 scale = scale*temp
180 END IF
181*
182 DO 40 i = n, 1, -1
183 temp = one / a( i, i )
184 rhs( i ) = rhs( i )*temp
185 DO 30 j = i + 1, n
186 rhs( i ) = rhs( i ) - rhs( j )*( a( i, j )*temp )
187 30 CONTINUE
188 40 CONTINUE
189*
190* Apply permutations JPIV to the solution (RHS)
191*
192 CALL slaswp( 1, rhs, lda, 1, n-1, jpiv, -1 )
193 RETURN
194*
195* End of SGESC2
196*
197 END
subroutine sgesc2(n, a, lda, rhs, ipiv, jpiv, scale)
SGESC2 solves a system of linear equations using the LU factorization with complete pivoting computed...
Definition sgesc2.f:114
subroutine slaswp(n, a, lda, k1, k2, ipiv, incx)
SLASWP performs a series of row interchanges on a general rectangular matrix.
Definition slaswp.f:115
subroutine sscal(n, sa, sx, incx)
SSCAL
Definition sscal.f:79