root / src / lapack / double / dlasr.f @ 10
Historique | Voir | Annoter | Télécharger (12,98 ko)
| 1 | 1 | pfleura2 | SUBROUTINE DLASR( SIDE, PIVOT, DIRECT, M, N, C, S, A, LDA ) |
|---|---|---|---|
| 2 | 1 | pfleura2 | * |
| 3 | 1 | pfleura2 | * -- LAPACK auxiliary routine (version 3.2) -- |
| 4 | 1 | pfleura2 | * -- LAPACK is a software package provided by Univ. of Tennessee, -- |
| 5 | 1 | pfleura2 | * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- |
| 6 | 1 | pfleura2 | * November 2006 |
| 7 | 1 | pfleura2 | * |
| 8 | 1 | pfleura2 | * .. Scalar Arguments .. |
| 9 | 1 | pfleura2 | CHARACTER DIRECT, PIVOT, SIDE |
| 10 | 1 | pfleura2 | INTEGER LDA, M, N |
| 11 | 1 | pfleura2 | * .. |
| 12 | 1 | pfleura2 | * .. Array Arguments .. |
| 13 | 1 | pfleura2 | DOUBLE PRECISION A( LDA, * ), C( * ), S( * ) |
| 14 | 1 | pfleura2 | * .. |
| 15 | 1 | pfleura2 | * |
| 16 | 1 | pfleura2 | * Purpose |
| 17 | 1 | pfleura2 | * ======= |
| 18 | 1 | pfleura2 | * |
| 19 | 1 | pfleura2 | * DLASR applies a sequence of plane rotations to a real matrix A, |
| 20 | 1 | pfleura2 | * from either the left or the right. |
| 21 | 1 | pfleura2 | * |
| 22 | 1 | pfleura2 | * When SIDE = 'L', the transformation takes the form |
| 23 | 1 | pfleura2 | * |
| 24 | 1 | pfleura2 | * A := P*A |
| 25 | 1 | pfleura2 | * |
| 26 | 1 | pfleura2 | * and when SIDE = 'R', the transformation takes the form |
| 27 | 1 | pfleura2 | * |
| 28 | 1 | pfleura2 | * A := A*P**T |
| 29 | 1 | pfleura2 | * |
| 30 | 1 | pfleura2 | * where P is an orthogonal matrix consisting of a sequence of z plane |
| 31 | 1 | pfleura2 | * rotations, with z = M when SIDE = 'L' and z = N when SIDE = 'R', |
| 32 | 1 | pfleura2 | * and P**T is the transpose of P. |
| 33 | 1 | pfleura2 | * |
| 34 | 1 | pfleura2 | * When DIRECT = 'F' (Forward sequence), then |
| 35 | 1 | pfleura2 | * |
| 36 | 1 | pfleura2 | * P = P(z-1) * ... * P(2) * P(1) |
| 37 | 1 | pfleura2 | * |
| 38 | 1 | pfleura2 | * and when DIRECT = 'B' (Backward sequence), then |
| 39 | 1 | pfleura2 | * |
| 40 | 1 | pfleura2 | * P = P(1) * P(2) * ... * P(z-1) |
| 41 | 1 | pfleura2 | * |
| 42 | 1 | pfleura2 | * where P(k) is a plane rotation matrix defined by the 2-by-2 rotation |
| 43 | 1 | pfleura2 | * |
| 44 | 1 | pfleura2 | * R(k) = ( c(k) s(k) ) |
| 45 | 1 | pfleura2 | * = ( -s(k) c(k) ). |
| 46 | 1 | pfleura2 | * |
| 47 | 1 | pfleura2 | * When PIVOT = 'V' (Variable pivot), the rotation is performed |
| 48 | 1 | pfleura2 | * for the plane (k,k+1), i.e., P(k) has the form |
| 49 | 1 | pfleura2 | * |
| 50 | 1 | pfleura2 | * P(k) = ( 1 ) |
| 51 | 1 | pfleura2 | * ( ... ) |
| 52 | 1 | pfleura2 | * ( 1 ) |
| 53 | 1 | pfleura2 | * ( c(k) s(k) ) |
| 54 | 1 | pfleura2 | * ( -s(k) c(k) ) |
| 55 | 1 | pfleura2 | * ( 1 ) |
| 56 | 1 | pfleura2 | * ( ... ) |
| 57 | 1 | pfleura2 | * ( 1 ) |
| 58 | 1 | pfleura2 | * |
| 59 | 1 | pfleura2 | * where R(k) appears as a rank-2 modification to the identity matrix in |
| 60 | 1 | pfleura2 | * rows and columns k and k+1. |
| 61 | 1 | pfleura2 | * |
| 62 | 1 | pfleura2 | * When PIVOT = 'T' (Top pivot), the rotation is performed for the |
| 63 | 1 | pfleura2 | * plane (1,k+1), so P(k) has the form |
| 64 | 1 | pfleura2 | * |
| 65 | 1 | pfleura2 | * P(k) = ( c(k) s(k) ) |
| 66 | 1 | pfleura2 | * ( 1 ) |
| 67 | 1 | pfleura2 | * ( ... ) |
| 68 | 1 | pfleura2 | * ( 1 ) |
| 69 | 1 | pfleura2 | * ( -s(k) c(k) ) |
| 70 | 1 | pfleura2 | * ( 1 ) |
| 71 | 1 | pfleura2 | * ( ... ) |
| 72 | 1 | pfleura2 | * ( 1 ) |
| 73 | 1 | pfleura2 | * |
| 74 | 1 | pfleura2 | * where R(k) appears in rows and columns 1 and k+1. |
| 75 | 1 | pfleura2 | * |
| 76 | 1 | pfleura2 | * Similarly, when PIVOT = 'B' (Bottom pivot), the rotation is |
| 77 | 1 | pfleura2 | * performed for the plane (k,z), giving P(k) the form |
| 78 | 1 | pfleura2 | * |
| 79 | 1 | pfleura2 | * P(k) = ( 1 ) |
| 80 | 1 | pfleura2 | * ( ... ) |
| 81 | 1 | pfleura2 | * ( 1 ) |
| 82 | 1 | pfleura2 | * ( c(k) s(k) ) |
| 83 | 1 | pfleura2 | * ( 1 ) |
| 84 | 1 | pfleura2 | * ( ... ) |
| 85 | 1 | pfleura2 | * ( 1 ) |
| 86 | 1 | pfleura2 | * ( -s(k) c(k) ) |
| 87 | 1 | pfleura2 | * |
| 88 | 1 | pfleura2 | * where R(k) appears in rows and columns k and z. The rotations are |
| 89 | 1 | pfleura2 | * performed without ever forming P(k) explicitly. |
| 90 | 1 | pfleura2 | * |
| 91 | 1 | pfleura2 | * Arguments |
| 92 | 1 | pfleura2 | * ========= |
| 93 | 1 | pfleura2 | * |
| 94 | 1 | pfleura2 | * SIDE (input) CHARACTER*1 |
| 95 | 1 | pfleura2 | * Specifies whether the plane rotation matrix P is applied to |
| 96 | 1 | pfleura2 | * A on the left or the right. |
| 97 | 1 | pfleura2 | * = 'L': Left, compute A := P*A |
| 98 | 1 | pfleura2 | * = 'R': Right, compute A:= A*P**T |
| 99 | 1 | pfleura2 | * |
| 100 | 1 | pfleura2 | * PIVOT (input) CHARACTER*1 |
| 101 | 1 | pfleura2 | * Specifies the plane for which P(k) is a plane rotation |
| 102 | 1 | pfleura2 | * matrix. |
| 103 | 1 | pfleura2 | * = 'V': Variable pivot, the plane (k,k+1) |
| 104 | 1 | pfleura2 | * = 'T': Top pivot, the plane (1,k+1) |
| 105 | 1 | pfleura2 | * = 'B': Bottom pivot, the plane (k,z) |
| 106 | 1 | pfleura2 | * |
| 107 | 1 | pfleura2 | * DIRECT (input) CHARACTER*1 |
| 108 | 1 | pfleura2 | * Specifies whether P is a forward or backward sequence of |
| 109 | 1 | pfleura2 | * plane rotations. |
| 110 | 1 | pfleura2 | * = 'F': Forward, P = P(z-1)*...*P(2)*P(1) |
| 111 | 1 | pfleura2 | * = 'B': Backward, P = P(1)*P(2)*...*P(z-1) |
| 112 | 1 | pfleura2 | * |
| 113 | 1 | pfleura2 | * M (input) INTEGER |
| 114 | 1 | pfleura2 | * The number of rows of the matrix A. If m <= 1, an immediate |
| 115 | 1 | pfleura2 | * return is effected. |
| 116 | 1 | pfleura2 | * |
| 117 | 1 | pfleura2 | * N (input) INTEGER |
| 118 | 1 | pfleura2 | * The number of columns of the matrix A. If n <= 1, an |
| 119 | 1 | pfleura2 | * immediate return is effected. |
| 120 | 1 | pfleura2 | * |
| 121 | 1 | pfleura2 | * C (input) DOUBLE PRECISION array, dimension |
| 122 | 1 | pfleura2 | * (M-1) if SIDE = 'L' |
| 123 | 1 | pfleura2 | * (N-1) if SIDE = 'R' |
| 124 | 1 | pfleura2 | * The cosines c(k) of the plane rotations. |
| 125 | 1 | pfleura2 | * |
| 126 | 1 | pfleura2 | * S (input) DOUBLE PRECISION array, dimension |
| 127 | 1 | pfleura2 | * (M-1) if SIDE = 'L' |
| 128 | 1 | pfleura2 | * (N-1) if SIDE = 'R' |
| 129 | 1 | pfleura2 | * The sines s(k) of the plane rotations. The 2-by-2 plane |
| 130 | 1 | pfleura2 | * rotation part of the matrix P(k), R(k), has the form |
| 131 | 1 | pfleura2 | * R(k) = ( c(k) s(k) ) |
| 132 | 1 | pfleura2 | * ( -s(k) c(k) ). |
| 133 | 1 | pfleura2 | * |
| 134 | 1 | pfleura2 | * A (input/output) DOUBLE PRECISION array, dimension (LDA,N) |
| 135 | 1 | pfleura2 | * The M-by-N matrix A. On exit, A is overwritten by P*A if |
| 136 | 1 | pfleura2 | * SIDE = 'R' or by A*P**T if SIDE = 'L'. |
| 137 | 1 | pfleura2 | * |
| 138 | 1 | pfleura2 | * LDA (input) INTEGER |
| 139 | 1 | pfleura2 | * The leading dimension of the array A. LDA >= max(1,M). |
| 140 | 1 | pfleura2 | * |
| 141 | 1 | pfleura2 | * ===================================================================== |
| 142 | 1 | pfleura2 | * |
| 143 | 1 | pfleura2 | * .. Parameters .. |
| 144 | 1 | pfleura2 | DOUBLE PRECISION ONE, ZERO |
| 145 | 1 | pfleura2 | PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 ) |
| 146 | 1 | pfleura2 | * .. |
| 147 | 1 | pfleura2 | * .. Local Scalars .. |
| 148 | 1 | pfleura2 | INTEGER I, INFO, J |
| 149 | 1 | pfleura2 | DOUBLE PRECISION CTEMP, STEMP, TEMP |
| 150 | 1 | pfleura2 | * .. |
| 151 | 1 | pfleura2 | * .. External Functions .. |
| 152 | 1 | pfleura2 | LOGICAL LSAME |
| 153 | 1 | pfleura2 | EXTERNAL LSAME |
| 154 | 1 | pfleura2 | * .. |
| 155 | 1 | pfleura2 | * .. External Subroutines .. |
| 156 | 1 | pfleura2 | EXTERNAL XERBLA |
| 157 | 1 | pfleura2 | * .. |
| 158 | 1 | pfleura2 | * .. Intrinsic Functions .. |
| 159 | 1 | pfleura2 | INTRINSIC MAX |
| 160 | 1 | pfleura2 | * .. |
| 161 | 1 | pfleura2 | * .. Executable Statements .. |
| 162 | 1 | pfleura2 | * |
| 163 | 1 | pfleura2 | * Test the input parameters |
| 164 | 1 | pfleura2 | * |
| 165 | 1 | pfleura2 | INFO = 0 |
| 166 | 1 | pfleura2 | IF( .NOT.( LSAME( SIDE, 'L' ) .OR. LSAME( SIDE, 'R' ) ) ) THEN |
| 167 | 1 | pfleura2 | INFO = 1 |
| 168 | 1 | pfleura2 | ELSE IF( .NOT.( LSAME( PIVOT, 'V' ) .OR. LSAME( PIVOT, |
| 169 | 1 | pfleura2 | $ 'T' ) .OR. LSAME( PIVOT, 'B' ) ) ) THEN |
| 170 | 1 | pfleura2 | INFO = 2 |
| 171 | 1 | pfleura2 | ELSE IF( .NOT.( LSAME( DIRECT, 'F' ) .OR. LSAME( DIRECT, 'B' ) ) ) |
| 172 | 1 | pfleura2 | $ THEN |
| 173 | 1 | pfleura2 | INFO = 3 |
| 174 | 1 | pfleura2 | ELSE IF( M.LT.0 ) THEN |
| 175 | 1 | pfleura2 | INFO = 4 |
| 176 | 1 | pfleura2 | ELSE IF( N.LT.0 ) THEN |
| 177 | 1 | pfleura2 | INFO = 5 |
| 178 | 1 | pfleura2 | ELSE IF( LDA.LT.MAX( 1, M ) ) THEN |
| 179 | 1 | pfleura2 | INFO = 9 |
| 180 | 1 | pfleura2 | END IF |
| 181 | 1 | pfleura2 | IF( INFO.NE.0 ) THEN |
| 182 | 1 | pfleura2 | CALL XERBLA( 'DLASR ', INFO ) |
| 183 | 1 | pfleura2 | RETURN |
| 184 | 1 | pfleura2 | END IF |
| 185 | 1 | pfleura2 | * |
| 186 | 1 | pfleura2 | * Quick return if possible |
| 187 | 1 | pfleura2 | * |
| 188 | 1 | pfleura2 | IF( ( M.EQ.0 ) .OR. ( N.EQ.0 ) ) |
| 189 | 1 | pfleura2 | $ RETURN |
| 190 | 1 | pfleura2 | IF( LSAME( SIDE, 'L' ) ) THEN |
| 191 | 1 | pfleura2 | * |
| 192 | 1 | pfleura2 | * Form P * A |
| 193 | 1 | pfleura2 | * |
| 194 | 1 | pfleura2 | IF( LSAME( PIVOT, 'V' ) ) THEN |
| 195 | 1 | pfleura2 | IF( LSAME( DIRECT, 'F' ) ) THEN |
| 196 | 1 | pfleura2 | DO 20 J = 1, M - 1 |
| 197 | 1 | pfleura2 | CTEMP = C( J ) |
| 198 | 1 | pfleura2 | STEMP = S( J ) |
| 199 | 1 | pfleura2 | IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN |
| 200 | 1 | pfleura2 | DO 10 I = 1, N |
| 201 | 1 | pfleura2 | TEMP = A( J+1, I ) |
| 202 | 1 | pfleura2 | A( J+1, I ) = CTEMP*TEMP - STEMP*A( J, I ) |
| 203 | 1 | pfleura2 | A( J, I ) = STEMP*TEMP + CTEMP*A( J, I ) |
| 204 | 1 | pfleura2 | 10 CONTINUE |
| 205 | 1 | pfleura2 | END IF |
| 206 | 1 | pfleura2 | 20 CONTINUE |
| 207 | 1 | pfleura2 | ELSE IF( LSAME( DIRECT, 'B' ) ) THEN |
| 208 | 1 | pfleura2 | DO 40 J = M - 1, 1, -1 |
| 209 | 1 | pfleura2 | CTEMP = C( J ) |
| 210 | 1 | pfleura2 | STEMP = S( J ) |
| 211 | 1 | pfleura2 | IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN |
| 212 | 1 | pfleura2 | DO 30 I = 1, N |
| 213 | 1 | pfleura2 | TEMP = A( J+1, I ) |
| 214 | 1 | pfleura2 | A( J+1, I ) = CTEMP*TEMP - STEMP*A( J, I ) |
| 215 | 1 | pfleura2 | A( J, I ) = STEMP*TEMP + CTEMP*A( J, I ) |
| 216 | 1 | pfleura2 | 30 CONTINUE |
| 217 | 1 | pfleura2 | END IF |
| 218 | 1 | pfleura2 | 40 CONTINUE |
| 219 | 1 | pfleura2 | END IF |
| 220 | 1 | pfleura2 | ELSE IF( LSAME( PIVOT, 'T' ) ) THEN |
| 221 | 1 | pfleura2 | IF( LSAME( DIRECT, 'F' ) ) THEN |
| 222 | 1 | pfleura2 | DO 60 J = 2, M |
| 223 | 1 | pfleura2 | CTEMP = C( J-1 ) |
| 224 | 1 | pfleura2 | STEMP = S( J-1 ) |
| 225 | 1 | pfleura2 | IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN |
| 226 | 1 | pfleura2 | DO 50 I = 1, N |
| 227 | 1 | pfleura2 | TEMP = A( J, I ) |
| 228 | 1 | pfleura2 | A( J, I ) = CTEMP*TEMP - STEMP*A( 1, I ) |
| 229 | 1 | pfleura2 | A( 1, I ) = STEMP*TEMP + CTEMP*A( 1, I ) |
| 230 | 1 | pfleura2 | 50 CONTINUE |
| 231 | 1 | pfleura2 | END IF |
| 232 | 1 | pfleura2 | 60 CONTINUE |
| 233 | 1 | pfleura2 | ELSE IF( LSAME( DIRECT, 'B' ) ) THEN |
| 234 | 1 | pfleura2 | DO 80 J = M, 2, -1 |
| 235 | 1 | pfleura2 | CTEMP = C( J-1 ) |
| 236 | 1 | pfleura2 | STEMP = S( J-1 ) |
| 237 | 1 | pfleura2 | IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN |
| 238 | 1 | pfleura2 | DO 70 I = 1, N |
| 239 | 1 | pfleura2 | TEMP = A( J, I ) |
| 240 | 1 | pfleura2 | A( J, I ) = CTEMP*TEMP - STEMP*A( 1, I ) |
| 241 | 1 | pfleura2 | A( 1, I ) = STEMP*TEMP + CTEMP*A( 1, I ) |
| 242 | 1 | pfleura2 | 70 CONTINUE |
| 243 | 1 | pfleura2 | END IF |
| 244 | 1 | pfleura2 | 80 CONTINUE |
| 245 | 1 | pfleura2 | END IF |
| 246 | 1 | pfleura2 | ELSE IF( LSAME( PIVOT, 'B' ) ) THEN |
| 247 | 1 | pfleura2 | IF( LSAME( DIRECT, 'F' ) ) THEN |
| 248 | 1 | pfleura2 | DO 100 J = 1, M - 1 |
| 249 | 1 | pfleura2 | CTEMP = C( J ) |
| 250 | 1 | pfleura2 | STEMP = S( J ) |
| 251 | 1 | pfleura2 | IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN |
| 252 | 1 | pfleura2 | DO 90 I = 1, N |
| 253 | 1 | pfleura2 | TEMP = A( J, I ) |
| 254 | 1 | pfleura2 | A( J, I ) = STEMP*A( M, I ) + CTEMP*TEMP |
| 255 | 1 | pfleura2 | A( M, I ) = CTEMP*A( M, I ) - STEMP*TEMP |
| 256 | 1 | pfleura2 | 90 CONTINUE |
| 257 | 1 | pfleura2 | END IF |
| 258 | 1 | pfleura2 | 100 CONTINUE |
| 259 | 1 | pfleura2 | ELSE IF( LSAME( DIRECT, 'B' ) ) THEN |
| 260 | 1 | pfleura2 | DO 120 J = M - 1, 1, -1 |
| 261 | 1 | pfleura2 | CTEMP = C( J ) |
| 262 | 1 | pfleura2 | STEMP = S( J ) |
| 263 | 1 | pfleura2 | IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN |
| 264 | 1 | pfleura2 | DO 110 I = 1, N |
| 265 | 1 | pfleura2 | TEMP = A( J, I ) |
| 266 | 1 | pfleura2 | A( J, I ) = STEMP*A( M, I ) + CTEMP*TEMP |
| 267 | 1 | pfleura2 | A( M, I ) = CTEMP*A( M, I ) - STEMP*TEMP |
| 268 | 1 | pfleura2 | 110 CONTINUE |
| 269 | 1 | pfleura2 | END IF |
| 270 | 1 | pfleura2 | 120 CONTINUE |
| 271 | 1 | pfleura2 | END IF |
| 272 | 1 | pfleura2 | END IF |
| 273 | 1 | pfleura2 | ELSE IF( LSAME( SIDE, 'R' ) ) THEN |
| 274 | 1 | pfleura2 | * |
| 275 | 1 | pfleura2 | * Form A * P' |
| 276 | 1 | pfleura2 | * |
| 277 | 1 | pfleura2 | IF( LSAME( PIVOT, 'V' ) ) THEN |
| 278 | 1 | pfleura2 | IF( LSAME( DIRECT, 'F' ) ) THEN |
| 279 | 1 | pfleura2 | DO 140 J = 1, N - 1 |
| 280 | 1 | pfleura2 | CTEMP = C( J ) |
| 281 | 1 | pfleura2 | STEMP = S( J ) |
| 282 | 1 | pfleura2 | IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN |
| 283 | 1 | pfleura2 | DO 130 I = 1, M |
| 284 | 1 | pfleura2 | TEMP = A( I, J+1 ) |
| 285 | 1 | pfleura2 | A( I, J+1 ) = CTEMP*TEMP - STEMP*A( I, J ) |
| 286 | 1 | pfleura2 | A( I, J ) = STEMP*TEMP + CTEMP*A( I, J ) |
| 287 | 1 | pfleura2 | 130 CONTINUE |
| 288 | 1 | pfleura2 | END IF |
| 289 | 1 | pfleura2 | 140 CONTINUE |
| 290 | 1 | pfleura2 | ELSE IF( LSAME( DIRECT, 'B' ) ) THEN |
| 291 | 1 | pfleura2 | DO 160 J = N - 1, 1, -1 |
| 292 | 1 | pfleura2 | CTEMP = C( J ) |
| 293 | 1 | pfleura2 | STEMP = S( J ) |
| 294 | 1 | pfleura2 | IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN |
| 295 | 1 | pfleura2 | DO 150 I = 1, M |
| 296 | 1 | pfleura2 | TEMP = A( I, J+1 ) |
| 297 | 1 | pfleura2 | A( I, J+1 ) = CTEMP*TEMP - STEMP*A( I, J ) |
| 298 | 1 | pfleura2 | A( I, J ) = STEMP*TEMP + CTEMP*A( I, J ) |
| 299 | 1 | pfleura2 | 150 CONTINUE |
| 300 | 1 | pfleura2 | END IF |
| 301 | 1 | pfleura2 | 160 CONTINUE |
| 302 | 1 | pfleura2 | END IF |
| 303 | 1 | pfleura2 | ELSE IF( LSAME( PIVOT, 'T' ) ) THEN |
| 304 | 1 | pfleura2 | IF( LSAME( DIRECT, 'F' ) ) THEN |
| 305 | 1 | pfleura2 | DO 180 J = 2, N |
| 306 | 1 | pfleura2 | CTEMP = C( J-1 ) |
| 307 | 1 | pfleura2 | STEMP = S( J-1 ) |
| 308 | 1 | pfleura2 | IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN |
| 309 | 1 | pfleura2 | DO 170 I = 1, M |
| 310 | 1 | pfleura2 | TEMP = A( I, J ) |
| 311 | 1 | pfleura2 | A( I, J ) = CTEMP*TEMP - STEMP*A( I, 1 ) |
| 312 | 1 | pfleura2 | A( I, 1 ) = STEMP*TEMP + CTEMP*A( I, 1 ) |
| 313 | 1 | pfleura2 | 170 CONTINUE |
| 314 | 1 | pfleura2 | END IF |
| 315 | 1 | pfleura2 | 180 CONTINUE |
| 316 | 1 | pfleura2 | ELSE IF( LSAME( DIRECT, 'B' ) ) THEN |
| 317 | 1 | pfleura2 | DO 200 J = N, 2, -1 |
| 318 | 1 | pfleura2 | CTEMP = C( J-1 ) |
| 319 | 1 | pfleura2 | STEMP = S( J-1 ) |
| 320 | 1 | pfleura2 | IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN |
| 321 | 1 | pfleura2 | DO 190 I = 1, M |
| 322 | 1 | pfleura2 | TEMP = A( I, J ) |
| 323 | 1 | pfleura2 | A( I, J ) = CTEMP*TEMP - STEMP*A( I, 1 ) |
| 324 | 1 | pfleura2 | A( I, 1 ) = STEMP*TEMP + CTEMP*A( I, 1 ) |
| 325 | 1 | pfleura2 | 190 CONTINUE |
| 326 | 1 | pfleura2 | END IF |
| 327 | 1 | pfleura2 | 200 CONTINUE |
| 328 | 1 | pfleura2 | END IF |
| 329 | 1 | pfleura2 | ELSE IF( LSAME( PIVOT, 'B' ) ) THEN |
| 330 | 1 | pfleura2 | IF( LSAME( DIRECT, 'F' ) ) THEN |
| 331 | 1 | pfleura2 | DO 220 J = 1, N - 1 |
| 332 | 1 | pfleura2 | CTEMP = C( J ) |
| 333 | 1 | pfleura2 | STEMP = S( J ) |
| 334 | 1 | pfleura2 | IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN |
| 335 | 1 | pfleura2 | DO 210 I = 1, M |
| 336 | 1 | pfleura2 | TEMP = A( I, J ) |
| 337 | 1 | pfleura2 | A( I, J ) = STEMP*A( I, N ) + CTEMP*TEMP |
| 338 | 1 | pfleura2 | A( I, N ) = CTEMP*A( I, N ) - STEMP*TEMP |
| 339 | 1 | pfleura2 | 210 CONTINUE |
| 340 | 1 | pfleura2 | END IF |
| 341 | 1 | pfleura2 | 220 CONTINUE |
| 342 | 1 | pfleura2 | ELSE IF( LSAME( DIRECT, 'B' ) ) THEN |
| 343 | 1 | pfleura2 | DO 240 J = N - 1, 1, -1 |
| 344 | 1 | pfleura2 | CTEMP = C( J ) |
| 345 | 1 | pfleura2 | STEMP = S( J ) |
| 346 | 1 | pfleura2 | IF( ( CTEMP.NE.ONE ) .OR. ( STEMP.NE.ZERO ) ) THEN |
| 347 | 1 | pfleura2 | DO 230 I = 1, M |
| 348 | 1 | pfleura2 | TEMP = A( I, J ) |
| 349 | 1 | pfleura2 | A( I, J ) = STEMP*A( I, N ) + CTEMP*TEMP |
| 350 | 1 | pfleura2 | A( I, N ) = CTEMP*A( I, N ) - STEMP*TEMP |
| 351 | 1 | pfleura2 | 230 CONTINUE |
| 352 | 1 | pfleura2 | END IF |
| 353 | 1 | pfleura2 | 240 CONTINUE |
| 354 | 1 | pfleura2 | END IF |
| 355 | 1 | pfleura2 | END IF |
| 356 | 1 | pfleura2 | END IF |
| 357 | 1 | pfleura2 | * |
| 358 | 1 | pfleura2 | RETURN |
| 359 | 1 | pfleura2 | * |
| 360 | 1 | pfleura2 | * End of DLASR |
| 361 | 1 | pfleura2 | * |
| 362 | 1 | pfleura2 | END |