integer function isamax (n, sx, incx) C***BEGIN PROLOGUE ISAMAX C***PURPOSE Find the smallest index of that component of a vector C having the maximum magnitude. C***CATEGORY D1A2 C***TYPE SINGLE PRECISION (ISAMAX-S, IDAMAX-D, ICAMAX-C) C***KEYWORDS BLAS, LINEAR ALGEBRA, MAXIMUM COMPONENT, VECTOR C***AUTHOR Lawson, C. L., (JPL) C Hanson, R. J., (SNLA) C Kincaid, D. R., (U. of Texas) C Krogh, F. T., (JPL) C***DESCRIPTION C C B L A S Subprogram C Description of Parameters C C --Input-- c n number of elements in input vector(s) c sx single precision vector with n elements c incx storage spacing between elements of sx C C --Output-- c isamax smallest index (zero if n .le. 0) C C Find smallest index of maximum magnitude of single precision SX. C ISAMAX = first I, I = 1 to N, to maximize ABS(SX(IX+(I-1)*INCX)), C where IX = 1 if INCX .GE. 0, else IX = 1+(1-N)*INCX. C C***REFERENCES C. L. Lawson, R. J. Hanson, D. R. Kincaid and F. T. C Krogh, Basic linear algebra subprograms for Fortran C usage, Algorithm No. 539, Transactions on Mathematical C Software 5, 3 (September 1979), pp. 308-323. C***ROUTINES CALLED (NONE) C***REVISION HISTORY (YYMMDD) C 791001 DATE WRITTEN C 861211 REVISION DATE from Version 3.2 C 891214 Prologue converted to Version 4.0 format. (BAB) C 900821 Modified to correct problem with a negative increment. C (WRB) C 920501 Reformatted the REFERENCES section. (WRB) C 920618 Slight restructuring of code. (RWC, WRB) C***END PROLOGUE ISAMAX real sx(*), smax, xmag integer i, incx, ix, n c***first executable statement isamax isamax = 0 if (n .le. 0) return isamax = 1 if (n .eq. 1) return c if (incx .eq. 1) goto 20 c c code for increment not equal to 1. c ix = 1 if (incx .lt. 0) ix = (-n+1)*incx + 1 smax = abs(sx(ix)) ix = ix + incx do 10 i = 2,n xmag = abs(sx(ix)) if (xmag .gt. smax) then isamax = i smax = xmag endif ix = ix + incx 10 continue return c c code for increments equal to 1. c 20 smax = abs(sx(1)) do 30 i = 2,n xmag = abs(sx(i)) if (xmag .gt. smax) then isamax = i smax = xmag endif 30 continue return end