Mercurial > octave-nkf

comparison libcruft/lapack/dlaswp.f @ 3333:15cddaacbc2d

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[project @ 1999-11-03 19:53:59 by jwe]
author jwe
date Wed, 03 Nov 1999 19:54:52 +0000
parents 30c606bec7a8
children 68db500cb558
comparison
equal deleted inserted replaced
3332:7c03933635c6 3333:15cddaacbc2d
1 SUBROUTINE DLASWP( N, A, LDA, K1, K2, IPIV, INCX ) 1 SUBROUTINE DLASWP( N, A, LDA, K1, K2, IPIV, INCX )
2 * 2 *
3 * -- LAPACK auxiliary routine (version 2.0) -- 3 * -- LAPACK auxiliary routine (version 3.0) --
4 * Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., 4 * Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
5 * Courant Institute, Argonne National Lab, and Rice University 5 * Courant Institute, Argonne National Lab, and Rice University
6 * October 31, 1992 6 * June 30, 1999
7 * 7 *
8 * .. Scalar Arguments .. 8 * .. Scalar Arguments ..
9 INTEGER INCX, K1, K2, LDA, N 9 INTEGER INCX, K1, K2, LDA, N
10 * .. 10 * ..
11 * .. Array Arguments .. 11 * .. Array Arguments ..
48 * 48 *
49 * INCX (input) INTEGER 49 * INCX (input) INTEGER
50 * The increment between successive values of IPIV. If IPIV 50 * The increment between successive values of IPIV. If IPIV
51 * is negative, the pivots are applied in reverse order. 51 * is negative, the pivots are applied in reverse order.
52 * 52 *
53 * Further Details
54 * ===============
55 *
56 * Modified by
57 * R. C. Whaley, Computer Science Dept., Univ. of Tenn., Knoxville, USA
58 *
53 * ===================================================================== 59 * =====================================================================
54 * 60 *
55 * .. Local Scalars .. 61 * .. Local Scalars ..
56 INTEGER I, IP, IX 62 INTEGER I, I1, I2, INC, IP, IX, IX0, J, K, N32
57 * .. 63 DOUBLE PRECISION TEMP
58 * .. External Subroutines ..
59 EXTERNAL DSWAP
60 * .. 64 * ..
61 * .. Executable Statements .. 65 * .. Executable Statements ..
62 * 66 *
63 * Interchange row I with row IPIV(I) for each of rows K1 through K2. 67 * Interchange row I with row IPIV(I) for each of rows K1 through K2.
64 * 68 *
65 IF( INCX.EQ.0 )
66 $ RETURN
67 IF( INCX.GT.0 ) THEN 69 IF( INCX.GT.0 ) THEN
68 IX = K1 70 IX0 = K1
71 I1 = K1
72 I2 = K2
73 INC = 1
74 ELSE IF( INCX.LT.0 ) THEN
75 IX0 = 1 + ( 1-K2 )*INCX
76 I1 = K2
77 I2 = K1
78 INC = -1
69 ELSE 79 ELSE
70 IX = 1 + ( 1-K2 )*INCX 80 RETURN
71 END IF 81 END IF
72 IF( INCX.EQ.1 ) THEN 82 *
73 DO 10 I = K1, K2 83 N32 = ( N / 32 )*32
74 IP = IPIV( I ) 84 IF( N32.NE.0 ) THEN
75 IF( IP.NE.I ) 85 DO 30 J = 1, N32, 32
76 $ CALL DSWAP( N, A( I, 1 ), LDA, A( IP, 1 ), LDA ) 86 IX = IX0
77 10 CONTINUE 87 DO 20 I = I1, I2, INC
78 ELSE IF( INCX.GT.1 ) THEN 88 IP = IPIV( IX )
79 DO 20 I = K1, K2 89 IF( IP.NE.I ) THEN
90 DO 10 K = J, J + 31
91 TEMP = A( I, K )
92 A( I, K ) = A( IP, K )
93 A( IP, K ) = TEMP
94 10 CONTINUE
95 END IF
96 IX = IX + INCX
97 20 CONTINUE
98 30 CONTINUE
99 END IF
100 IF( N32.NE.N ) THEN
101 N32 = N32 + 1
102 IX = IX0
103 DO 50 I = I1, I2, INC
80 IP = IPIV( IX ) 104 IP = IPIV( IX )
81 IF( IP.NE.I ) 105 IF( IP.NE.I ) THEN
82 $ CALL DSWAP( N, A( I, 1 ), LDA, A( IP, 1 ), LDA ) 106 DO 40 K = N32, N
107 TEMP = A( I, K )
108 A( I, K ) = A( IP, K )
109 A( IP, K ) = TEMP
110 40 CONTINUE
111 END IF
83 IX = IX + INCX 112 IX = IX + INCX
84 20 CONTINUE 113 50 CONTINUE
85 ELSE IF( INCX.LT.0 ) THEN
86 DO 30 I = K2, K1, -1
87 IP = IPIV( IX )
88 IF( IP.NE.I )
89 $ CALL DSWAP( N, A( I, 1 ), LDA, A( IP, 1 ), LDA )
90 IX = IX + INCX
91 30 CONTINUE
92 END IF 114 END IF
93 * 115 *
94 RETURN 116 RETURN
95 * 117 *
96 * End of DLASWP 118 * End of DLASWP