home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / octave-1.1.1p1-src.tgz / tar.out / fsf / octave / libcruft / lapack / izmax1.f < prev    next >
Text File  |  1996-09-28  |  2KB  |  97 lines
  1.       INTEGER          FUNCTION IZMAX1( N, CX, INCX )
  2. *
  3. *  -- LAPACK auxiliary routine (version 2.0) --
  4. *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
  5. *     Courant Institute, Argonne National Lab, and Rice University
  6. *     September 30, 1994
  7. *
  8. *     .. Scalar Arguments ..
  9.       INTEGER            INCX, N
  10. *     ..
  11. *     .. Array Arguments ..
  12.       COMPLEX*16         CX( * )
  13. *     ..
  14. *
  15. *  Purpose
  16. *  =======
  17. *
  18. *  IZMAX1 finds the index of the element whose real part has maximum
  19. *  absolute value.
  20. *
  21. *  Based on IZAMAX from Level 1 BLAS.
  22. *  The change is to use the 'genuine' absolute value.
  23. *
  24. *  Contributed by Nick Higham for use with ZLACON.
  25. *
  26. *  Arguments
  27. *  =========
  28. *
  29. *  N       (input) INTEGER
  30. *          The number of elements in the vector CX.
  31. *
  32. *  CX      (input) COMPLEX*16 array, dimension (N)
  33. *          The vector whose elements will be summed.
  34. *
  35. *  INCX    (input) INTEGER
  36. *          The spacing between successive values of CX.  INCX >= 1.
  37. *
  38. * =====================================================================
  39. *
  40. *     .. Local Scalars ..
  41.       INTEGER            I, IX
  42.       DOUBLE PRECISION   SMAX
  43.       COMPLEX*16         ZDUM
  44. *     ..
  45. *     .. Intrinsic Functions ..
  46.       INTRINSIC          ABS, DBLE
  47. *     ..
  48. *     .. Statement Functions ..
  49.       DOUBLE PRECISION   CABS1
  50. *     ..
  51. *     .. Statement Function definitions ..
  52. *
  53. *     NEXT LINE IS THE ONLY MODIFICATION.
  54.       CABS1( ZDUM ) = ABS( DBLE( ZDUM ) )
  55. *     ..
  56. *     .. Executable Statements ..
  57. *
  58.       IZMAX1 = 0
  59.       IF( N.LT.1 )
  60.      $   RETURN
  61.       IZMAX1 = 1
  62.       IF( N.EQ.1 )
  63.      $   RETURN
  64.       IF( INCX.EQ.1 )
  65.      $   GO TO 30
  66. *
  67. *     CODE FOR INCREMENT NOT EQUAL TO 1
  68. *
  69.       IX = 1
  70.       SMAX = CABS1( CX( 1 ) )
  71.       IX = IX + INCX
  72.       DO 20 I = 2, N
  73.          IF( CABS1( CX( IX ) ).LE.SMAX )
  74.      $      GO TO 10
  75.          IZMAX1 = I
  76.          SMAX = CABS1( CX( IX ) )
  77.    10    CONTINUE
  78.          IX = IX + INCX
  79.    20 CONTINUE
  80.       RETURN
  81. *
  82. *     CODE FOR INCREMENT EQUAL TO 1
  83. *
  84.    30 CONTINUE
  85.       SMAX = CABS1( CX( 1 ) )
  86.       DO 40 I = 2, N
  87.          IF( CABS1( CX( I ) ).LE.SMAX )
  88.      $      GO TO 40
  89.          IZMAX1 = I
  90.          SMAX = CABS1( CX( I ) )
  91.    40 CONTINUE
  92.       RETURN
  93. *
  94. *     End of IZMAX1
  95. *
  96.       END
  97.