![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to drotm.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / lapack / blas|
Return to drotm.f CVS log | Up to [local] / rpl / lapack / blas |
1.1 bertrand 1: SUBROUTINE DROTM(N,DX,INCX,DY,INCY,DPARAM)
2: * .. Scalar Arguments ..
3: INTEGER INCX,INCY,N
4: * ..
5: * .. Array Arguments ..
6: DOUBLE PRECISION DPARAM(5),DX(*),DY(*)
7: * ..
8: *
9: * Purpose
10: * =======
11: *
12: * APPLY THE MODIFIED GIVENS TRANSFORMATION, H, TO THE 2 BY N MATRIX
13: *
14: * (DX**T) , WHERE **T INDICATES TRANSPOSE. THE ELEMENTS OF DX ARE IN
15: * (DY**T)
16: *
17: * DX(LX+I*INCX), I = 0 TO N-1, WHERE LX = 1 IF INCX .GE. 0, ELSE
18: * LX = (-INCX)*N, AND SIMILARLY FOR SY USING LY AND INCY.
19: * WITH DPARAM(1)=DFLAG, H HAS ONE OF THE FOLLOWING FORMS..
20: *
21: * DFLAG=-1.D0 DFLAG=0.D0 DFLAG=1.D0 DFLAG=-2.D0
22: *
23: * (DH11 DH12) (1.D0 DH12) (DH11 1.D0) (1.D0 0.D0)
24: * H=( ) ( ) ( ) ( )
25: * (DH21 DH22), (DH21 1.D0), (-1.D0 DH22), (0.D0 1.D0).
26: * SEE DROTMG FOR A DESCRIPTION OF DATA STORAGE IN DPARAM.
27: *
28: * Arguments
29: * =========
30: *
31: * N (input) INTEGER
32: * number of elements in input vector(s)
33: *
34: * DX (input/output) DOUBLE PRECISION array, dimension N
35: * double precision vector with N elements
36: *
37: * INCX (input) INTEGER
38: * storage spacing between elements of DX
39: *
40: * DY (input/output) DOUBLE PRECISION array, dimension N
41: * double precision vector with N elements
42: *
43: * INCY (input) INTEGER
44: * storage spacing between elements of DY
45: *
46: * DPARAM (input/output) DOUBLE PRECISION array, dimension 5
47: * DPARAM(1)=DFLAG
48: * DPARAM(2)=DH11
49: * DPARAM(3)=DH21
50: * DPARAM(4)=DH12
51: * DPARAM(5)=DH22
52: *
53: * =====================================================================
54: *
55: * .. Local Scalars ..
56: DOUBLE PRECISION DFLAG,DH11,DH12,DH21,DH22,TWO,W,Z,ZERO
57: INTEGER I,KX,KY,NSTEPS
58: * ..
59: * .. Data statements ..
60: DATA ZERO,TWO/0.D0,2.D0/
61: * ..
62: *
63: DFLAG = DPARAM(1)
1.8 ! bertrand 64: IF (N.LE.0 .OR. (DFLAG+TWO.EQ.ZERO)) RETURN
! 65: IF (INCX.EQ.INCY.AND.INCX.GT.0) THEN
1.1 bertrand 66: *
1.8 ! bertrand 67: NSTEPS = N*INCX
! 68: IF (DFLAG.LT.ZERO) THEN
! 69: DH11 = DPARAM(2)
! 70: DH12 = DPARAM(4)
! 71: DH21 = DPARAM(3)
! 72: DH22 = DPARAM(5)
! 73: DO I = 1,NSTEPS,INCX
! 74: W = DX(I)
! 75: Z = DY(I)
! 76: DX(I) = W*DH11 + Z*DH12
! 77: DY(I) = W*DH21 + Z*DH22
! 78: END DO
! 79: ELSE IF (DFLAG.EQ.ZERO) THEN
! 80: DH12 = DPARAM(4)
! 81: DH21 = DPARAM(3)
! 82: DO I = 1,NSTEPS,INCX
! 83: W = DX(I)
! 84: Z = DY(I)
! 85: DX(I) = W + Z*DH12
! 86: DY(I) = W*DH21 + Z
! 87: END DO
! 88: ELSE
! 89: DH11 = DPARAM(2)
! 90: DH22 = DPARAM(5)
! 91: DO I = 1,NSTEPS,INCX
! 92: W = DX(I)
! 93: Z = DY(I)
! 94: DX(I) = W*DH11 + Z
! 95: DY(I) = -W + DH22*Z
! 96: END DO
! 97: END IF
1.4 bertrand 98: ELSE
1.8 ! bertrand 99: KX = 1
! 100: KY = 1
! 101: IF (INCX.LT.0) KX = 1 + (1-N)*INCX
! 102: IF (INCY.LT.0) KY = 1 + (1-N)*INCY
1.1 bertrand 103: *
1.8 ! bertrand 104: IF (DFLAG.LT.ZERO) THEN
! 105: DH11 = DPARAM(2)
! 106: DH12 = DPARAM(4)
! 107: DH21 = DPARAM(3)
! 108: DH22 = DPARAM(5)
! 109: DO I = 1,N
! 110: W = DX(KX)
! 111: Z = DY(KY)
! 112: DX(KX) = W*DH11 + Z*DH12
! 113: DY(KY) = W*DH21 + Z*DH22
! 114: KX = KX + INCX
! 115: KY = KY + INCY
! 116: END DO
! 117: ELSE IF (DFLAG.EQ.ZERO) THEN
! 118: DH12 = DPARAM(4)
! 119: DH21 = DPARAM(3)
! 120: DO I = 1,N
! 121: W = DX(KX)
! 122: Z = DY(KY)
! 123: DX(KX) = W + Z*DH12
! 124: DY(KY) = W*DH21 + Z
! 125: KX = KX + INCX
! 126: KY = KY + INCY
! 127: END DO
! 128: ELSE
! 129: DH11 = DPARAM(2)
! 130: DH22 = DPARAM(5)
! 131: DO I = 1,N
! 132: W = DX(KX)
! 133: Z = DY(KY)
! 134: DX(KX) = W*DH11 + Z
! 135: DY(KY) = -W + DH22*Z
! 136: KX = KX + INCX
! 137: KY = KY + INCY
! 138: END DO
! 139: END IF
1.4 bertrand 140: END IF
1.1 bertrand 141: RETURN
142: END