isamax.f 2.5 KB

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