Commit 9ff65bed authored by Yannick Ulrich's avatar Yannick Ulrich

Allowed quad testing with GiNaC

parent a473e15f
......@@ -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
......
......@@ -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
......
......@@ -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
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment