@@ -45,20 +45,54 @@ subroutine test_sum(error)
45
45
! scramble array
46
46
do i = 1, n
47
47
call random_number(u)
48
- j = 1 + FLOOR (n*u)
48
+ j = 1 + floor (n*u)
49
49
call swap( x(i), x(j) )
50
50
end do
51
51
52
52
err(:) = 0._${k1}$
53
53
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
57
57
err(1:ncalc) = err(1:ncalc) + abs(1._${k1}$-xsum(1:ncalc)/total_sum)
58
58
end do
59
59
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" )
62
96
if (allocated(error)) return
63
97
end block
64
98
#:endfor
0 commit comments