Free cookie consent management tool by TermsFeed Policy Generator

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

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

#2789 added Finbarr O'Sullivan smoothing spline code

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