Statistiques
| Révision :

root / src / blas / drotm.f @ 11

Historique | Voir | Annoter | Télécharger (3,68 ko)

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