Free cookie consent management tool by TermsFeed Policy Generator

source: branches/2789_MathNetNumerics-Exploration/HeuristicLab.Algorithms.DataAnalysis.Experimental/sbart/drotm.f @ 17185

Last change on this file since 17185 was 15457, checked in by gkronber, 7 years ago

#2789 added Finbarr O'Sullivan smoothing spline code

File size: 3.7 KB
Line 
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(1),DY(1)
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 5 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)
64      IF (N.LE.0 .OR. (DFLAG+TWO.EQ.ZERO)) GO TO 140
65      IF (.NOT. (INCX.EQ.INCY.AND.INCX.GT.0)) GO TO 70
66*
67      NSTEPS = N*INCX
68      IF (DFLAG) 50,10,30
69   10 CONTINUE
70      DH12 = DPARAM(4)
71      DH21 = DPARAM(3)
72      DO 20 I = 1,NSTEPS,INCX
73          W = DX(I)
74          Z = DY(I)
75          DX(I) = W + Z*DH12
76          DY(I) = W*DH21 + Z
77   20 CONTINUE
78      GO TO 140
79   30 CONTINUE
80      DH11 = DPARAM(2)
81      DH22 = DPARAM(5)
82      DO 40 I = 1,NSTEPS,INCX
83          W = DX(I)
84          Z = DY(I)
85          DX(I) = W*DH11 + Z
86          DY(I) = -W + DH22*Z
87   40 CONTINUE
88      GO TO 140
89   50 CONTINUE
90      DH11 = DPARAM(2)
91      DH12 = DPARAM(4)
92      DH21 = DPARAM(3)
93      DH22 = DPARAM(5)
94      DO 60 I = 1,NSTEPS,INCX
95          W = DX(I)
96          Z = DY(I)
97          DX(I) = W*DH11 + Z*DH12
98          DY(I) = W*DH21 + Z*DH22
99   60 CONTINUE
100      GO TO 140
101   70 CONTINUE
102      KX = 1
103      KY = 1
104      IF (INCX.LT.0) KX = 1 + (1-N)*INCX
105      IF (INCY.LT.0) KY = 1 + (1-N)*INCY
106*
107      IF (DFLAG) 120,80,100
108   80 CONTINUE
109      DH12 = DPARAM(4)
110      DH21 = DPARAM(3)
111      DO 90 I = 1,N
112          W = DX(KX)
113          Z = DY(KY)
114          DX(KX) = W + Z*DH12
115          DY(KY) = W*DH21 + Z
116          KX = KX + INCX
117          KY = KY + INCY
118   90 CONTINUE
119      GO TO 140
120  100 CONTINUE
121      DH11 = DPARAM(2)
122      DH22 = DPARAM(5)
123      DO 110 I = 1,N
124          W = DX(KX)
125          Z = DY(KY)
126          DX(KX) = W*DH11 + Z
127          DY(KY) = -W + DH22*Z
128          KX = KX + INCX
129          KY = KY + INCY
130  110 CONTINUE
131      GO TO 140
132  120 CONTINUE
133      DH11 = DPARAM(2)
134      DH12 = DPARAM(4)
135      DH21 = DPARAM(3)
136      DH22 = DPARAM(5)
137      DO 130 I = 1,N
138          W = DX(KX)
139          Z = DY(KY)
140          DX(KX) = W*DH11 + Z*DH12
141          DY(KY) = W*DH21 + Z*DH22
142          KX = KX + INCX
143          KY = KY + INCY
144  130 CONTINUE
145  140 CONTINUE
146      RETURN
147      END
Note: See TracBrowser for help on using the repository browser.