Skip to content

Commit c888876

Browse files
committed
fix github issue 619
1 parent 8e0d8dd commit c888876

File tree

2 files changed

+21
-3
lines changed

2 files changed

+21
-3
lines changed

src/stdlib_quadrature_gauss.f90

Lines changed: 0 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -56,8 +56,6 @@ pure module subroutine gauss_legendre_fp64 (x, w, interval)
5656
if (present(interval)) then
5757
associate ( a => interval(1) , b => interval(2) )
5858
x = 0.5_dp*(b-a)*x+0.5_dp*(b+a)
59-
x(1) = interval(1)
60-
x(size(x)) = interval(2)
6159
w = 0.5_dp*(b-a)*w
6260
end associate
6361
end if

src/tests/quadrature/test_gauss.f90

Lines changed: 21 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -21,7 +21,8 @@ subroutine collect_gauss(testsuite)
2121
new_unittest("gauss-lobatto-analytic", test_gauss_lobatto_analytic), &
2222
new_unittest("gauss-lobatto-5", test_gauss_lobatto_5), &
2323
new_unittest("gauss-lobatto-32", test_gauss_lobatto_32), &
24-
new_unittest("gauss-lobatto-64", test_gauss_lobatto_64) &
24+
new_unittest("gauss-lobatto-64", test_gauss_lobatto_64), &
25+
new_unittest("gauss-github-issue-619", test_fix_github_issue619) &
2526
]
2627
end subroutine
2728

@@ -48,6 +49,25 @@ subroutine test_gauss_analytic(error)
4849

4950
end subroutine
5051

52+
subroutine test_fix_github_issue619(error)
53+
!> Error handling
54+
type(error_type), allocatable, intent(out) :: error
55+
integer :: i
56+
57+
! test the values of nodes and weights
58+
i = 5
59+
block
60+
real(dp), dimension(i) :: x1,w1,x2,w2
61+
call gauss_legendre(x1,w1)
62+
call gauss_legendre(x2,w2,interval=[-1._dp, 1._dp])
63+
64+
call check(error, all(abs(x1-x2) < 2*epsilon(x1(1))))
65+
if (allocated(error)) return
66+
call check(error, all(abs(w1-w2) < 2*epsilon(w1(1))))
67+
end block
68+
69+
end subroutine
70+
5171
subroutine test_gauss_5(error)
5272
!> Error handling
5373
type(error_type), allocatable, intent(out) :: error

0 commit comments

Comments
 (0)