# HG changeset patch
# User Jaroslav Hajek
# Date 1207035380 -7200
# Node ID 5f23ff841403b1a3e5c395db9a223cfa2d1afa58
# Parent 6c0f7bcf5b557042f3c12750e36da120f0424135
implement BLAS-F77 call compatibility check
diff --git a/ChangeLog b/ChangeLog
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2008-04-01 Jaroslav Hajek
+
+ * acx_blas_f77_func.m4: new source
+ * configure.in: call ACX_BLAS_WITH_F77_FUNC instead of ACX_BLAS.
+ Supply a warning for incompatible Fortran/BLAS configuration.
+
2008-03-25 Jaroslav Hajek
* configure.in: Check for expm1 and log1p functions.
diff --git a/acx_blas_f77_func.m4 b/acx_blas_f77_func.m4
new file mode 100644
--- /dev/null
+++ b/acx_blas_f77_func.m4
@@ -0,0 +1,151 @@
+##### http://autoconf-archive.cryp.to/acx_blas_f77_func.html
+#
+# SYNOPSIS
+#
+# ACX_BLAS_F77_FUNC([ACTION-IF-PASS[, ACTION-IF-FAIL[, ACTION-IF-CROSS-COMPILING]])
+# ACX_BLAS_WITH_F77_FUNC([ACTION-IF-FOUND-AND-PASS[, ACTION-IF-NOT-FOUND-OR-FAIL]])
+#
+# DESCRIPTION
+#
+# These macros are intended as a supplement to the ACX_BLAS macro, to
+# verify that BLAS functions with non-REAL or INTEGER are properly
+# callable from Fortran. This is necessary, for example, if you want
+# to build the LAPACK library on top of the BLAS.
+#
+# ACX_BLAS_F77_FUNC uses the defined BLAS_LIBS and Fortran
+# environment to check for compatibility, and takes a specific action
+# in case of success, resp. failure, resp. cross-compilation.
+#
+# ACX_BLAS_WITH_F77_FUNC is a drop-in replacement wrapper for
+# ACX_BLAS that calls ACX_BLAS_F77_FUNC after detecting a BLAS
+# library and rejects it on failure (i.e. pretends that no library
+# was found).
+#
+# LAST MODIFICATION
+#
+# 2008-03-31
+#
+# COPYLEFT
+#
+# Copyright (c) 2008 Jaroslav Hajek
+#
+# This program is free software: you can redistribute it and/or
+# modify it under the terms of the GNU General Public License as
+# published by the Free Software Foundation, either version 3 of the
+# License, or (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+# General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program. If not, see
+# .
+#
+# As a special exception, the respective Autoconf Macro's copyright
+# owner gives unlimited permission to copy, distribute and modify the
+# configure scripts that are the output of Autoconf when processing
+# the Macro. You need not follow the terms of the GNU General Public
+# License when using or distributing such scripts, even though
+# portions of the text of the Macro appear in them. The GNU General
+# Public License (GPL) does govern all other use of the material that
+# constitutes the Autoconf Macro.
+#
+# This special exception to the GPL applies to versions of the
+# Autoconf Macro released by the Autoconf Macro Archive. When you
+# make and distribute a modified version of the Autoconf Macro, you
+# may extend this special exception to the GPL to apply to your
+# modified version as well.
+
+AC_DEFUN([ACX_BLAS_F77_FUNC], [
+AC_PREREQ(2.50)
+AC_REQUIRE([ACX_BLAS])
+
+# F77 call-compatibility checks
+if test "$cross_compiling" = yes ; then
+ ifelse($3, ,$1,$3)
+elif test x"$acx_blas_ok" = xyes; then
+ LIBS="$BLAS_LIBS $LIBS"
+ AC_LANG_PUSH(Fortran 77)
+# LSAME check (LOGICAL return values)
+ AC_MSG_CHECKING([whether LSAME is called correctly from Fortran])
+ AC_RUN_IFELSE(AC_LANG_PROGRAM(,[[
+ logical lsame,w
+ external lsame
+ character c1,c2
+ c1 = 'A'
+ c2 = 'B'
+ w = lsame(c1,c2)
+ if (w) stop 1
+ w = lsame(c1,c1)
+ if (.not. w) stop 1
+ ]]),[acx_blas_lsame_fcall_ok=yes],
+ [acx_blas_lsame_fcall_ok=no])
+ AC_MSG_RESULT([$acx_blas_lsame_fcall_ok])
+# DDOT check (DOUBLE return values)
+ AC_MSG_CHECKING([whether DDOT is called correctly from Fortran])
+ AC_RUN_IFELSE(AC_LANG_PROGRAM(,[[
+ double precision ddot,a(1),b(1),w
+ external ddot
+ a(1) = 1e0
+ b(1) = 2e0
+ w = ddot(1,a,1,b,1)
+ if (w .ne. a(1)*b(1)) stop 1
+ ]]),[acx_blas_ddot_fcall_ok=yes],
+ [acx_blas_ddot_fcall_ok=no])
+ AC_MSG_RESULT([$acx_blas_ddot_fcall_ok])
+# CDOTU check (COMPLEX return values)
+ AC_MSG_CHECKING([whether CDOTU is called correctly from Fortran])
+ AC_RUN_IFELSE(AC_LANG_PROGRAM(,[[
+ complex cdotu,a(1),b(1),w
+ external cdotu
+ a(1) = cmplx(1e0,1e0)
+ b(1) = cmplx(1e0,2e0)
+ w = cdotu(1,a,1,b,1)
+ if (w .ne. a(1)*b(1)) stop 1
+ ]]),[acx_blas_cdotu_fcall_ok=yes],
+ [acx_blas_cdotu_fcall_ok=no])
+ AC_MSG_RESULT([$acx_blas_cdotu_fcall_ok])
+# ZDOTU check (DOUBLE COMPLEX return values)
+ AC_MSG_CHECKING([whether ZDOTU is called correctly from Fortran])
+ AC_RUN_IFELSE(AC_LANG_PROGRAM(,[[
+ double complex zdotu,a(1),b(1),w
+ external zdotu
+ a(1) = dcmplx(1d0,1d0)
+ b(1) = dcmplx(1d0,2d0)
+ w = zdotu(1,a,1,b,1)
+ if (w .ne. a(1)*b(1)) stop 1
+ ]]),[acx_blas_zdotu_fcall_ok=yes],
+ [acx_blas_zdotu_fcall_ok=no])
+ AC_MSG_RESULT([$acx_blas_zdotu_fcall_ok])
+
+ AC_LANG_POP(Fortran 77)
+
+# if any of the tests failed, reject the BLAS library
+ if test $acx_blas_lsame_fcall_ok = yes \
+ -a $acx_blas_ddot_fcall_ok = yes \
+ -a $acx_blas_cdotu_fcall_ok = yes \
+ -a $acx_blas_zdotu_fcall_ok = yes ; then
+ acx_blas_f77_func_ok=yes;
+ $1
+ else
+ acx_blas_f77_func_ok=no;
+ $2
+ fi
+fi
+
+])dnl ACX_BLAS_F77_FUNC
+
+AC_DEFUN([ACX_BLAS_WITH_F77_FUNC], [
+AC_PREREQ(2.50)
+ACX_BLAS([# disable special action], [])
+if test x$acx_blas_ok = xyes ; then
+ ACX_BLAS_F77_FUNC(
+ [ifelse([$1],,AC_DEFINE(HAVE_BLAS,1,[Define if you have a BLAS library.]),[$1])],
+ [acx_blas_ok=no; BLAS_LIBS=])
+fi
+if test x$acx_blas_ok = xno ; then
+ $2
+fi
+])dnl ACX_BLAS_WITH_F77_FUNC
diff --git a/configure.in b/configure.in
--- a/configure.in
+++ b/configure.in
@@ -723,13 +723,21 @@
### Checks for BLAS and LAPACK libraries:
# (Build subdirectories of libcruft if they aren't found on the system.)
-
sinclude(acx_blas.m4)
+sinclude(acx_blas_f77_func.m4)
sinclude(acx_lapack.m4)
-ACX_BLAS([], [BLAS_DIR="blas"])
+ACX_BLAS_WITH_F77_FUNC([], [BLAS_DIR="blas"])
ACX_LAPACK([BLAS_LIBS="$LAPACK_LIBS $BLAS_LIBS"], [LAPACK_DIR="lapack"])
AC_SUBST(BLAS_DIR)
AC_SUBST(LAPACK_DIR)
+
+if test x$acx_blas_f77_func_ok = xno ; then
+ warn_blas_f77_incompatible=\
+"BLAS library was detected but found incompatible with your Fortran 77 compiler. \
+The default (slow) BLAS implementation will be used. Consider using a switch \
+like -ff2c to make your Fortran compiler use a compatible calling convention, \
+or supplying a different BLAS library."
+fi
# Check for AMD library
AMD_LIBS=
@@ -1963,6 +1971,11 @@
warn_msg_printed=true
fi
+if test -n "$warn_blas_f77_incompatible"; then
+ AC_MSG_WARN($warn_blas_f77_incompatible)
+ warn_msg_printed=true
+fi
+
if test -n "$warn_umfpack"; then
AC_MSG_WARN($warn_umfpack)
warn_msg_printed=true
diff --git a/libcruft/ChangeLog b/libcruft/ChangeLog
--- a/libcruft/ChangeLog
+++ b/libcruft/ChangeLog
@@ -1,3 +1,9 @@
+2008-04-01 Jaroslav Hajek
+
+ * blas-xtra/xzdotu.f: Turn into simple wrapper for zdotu.
+ * blas-xtra/xzdotc.f: Turn into simple wrapper for zdotc.
+ * qrupdate/zqrqhv.f: Revert to revision a89b3fa632ee.
+
2008-03-22 David Bateman
* qrupdate/dch1up.f: Remove unused external reference to dlartv.
diff --git a/libcruft/blas-xtra/xzdotc.f b/libcruft/blas-xtra/xzdotc.f
--- a/libcruft/blas-xtra/xzdotc.f
+++ b/libcruft/blas-xtra/xzdotc.f
@@ -1,46 +1,7 @@
-*** This subroutine includes all of the ZDOTC 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 ZDOTC is compiled with a
-*** compiler that uses the g77 (f2c-compatible) calling convention for
-*** complex-valued functions, all hell will break loose.
-
- subroutine xzdotc(n,zx,incx,zy,incy,ztemp)
-
-*** double complex function zdotc(n,zx,incx,zy,incy)
-c
-c forms the dot product of a vector.
-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)
-*** zdotc = (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 + dconjg(zx(ix))*zy(iy)
- ix = ix + incx
- iy = iy + incy
- 10 continue
-*** zdotc = ztemp
- return
-c
-c code for both increments equal to 1
-c
- 20 do 30 i = 1,n
- ztemp = ztemp + dconjg(zx(i))*zy(i)
- 30 continue
-**** zdotc = ztemp
+ subroutine xzdotc(n,zx,incx,zy,incy,retval)
+ double complex zdotc, zx(*), zy(*), retval
+ integer n, incx, incy
+ external zdotc
+ retval = zdotc (n, dx, incx, dy, incy)
return
end
diff --git a/libcruft/blas-xtra/xzdotu.f b/libcruft/blas-xtra/xzdotu.f
--- a/libcruft/blas-xtra/xzdotu.f
+++ b/libcruft/blas-xtra/xzdotu.f
@@ -1,46 +1,7 @@
-*** 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
+ subroutine xzdotu(n,zx,incx,zy,incy,retval)
+ double complex zdotu, zx(*), zy(*), retval
+ integer n, incx, incy
+ external zdotu
+ retval = zdotu (n, dx, incx, dy, incy)
return
end
diff --git a/libcruft/qrupdate/zqrqhv.f b/libcruft/qrupdate/zqrqhv.f
--- a/libcruft/qrupdate/zqrqhv.f
+++ b/libcruft/qrupdate/zqrqhv.f
@@ -41,7 +41,7 @@
integer m,n,k,ldq,ldr
double complex Q(ldq,*),R(ldr,*),u(*),rr
double precision c
- double complex s,w,w1
+ double complex s,w,w1,zdotc
external zdotc,zlartg,zrot
integer i,info
c quick return if possible.
@@ -59,10 +59,10 @@
call xerbla('ZQRQHV',info)
end if
c form each element of w = Q'*u when necessary.
- call xzdotc(m,Q(1,k),1,u,1,rr)
+ rr = zdotc(m,Q(1,k),1,u,1)
do i = k-1,1,-1
w1 = rr
- call xzdotc(m,Q(1,i),1,u,1,w)
+ w = zdotc(m,Q(1,i),1,u,1)
call zlartg(w,w1,c,s,rr)
c apply rotation to rows of R if necessary
if (i <= n) then