share/odepack/fortran/idamax.f

   1 *DECK IDAMAX
   2       INTEGER FUNCTION IDAMAX (N, DX, INCX)
   3 C***BEGIN PROLOGUE  IDAMAX
   4 C***PURPOSE  Find the smallest index of that component of a vector
   5 C            having the maximum magnitude.
   6 C***CATEGORY  D1A2
   7 C***TYPE      DOUBLE PRECISION (ISAMAX-S, IDAMAX-D, ICAMAX-C)
   8 C***KEYWORDS  BLAS, LINEAR ALGEBRA, MAXIMUM COMPONENT, VECTOR
   9 C***AUTHOR  Lawson, C. L., (JPL)
  10 C           Hanson, R. J., (SNLA)
  11 C           Kincaid, D. R., (U. of Texas)
  12 C           Krogh, F. T., (JPL)
  13 C***DESCRIPTION
  14 C
  15 C                B L A S  Subprogram
  16 C    Description of Parameters
  17 C
  18 C     --Input--
  19 C        N  number of elements in input vector(s)
  20 C       DX  double precision vector with N elements
  21 C     INCX  storage spacing between elements of DX
  22 C
  23 C     --Output--
  24 C   IDAMAX  smallest index (zero if N .LE. 0)
  25 C
  26 C     Find smallest index of maximum magnitude of double precision DX.
  27 C     IDAMAX = first I, I = 1 to N, to maximize ABS(DX(IX+(I-1)*INCX)),
  28 C     where IX = 1 if INCX .GE. 0, else IX = 1+(1-N)*INCX.
  29 C
  30 C***REFERENCES  C. L. Lawson, R. J. Hanson, D. R. Kincaid and F. T.
  31 C                 Krogh, Basic linear algebra subprograms for Fortran
  32 C                 usage, Algorithm No. 539, Transactions on Mathematical
  33 C                 Software 5, 3 (September 1979), pp. 308-323.
  34 C***ROUTINES CALLED  (NONE)
  35 C***REVISION HISTORY  (YYMMDD)
  36 C   791001  DATE WRITTEN
  37 C   890531  Changed all specific intrinsics to generic.  (WRB)
  38 C   890531  REVISION DATE from Version 3.2
  39 C   891214  Prologue converted to Version 4.0 format.  (BAB)
  40 C   900821  Modified to correct problem with a negative increment.
  41 C           (WRB)
  42 C   920501  Reformatted the REFERENCES section.  (WRB)
  43 C***END PROLOGUE  IDAMAX
  44       DOUBLE PRECISION DX(*), DMAX, XMAG
  45       INTEGER I, INCX, IX, N
  46 C***FIRST EXECUTABLE STATEMENT  IDAMAX
  47       IDAMAX = 0
  48       IF (N .LE. 0) RETURN
  49       IDAMAX = 1
  50       IF (N .EQ. 1) RETURN
  51 C
  52       IF (INCX .EQ. 1) GOTO 20
  53 C
  54 C     Code for increments not equal to 1.
  55 C
  56       IX = 1
  57       IF (INCX .LT. 0) IX = (-N+1)*INCX + 1
  58       DMAX = ABS(DX(IX))
  59       IX = IX + INCX
  60       DO 10 I = 2,N
  61         XMAG = ABS(DX(IX))
  62         IF (XMAG .GT. DMAX) THEN
  63           IDAMAX = I
  64           DMAX = XMAG
  65         ENDIF
  66         IX = IX + INCX
  67    10 CONTINUE
  68       RETURN
  69 C
  70 C     Code for increments equal to 1.
  71 C
  72    20 DMAX = ABS(DX(1))
  73       DO 30 I = 2,N
  74         XMAG = ABS(DX(I))
  75         IF (XMAG .GT. DMAX) THEN
  76           IDAMAX = I
  77           DMAX = XMAG
  78         ENDIF
  79    30 CONTINUE
  80       RETURN
  81       END