# HG changeset patch # User Jaroslav Hajek # Date 1205921400 -3600 # Node ID 697172110a327519a2ba4dcb362a491bafb824e1 # Parent 8a939b21786329cab992c0e1136a4c7e90d0128a test BLAS ZDOTC/ZDOTU calling convention compatibility diff -r 8a939b217863 -r 697172110a32 ChangeLog --- a/ChangeLog Tue Mar 18 21:32:48 2008 -0400 +++ b/ChangeLog Wed Mar 19 11:10:00 2008 +0100 @@ -1,3 +1,9 @@ 2008-03-18 David Bateman + + * acx_blas.m4: check BLAS library for compatible ZDOTU/ZDOTC calling + convention. (revert to default BLAS if negative) + * configure.in: warn if incompatible calling convention found. + 2008-03-18 David Bateman * configure.in (AC_CHECK_FUNCS): Also check lgamma_r. diff -r 8a939b217863 -r 697172110a32 acx_blas.m4 --- a/acx_blas.m4 Tue Mar 18 21:32:48 2008 -0400 +++ b/acx_blas.m4 Wed Mar 19 11:10:00 2008 +0100 @@ -154,9 +154,34 @@ if test $acx_blas_ok = no; then AC_CHECK_LIB(blas, $sgemm, [acx_blas_ok=yes; BLAS_LIBS="-lblas"]) fi -AC_SUBST(BLAS_LIBS) + +# test whether zdotc/zdotu are called correctly +if test x"$acx_blas_ok" = xyes; then + LIBS="$LIBS $BLAS_LIBS" + echo -n "checking for compatible BLAS ZDOTC/ZDOTU calling convention..." + AC_LANG_PUSH(Fortran 77) + AC_RUN_IFELSE(AC_LANG_PROGRAM(,[[ + double complex zdotc,zdotu,a(1),b(1),w + a = dcmplx(1,1) + b = dcmplx(1,2) + w = zdotu(1,a,1,b,1) + if (w .ne. a(1)*b(1)) stop 1 + w = zdotc(1,a,1,b,1) + if (w .ne. conjg(a(1))*b(1)) stop 1 + ]]),[acx_blas_zdot_compatible=yes], + [acx_blas_zdot_compatible=no]) + AC_LANG_POP(Fortran 77) + echo $acx_blas_zdot_compatible + if test x"$acx_blas_zdot_compatible" = xno; then + warn_blas_incompatible=yes + acx_blas_ok=no + BLAS_LIBS= + fi +fi LIBS="$acx_blas_save_LIBS" + +AC_SUBST(BLAS_LIBS) # Finally, execute ACTION-IF-FOUND/ACTION-IF-NOT-FOUND: if test x"$acx_blas_ok" = xyes; then diff -r 8a939b217863 -r 697172110a32 configure.in --- a/configure.in Tue Mar 18 21:32:48 2008 -0400 +++ b/configure.in Wed Mar 19 11:10:00 2008 +0100 @@ -1898,6 +1898,12 @@ if $ENABLE_DYNAMIC_LINKING; then fi fi +if test -n "$warn_blas_incompatible"; then + AC_MSG_WARN([BLAS library found, but seems incompatible with the Fortran compiler. +The default BLAS will be used. Try adding -ff2c to FFLAGS as a workaround.]) + warn_msg_printed=true +fi + if test -n "$gxx_only"; then AC_MSG_WARN($gxx_only) warn_msg_printed=true diff -r 8a939b217863 -r 697172110a32 libcruft/ChangeLog --- a/libcruft/ChangeLog Tue Mar 18 21:32:48 2008 -0400 +++ b/libcruft/ChangeLog Wed Mar 19 11:10:00 2008 +0100 @@ -1,3 +1,9 @@ 2008-03-18 John W. Eaton + + * qrupdate/zqrqhv.f: revert to revision a89b3fa632ee. + * blas-xtra/xzdotu.f: simplify to wrap a call to zdotu. + * blas-xtra/xzdotc.f: simplify to wrap a call to zdotc. + 2008-03-18 John W. Eaton * qrupdate/zqrqhv.f (zqrqhv): Call xzdotc instead of zdotc. diff -r 8a939b217863 -r 697172110a32 libcruft/blas-xtra/xzdotc.f --- a/libcruft/blas-xtra/xzdotc.f Tue Mar 18 21:32:48 2008 -0400 +++ b/libcruft/blas-xtra/xzdotc.f Wed Mar 19 11:10:00 2008 +0100 @@ -1,46 +1,8 @@ -*** 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) + integer n,incx,incy + double complex zx(*),zy(*),ztemp,zdotc + external zdotc - subroutine xzdotc(n,zx,incx,zy,incy,ztemp) + ztemp = zdotc(n,zx,incx,zy,incy) -*** 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 - return end diff -r 8a939b217863 -r 697172110a32 libcruft/blas-xtra/xzdotu.f --- a/libcruft/blas-xtra/xzdotu.f Tue Mar 18 21:32:48 2008 -0400 +++ b/libcruft/blas-xtra/xzdotu.f Wed Mar 19 11:10:00 2008 +0100 @@ -1,46 +1,8 @@ -*** 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) + integer n,incx,incy + double complex zx(*),zy(*),ztemp,zdotu + external zdotu - subroutine xzdotu(n,zx,incx,zy,incy,ztemp) + ztemp = zdotu(n,zx,incx,zy,incy) -*** 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 diff -r 8a939b217863 -r 697172110a32 libcruft/qrupdate/zqrqhv.f --- a/libcruft/qrupdate/zqrqhv.f Tue Mar 18 21:32:48 2008 -0400 +++ b/libcruft/qrupdate/zqrqhv.f Wed Mar 19 11:10:00 2008 +0100 @@ -41,7 +41,7 @@ c necessary, however. 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 @@ c check arguments. 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