diff --git a/checks/test.f90 b/checks/test.f90 index 3ed677260351fe528c240d168116186b2be73335..d149f19c4720a85874b17ce3e2587ed8ca399458 100644 --- a/checks/test.f90 +++ b/checks/test.f90 @@ -393,8 +393,12 @@ CONTAINS #ifdef HAVE_MM function evalt(arr, what) +#if KINDREAL==16 + use ieps, only: inum2inum +#endif implicit none - complex(kind=prec) :: arr(:), evalt, geval + complex(kind=prec) :: arr(:), evalt + complex(kind=8) :: geval integer what, i, l evalt =0. @@ -413,7 +417,11 @@ CONTAINS if (what .eq. 0) then evalt = G(arr(1:l)) elseif (what.eq.1) then +#if KINDREAL==16 + evalt = cmplx(geval(inum2inum(toinum(arr(1:l))),l),kind=prec) +#else evalt = geval(toinum(arr(1:l)),l) +#endif endif end function @@ -647,6 +655,9 @@ CONTAINS #endif SUBROUTINE DO_LONG_TEST +#if KINDREAL==16 + use ieps,only:inum2inum +#endif implicit none integer,parameter :: nzero = 10 integer,parameter :: nieps = 30 @@ -684,7 +695,11 @@ CONTAINS print*,"Testing ",perweight(w)," GPLs with w=",w do i=1,perweight(w) args(1:w) = basis((/ (1+int(size(basis)*ran2(seed)),j=1,w) /)) - ans(1) = geval([args(1:w),ione], w+1) +#if KINDREAL==16 + ans(1) = cmplx(geval(inum2inum([args(1:w),ione]), w+1),kind=prec) +#else + ans(1) = cmplx(geval([args(1:w),ione], w+1),kind=prec) +#endif ans(2) = G(args(1:w),ione) if(abs(ans(1)-ans(2)) > tol) goto 123 enddo diff --git a/configure b/configure index 421d66401a99cd90b8323e14a8d2bee1b23e4acd..0efd3dec81cffd6baaebd53c9e2a2a4275dea7ee 100755 --- a/configure +++ b/configure @@ -534,10 +534,6 @@ CONF_LD=\${LD:-\$CONF_FC} if \$CONF_QUAD ; then - if \$HAVE_GINAC ; then - echo "GiNaC testing is not supported for quad-precision!" 1>&3 - exit 1 - fi echo -n "does \$CONF_FC support quad-precision... " 1>&3 rm -fr \$test* tee \$test.f90 << _EOF_ 1>&2 diff --git a/src/ieps.f90 b/src/ieps.f90 index a2930532a33fb2912e988fdc7fefa90fb1599a4c..0b89fb6af0e16f2fec44125d33e118f340dbc323 100644 --- a/src/ieps.f90 +++ b/src/ieps.f90 @@ -29,6 +29,20 @@ MODULE ieps interface aimag module procedure imags, imagv end interface aimag + +#if KINDREAL==16 +#ifdef HAVE_GINAC + type inumD + complex(kind=8) :: c + integer(1) :: i0 + end type inumD + + interface inum2inum + module procedure inum2inumS, inum2inumV + end interface inum2inum +#endif +#endif + CONTAINS FUNCTION ABSINUM(n1) implicit none @@ -159,4 +173,23 @@ CONTAINS imags = aimag(z%c) END FUNCTION + +#if KINDREAL==16 +#ifdef HAVE_GINAC + FUNCTION INUM2INUMS(i) + type(inum ) :: i + type(inumD) :: inum2inums + inum2inums = inumD( cmplx(i%c, kind=8), i%i0) + END FUNCTION INUM2INUMS + FUNCTION INUM2INUMV(i) + type(inum ) :: i(:) + type(inumD) :: inum2inumv(size(i)) + integer j + do j=1,size(i) + inum2inumv(j) = inumD( cmplx(i(j)%c, kind=8), i(j)%i0) + enddo + END FUNCTION INUM2INUMV +#endif +#endif + END MODULE IEPS