LAPACK: BLAS/SRC/srotm.f Source File

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 *     (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