 |
LAPACK 3.3.1
Linear Algebra PACKage
|
|
LAPACK 3.3.1
Linear Algebra PACKage
|
00001 SUBROUTINE SGETRS( TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO ) 00002 * 00003 * -- LAPACK routine (version 3.3.1) -- 00004 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00005 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00006 * -- April 2011 -- 00007 * 00008 * .. Scalar Arguments .. 00009 CHARACTER TRANS 00010 INTEGER INFO, LDA, LDB, N, NRHS 00011 * .. 00012 * .. Array Arguments .. 00013 INTEGER IPIV( * ) 00014 REAL A( LDA, * ), B( LDB, * ) 00015 * .. 00016 * 00017 * Purpose 00018 * ======= 00019 * 00020 * SGETRS solves a system of linear equations 00021 * A * X = B or A**T * X = B 00022 * with a general N-by-N matrix A using the LU factorization computed 00023 * by SGETRF. 00024 * 00025 * Arguments 00026 * ========= 00027 * 00028 * TRANS (input) CHARACTER*1 00029 * Specifies the form of the system of equations: 00030 * = 'N': A * X = B (No transpose) 00031 * = 'T': A**T* X = B (Transpose) 00032 * = 'C': A**T* X = B (Conjugate transpose = Transpose) 00033 * 00034 * N (input) INTEGER 00035 * The order of the matrix A. N >= 0. 00036 * 00037 * NRHS (input) INTEGER 00038 * The number of right hand sides, i.e., the number of columns 00039 * of the matrix B. NRHS >= 0. 00040 * 00041 * A (input) REAL array, dimension (LDA,N) 00042 * The factors L and U from the factorization A = P*L*U 00043 * as computed by SGETRF. 00044 * 00045 * LDA (input) INTEGER 00046 * The leading dimension of the array A. LDA >= max(1,N). 00047 * 00048 * IPIV (input) INTEGER array, dimension (N) 00049 * The pivot indices from SGETRF; for 1<=i<=N, row i of the 00050 * matrix was interchanged with row IPIV(i). 00051 * 00052 * B (input/output) REAL array, dimension (LDB,NRHS) 00053 * On entry, the right hand side matrix B. 00054 * On exit, the solution matrix X. 00055 * 00056 * LDB (input) INTEGER 00057 * The leading dimension of the array B. LDB >= max(1,N). 00058 * 00059 * INFO (output) INTEGER 00060 * = 0: successful exit 00061 * < 0: if INFO = -i, the i-th argument had an illegal value 00062 * 00063 * ===================================================================== 00064 * 00065 * .. Parameters .. 00066 REAL ONE 00067 PARAMETER ( ONE = 1.0E+0 ) 00068 * .. 00069 * .. Local Scalars .. 00070 LOGICAL NOTRAN 00071 * .. 00072 * .. External Functions .. 00073 LOGICAL LSAME 00074 EXTERNAL LSAME 00075 * .. 00076 * .. External Subroutines .. 00077 EXTERNAL SLASWP, STRSM, XERBLA 00078 * .. 00079 * .. Intrinsic Functions .. 00080 INTRINSIC MAX 00081 * .. 00082 * .. Executable Statements .. 00083 * 00084 * Test the input parameters. 00085 * 00086 INFO = 0 00087 NOTRAN = LSAME( TRANS, 'N' ) 00088 IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT. 00089 $ LSAME( TRANS, 'C' ) ) THEN 00090 INFO = -1 00091 ELSE IF( N.LT.0 ) THEN 00092 INFO = -2 00093 ELSE IF( NRHS.LT.0 ) THEN 00094 INFO = -3 00095 ELSE IF( LDA.LT.MAX( 1, N ) ) THEN 00096 INFO = -5 00097 ELSE IF( LDB.LT.MAX( 1, N ) ) THEN 00098 INFO = -8 00099 END IF 00100 IF( INFO.NE.0 ) THEN 00101 CALL XERBLA( 'SGETRS', -INFO ) 00102 RETURN 00103 END IF 00104 * 00105 * Quick return if possible 00106 * 00107 IF( N.EQ.0 .OR. NRHS.EQ.0 ) 00108 $ RETURN 00109 * 00110 IF( NOTRAN ) THEN 00111 * 00112 * Solve A * X = B. 00113 * 00114 * Apply row interchanges to the right hand sides. 00115 * 00116 CALL SLASWP( NRHS, B, LDB, 1, N, IPIV, 1 ) 00117 * 00118 * Solve L*X = B, overwriting B with X. 00119 * 00120 CALL STRSM( 'Left', 'Lower', 'No transpose', 'Unit', N, NRHS, 00121 $ ONE, A, LDA, B, LDB ) 00122 * 00123 * Solve U*X = B, overwriting B with X. 00124 * 00125 CALL STRSM( 'Left', 'Upper', 'No transpose', 'Non-unit', N, 00126 $ NRHS, ONE, A, LDA, B, LDB ) 00127 ELSE 00128 * 00129 * Solve A**T * X = B. 00130 * 00131 * Solve U**T *X = B, overwriting B with X. 00132 * 00133 CALL STRSM( 'Left', 'Upper', 'Transpose', 'Non-unit', N, NRHS, 00134 $ ONE, A, LDA, B, LDB ) 00135 * 00136 * Solve L**T *X = B, overwriting B with X. 00137 * 00138 CALL STRSM( 'Left', 'Lower', 'Transpose', 'Unit', N, NRHS, ONE, 00139 $ A, LDA, B, LDB ) 00140 * 00141 * Apply row interchanges to the solution vectors. 00142 * 00143 CALL SLASWP( NRHS, B, LDB, 1, N, IPIV, -1 ) 00144 END IF 00145 * 00146 RETURN 00147 * 00148 * End of SGETRS 00149 * 00150 END
1.7.3 
