LAPACK 3.3.1
Linear Algebra PACKage

drotm.f

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