 |
LAPACK 3.3.1
Linear Algebra PACKage
|
|
LAPACK 3.3.1
Linear Algebra PACKage
|
00001 SUBROUTINE SROTM(N,SX,INCX,SY,INCY,SPARAM) 00002 * .. Scalar Arguments .. 00003 INTEGER INCX,INCY,N 00004 * .. 00005 * .. Array Arguments .. 00006 REAL SPARAM(5),SX(*),SY(*) 00007 * .. 00008 * 00009 * Purpose 00010 * ======= 00011 * 00012 * APPLY THE MODIFIED GIVENS TRANSFORMATION, H, TO THE 2 BY N MATRIX 00013 * 00014 * (SX**T) , WHERE **T INDICATES TRANSPOSE. THE ELEMENTS OF SX ARE IN 00015 * (SX**T) 00016 * 00017 * SX(LX+I*INCX), I = 0 TO N-1, WHERE LX = 1 IF INCX .GE. 0, ELSE 00018 * LX = (-INCX)*N, AND SIMILARLY FOR SY USING USING LY AND INCY. 00019 * WITH SPARAM(1)=SFLAG, H HAS ONE OF THE FOLLOWING FORMS.. 00020 * 00021 * SFLAG=-1.E0 SFLAG=0.E0 SFLAG=1.E0 SFLAG=-2.E0 00022 * 00023 * (SH11 SH12) (1.E0 SH12) (SH11 1.E0) (1.E0 0.E0) 00024 * H=( ) ( ) ( ) ( ) 00025 * (SH21 SH22), (SH21 1.E0), (-1.E0 SH22), (0.E0 1.E0). 00026 * SEE SROTMG FOR A DESCRIPTION OF DATA STORAGE IN SPARAM. 00027 * 00028 * 00029 * Arguments 00030 * ========= 00031 * 00032 * N (input) INTEGER 00033 * number of elements in input vector(s) 00034 * 00035 * SX (input/output) REAL array, dimension N 00036 * double precision vector with N elements 00037 * 00038 * INCX (input) INTEGER 00039 * storage spacing between elements of SX 00040 * 00041 * SY (input/output) REAL array, dimension N 00042 * double precision vector with N elements 00043 * 00044 * INCY (input) INTEGER 00045 * storage spacing between elements of SY 00046 * 00047 * SPARAM (input/output) REAL array, dimension 5 00048 * SPARAM(1)=SFLAG 00049 * SPARAM(2)=SH11 00050 * SPARAM(3)=SH21 00051 * SPARAM(4)=SH12 00052 * SPARAM(5)=SH22 00053 * 00054 * ===================================================================== 00055 * 00056 * .. Local Scalars .. 00057 REAL SFLAG,SH11,SH12,SH21,SH22,TWO,W,Z,ZERO 00058 INTEGER I,KX,KY,NSTEPS 00059 * .. 00060 * .. Data statements .. 00061 DATA ZERO,TWO/0.E0,2.E0/ 00062 * .. 00063 * 00064 SFLAG = SPARAM(1) 00065 IF (N.LE.0 .OR. (SFLAG+TWO.EQ.ZERO)) RETURN 00066 IF (INCX.EQ.INCY.AND.INCX.GT.0) THEN 00067 * 00068 NSTEPS = N*INCX 00069 IF (SFLAG.LT.ZERO) THEN 00070 SH11 = SPARAM(2) 00071 SH12 = SPARAM(4) 00072 SH21 = SPARAM(3) 00073 SH22 = SPARAM(5) 00074 DO I = 1,NSTEPS,INCX 00075 W = SX(I) 00076 Z = SY(I) 00077 SX(I) = W*SH11 + Z*SH12 00078 SY(I) = W*SH21 + Z*SH22 00079 END DO 00080 ELSE IF (SFLAG.EQ.ZERO) THEN 00081 SH12 = SPARAM(4) 00082 SH21 = SPARAM(3) 00083 DO I = 1,NSTEPS,INCX 00084 W = SX(I) 00085 Z = SY(I) 00086 SX(I) = W + Z*SH12 00087 SY(I) = W*SH21 + Z 00088 END DO 00089 ELSE 00090 SH11 = SPARAM(2) 00091 SH22 = SPARAM(5) 00092 DO I = 1,NSTEPS,INCX 00093 W = SX(I) 00094 Z = SY(I) 00095 SX(I) = W*SH11 + Z 00096 SY(I) = -W + SH22*Z 00097 END DO 00098 END IF 00099 ELSE 00100 KX = 1 00101 KY = 1 00102 IF (INCX.LT.0) KX = 1 + (1-N)*INCX 00103 IF (INCY.LT.0) KY = 1 + (1-N)*INCY 00104 * 00105 IF (SFLAG.LT.ZERO) THEN 00106 SH11 = SPARAM(2) 00107 SH12 = SPARAM(4) 00108 SH21 = SPARAM(3) 00109 SH22 = SPARAM(5) 00110 DO I = 1,N 00111 W = SX(KX) 00112 Z = SY(KY) 00113 SX(KX) = W*SH11 + Z*SH12 00114 SY(KY) = W*SH21 + Z*SH22 00115 KX = KX + INCX 00116 KY = KY + INCY 00117 END DO 00118 ELSE IF (SFLAG.EQ.ZERO) THEN 00119 SH12 = SPARAM(4) 00120 SH21 = SPARAM(3) 00121 DO I = 1,N 00122 W = SX(KX) 00123 Z = SY(KY) 00124 SX(KX) = W + Z*SH12 00125 SY(KY) = W*SH21 + Z 00126 KX = KX + INCX 00127 KY = KY + INCY 00128 END DO 00129 ELSE 00130 SH11 = SPARAM(2) 00131 SH22 = SPARAM(5) 00132 DO I = 1,N 00133 W = SX(KX) 00134 Z = SY(KY) 00135 SX(KX) = W*SH11 + Z 00136 SY(KY) = -W + SH22*Z 00137 KX = KX + INCX 00138 KY = KY + INCY 00139 END DO 00140 END IF 00141 END IF 00142 RETURN 00143 END
1.7.3 
