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