Mercurial > octave-nkf

changeset 7095:efd16513ff8f

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[project @ 2007-11-01 17:37:21 by jwe]
author jwe
date Thu, 01 Nov 2007 17:37:21 +0000
parents dbf9b76b0fe9
children 81bed50b9feb
files ChangeLog configure.in libcruft/ChangeLog libcruft/blas-xtra/xzdotu.f libcruft/lapack-xtra/xzlange.f
diffstat 5 files changed, 213 insertions(+), 56 deletions(-) [+]
line wrap: on
line diff
--- a/ChangeLog	Thu Nov 01 02:17:32 2007 +0000
+++ b/ChangeLog	Thu Nov 01 17:37:21 2007 +0000
@@ -1,3 +1,8 @@
+2007-11-01  John W. Eaton  <jwe@octave.org>
+
+	* configure.in: Delete BLAS library calling convention
+	compatibility check.
+
 2007-10-31  John W. Eaton  <jwe@octave.org>
 
 	* README.binary-dist: Delete.
--- a/configure.in	Thu Nov 01 02:17:32 2007 +0000
+++ b/configure.in	Thu Nov 01 17:37:21 2007 +0000
@@ -29,7 +29,7 @@
 EXTERN_CXXFLAGS="$CXXFLAGS"
 
 AC_INIT
-AC_REVISION($Revision: 1.589 $)
+AC_REVISION($Revision: 1.590 $)
 AC_PREREQ(2.57)
 AC_CONFIG_SRCDIR([src/octave.cc])
 AC_CONFIG_HEADER(config.h)
@@ -731,49 +731,6 @@
 AC_SUBST(BLAS_DIR)
 AC_SUBST(LAPACK_DIR)
 
-dnl I see no clean way to do the following check with autoconf macros,
-dnl hence the big mess.
-
-AC_MSG_CHECKING([BLAS library calling convention compatibility])
-cat << EOF > conftest.f
-      program foo
-      double complex zdotu, zx(10), zy(10), retval
-      integer n, incx, incy
-      n = 10
-      incx = 1
-      incy = 1
-      do 10 i = 1, n
-        zx(i) = dcmplx (i, 0)
-        zy(i) = dcmplx (0, i)
-   10 continue
-      retval = zdotu (n, zx, incx, zy, incy)
-      if (retval .eq. dcmplx (0, 385)) then
-        print *, 'succeeded'
-      else
-        print *, 'failed'
-        print *, retval
-      endif
-      end
-EOF
-XLIBS="$LIBS"
-LIBS="$BLAS_LIBS $FLIBS $LIBS"
-AC_LANG_PUSH(Fortran 77)
-(eval "$ac_compile"; eval "$ac_link") 2>&AS_MESSAGE_LOG_FD
-AC_LANG_POP(Fortran 77)
-LIBS="$XLIBS"
-case "`./conftest$ac_exeext`" in
-  *succeeded*)
-  AC_MSG_RESULT(yes)
-;;
-  *)
-  AC_MSG_RESULT(no)
-  AC_MSG_WARN([Your BLAS library was apparently compiled with a Fortran])
-  AC_MSG_WARN([compiler that uses a different calling convention from])
-  AC_MSG_WARN([the one used by the selected compiler, $F77.])
-  AC_MSG_ERROR([You must correct this problem before building Octave.])
-;;
-esac
-
 # Check for AMD library
 AMD_LIBS=
 AC_SUBST(AMD_LIBS)
--- a/libcruft/ChangeLog	Thu Nov 01 02:17:32 2007 +0000
+++ b/libcruft/ChangeLog	Thu Nov 01 17:37:21 2007 +0000
@@ -1,3 +1,11 @@
+2007-11-01  John W. Eaton  <jwe@octave.org>
+
+	* lapack-xtra/xzlange.f: Include complete implementation of ZLANGE
+	function here.
+
+	* blas-xtra/xzdotu.f: Include complete implementation of ZDOTU
+	function here.
+
 2007-10-26  John W. Eaton  <jwe@octave.org>
 
 	* lapack/dlals0.f: New file.
--- a/libcruft/blas-xtra/xzdotu.f	Thu Nov 01 02:17:32 2007 +0000
+++ b/libcruft/blas-xtra/xzdotu.f	Thu Nov 01 17:37:21 2007 +0000
@@ -1,6 +1,46 @@
-      subroutine xzdotu (n, zx, incx, zy, incy, retval)
-      double complex zdotu, zx(*), zy(*), retval
-      integer n, incx, incy
-      retval = zdotu (n, zx, incx, zy, incy)
+*** This subroutine includes all of the ZDOTU function instead of simply
+*** wrapping it in a subroutine to avoid possible differences in the way
+*** complex values are returned by various Fortran compilers.  For
+*** example, if we simply wrap the function and compile this file with
+*** gfortran and the library that provides ZDOTU is compiled with a
+*** compiler that uses the g77 (f2c-compatible) calling convention for
+*** complex-valued functions, all hell will break loose.
+
+      subroutine xzdotu(n,zx,incx,zy,incy,ztemp)
+
+***   double complex function zdotu(n,zx,incx,zy,incy)
+c
+c     forms the dot product of two vectors.
+c     jack dongarra, 3/11/78.
+c     modified 12/3/93, array(1) declarations changed to array(*)
+c
+      double complex zx(*),zy(*),ztemp
+      integer i,incx,incy,ix,iy,n
+      ztemp = (0.0d0,0.0d0)
+      zdotu = (0.0d0,0.0d0)
+      if(n.le.0)return
+      if(incx.eq.1.and.incy.eq.1)go to 20
+c
+c        code for unequal increments or equal increments
+c          not equal to 1
+c
+      ix = 1
+      iy = 1
+      if(incx.lt.0)ix = (-n+1)*incx + 1
+      if(incy.lt.0)iy = (-n+1)*incy + 1
+      do 10 i = 1,n
+        ztemp = ztemp + zx(ix)*zy(iy)
+        ix = ix + incx
+        iy = iy + incy
+   10 continue
+      zdotu = ztemp
+      return
+c
+c        code for both increments equal to 1
+c
+   20 do 30 i = 1,n
+        ztemp = ztemp + zx(i)*zy(i)
+   30 continue
+***   zdotu = ztemp
       return
       end
--- a/libcruft/lapack-xtra/xzlange.f	Thu Nov 01 02:17:32 2007 +0000
+++ b/libcruft/lapack-xtra/xzlange.f	Thu Nov 01 17:37:21 2007 +0000
@@ -1,8 +1,155 @@
-      subroutine xzlange (norm, m, n, a, lda, work, retval)
-      character norm
-      integer lda, m, n
-      double precision work (*), zlange, retval
-      complex*16 a (lda, *)
-      retval = zlange (norm, m, n, a, lda, work)
-      return
-      end
+*** This subroutine includes all of the ZLANGE function instead of
+*** simply wrapping it in a subroutine to avoid possible differences in
+*** the way complex values are returned by various Fortran compilers.
+*** For example, if we simply wrap the function and compile this file
+*** with gfortran and the library that provides ZLANGE is compiled with
+*** a compiler that uses the g77 (f2c-compatible) calling convention for
+*** complex-valued functions, all hell will break loose.
+
+      SUBROUTINE XZLANGE ( NORM, M, N, A, LDA, WORK, VALUE )
+
+***   DOUBLE PRECISION FUNCTION ZLANGE( NORM, M, N, A, LDA, WORK )
+*
+*  -- LAPACK auxiliary routine (version 3.1) --
+*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
+*     November 2006
+*
+*     .. Scalar Arguments ..
+      CHARACTER          NORM
+      INTEGER            LDA, M, N
+*     ..
+*     .. Array Arguments ..
+      DOUBLE PRECISION   WORK( * )
+      COMPLEX*16         A( LDA, * )
+*     ..
+*
+*  Purpose
+*  =======
+*
+*  ZLANGE  returns the value of the one norm,  or the Frobenius norm, or
+*  the  infinity norm,  or the  element of  largest absolute value  of a
+*  complex matrix A.
+*
+*  Description
+*  ===========
+*
+*  ZLANGE returns the value
+*
+*     ZLANGE = ( max(abs(A(i,j))), NORM = 'M' or 'm'
+*              (
+*              ( norm1(A),         NORM = '1', 'O' or 'o'
+*              (
+*              ( normI(A),         NORM = 'I' or 'i'
+*              (
+*              ( normF(A),         NORM = 'F', 'f', 'E' or 'e'
+*
+*  where  norm1  denotes the  one norm of a matrix (maximum column sum),
+*  normI  denotes the  infinity norm  of a matrix  (maximum row sum) and
+*  normF  denotes the  Frobenius norm of a matrix (square root of sum of
+*  squares).  Note that  max(abs(A(i,j)))  is not a consistent matrix norm.
+*
+*  Arguments
+*  =========
+*
+*  NORM    (input) CHARACTER*1
+*          Specifies the value to be returned in ZLANGE as described
+*          above.
+*
+*  M       (input) INTEGER
+*          The number of rows of the matrix A.  M >= 0.  When M = 0,
+*          ZLANGE is set to zero.
+*
+*  N       (input) INTEGER
+*          The number of columns of the matrix A.  N >= 0.  When N = 0,
+*          ZLANGE is set to zero.
+*
+*  A       (input) COMPLEX*16 array, dimension (LDA,N)
+*          The m by n matrix A.
+*
+*  LDA     (input) INTEGER
+*          The leading dimension of the array A.  LDA >= max(M,1).
+*
+*  WORK    (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK)),
+*          where LWORK >= M when NORM = 'I'; otherwise, WORK is not
+*          referenced.
+*
+* =====================================================================
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ONE, ZERO
+      PARAMETER          ( ONE = 1.0D+0, ZERO = 0.0D+0 )
+*     ..
+*     .. Local Scalars ..
+      INTEGER            I, J
+      DOUBLE PRECISION   SCALE, SUM, VALUE
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           ZLASSQ
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, MAX, MIN, SQRT
+*     ..
+*     .. Executable Statements ..
+*
+      IF( MIN( M, N ).EQ.0 ) THEN
+         VALUE = ZERO
+      ELSE IF( LSAME( NORM, 'M' ) ) THEN
+*
+*        Find max(abs(A(i,j))).
+*
+         VALUE = ZERO
+         DO 20 J = 1, N
+            DO 10 I = 1, M
+               VALUE = MAX( VALUE, ABS( A( I, J ) ) )
+   10       CONTINUE
+   20    CONTINUE
+      ELSE IF( ( LSAME( NORM, 'O' ) ) .OR. ( NORM.EQ.'1' ) ) THEN
+*
+*        Find norm1(A).
+*
+         VALUE = ZERO
+         DO 40 J = 1, N
+            SUM = ZERO
+            DO 30 I = 1, M
+               SUM = SUM + ABS( A( I, J ) )
+   30       CONTINUE
+            VALUE = MAX( VALUE, SUM )
+   40    CONTINUE
+      ELSE IF( LSAME( NORM, 'I' ) ) THEN
+*
+*        Find normI(A).
+*
+         DO 50 I = 1, M
+            WORK( I ) = ZERO
+   50    CONTINUE
+         DO 70 J = 1, N
+            DO 60 I = 1, M
+               WORK( I ) = WORK( I ) + ABS( A( I, J ) )
+   60       CONTINUE
+   70    CONTINUE
+         VALUE = ZERO
+         DO 80 I = 1, M
+            VALUE = MAX( VALUE, WORK( I ) )
+   80    CONTINUE
+      ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
+*
+*        Find normF(A).
+*
+         SCALE = ZERO
+         SUM = ONE
+         DO 90 J = 1, N
+            CALL ZLASSQ( M, A( 1, J ), 1, SCALE, SUM )
+   90    CONTINUE
+         VALUE = SCALE*SQRT( SUM )
+      END IF
+*
+***   ZLANGE = VALUE
+      RETURN
+*
+*     End of ZLANGE
+*
+      END