|
LAPACK 3.3.0
|
|
LAPACK 3.3.0
|
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 * (DX**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)) GO TO 140 00066 IF (.NOT. (INCX.EQ.INCY.AND.INCX.GT.0)) GO TO 70 00067 * 00068 NSTEPS = N*INCX 00069 IF (SFLAG.LT.ZERO) THEN 00070 GO TO 50 00071 ELSE IF (SFLAG.EQ.ZERO) THEN 00072 GO TO 10 00073 ELSE 00074 GO TO 30 00075 END IF 00076 10 CONTINUE 00077 SH12 = SPARAM(4) 00078 SH21 = SPARAM(3) 00079 DO 20 I = 1,NSTEPS,INCX 00080 W = SX(I) 00081 Z = SY(I) 00082 SX(I) = W + Z*SH12 00083 SY(I) = W*SH21 + Z 00084 20 CONTINUE 00085 GO TO 140 00086 30 CONTINUE 00087 SH11 = SPARAM(2) 00088 SH22 = SPARAM(5) 00089 DO 40 I = 1,NSTEPS,INCX 00090 W = SX(I) 00091 Z = SY(I) 00092 SX(I) = W*SH11 + Z 00093 SY(I) = -W + SH22*Z 00094 40 CONTINUE 00095 GO TO 140 00096 50 CONTINUE 00097 SH11 = SPARAM(2) 00098 SH12 = SPARAM(4) 00099 SH21 = SPARAM(3) 00100 SH22 = SPARAM(5) 00101 DO 60 I = 1,NSTEPS,INCX 00102 W = SX(I) 00103 Z = SY(I) 00104 SX(I) = W*SH11 + Z*SH12 00105 SY(I) = W*SH21 + Z*SH22 00106 60 CONTINUE 00107 GO TO 140 00108 70 CONTINUE 00109 KX = 1 00110 KY = 1 00111 IF (INCX.LT.0) KX = 1 + (1-N)*INCX 00112 IF (INCY.LT.0) KY = 1 + (1-N)*INCY 00113 * 00114 IF (SFLAG.LT.ZERO) THEN 00115 GO TO 120 00116 ELSE IF (SFLAG.EQ.ZERO) THEN 00117 GO TO 80 00118 ELSE 00119 GO TO 100 00120 END IF 00121 80 CONTINUE 00122 SH12 = SPARAM(4) 00123 SH21 = SPARAM(3) 00124 DO 90 I = 1,N 00125 W = SX(KX) 00126 Z = SY(KY) 00127 SX(KX) = W + Z*SH12 00128 SY(KY) = W*SH21 + Z 00129 KX = KX + INCX 00130 KY = KY + INCY 00131 90 CONTINUE 00132 GO TO 140 00133 100 CONTINUE 00134 SH11 = SPARAM(2) 00135 SH22 = SPARAM(5) 00136 DO 110 I = 1,N 00137 W = SX(KX) 00138 Z = SY(KY) 00139 SX(KX) = W*SH11 + Z 00140 SY(KY) = -W + SH22*Z 00141 KX = KX + INCX 00142 KY = KY + INCY 00143 110 CONTINUE 00144 GO TO 140 00145 120 CONTINUE 00146 SH11 = SPARAM(2) 00147 SH12 = SPARAM(4) 00148 SH21 = SPARAM(3) 00149 SH22 = SPARAM(5) 00150 DO 130 I = 1,N 00151 W = SX(KX) 00152 Z = SY(KY) 00153 SX(KX) = W*SH11 + Z*SH12 00154 SY(KY) = W*SH21 + Z*SH22 00155 KX = KX + INCX 00156 KY = KY + INCY 00157 130 CONTINUE 00158 140 CONTINUE 00159 RETURN 00160 END
1.7.3 
