# HG changeset patch
# User Jaroslav Hajek <address@hidden>
# Date 1211862375 -7200
# Node ID de558a3a7345c178ad1d7e942014a25beff47f00
# Parent  edc25a3fb2bce80302402d876e660de57e332c43
add icmax1 to libcruft/lapack

diff --git a/libcruft/ChangeLog b/libcruft/ChangeLog
--- a/libcruft/ChangeLog
+++ b/libcruft/ChangeLog
@@ -1,3 +1,8 @@
+2008-05-27  Jaroslav Hajek <address@hidden>
+
+	* lapack/icmax1.f: New file.
+	* lapack/Makefile.in: Add it.
+
 2008-05-21  David Bateman  <address@hidden>
 
 	* odepack/slsode.f, odepack/sintdy.f: Replace the use of xerrwv
diff --git a/libcruft/lapack/Makefile.in b/libcruft/lapack/Makefile.in
--- a/libcruft/lapack/Makefile.in
+++ b/libcruft/lapack/Makefile.in
@@ -68,7 +68,7 @@
   dpotri.f dpotrs.f dptsv.f dpttrf.f dpttrs.f dptts2.f drscl.f \
   dsteqr.f dsterf.f dsyev.f dsytd2.f dsytrd.f dtgevc.f dtrcon.f \
   dtrevc.f dtrexc.f dtrsen.f dtrsyl.f dtrti2.f dtrtri.f dtrtrs.f \
-  dtzrzf.f dzsum1.f ieeeck.f ilaenv.f iparmq.f izmax1.f \
+  dtzrzf.f dzsum1.f ieeeck.f ilaenv.f iparmq.f izmax1.f icmax1.f \
   sbdsqr.f sgbcon.f sgbtf2.f sgbtrf.f sgbtrs.f sgebak.f sgebal.f \
   sgebd2.f sgebrd.f sgecon.f sgeesx.f sgeev.f sgehd2.f sgehrd.f \
   sgelq2.f sgelqf.f sgelsd.f sgelss.f sgelsy.f sgeqp3.f sgeqpf.f \
diff --git a/libcruft/lapack/icmax1.f b/libcruft/lapack/icmax1.f
new file mode 100644
--- /dev/null
+++ b/libcruft/lapack/icmax1.f
@@ -0,0 +1,95 @@
+      INTEGER          FUNCTION ICMAX1( N, CX, INCX )
+*
+*  -- LAPACK auxiliary routine (version 3.1) --
+*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
+*     November 2006
+*
+*     .. Scalar Arguments ..
+      INTEGER            INCX, N
+*     ..
+*     .. Array Arguments ..
+      COMPLEX            CX( * )
+*     ..
+*
+*  Purpose
+*  =======
+*
+*  ICMAX1 finds the index of the element whose real part has maximum
+*  absolute value.
+*
+*  Based on ICAMAX from Level 1 BLAS.
+*  The change is to use the 'genuine' absolute value.
+*
+*  Contributed by Nick Higham for use with CLACON.
+*
+*  Arguments
+*  =========
+*
+*  N       (input) INTEGER
+*          The number of elements in the vector CX.
+*
+*  CX      (input) COMPLEX array, dimension (N)
+*          The vector whose elements will be summed.
+*
+*  INCX    (input) INTEGER
+*          The spacing between successive values of CX.  INCX >= 1.
+*
+* =====================================================================
+*
+*     .. Local Scalars ..
+      INTEGER            I, IX
+      REAL               SMAX
+      COMPLEX            ZDUM
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS
+*     ..
+*     .. Statement Functions ..
+      REAL               CABS1
+*     ..
+*     .. Statement Function definitions ..
+*
+*     NEXT LINE IS THE ONLY MODIFICATION.
+      CABS1( ZDUM ) = ABS( ZDUM )
+*     ..
+*     .. Executable Statements ..
+*
+      ICMAX1 = 0
+      IF( N.LT.1 )
+     $   RETURN
+      ICMAX1 = 1
+      IF( N.EQ.1 )
+     $   RETURN
+      IF( INCX.EQ.1 )
+     $   GO TO 30
+*
+*     CODE FOR INCREMENT NOT EQUAL TO 1
+*
+      IX = 1
+      SMAX = CABS1( CX( 1 ) )
+      IX = IX + INCX
+      DO 20 I = 2, N
+         IF( CABS1( CX( IX ) ).LE.SMAX )
+     $      GO TO 10
+         ICMAX1 = I
+         SMAX = CABS1( CX( IX ) )
+   10    CONTINUE
+         IX = IX + INCX
+   20 CONTINUE
+      RETURN
+*
+*     CODE FOR INCREMENT EQUAL TO 1
+*
+   30 CONTINUE
+      SMAX = CABS1( CX( 1 ) )
+      DO 40 I = 2, N
+         IF( CABS1( CX( I ) ).LE.SMAX )
+     $      GO TO 40
+         ICMAX1 = I
+         SMAX = CABS1( CX( I ) )
+   40 CONTINUE
+      RETURN
+*
+*     End of ICMAX1
+*
+      END