00001 /* sptts2.f -- translated by f2c (version 20061008). 00002 You must link the resulting object file with libf2c: 00003 on Microsoft Windows system, link with libf2c.lib; 00004 on Linux or Unix systems, link with .../path/to/libf2c.a -lm 00005 or, if you install libf2c.a in a standard place, with -lf2c -lm 00006 -- in that order, at the end of the command line, as in 00007 cc *.o -lf2c -lm 00008 Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., 00009 00010 http://www.netlib.org/f2c/libf2c.zip 00011 */ 00012 00013 #include "f2c.h" 00014 #include "blaswrap.h" 00015 00016 /* Subroutine */ int sptts2_(integer *n, integer *nrhs, real *d__, real *e, 00017 real *b, integer *ldb) 00018 { 00019 /* System generated locals */ 00020 integer b_dim1, b_offset, i__1, i__2; 00021 real r__1; 00022 00023 /* Local variables */ 00024 integer i__, j; 00025 extern /* Subroutine */ int sscal_(integer *, real *, real *, integer *); 00026 00027 00028 /* -- LAPACK routine (version 3.2) -- */ 00029 /* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */ 00030 /* November 2006 */ 00031 00032 /* .. Scalar Arguments .. */ 00033 /* .. */ 00034 /* .. Array Arguments .. */ 00035 /* .. */ 00036 00037 /* Purpose */ 00038 /* ======= */ 00039 00040 /* SPTTS2 solves a tridiagonal system of the form */ 00041 /* A * X = B */ 00042 /* using the L*D*L' factorization of A computed by SPTTRF. D is a */ 00043 /* diagonal matrix specified in the vector D, L is a unit bidiagonal */ 00044 /* matrix whose subdiagonal is specified in the vector E, and X and B */ 00045 /* are N by NRHS matrices. */ 00046 00047 /* Arguments */ 00048 /* ========= */ 00049 00050 /* N (input) INTEGER */ 00051 /* The order of the tridiagonal matrix A. N >= 0. */ 00052 00053 /* NRHS (input) INTEGER */ 00054 /* The number of right hand sides, i.e., the number of columns */ 00055 /* of the matrix B. NRHS >= 0. */ 00056 00057 /* D (input) REAL array, dimension (N) */ 00058 /* The n diagonal elements of the diagonal matrix D from the */ 00059 /* L*D*L' factorization of A. */ 00060 00061 /* E (input) REAL array, dimension (N-1) */ 00062 /* The (n-1) subdiagonal elements of the unit bidiagonal factor */ 00063 /* L from the L*D*L' factorization of A. E can also be regarded */ 00064 /* as the superdiagonal of the unit bidiagonal factor U from the */ 00065 /* factorization A = U'*D*U. */ 00066 00067 /* B (input/output) REAL array, dimension (LDB,NRHS) */ 00068 /* On entry, the right hand side vectors B for the system of */ 00069 /* linear equations. */ 00070 /* On exit, the solution vectors, X. */ 00071 00072 /* LDB (input) INTEGER */ 00073 /* The leading dimension of the array B. LDB >= max(1,N). */ 00074 00075 /* ===================================================================== */ 00076 00077 /* .. Local Scalars .. */ 00078 /* .. */ 00079 /* .. External Subroutines .. */ 00080 /* .. */ 00081 /* .. Executable Statements .. */ 00082 00083 /* Quick return if possible */ 00084 00085 /* Parameter adjustments */ 00086 --d__; 00087 --e; 00088 b_dim1 = *ldb; 00089 b_offset = 1 + b_dim1; 00090 b -= b_offset; 00091 00092 /* Function Body */ 00093 if (*n <= 1) { 00094 if (*n == 1) { 00095 r__1 = 1.f / d__[1]; 00096 sscal_(nrhs, &r__1, &b[b_offset], ldb); 00097 } 00098 return 0; 00099 } 00100 00101 /* Solve A * X = B using the factorization A = L*D*L', */ 00102 /* overwriting each right hand side vector with its solution. */ 00103 00104 i__1 = *nrhs; 00105 for (j = 1; j <= i__1; ++j) { 00106 00107 /* Solve L * x = b. */ 00108 00109 i__2 = *n; 00110 for (i__ = 2; i__ <= i__2; ++i__) { 00111 b[i__ + j * b_dim1] -= b[i__ - 1 + j * b_dim1] * e[i__ - 1]; 00112 /* L10: */ 00113 } 00114 00115 /* Solve D * L' * x = b. */ 00116 00117 b[*n + j * b_dim1] /= d__[*n]; 00118 for (i__ = *n - 1; i__ >= 1; --i__) { 00119 b[i__ + j * b_dim1] = b[i__ + j * b_dim1] / d__[i__] - b[i__ + 1 00120 + j * b_dim1] * e[i__]; 00121 /* L20: */ 00122 } 00123 /* L30: */ 00124 } 00125 00126 return 0; 00127 00128 /* End of SPTTS2 */ 00129 00130 } /* sptts2_ */