LAPACK: BLAS/SRC/drotm.f Source File

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