# 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