LAPACK 3.3.1
Linear Algebra PACKage

srotm.f

Go to the documentation of this file.
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
 All Files Functions