Commit d7d9084b authored by ulrich_y's avatar ulrich_y

Used ieps for gpl_module

Note that you shouldn't run this! It works but
includes loads of unnecessary casting.
parent 5919f09d
This diff is collapsed.
......@@ -11,22 +11,23 @@ MODULE ieps
type(inum), parameter :: izero=inum( 0.,di0)
type(inum), parameter :: imone=inum(-1.,di0)
type(inum), parameter :: ione=inum(+1.,di0)
interface operator (*)
module procedure multinum
module procedure multinumss, multinumvs
end interface operator (*)
interface operator (+)
module procedure addinum
module procedure addinumss, addinumvs
end interface operator (+)
interface operator (-)
module procedure subinum
module procedure subinumss,subinumvs,subinumsv
end interface operator (-)
interface operator (**)
module procedure powinum
end interface operator (**)
interface operator (/)
module procedure divint, divinum
module procedure divint, divinumss, divinumvs
end interface operator (/)
interface abs
module procedure absinum, absinumv
......@@ -34,35 +35,80 @@ MODULE ieps
interface log
module procedure loginum
end interface log
interface toinum
module procedure toinum_cmplx, toinum_real, toinum_int
end interface toinum
interface tocmplx
module procedure tocmplxv, tocmplxs
end interface tocmplx
CONTAINS
FUNCTION MULTINUM(n1, n2)
FUNCTION MULTINUMSS(n1, n2)
implicit none
type(inum), intent(in) :: n1, n2
type(inum) :: multinum
multinum = inum( n1%c*n2%c, int(sign(1._prec,real(n1%c)*n2%i0 + real(n2%c)*n1%i0)) )
END FUNCTION MULTINUM
type(inum) :: multinumss
multinumss = inum( n1%c*n2%c, int(sign(1._prec,real(n1%c)*n2%i0 + real(n2%c)*n1%i0)) )
END FUNCTION MULTINUMSS
FUNCTION ADDINUM(n1, n2)
FUNCTION MULTINUMVS(n1, n2)
implicit none
type(inum), intent(in) :: n1(:), n2
type(inum) :: multinumvs(size(n1))
integer i
do i = 1,size(n1)
multinumvs(i) = inum( n1(i)%c*n2%c, int(sign(1._prec,real(n1(i)%c)*n2%i0 + real(n2%c)*n1(i)%i0)) )
enddo
END FUNCTION MULTINUMVS
FUNCTION ADDINUMSS(n1, n2)
implicit none
type(inum), intent(in) :: n1, n2
type(inum) :: addinum
type(inum) :: addinumss
!TODO: what *is* the sum?
addinum = inum(n1%c + n2%c, n1%i0 )
END FUNCTION ADDINUM
addinumss = inum(n1%c + n2%c, n1%i0 )
END FUNCTION ADDINUMSS
FUNCTION SUBINUM(n1, n2)
FUNCTION ADDINUMVS(n1, n2)
implicit none
type(inum), intent(in) :: n1(:), n2
type(inum) :: addinumvs(size(n1))
!TODO: what *is* the sum?
integer i
do i = 1,size(n1)
addinumvs(i) = inum(n1(i)%c + n2%c, n1(i)%i0 )
enddo
END FUNCTION ADDINUMVS
FUNCTION SUBINUMSS(n1, n2)
implicit none
type(inum), intent(in) :: n1, n2
type(inum) :: subinum
type(inum) :: subinumss
!TODO: what *is* the sum?
subinum = inum(n1%c - n2%c, n1%i0 )
END FUNCTION SUBINUM
subinumss = inum(n1%c - n2%c, n1%i0 )
END FUNCTION SUBINUMSS
FUNCTION SUBINUMVS(n1, n2)
implicit none
type(inum), intent(in) :: n1(:), n2
type(inum) :: subinumvs(size(n1))
!TODO: what *is* the sum?
integer i
do i = 1,size(n1)
subinumvs(i) = inum(n1(i)%c - n2%c, n1(i)%i0 )
enddo
END FUNCTION SUBINUMvs
FUNCTION SUBINUMSV(n2, n1)
implicit none
type(inum), intent(in) :: n1(:), n2
type(inum) :: subinumsv(size(n1))
!TODO: what *is* the sum?
integer i
do i = 1,size(n1)
subinumsv(i) = inum(n2%c - n1(i)%c, n1(i)%i0 )
enddo
END FUNCTION SUBINUMSV
FUNCTION ABSINUM(n1)
implicit none
......@@ -99,18 +145,28 @@ CONTAINS
divint = inum( n1%c/m, n1%i0*sign(1,m))
END FUNCTION DIVINT
FUNCTION DIVINUM(n1, n2)
FUNCTION DIVINUMss(n1, n2)
implicit none
type(inum), intent(in) :: n1, n2
type(inum) :: divinum
divinum = inum( n1%c/n2%c, int(sign(1., real(n2%c)*n1%i0 - real(n1%c)*n2%i0)))
END FUNCTION DIVINUM
type(inum) :: divinumss
divinumss = inum( n1%c/n2%c, int(sign(1., real(n2%c)*n1%i0 - real(n1%c)*n2%i0)))
END FUNCTION DIVINUMss
FUNCTION DIVINUMvs(n1, n2)
implicit none
type(inum), intent(in) :: n1(:), n2
type(inum) :: divinumvs(size(n1))
integer i
do i = 1,size(n1)
divinumvs(i) = inum( n1(i)%c/n2%c, int(sign(1., real(n2%c)*n1(i)%i0 - real(n1(i)%c)*n2%i0)))
enddo
END FUNCTION DIVINUMvs
FUNCTION LOGINUM(n1)
implicit none
type(inum), intent(in) :: n1
type(inum) :: loginum
loginum = inum( log(n1%c), n1%i0 * int(sign(1._prec, real(n1%c))) )
complex(kind=prec) :: loginum
loginum = log(n1%c)
END FUNCTION LOGINUM
......@@ -129,7 +185,7 @@ CONTAINS
toinum_cmplx(i) = inum(z(i), ss)
enddo
END FUNCTION TOINUM_cmplx
FUNCTION TOINUM_real(z, s)
real(kind=prec) :: z(:)
type(inum) :: toinum_real(size(z))
......@@ -163,5 +219,16 @@ CONTAINS
enddo
END FUNCTION TOINUM_int
FUNCTION TOCMPLXv(z)
type(inum) :: z(:)
complex(kind=prec) tocmplxv(size(z))
tocmplxv = z%c
END FUNCTION
FUNCTION TOCMPLXs(z)
type(inum) :: z
complex(kind=prec) tocmplxs
tocmplxs = z%c
END FUNCTION
END MODULE IEPS
......@@ -4,6 +4,9 @@ MODULE maths_functions
use utils
implicit none
interface polylog
module procedure polylogcmplx,polyloginum
end interface polylog
CONTAINS
FUNCTION naive_polylog(m,x) result(res)
......@@ -243,7 +246,14 @@ CONTAINS
end if
END FUNCTION trilog
FUNCTION polylog(m,x) result(res)
FUNCTION polyloginum(m,x) result(res)
integer :: m
type(inum) :: x
complex(kind=prec) :: res
res = polylog(m,x%c)
END FUNCTION polyloginum
FUNCTION polylogcmplx(m,x) result(res)
! computes the polylog
integer :: m
......@@ -257,7 +267,7 @@ CONTAINS
else
res = naive_polylog(m,x)
end if
END FUNCTION polylog
END FUNCTION polylogcmplx
END MODULE maths_functions
......
......@@ -72,7 +72,7 @@ CONTAINS
character(len=*) :: test_id
print*, ' ', 'testing GPL ', test_id, ' ...'
res = G_condensed(m,z,y,k)
res = G_condensed(m,toinum(z),inum(y,di0),k)
call check(res,ref)
end subroutine test_one_condensed
......
......@@ -2,6 +2,7 @@
MODULE utils
use globals
use ieps
implicit none
! logical :: print_enabled = .true.
......@@ -11,7 +12,7 @@ CONTAINS
FUNCTION get_condensed_m(z) result(m)
! returns condensed m where the ones not needed are filled with 0 (returns same size as z)
complex(kind=prec), intent(in) :: z(:)
type(inum), intent(in) :: z(:)
integer :: m(size(z)), pos, i
m = 1
pos = 1
......@@ -32,7 +33,7 @@ CONTAINS
FUNCTION get_condensed_z(m, z_in) result(z_out)
! returns condensed z vector
integer :: m(:), i, pos
complex(kind=prec) :: z_in(:), z_out(size(m))
type(inum) :: z_in(:), z_out(size(m))
pos = 0
do i=1,size(m)
pos = pos + m(i)
......@@ -43,8 +44,8 @@ CONTAINS
FUNCTION get_flattened_z(m,z_in) result(z_out)
! returns flattened version of z based on m and z
integer :: m(:), i, pos
complex(kind=prec) :: z_in(:), z_out(sum(m))
z_out = 0
type(inum) :: z_in(:), z_out(sum(m))
z_out = izero
pos = 0
do i=1,size(m)
pos = pos + m(i)
......@@ -53,7 +54,7 @@ CONTAINS
END FUNCTION get_flattened_z
FUNCTION find_amount_trailing_zeros(z) result(res)
complex(kind=prec) :: z(:)
type(inum) :: z(:)
integer :: res, i
res = 0
do i = size(z), 1, -1
......@@ -105,8 +106,8 @@ CONTAINS
FUNCTION zeroes(n) result(res)
integer :: n
complex(kind=prec) :: res(n)
res = 0
type(inum) :: res(n)
res = izero
END FUNCTION zeroes
RECURSIVE FUNCTION factorial(n) result(res)
......@@ -129,15 +130,15 @@ CONTAINS
FUNCTION shuffle_with_zero(a) result(res)
! rows of result are shuffles of a with 0
complex :: a(:)
complex :: res(size(a)+1,size(a)+1)
type(inum) :: a(:)
type(inum) :: res(size(a)+1,size(a)+1)
integer :: i,j, N
N = size(a)+1
do i = 1,N
! i is the index of the row
! j is the index of the zero
j = N+1-i
res(i,j) = 0
res(i,j) = izero
res(i,1:j-1) = a(1:j-1)
res(i,j+1:N) = a(j:)
end do
......
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