163 lines
4.9 KiB
Fortran
163 lines
4.9 KiB
Fortran
SUBROUTINE MB02UU( N, A, LDA, RHS, IPIV, JPIV, SCALE )
|
|
C
|
|
C SLICOT RELEASE 5.0.
|
|
C
|
|
C Copyright (c) 2002-2009 NICONET e.V.
|
|
C
|
|
C This program is free software: you can redistribute it and/or
|
|
C modify it under the terms of the GNU General Public License as
|
|
C published by the Free Software Foundation, either version 2 of
|
|
C the License, or (at your option) any later version.
|
|
C
|
|
C This program is distributed in the hope that it will be useful,
|
|
C but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
C MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
C GNU General Public License for more details.
|
|
C
|
|
C You should have received a copy of the GNU General Public License
|
|
C along with this program. If not, see
|
|
C <http://www.gnu.org/licenses/>.
|
|
C
|
|
C PURPOSE
|
|
C
|
|
C To solve for x in A * x = scale * RHS, using the LU factorization
|
|
C of the N-by-N matrix A computed by SLICOT Library routine MB02UV.
|
|
C The factorization has the form A = P * L * U * Q, where P and Q
|
|
C are permutation matrices, L is unit lower triangular and U is
|
|
C upper triangular.
|
|
C
|
|
C ARGUMENTS
|
|
C
|
|
C Input/Output Parameters
|
|
C
|
|
C N (input) INTEGER
|
|
C The order of the matrix A.
|
|
C
|
|
C A (input) DOUBLE PRECISION array, dimension (LDA, N)
|
|
C The leading N-by-N part of this array must contain
|
|
C the LU part of the factorization of the matrix A computed
|
|
C by SLICOT Library routine MB02UV: A = P * L * U * Q.
|
|
C
|
|
C LDA INTEGER
|
|
C The leading dimension of the array A. LDA >= max(1, N).
|
|
C
|
|
C RHS (input/output) DOUBLE PRECISION array, dimension (N)
|
|
C On entry, this array must contain the right hand side
|
|
C of the system.
|
|
C On exit, this array contains the solution of the system.
|
|
C
|
|
C IPIV (input) INTEGER array, dimension (N)
|
|
C The pivot indices; for 1 <= i <= N, row i of the
|
|
C matrix has been interchanged with row IPIV(i).
|
|
C
|
|
C JPIV (input) INTEGER array, dimension (N)
|
|
C The pivot indices; for 1 <= j <= N, column j of the
|
|
C matrix has been interchanged with column JPIV(j).
|
|
C
|
|
C SCALE (output) DOUBLE PRECISION
|
|
C The scale factor, chosen 0 < SCALE <= 1 to prevent
|
|
C overflow in the solution.
|
|
C
|
|
C FURTHER COMMENTS
|
|
C
|
|
C In the interest of speed, this routine does not check the input
|
|
C for errors. It should only be used if the order of the matrix A
|
|
C is very small.
|
|
C
|
|
C CONTRIBUTOR
|
|
C
|
|
C Bo Kagstrom and P. Poromaa, Univ. of Umea, Sweden, Nov. 1993.
|
|
C
|
|
C REVISIONS
|
|
C
|
|
C April 1998 (T. Penzl).
|
|
C Sep. 1998 (V. Sima).
|
|
C
|
|
C ******************************************************************
|
|
C
|
|
C .. Parameters ..
|
|
DOUBLE PRECISION ONE, TWO
|
|
PARAMETER ( ONE = 1.0D+0, TWO = 2.0D+0 )
|
|
C .. Scalar Arguments ..
|
|
INTEGER LDA, N
|
|
DOUBLE PRECISION SCALE
|
|
C .. Array Arguments ..
|
|
INTEGER IPIV( * ), JPIV( * )
|
|
DOUBLE PRECISION A( LDA, * ), RHS( * )
|
|
C .. Local Scalars ..
|
|
INTEGER I, IP, J
|
|
DOUBLE PRECISION BIGNUM, EPS, FACTOR, SMLNUM, TEMP
|
|
C .. External Functions ..
|
|
INTEGER IDAMAX
|
|
DOUBLE PRECISION DLAMCH
|
|
EXTERNAL DLAMCH, IDAMAX
|
|
C .. External Subroutines ..
|
|
EXTERNAL DAXPY, DLABAD, DSCAL
|
|
C .. Intrinsic Functions ..
|
|
INTRINSIC ABS, DBLE, MAX
|
|
C .. Executable Statements ..
|
|
C
|
|
C Set constants to control owerflow.
|
|
C
|
|
EPS = DLAMCH( 'Precision' )
|
|
SMLNUM = DLAMCH( 'Safe minimum' ) / EPS
|
|
BIGNUM = ONE / SMLNUM
|
|
CALL DLABAD( SMLNUM, BIGNUM )
|
|
C
|
|
C Apply permutations IPIV to RHS.
|
|
C
|
|
DO 20 I = 1, N - 1
|
|
IP = IPIV(I)
|
|
IF ( IP.NE.I ) THEN
|
|
TEMP = RHS(I)
|
|
RHS(I) = RHS(IP)
|
|
RHS(IP) = TEMP
|
|
ENDIF
|
|
20 CONTINUE
|
|
C
|
|
C Solve for L part.
|
|
C
|
|
DO 40 I = 1, N - 1
|
|
CALL DAXPY( N-I, -RHS(I), A(I+1, I), 1, RHS(I+1), 1 )
|
|
40 CONTINUE
|
|
C
|
|
C Solve for U part.
|
|
C
|
|
C Check for scaling.
|
|
C
|
|
FACTOR = TWO * DBLE( N )
|
|
I = 1
|
|
60 CONTINUE
|
|
IF ( ( FACTOR * SMLNUM ) * ABS( RHS(I) ) .LE. ABS( A(I, I) ) )
|
|
$ THEN
|
|
I = I + 1
|
|
IF ( I .LE. N ) GO TO 60
|
|
SCALE = ONE
|
|
ELSE
|
|
SCALE = ( ONE / FACTOR ) / ABS( RHS( IDAMAX( N, RHS, 1 ) ) )
|
|
CALL DSCAL( N, SCALE, RHS, 1 )
|
|
END IF
|
|
C
|
|
DO 100 I = N, 1, -1
|
|
TEMP = ONE / A(I, I)
|
|
RHS(I) = RHS(I) * TEMP
|
|
DO 80 J = I + 1, N
|
|
RHS(I) = RHS(I) - RHS(J) * ( A(I, J) * TEMP )
|
|
80 CONTINUE
|
|
100 CONTINUE
|
|
C
|
|
C Apply permutations JPIV to the solution (RHS).
|
|
C
|
|
DO 120 I = N - 1, 1, -1
|
|
IP = JPIV(I)
|
|
IF ( IP.NE.I ) THEN
|
|
TEMP = RHS(I)
|
|
RHS(I) = RHS(IP)
|
|
RHS(IP) = TEMP
|
|
ENDIF
|
|
120 CONTINUE
|
|
C
|
|
RETURN
|
|
C *** Last line of MB02UU ***
|
|
END
|