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