![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b SROT 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 * Definition: 00009 * =========== 00010 * 00011 * SUBROUTINE SROT(N,SX,INCX,SY,INCY,C,S) 00012 * 00013 * .. Scalar Arguments .. 00014 * REAL C,S 00015 * INTEGER INCX,INCY,N 00016 * .. 00017 * .. Array Arguments .. 00018 * REAL SX(*),SY(*) 00019 * .. 00020 * 00021 * 00022 *> \par Purpose: 00023 * ============= 00024 *> 00025 *> \verbatim 00026 *> 00027 *> applies a plane rotation. 00028 *> \endverbatim 00029 * 00030 * Authors: 00031 * ======== 00032 * 00033 *> \author Univ. of Tennessee 00034 *> \author Univ. of California Berkeley 00035 *> \author Univ. of Colorado Denver 00036 *> \author NAG Ltd. 00037 * 00038 *> \date November 2011 00039 * 00040 *> \ingroup single_blas_level1 00041 * 00042 *> \par Further Details: 00043 * ===================== 00044 *> 00045 *> \verbatim 00046 *> 00047 *> jack dongarra, linpack, 3/11/78. 00048 *> modified 12/3/93, array(1) declarations changed to array(*) 00049 *> \endverbatim 00050 *> 00051 * ===================================================================== 00052 SUBROUTINE SROT(N,SX,INCX,SY,INCY,C,S) 00053 * 00054 * -- Reference BLAS level1 routine (version 3.4.0) -- 00055 * -- Reference BLAS is a software package provided by Univ. of Tennessee, -- 00056 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00057 * November 2011 00058 * 00059 * .. Scalar Arguments .. 00060 REAL C,S 00061 INTEGER INCX,INCY,N 00062 * .. 00063 * .. Array Arguments .. 00064 REAL SX(*),SY(*) 00065 * .. 00066 * 00067 * ===================================================================== 00068 * 00069 * .. Local Scalars .. 00070 REAL STEMP 00071 INTEGER I,IX,IY 00072 * .. 00073 IF (N.LE.0) RETURN 00074 IF (INCX.EQ.1 .AND. INCY.EQ.1) THEN 00075 * 00076 * code for both increments equal to 1 00077 * 00078 DO I = 1,N 00079 STEMP = C*SX(I) + S*SY(I) 00080 SY(I) = C*SY(I) - S*SX(I) 00081 SX(I) = STEMP 00082 END DO 00083 ELSE 00084 * 00085 * code for unequal increments or equal increments not equal 00086 * to 1 00087 * 00088 IX = 1 00089 IY = 1 00090 IF (INCX.LT.0) IX = (-N+1)*INCX + 1 00091 IF (INCY.LT.0) IY = (-N+1)*INCY + 1 00092 DO I = 1,N 00093 STEMP = C*SX(IX) + S*SY(IY) 00094 SY(IY) = C*SY(IY) - S*SX(IX) 00095 SX(IX) = STEMP 00096 IX = IX + INCX 00097 IY = IY + INCY 00098 END DO 00099 END IF 00100 RETURN 00101 END