Mercurial > octave-nkf

changeset 8030:c42ba026faf1

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[mq]: blas
author John W. Eaton <jwe@octave.org>
date Tue, 12 Aug 2008 11:02:35 -0400
parents 090001c04619
children d9987dbdf91b
files libcruft/ChangeLog libcruft/blas/Makefile.in libcruft/blas/icamax.f libcruft/blas/isamax.f libcruft/lapack/Makefile.in libcruft/lapack/icmax1.f
diffstat 6 files changed, 216 insertions(+), 6 deletions(-) [+]
line wrap: on
line diff
--- a/libcruft/ChangeLog	Tue Aug 12 10:54:31 2008 -0400
+++ b/libcruft/ChangeLog	Tue Aug 12 11:02:35 2008 -0400
@@ -1,3 +1,11 @@
+2008-08-12  Thomas Treichl  <Thomas.Treichl@gmx.net>
+
+	* blas/icamax.f, blas/isamax.f: New files.
+	* blas/Makefile.in (FSRC): Add them to the list.
+
+	* lapack/icmax1.f: New file.
+	* lapack/Makefile.in (FSRC): Add it to the list.
+	
 2008-06-16  David Bateman  <dbateman@free.fr>
 
 	* slatec-fn/xacosh.f, slatec-fn/xasinh.f: Replace xsacosh with
--- a/libcruft/blas/Makefile.in	Tue Aug 12 10:54:31 2008 -0400
+++ b/libcruft/blas/Makefile.in	Tue Aug 12 11:02:35 2008 -0400
@@ -29,11 +29,11 @@
 FSRC = dasum.f daxpy.f dcabs1.f dcopy.f ddot.f dgemm.f dgemv.f \
   dger.f dmach.f dnrm2.f drot.f dscal.f dswap.f dsymv.f dsyr.f \
   dsyr2.f dsyr2k.f dsyrk.f dtbsv.f dtrmm.f dtrmv.f dtrsm.f dtrsv.f \
-  dzasum.f dznrm2.f idamax.f izamax.f lsame.f sdot.f sgemm.f \
-  sgemv.f sscal.f ssyrk.f strsm.f zaxpy.f zcopy.f zdotc.f zdotu.f \
-  zdrot.f zdscal.f zgemm.f zgemv.f zgerc.f zgeru.f zhemv.f zher.f \
-  zher2.f zher2k.f zherk.f zscal.f zswap.f ztbsv.f ztrmm.f ztrmv.f \
-  ztrsm.f ztrsv.f sasum.f saxpy.f scabs1.f scopy.f \
+  dzasum.f dznrm2.f icamax.f idamax.f isamax.f izamax.f lsame.f sdot.f \
+  sgemm.f sgemv.f sscal.f ssyrk.f strsm.f zaxpy.f zcopy.f zdotc.f \
+  zdotu.f zdrot.f zdscal.f zgemm.f zgemv.f zgerc.f zgeru.f zhemv.f \
+  zher.f zher2.f zher2k.f zherk.f zscal.f zswap.f ztbsv.f ztrmm.f \
+  ztrmv.f ztrsm.f ztrsv.f sasum.f saxpy.f scabs1.f scopy.f \
   sger.f smach.f snrm2.f srot.f sswap.f ssymv.f ssyr.f \
   ssyr2.f ssyr2k.f stbsv.f strmm.f strmv.f strsv.f \
   scasum.f scnrm2.f caxpy.f ccopy.f cdotc.f cdotu.f \
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/libcruft/blas/icamax.f	Tue Aug 12 11:02:35 2008 -0400
@@ -0,0 +1,54 @@
+      INTEGER FUNCTION ICAMAX(N,CX,INCX)
+*     .. Scalar Arguments ..
+      INTEGER INCX,N
+*     ..
+*     .. Array Arguments ..
+      COMPLEX CX(*)
+*     ..
+*
+*  Purpose
+*  =======
+*
+*     finds the index of element having max. absolute value.
+*     jack dongarra, linpack, 3/11/78.
+*     modified 3/93 to return if incx .le. 0.
+*     modified 12/3/93, array(1) declarations changed to array(*)
+*
+*
+*     .. Local Scalars ..
+      REAL SMAX
+      INTEGER I,IX
+*     ..
+*     .. External Functions ..
+      REAL SCABS1
+      EXTERNAL SCABS1
+*     ..
+      ICAMAX = 0
+      IF (N.LT.1 .OR. INCX.LE.0) RETURN
+      ICAMAX = 1
+      IF (N.EQ.1) RETURN
+      IF (INCX.EQ.1) GO TO 20
+*
+*        code for increment not equal to 1
+*
+      IX = 1
+      SMAX = SCABS1(CX(1))
+      IX = IX + INCX
+      DO 10 I = 2,N
+          IF (SCABS1(CX(IX)).LE.SMAX) GO TO 5
+          ICAMAX = I
+          SMAX = SCABS1(CX(IX))
+    5     IX = IX + INCX
+   10 CONTINUE
+      RETURN
+*
+*        code for increment equal to 1
+*
+   20 SMAX = SCABS1(CX(1))
+      DO 30 I = 2,N
+          IF (SCABS1(CX(I)).LE.SMAX) GO TO 30
+          ICAMAX = I
+          SMAX = SCABS1(CX(I))
+   30 CONTINUE
+      RETURN
+      END
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/libcruft/blas/isamax.f	Tue Aug 12 11:02:35 2008 -0400
@@ -0,0 +1,53 @@
+      INTEGER FUNCTION ISAMAX(N,SX,INCX)
+*     .. Scalar Arguments ..
+      INTEGER INCX,N
+*     ..
+*     .. Array Arguments ..
+      REAL SX(*)
+*     ..
+*
+*  Purpose
+*  =======
+*
+*     finds the index of element having max. absolute value.
+*     jack dongarra, linpack, 3/11/78.
+*     modified 3/93 to return if incx .le. 0.
+*     modified 12/3/93, array(1) declarations changed to array(*)
+*
+*
+*     .. Local Scalars ..
+      REAL SMAX
+      INTEGER I,IX
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC ABS
+*     ..
+      ISAMAX = 0
+      IF (N.LT.1 .OR. INCX.LE.0) RETURN
+      ISAMAX = 1
+      IF (N.EQ.1) RETURN
+      IF (INCX.EQ.1) GO TO 20
+*
+*        code for increment not equal to 1
+*
+      IX = 1
+      SMAX = ABS(SX(1))
+      IX = IX + INCX
+      DO 10 I = 2,N
+          IF (ABS(SX(IX)).LE.SMAX) GO TO 5
+          ISAMAX = I
+          SMAX = ABS(SX(IX))
+    5     IX = IX + INCX
+   10 CONTINUE
+      RETURN
+*
+*        code for increment equal to 1
+*
+   20 SMAX = ABS(SX(1))
+      DO 30 I = 2,N
+          IF (ABS(SX(I)).LE.SMAX) GO TO 30
+          ISAMAX = I
+          SMAX = ABS(SX(I))
+   30 CONTINUE
+      RETURN
+      END
--- a/libcruft/lapack/Makefile.in	Tue Aug 12 10:54:31 2008 -0400
+++ b/libcruft/lapack/Makefile.in	Tue Aug 12 11:02:35 2008 -0400
@@ -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 icmax1.f ieeeck.f ilaenv.f iparmq.f izmax1.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 \
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/libcruft/lapack/icmax1.f	Tue Aug 12 11:02:35 2008 -0400
@@ -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