LAPACK 3.3.0
|
00001 SUBROUTINE DROT(N,DX,INCX,DY,INCY,C,S) 00002 * .. Scalar Arguments .. 00003 DOUBLE PRECISION C,S 00004 INTEGER INCX,INCY,N 00005 * .. 00006 * .. Array Arguments .. 00007 DOUBLE PRECISION DX(*),DY(*) 00008 * .. 00009 * 00010 * Purpose 00011 * ======= 00012 * 00013 * DROT applies a plane rotation. 00014 * 00015 * Further Details 00016 * =============== 00017 * 00018 * jack dongarra, linpack, 3/11/78. 00019 * modified 12/3/93, array(1) declarations changed to array(*) 00020 * 00021 * ===================================================================== 00022 * 00023 * .. Local Scalars .. 00024 DOUBLE PRECISION DTEMP 00025 INTEGER I,IX,IY 00026 * .. 00027 IF (N.LE.0) RETURN 00028 IF (INCX.EQ.1 .AND. INCY.EQ.1) GO TO 20 00029 * 00030 * code for unequal increments or equal increments not equal 00031 * to 1 00032 * 00033 IX = 1 00034 IY = 1 00035 IF (INCX.LT.0) IX = (-N+1)*INCX + 1 00036 IF (INCY.LT.0) IY = (-N+1)*INCY + 1 00037 DO 10 I = 1,N 00038 DTEMP = C*DX(IX) + S*DY(IY) 00039 DY(IY) = C*DY(IY) - S*DX(IX) 00040 DX(IX) = DTEMP 00041 IX = IX + INCX 00042 IY = IY + INCY 00043 10 CONTINUE 00044 RETURN 00045 * 00046 * code for both increments equal to 1 00047 * 00048 20 DO 30 I = 1,N 00049 DTEMP = C*DX(I) + S*DY(I) 00050 DY(I) = C*DY(I) - S*DX(I) 00051 DX(I) = DTEMP 00052 30 CONTINUE 00053 RETURN 00054 END