Free cookie consent management tool by TermsFeed Policy Generator

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

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

#2789 added Finbarr O'Sullivan smoothing spline code

File size: 1.2 KB
Line 
1      INTEGER FUNCTION ICAMAX(N,CX,INCX)
2*     .. Scalar Arguments ..
3      INTEGER INCX,N
4*     ..
5*     .. Array Arguments ..
6      COMPLEX CX(*)
7*     ..
8*
9*  Purpose
10*  =======
11*
12*     finds the index of element having max. absolute value.
13*     jack dongarra, linpack, 3/11/78.
14*     modified 3/93 to return if incx .le. 0.
15*     modified 12/3/93, array(1) declarations changed to array(*)
16*
17*
18*     .. Local Scalars ..
19      REAL SMAX
20      INTEGER I,IX
21*     ..
22*     .. External Functions ..
23      REAL SCABS1
24      EXTERNAL SCABS1
25*     ..
26      ICAMAX = 0
27      IF (N.LT.1 .OR. INCX.LE.0) RETURN
28      ICAMAX = 1
29      IF (N.EQ.1) RETURN
30      IF (INCX.EQ.1) GO TO 20
31*
32*        code for increment not equal to 1
33*
34      IX = 1
35      SMAX = SCABS1(CX(1))
36      IX = IX + INCX
37      DO 10 I = 2,N
38          IF (SCABS1(CX(IX)).LE.SMAX) GO TO 5
39          ICAMAX = I
40          SMAX = SCABS1(CX(IX))
41    5     IX = IX + INCX
42   10 CONTINUE
43      RETURN
44*
45*        code for increment equal to 1
46*
47   20 SMAX = SCABS1(CX(1))
48      DO 30 I = 2,N
49          IF (SCABS1(CX(I)).LE.SMAX) GO TO 30
50          ICAMAX = I
51          SMAX = SCABS1(CX(I))
52   30 CONTINUE
53      RETURN
54      END
Note: See TracBrowser for help on using the repository browser.