Skip to content

Commit 243ea6f

Browse files
committed
add complex sum test
1 parent 4625205 commit 243ea6f

File tree

1 file changed

+40
-6
lines changed

1 file changed

+40
-6
lines changed

test/intrinsics/test_intrinsics.fypp

Lines changed: 40 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -45,20 +45,54 @@ subroutine test_sum(error)
4545
! scramble array
4646
do i = 1, n
4747
call random_number(u)
48-
j = 1 + FLOOR(n*u)
48+
j = 1 + floor(n*u)
4949
call swap( x(i), x(j) )
5050
end do
5151

5252
err(:) = 0._${k1}$
5353
do iter = 1, niter
54-
xsum(1) = sum(x)
55-
xsum(2) = fsum_kahan(x)
56-
xsum(3) = fsum(x)
54+
xsum(1) = sum(x) ! compiler intrinsic
55+
xsum(2) = fsum_kahan(x) ! chunked Kahan summation
56+
xsum(3) = fsum(x) ! chunked summation
5757
err(1:ncalc) = err(1:ncalc) + abs(1._${k1}$-xsum(1:ncalc)/total_sum)
5858
end do
5959
err(1:ncalc) = err(1:ncalc) / niter
60-
print *, err
61-
call check(error, all(err(:)<tolerance) )
60+
61+
call check(error, all(err(:)<tolerance) , "real sum is not accurate" )
62+
if (allocated(error)) return
63+
end block
64+
#:endfor
65+
66+
#:for k1, t1, s1 in C_KINDS_TYPES
67+
block
68+
${t1}$, allocatable :: x(:)
69+
real(${k1}$), parameter :: total_sum = 4*atan(1._${k1}$), tolerance = epsilon(1._${k1}$)*100
70+
real(${k1}$) :: err(ncalc)
71+
${t1}$ :: xsum(ncalc), meanval(ncalc)
72+
73+
allocate(x(n))
74+
do i = 1, n
75+
x(i) = complex(&
76+
8*atan(1._${k1}$)*(real(i,kind=${k1}$)-0.5_${k1}$)/real(2*n,kind=${k1}$)**2,&
77+
8*atan(1._${k1}$)*(real(i+n,kind=${k1}$)-0.5_${k1}$)/real(2*n,kind=${k1}$)**2)
78+
end do
79+
! scramble array
80+
do i = 1, n
81+
call random_number(u)
82+
j = 1 + floor(n*u)
83+
call swap( x(i), x(j) )
84+
end do
85+
86+
err(:) = 0._${k1}$
87+
do iter = 1, niter
88+
xsum(1) = sum(x) ! compiler intrinsic
89+
xsum(2) = fsum_kahan(x) ! chunked Kahan summation
90+
xsum(3) = fsum(x) ! chunked summation
91+
err(1:ncalc) = err(1:ncalc) + abs(1._${k1}$-(xsum(1:ncalc)%re+xsum(1:ncalc)%im)/total_sum)
92+
end do
93+
err(1:ncalc) = err(1:ncalc) / niter
94+
95+
call check(error, all(err(:)<tolerance) , "complex sum is not accurate" )
6296
if (allocated(error)) return
6397
end block
6498
#:endfor

0 commit comments

Comments
 (0)