Commit 9ff65bed authored by ulrich_y's avatar ulrich_y

Allowed quad testing with GiNaC

parent a473e15f
...@@ -393,8 +393,12 @@ CONTAINS ...@@ -393,8 +393,12 @@ CONTAINS
#ifdef HAVE_MM #ifdef HAVE_MM
function evalt(arr, what) function evalt(arr, what)
#if KINDREAL==16
use ieps, only: inum2inum
#endif
implicit none implicit none
complex(kind=prec) :: arr(:), evalt, geval complex(kind=prec) :: arr(:), evalt
complex(kind=8) :: geval
integer what, i, l integer what, i, l
evalt =0. evalt =0.
...@@ -413,7 +417,11 @@ CONTAINS ...@@ -413,7 +417,11 @@ CONTAINS
if (what .eq. 0) then if (what .eq. 0) then
evalt = G(arr(1:l)) evalt = G(arr(1:l))
elseif (what.eq.1) then 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) evalt = geval(toinum(arr(1:l)),l)
#endif
endif endif
end function end function
...@@ -647,6 +655,9 @@ CONTAINS ...@@ -647,6 +655,9 @@ CONTAINS
#endif #endif
SUBROUTINE DO_LONG_TEST SUBROUTINE DO_LONG_TEST
#if KINDREAL==16
use ieps,only:inum2inum
#endif
implicit none implicit none
integer,parameter :: nzero = 10 integer,parameter :: nzero = 10
integer,parameter :: nieps = 30 integer,parameter :: nieps = 30
...@@ -684,7 +695,11 @@ CONTAINS ...@@ -684,7 +695,11 @@ CONTAINS
print*,"Testing ",perweight(w)," GPLs with w=",w print*,"Testing ",perweight(w)," GPLs with w=",w
do i=1,perweight(w) do i=1,perweight(w)
args(1:w) = basis((/ (1+int(size(basis)*ran2(seed)),j=1,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) ans(2) = G(args(1:w),ione)
if(abs(ans(1)-ans(2)) > tol) goto 123 if(abs(ans(1)-ans(2)) > tol) goto 123
enddo enddo
......
...@@ -534,10 +534,6 @@ CONF_LD=${LD:-$CONF_FC} ...@@ -534,10 +534,6 @@ CONF_LD=${LD:-$CONF_FC}
if $CONF_QUAD ; then 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 echo -n "does $CONF_FC support quad-precision... " 1>&3
rm -fr $test* rm -fr $test*
tee $test.f90 << _EOF_ 1>&2 tee $test.f90 << _EOF_ 1>&2
......
...@@ -29,6 +29,20 @@ MODULE ieps ...@@ -29,6 +29,20 @@ MODULE ieps
interface aimag interface aimag
module procedure imags, imagv module procedure imags, imagv
end interface aimag 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 CONTAINS
FUNCTION ABSINUM(n1) FUNCTION ABSINUM(n1)
implicit none implicit none
...@@ -159,4 +173,23 @@ CONTAINS ...@@ -159,4 +173,23 @@ CONTAINS
imags = aimag(z%c) imags = aimag(z%c)
END FUNCTION 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 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