Mercurial > hg > octave-terminal
changeset 8030:c42ba026faf1
[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 +++ b/libcruft/ChangeLog @@ -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 +++ b/libcruft/blas/Makefile.in @@ -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 \
new file mode 100644 --- /dev/null +++ b/libcruft/blas/icamax.f @@ -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
new file mode 100644 --- /dev/null +++ b/libcruft/blas/isamax.f @@ -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 +++ 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 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 \
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