! This file: http://ftp.aset.psu.edu/pub/ger/fortran/hdk/KahnSum.f90
!
Program KahnTest
! by James Giles, posted at comp.lang.fortran on 03 April 2002.
 implicit none

 integer, parameter :: size=2**10
 integer :: i

 real :: ss = 0.0, ks = 0.0
 real(kind(0.0d0)) :: ds = 0.0

 real :: t, y, c = 0.0 !kahan temporaries

 real, parameter :: x = 2**23 + 2**18 - 2**8 + 1
! real, parameter :: x = 1

 do i = 1, size

!   kahan sum
    y = x - c
    t = ks + y
    c = (t-ks)-y
    ks  = t

!   single sum
    ss = ss + x

!   double sum
    ds = ds + x

 end do

 Write(*,"(' double precision sum is: ', g16.9)") ds
 Write(*,"(' single precision sum is: ', g16.9, ' in error by', f9.4, &
   & '%')")ss, 100*abs(ds-ss)/ds
 Write(*,"('            Kahan sum is: ', g16.9, ' in error by', f9.4, &
   & '%')")ks, 100*abs(ds-ks)/ds

 stop

End Program