icamax.f 2.6 KB

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