![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b SPFTRS 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 *> \htmlonly 00009 *> Download SPFTRS + dependencies 00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/spftrs.f"> 00011 *> [TGZ]</a> 00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/spftrs.f"> 00013 *> [ZIP]</a> 00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/spftrs.f"> 00015 *> [TXT]</a> 00016 *> \endhtmlonly 00017 * 00018 * Definition: 00019 * =========== 00020 * 00021 * SUBROUTINE SPFTRS( TRANSR, UPLO, N, NRHS, A, B, LDB, INFO ) 00022 * 00023 * .. Scalar Arguments .. 00024 * CHARACTER TRANSR, UPLO 00025 * INTEGER INFO, LDB, N, NRHS 00026 * .. 00027 * .. Array Arguments .. 00028 * REAL A( 0: * ), B( LDB, * ) 00029 * .. 00030 * 00031 * 00032 *> \par Purpose: 00033 * ============= 00034 *> 00035 *> \verbatim 00036 *> 00037 *> SPFTRS solves a system of linear equations A*X = B with a symmetric 00038 *> positive definite matrix A using the Cholesky factorization 00039 *> A = U**T*U or A = L*L**T computed by SPFTRF. 00040 *> \endverbatim 00041 * 00042 * Arguments: 00043 * ========== 00044 * 00045 *> \param[in] TRANSR 00046 *> \verbatim 00047 *> TRANSR is CHARACTER*1 00048 *> = 'N': The Normal TRANSR of RFP A is stored; 00049 *> = 'T': The Transpose TRANSR of RFP A is stored. 00050 *> \endverbatim 00051 *> 00052 *> \param[in] UPLO 00053 *> \verbatim 00054 *> UPLO is CHARACTER*1 00055 *> = 'U': Upper triangle of RFP A is stored; 00056 *> = 'L': Lower triangle of RFP A is stored. 00057 *> \endverbatim 00058 *> 00059 *> \param[in] N 00060 *> \verbatim 00061 *> N is INTEGER 00062 *> The order of the matrix A. N >= 0. 00063 *> \endverbatim 00064 *> 00065 *> \param[in] NRHS 00066 *> \verbatim 00067 *> NRHS is INTEGER 00068 *> The number of right hand sides, i.e., the number of columns 00069 *> of the matrix B. NRHS >= 0. 00070 *> \endverbatim 00071 *> 00072 *> \param[in] A 00073 *> \verbatim 00074 *> A is REAL array, dimension ( N*(N+1)/2 ) 00075 *> The triangular factor U or L from the Cholesky factorization 00076 *> of RFP A = U**H*U or RFP A = L*L**T, as computed by SPFTRF. 00077 *> See note below for more details about RFP A. 00078 *> \endverbatim 00079 *> 00080 *> \param[in,out] B 00081 *> \verbatim 00082 *> B is REAL array, dimension (LDB,NRHS) 00083 *> On entry, the right hand side matrix B. 00084 *> On exit, the solution matrix X. 00085 *> \endverbatim 00086 *> 00087 *> \param[in] LDB 00088 *> \verbatim 00089 *> LDB is INTEGER 00090 *> The leading dimension of the array B. LDB >= max(1,N). 00091 *> \endverbatim 00092 *> 00093 *> \param[out] INFO 00094 *> \verbatim 00095 *> INFO is INTEGER 00096 *> = 0: successful exit 00097 *> < 0: if INFO = -i, the i-th argument had an illegal value 00098 *> \endverbatim 00099 * 00100 * Authors: 00101 * ======== 00102 * 00103 *> \author Univ. of Tennessee 00104 *> \author Univ. of California Berkeley 00105 *> \author Univ. of Colorado Denver 00106 *> \author NAG Ltd. 00107 * 00108 *> \date November 2011 00109 * 00110 *> \ingroup realOTHERcomputational 00111 * 00112 *> \par Further Details: 00113 * ===================== 00114 *> 00115 *> \verbatim 00116 *> 00117 *> We first consider Rectangular Full Packed (RFP) Format when N is 00118 *> even. We give an example where N = 6. 00119 *> 00120 *> AP is Upper AP is Lower 00121 *> 00122 *> 00 01 02 03 04 05 00 00123 *> 11 12 13 14 15 10 11 00124 *> 22 23 24 25 20 21 22 00125 *> 33 34 35 30 31 32 33 00126 *> 44 45 40 41 42 43 44 00127 *> 55 50 51 52 53 54 55 00128 *> 00129 *> 00130 *> Let TRANSR = 'N'. RFP holds AP as follows: 00131 *> For UPLO = 'U' the upper trapezoid A(0:5,0:2) consists of the last 00132 *> three columns of AP upper. The lower triangle A(4:6,0:2) consists of 00133 *> the transpose of the first three columns of AP upper. 00134 *> For UPLO = 'L' the lower trapezoid A(1:6,0:2) consists of the first 00135 *> three columns of AP lower. The upper triangle A(0:2,0:2) consists of 00136 *> the transpose of the last three columns of AP lower. 00137 *> This covers the case N even and TRANSR = 'N'. 00138 *> 00139 *> RFP A RFP A 00140 *> 00141 *> 03 04 05 33 43 53 00142 *> 13 14 15 00 44 54 00143 *> 23 24 25 10 11 55 00144 *> 33 34 35 20 21 22 00145 *> 00 44 45 30 31 32 00146 *> 01 11 55 40 41 42 00147 *> 02 12 22 50 51 52 00148 *> 00149 *> Now let TRANSR = 'T'. RFP A in both UPLO cases is just the 00150 *> transpose of RFP A above. One therefore gets: 00151 *> 00152 *> 00153 *> RFP A RFP A 00154 *> 00155 *> 03 13 23 33 00 01 02 33 00 10 20 30 40 50 00156 *> 04 14 24 34 44 11 12 43 44 11 21 31 41 51 00157 *> 05 15 25 35 45 55 22 53 54 55 22 32 42 52 00158 *> 00159 *> 00160 *> We then consider Rectangular Full Packed (RFP) Format when N is 00161 *> odd. We give an example where N = 5. 00162 *> 00163 *> AP is Upper AP is Lower 00164 *> 00165 *> 00 01 02 03 04 00 00166 *> 11 12 13 14 10 11 00167 *> 22 23 24 20 21 22 00168 *> 33 34 30 31 32 33 00169 *> 44 40 41 42 43 44 00170 *> 00171 *> 00172 *> Let TRANSR = 'N'. RFP holds AP as follows: 00173 *> For UPLO = 'U' the upper trapezoid A(0:4,0:2) consists of the last 00174 *> three columns of AP upper. The lower triangle A(3:4,0:1) consists of 00175 *> the transpose of the first two columns of AP upper. 00176 *> For UPLO = 'L' the lower trapezoid A(0:4,0:2) consists of the first 00177 *> three columns of AP lower. The upper triangle A(0:1,1:2) consists of 00178 *> the transpose of the last two columns of AP lower. 00179 *> This covers the case N odd and TRANSR = 'N'. 00180 *> 00181 *> RFP A RFP A 00182 *> 00183 *> 02 03 04 00 33 43 00184 *> 12 13 14 10 11 44 00185 *> 22 23 24 20 21 22 00186 *> 00 33 34 30 31 32 00187 *> 01 11 44 40 41 42 00188 *> 00189 *> Now let TRANSR = 'T'. RFP A in both UPLO cases is just the 00190 *> transpose of RFP A above. One therefore gets: 00191 *> 00192 *> RFP A RFP A 00193 *> 00194 *> 02 12 22 00 01 00 10 20 30 40 50 00195 *> 03 13 23 33 11 33 11 21 31 41 51 00196 *> 04 14 24 34 44 43 44 22 32 42 52 00197 *> \endverbatim 00198 *> 00199 * ===================================================================== 00200 SUBROUTINE SPFTRS( TRANSR, UPLO, N, NRHS, A, B, LDB, INFO ) 00201 * 00202 * -- LAPACK computational routine (version 3.4.0) -- 00203 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00204 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00205 * November 2011 00206 * 00207 * .. Scalar Arguments .. 00208 CHARACTER TRANSR, UPLO 00209 INTEGER INFO, LDB, N, NRHS 00210 * .. 00211 * .. Array Arguments .. 00212 REAL A( 0: * ), B( LDB, * ) 00213 * .. 00214 * 00215 * ===================================================================== 00216 * 00217 * .. Parameters .. 00218 REAL ONE 00219 PARAMETER ( ONE = 1.0E+0 ) 00220 * .. 00221 * .. Local Scalars .. 00222 LOGICAL LOWER, NORMALTRANSR 00223 * .. 00224 * .. External Functions .. 00225 LOGICAL LSAME 00226 EXTERNAL LSAME 00227 * .. 00228 * .. External Subroutines .. 00229 EXTERNAL XERBLA, STFSM 00230 * .. 00231 * .. Intrinsic Functions .. 00232 INTRINSIC MAX 00233 * .. 00234 * .. Executable Statements .. 00235 * 00236 * Test the input parameters. 00237 * 00238 INFO = 0 00239 NORMALTRANSR = LSAME( TRANSR, 'N' ) 00240 LOWER = LSAME( UPLO, 'L' ) 00241 IF( .NOT.NORMALTRANSR .AND. .NOT.LSAME( TRANSR, 'T' ) ) THEN 00242 INFO = -1 00243 ELSE IF( .NOT.LOWER .AND. .NOT.LSAME( UPLO, 'U' ) ) THEN 00244 INFO = -2 00245 ELSE IF( N.LT.0 ) THEN 00246 INFO = -3 00247 ELSE IF( NRHS.LT.0 ) THEN 00248 INFO = -4 00249 ELSE IF( LDB.LT.MAX( 1, N ) ) THEN 00250 INFO = -7 00251 END IF 00252 IF( INFO.NE.0 ) THEN 00253 CALL XERBLA( 'SPFTRS', -INFO ) 00254 RETURN 00255 END IF 00256 * 00257 * Quick return if possible 00258 * 00259 IF( N.EQ.0 .OR. NRHS.EQ.0 ) 00260 $ RETURN 00261 * 00262 * start execution: there are two triangular solves 00263 * 00264 IF( LOWER ) THEN 00265 CALL STFSM( TRANSR, 'L', UPLO, 'N', 'N', N, NRHS, ONE, A, B, 00266 $ LDB ) 00267 CALL STFSM( TRANSR, 'L', UPLO, 'T', 'N', N, NRHS, ONE, A, B, 00268 $ LDB ) 00269 ELSE 00270 CALL STFSM( TRANSR, 'L', UPLO, 'T', 'N', N, NRHS, ONE, A, B, 00271 $ LDB ) 00272 CALL STFSM( TRANSR, 'L', UPLO, 'N', 'N', N, NRHS, ONE, A, B, 00273 $ LDB ) 00274 END IF 00275 * 00276 RETURN 00277 * 00278 * End of SPFTRS 00279 * 00280 END