From 9ff65bedab3b94d529a96c66f1fd47c3320887ff Mon Sep 17 00:00:00 2001 From: Yannick Ulrich Date: Fri, 27 Sep 2019 16:08:09 +0200 Subject: [PATCH] Allowed quad testing with GiNaC --- checks/test.f90 | 19 +++++++++++++++++-- configure | 4 ---- src/ieps.f90 | 33 +++++++++++++++++++++++++++++++++ 3 files changed, 50 insertions(+), 6 deletions(-) diff --git a/checks/test.f90 b/checks/test.f90 index 3ed6772..d149f19 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 421d664..0efd3de 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 a293053..0b89fb6 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 -- GitLab