From 9ff65bedab3b94d529a96c66f1fd47c3320887ff Mon Sep 17 00:00:00 2001
From: Yannick Ulrich <yannick.ulrich@psi.ch>
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