1! { dg-do run } 2! PR 33683 - we used to pick up the wrong gamma function 3! from the library on some systems. 4program main 5 implicit none 6 integer, parameter :: n_max = 20 7 double precision, dimension(0:n_max) :: c 8 double precision :: pi 9 integer :: n 10 double precision :: td, xd 11 real :: ts,xs 12 13 pi = 4 * atan(1.d0) 14 c(0) = 1. 15 do n=1, n_max 16 c(n) = (2*n-1)*c(n-1)*0.5d0 17 end do 18 19 do n=1, n_max 20 xs = n + 0.5 21 xd = n + 0.5d0 22 td = c(n)*sqrt(pi) 23 ts = c(n)*sqrt(pi) 24 if (abs(gamma(xs)-ts)/ts > 9e-6) call abort 25 if (abs(gamma(xd)-td)/td > 5e-14) call abort 26 end do 27 call tst_s(2.3, gamma(2.3)) 28 call tst_s(3.7, gamma(3.7)) 29 call tst_s(5.5, gamma(5.5)) 30 call tst_d(4.2d0, gamma(4.2d0)) 31 call tst_d(8.1d0, gamma(8.1d0)) 32contains 33 subroutine tst_s(a, b) 34 real :: a, b 35 if (abs(gamma(a) - b)/b > 1e-6) call abort 36 end subroutine tst_s 37 38 subroutine tst_d(a, b) 39 double precision :: a,b 40 if (abs(gamma(a) - b)/b > 5e-14) call abort 41 end subroutine tst_d 42end program main 43