Mercurial > octave-nkf
comparison libcruft/lapack/sgttrs.f @ 7789:82be108cc558
First attempt at single precision tyeps
* * *
corrections to qrupdate single precision routines
* * *
prefer demotion to single over promotion to double
* * *
Add single precision support to log2 function
* * *
Trivial PROJECT file update
* * *
Cache optimized hermitian/transpose methods
* * *
Add tests for tranpose/hermitian and ChangeLog entry for new transpose code
author | David Bateman <dbateman@free.fr> |
---|---|
date | Sun, 27 Apr 2008 22:34:17 +0200 |
parents | |
children |
comparison
equal
deleted
inserted
replaced
7788:45f5faba05a2 | 7789:82be108cc558 |
---|---|
1 SUBROUTINE SGTTRS( TRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, LDB, | |
2 $ INFO ) | |
3 * | |
4 * -- LAPACK routine (version 3.1) -- | |
5 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. | |
6 * November 2006 | |
7 * | |
8 * .. Scalar Arguments .. | |
9 CHARACTER TRANS | |
10 INTEGER INFO, LDB, N, NRHS | |
11 * .. | |
12 * .. Array Arguments .. | |
13 INTEGER IPIV( * ) | |
14 REAL B( LDB, * ), D( * ), DL( * ), DU( * ), DU2( * ) | |
15 * .. | |
16 * | |
17 * Purpose | |
18 * ======= | |
19 * | |
20 * SGTTRS solves one of the systems of equations | |
21 * A*X = B or A'*X = B, | |
22 * with a tridiagonal matrix A using the LU factorization computed | |
23 * by SGTTRF. | |
24 * | |
25 * Arguments | |
26 * ========= | |
27 * | |
28 * TRANS (input) CHARACTER*1 | |
29 * Specifies the form of the system of equations. | |
30 * = 'N': A * X = B (No transpose) | |
31 * = 'T': A'* X = B (Transpose) | |
32 * = 'C': A'* X = B (Conjugate transpose = Transpose) | |
33 * | |
34 * N (input) INTEGER | |
35 * The order of the matrix A. | |
36 * | |
37 * NRHS (input) INTEGER | |
38 * The number of right hand sides, i.e., the number of columns | |
39 * of the matrix B. NRHS >= 0. | |
40 * | |
41 * DL (input) REAL array, dimension (N-1) | |
42 * The (n-1) multipliers that define the matrix L from the | |
43 * LU factorization of A. | |
44 * | |
45 * D (input) REAL array, dimension (N) | |
46 * The n diagonal elements of the upper triangular matrix U from | |
47 * the LU factorization of A. | |
48 * | |
49 * DU (input) REAL array, dimension (N-1) | |
50 * The (n-1) elements of the first super-diagonal of U. | |
51 * | |
52 * DU2 (input) REAL array, dimension (N-2) | |
53 * The (n-2) elements of the second super-diagonal of U. | |
54 * | |
55 * IPIV (input) INTEGER array, dimension (N) | |
56 * The pivot indices; for 1 <= i <= n, row i of the matrix was | |
57 * interchanged with row IPIV(i). IPIV(i) will always be either | |
58 * i or i+1; IPIV(i) = i indicates a row interchange was not | |
59 * required. | |
60 * | |
61 * B (input/output) REAL array, dimension (LDB,NRHS) | |
62 * On entry, the matrix of right hand side vectors B. | |
63 * On exit, B is overwritten by the solution vectors X. | |
64 * | |
65 * LDB (input) INTEGER | |
66 * The leading dimension of the array B. LDB >= max(1,N). | |
67 * | |
68 * INFO (output) INTEGER | |
69 * = 0: successful exit | |
70 * < 0: if INFO = -i, the i-th argument had an illegal value | |
71 * | |
72 * ===================================================================== | |
73 * | |
74 * .. Local Scalars .. | |
75 LOGICAL NOTRAN | |
76 INTEGER ITRANS, J, JB, NB | |
77 * .. | |
78 * .. External Functions .. | |
79 INTEGER ILAENV | |
80 EXTERNAL ILAENV | |
81 * .. | |
82 * .. External Subroutines .. | |
83 EXTERNAL SGTTS2, XERBLA | |
84 * .. | |
85 * .. Intrinsic Functions .. | |
86 INTRINSIC MAX, MIN | |
87 * .. | |
88 * .. Executable Statements .. | |
89 * | |
90 INFO = 0 | |
91 NOTRAN = ( TRANS.EQ.'N' .OR. TRANS.EQ.'n' ) | |
92 IF( .NOT.NOTRAN .AND. .NOT.( TRANS.EQ.'T' .OR. TRANS.EQ. | |
93 $ 't' ) .AND. .NOT.( TRANS.EQ.'C' .OR. TRANS.EQ.'c' ) ) THEN | |
94 INFO = -1 | |
95 ELSE IF( N.LT.0 ) THEN | |
96 INFO = -2 | |
97 ELSE IF( NRHS.LT.0 ) THEN | |
98 INFO = -3 | |
99 ELSE IF( LDB.LT.MAX( N, 1 ) ) THEN | |
100 INFO = -10 | |
101 END IF | |
102 IF( INFO.NE.0 ) THEN | |
103 CALL XERBLA( 'SGTTRS', -INFO ) | |
104 RETURN | |
105 END IF | |
106 * | |
107 * Quick return if possible | |
108 * | |
109 IF( N.EQ.0 .OR. NRHS.EQ.0 ) | |
110 $ RETURN | |
111 * | |
112 * Decode TRANS | |
113 * | |
114 IF( NOTRAN ) THEN | |
115 ITRANS = 0 | |
116 ELSE | |
117 ITRANS = 1 | |
118 END IF | |
119 * | |
120 * Determine the number of right-hand sides to solve at a time. | |
121 * | |
122 IF( NRHS.EQ.1 ) THEN | |
123 NB = 1 | |
124 ELSE | |
125 NB = MAX( 1, ILAENV( 1, 'SGTTRS', TRANS, N, NRHS, -1, -1 ) ) | |
126 END IF | |
127 * | |
128 IF( NB.GE.NRHS ) THEN | |
129 CALL SGTTS2( ITRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, LDB ) | |
130 ELSE | |
131 DO 10 J = 1, NRHS, NB | |
132 JB = MIN( NRHS-J+1, NB ) | |
133 CALL SGTTS2( ITRANS, N, JB, DL, D, DU, DU2, IPIV, B( 1, J ), | |
134 $ LDB ) | |
135 10 CONTINUE | |
136 END IF | |
137 * | |
138 * End of SGTTRS | |
139 * | |
140 END |