d5/ddc/icmax1_8f_source.html

00001       INTEGER          FUNCTION ICMAX1( N, CX, INCX )
00002 *
00003 *  -- LAPACK auxiliary routine (version 3.2) --
00004 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00005 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00006 *     November 2006
00007 *
00008 *     .. Scalar Arguments ..
00009       INTEGER            INCX, N
00010 *     ..
00011 *     .. Array Arguments ..
00012       COMPLEX            CX( * )
00013 *     ..
00014 *
00015 *  Purpose
00016 *  =======
00017 *
00018 *  ICMAX1 finds the index of the element whose real part has maximum
00019 *  absolute value.
00020 *
00021 *  Based on ICAMAX from Level 1 BLAS.
00022 *  The change is to use the 'genuine' absolute value.
00023 *
00024 *  Contributed by Nick Higham for use with CLACON.
00025 *
00026 *  Arguments
00027 *  =========
00028 *
00029 *  N       (input) INTEGER
00030 *          The number of elements in the vector CX.
00031 *
00032 *  CX      (input) COMPLEX array, dimension (N)
00033 *          The vector whose elements will be summed.
00034 *
00035 *  INCX    (input) INTEGER
00036 *          The spacing between successive values of CX.  INCX >= 1.
00037 *
00038 * =====================================================================
00039 *
00040 *     .. Local Scalars ..
00041       INTEGER            I, IX
00042       REAL               SMAX
00043       COMPLEX            ZDUM
00044 *     ..
00045 *     .. Intrinsic Functions ..
00046       INTRINSIC          ABS
00047 *     ..
00048 *     .. Statement Functions ..
00049       REAL               CABS1
00050 *     ..
00051 *     .. Statement Function definitions ..
00052 *
00053 *     NEXT LINE IS THE ONLY MODIFICATION.
00054       CABS1( ZDUM ) = ABS( ZDUM )
00055 *     ..
00056 *     .. Executable Statements ..
00057 *
00058       ICMAX1 = 0
00059       IF( N.LT.1 )
00060      $   RETURN
00061       ICMAX1 = 1
00062       IF( N.EQ.1 )
00063      $   RETURN
00064       IF( INCX.EQ.1 )
00065      $   GO TO 30
00066 *
00067 *     CODE FOR INCREMENT NOT EQUAL TO 1
00068 *
00069       IX = 1
00070       SMAX = CABS1( CX( 1 ) )
00071       IX = IX + INCX
00072       DO 20 I = 2, N
00073          IF( CABS1( CX( IX ) ).LE.SMAX )
00074      $      GO TO 10
00075          ICMAX1 = I
00076          SMAX = CABS1( CX( IX ) )
00077    10    CONTINUE
00078          IX = IX + INCX
00079    20 CONTINUE
00080       RETURN
00081 *
00082 *     CODE FOR INCREMENT EQUAL TO 1
00083 *
00084    30 CONTINUE
00085       SMAX = CABS1( CX( 1 ) )
00086       DO 40 I = 2, N
00087          IF( CABS1( CX( I ) ).LE.SMAX )
00088      $      GO TO 40
00089          ICMAX1 = I
00090          SMAX = CABS1( CX( I ) )
00091    40 CONTINUE
00092       RETURN
00093 *
00094 *     End of ICMAX1
00095 *
00096       END