Mercurial > octave-nkf
comparison libcruft/lapack/sgetf2.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 SGETF2( M, N, A, LDA, IPIV, INFO ) | |
2 * | |
3 * -- LAPACK routine (version 3.1) -- | |
4 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. | |
5 * November 2006 | |
6 * | |
7 * .. Scalar Arguments .. | |
8 INTEGER INFO, LDA, M, N | |
9 * .. | |
10 * .. Array Arguments .. | |
11 INTEGER IPIV( * ) | |
12 REAL A( LDA, * ) | |
13 * .. | |
14 * | |
15 * Purpose | |
16 * ======= | |
17 * | |
18 * SGETF2 computes an LU factorization of a general m-by-n matrix A | |
19 * using partial pivoting with row interchanges. | |
20 * | |
21 * The factorization has the form | |
22 * A = P * L * U | |
23 * where P is a permutation matrix, L is lower triangular with unit | |
24 * diagonal elements (lower trapezoidal if m > n), and U is upper | |
25 * triangular (upper trapezoidal if m < n). | |
26 * | |
27 * This is the right-looking Level 2 BLAS version of the algorithm. | |
28 * | |
29 * Arguments | |
30 * ========= | |
31 * | |
32 * M (input) INTEGER | |
33 * The number of rows of the matrix A. M >= 0. | |
34 * | |
35 * N (input) INTEGER | |
36 * The number of columns of the matrix A. N >= 0. | |
37 * | |
38 * A (input/output) REAL array, dimension (LDA,N) | |
39 * On entry, the m by n matrix to be factored. | |
40 * On exit, the factors L and U from the factorization | |
41 * A = P*L*U; the unit diagonal elements of L are not stored. | |
42 * | |
43 * LDA (input) INTEGER | |
44 * The leading dimension of the array A. LDA >= max(1,M). | |
45 * | |
46 * IPIV (output) INTEGER array, dimension (min(M,N)) | |
47 * The pivot indices; for 1 <= i <= min(M,N), row i of the | |
48 * matrix was interchanged with row IPIV(i). | |
49 * | |
50 * INFO (output) INTEGER | |
51 * = 0: successful exit | |
52 * < 0: if INFO = -k, the k-th argument had an illegal value | |
53 * > 0: if INFO = k, U(k,k) is exactly zero. The factorization | |
54 * has been completed, but the factor U is exactly | |
55 * singular, and division by zero will occur if it is used | |
56 * to solve a system of equations. | |
57 * | |
58 * ===================================================================== | |
59 * | |
60 * .. Parameters .. | |
61 REAL ONE, ZERO | |
62 PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 ) | |
63 * .. | |
64 * .. Local Scalars .. | |
65 REAL SFMIN | |
66 INTEGER I, J, JP | |
67 * .. | |
68 * .. External Functions .. | |
69 REAL SLAMCH | |
70 INTEGER ISAMAX | |
71 EXTERNAL SLAMCH, ISAMAX | |
72 * .. | |
73 * .. External Subroutines .. | |
74 EXTERNAL SGER, SSCAL, SSWAP, XERBLA | |
75 * .. | |
76 * .. Intrinsic Functions .. | |
77 INTRINSIC MAX, MIN | |
78 * .. | |
79 * .. Executable Statements .. | |
80 * | |
81 * Test the input parameters. | |
82 * | |
83 INFO = 0 | |
84 IF( M.LT.0 ) THEN | |
85 INFO = -1 | |
86 ELSE IF( N.LT.0 ) THEN | |
87 INFO = -2 | |
88 ELSE IF( LDA.LT.MAX( 1, M ) ) THEN | |
89 INFO = -4 | |
90 END IF | |
91 IF( INFO.NE.0 ) THEN | |
92 CALL XERBLA( 'SGETF2', -INFO ) | |
93 RETURN | |
94 END IF | |
95 * | |
96 * Quick return if possible | |
97 * | |
98 IF( M.EQ.0 .OR. N.EQ.0 ) | |
99 $ RETURN | |
100 * | |
101 * Compute machine safe minimum | |
102 * | |
103 SFMIN = SLAMCH('S') | |
104 * | |
105 DO 10 J = 1, MIN( M, N ) | |
106 * | |
107 * Find pivot and test for singularity. | |
108 * | |
109 JP = J - 1 + ISAMAX( M-J+1, A( J, J ), 1 ) | |
110 IPIV( J ) = JP | |
111 IF( A( JP, J ).NE.ZERO ) THEN | |
112 * | |
113 * Apply the interchange to columns 1:N. | |
114 * | |
115 IF( JP.NE.J ) | |
116 $ CALL SSWAP( N, A( J, 1 ), LDA, A( JP, 1 ), LDA ) | |
117 * | |
118 * Compute elements J+1:M of J-th column. | |
119 * | |
120 IF( J.LT.M ) THEN | |
121 IF( ABS(A( J, J )) .GE. SFMIN ) THEN | |
122 CALL SSCAL( M-J, ONE / A( J, J ), A( J+1, J ), 1 ) | |
123 ELSE | |
124 DO 20 I = 1, M-J | |
125 A( J+I, J ) = A( J+I, J ) / A( J, J ) | |
126 20 CONTINUE | |
127 END IF | |
128 END IF | |
129 * | |
130 ELSE IF( INFO.EQ.0 ) THEN | |
131 * | |
132 INFO = J | |
133 END IF | |
134 * | |
135 IF( J.LT.MIN( M, N ) ) THEN | |
136 * | |
137 * Update trailing submatrix. | |
138 * | |
139 CALL SGER( M-J, N-J, -ONE, A( J+1, J ), 1, A( J, J+1 ), LDA, | |
140 $ A( J+1, J+1 ), LDA ) | |
141 END IF | |
142 10 CONTINUE | |
143 RETURN | |
144 * | |
145 * End of SGETF2 | |
146 * | |
147 END |