module functions implicit none contains function f(x) result(y) real(8), intent(in) :: x real(8) :: y y = ((((x * x) - 3.5d0) * x + 2.5d0) * x - 7d0) * x - 6.4d0 end function function F1(x) result(y) real(8), intent(in) :: x real(8) :: y ! y = (1d0/6d0)*(x**6) - (3.5d0/4d0)*(x**4) + (2.5d0/3d0)*(x**3) - (7d0/2d0)*(x**2) - 6.4d0*x y = (((((1d0/6d0) * x * x - 3.5d0/4d0) * x + 2.5d0/3d0) * x - 7d0/2d0) * x - 6.4d0) * x end function function trap(grid, N, h) result(int1) integer, intent(in) :: N integer :: i real(8), dimension(:) :: grid(N+1) real(8) :: h, int1 int1 = 0d0 do i = 2, N int1 = int1 + grid(i) end do int1 = (2d0*int1 + grid(1) + grid(N+1))*h/2d0 end function subroutine intrect(a, b, eps, err, h, N) integer :: N, i real(8) :: a, b, eps, err, h real(8) :: int1, prevint, k, r prevint = 0d0 int1 = 100d0 N = 1 do while (dabs(int1 - prevint)/3d0 > (eps)) N = N * 2 h = (b - a) / N prevint = int1 int1 = 0 do i = 0, N - 1 int1 = int1 + f(a + (i + 0.5d0) * h) end do int1 = int1 * h end do err = dabs((F1(b) - F1(a)) - int1) write(*,*) N, eps, err end subroutine subroutine inttrap(a, b, eps, err, h, N) integer :: N, i real(8) :: a, b, eps, err, h real(8) :: int1, prevint prevint = 0d0 int1 = 100d0 N = 1 do while (dabs(int1 - prevint) / 3 > (eps)) N = N * 2 h = (b - a) / N prevint = int1 int1 = 0.5d0 * (f(a) + f(b)) do i = 1, N - 1 int1 = int1 + f(a + i * h) end do int1 = int1 * h end do err = dabs((F1(b) - F1(a)) - int1) write(*,*) N, eps, err end subroutine subroutine intsimps(a, b, eps, err, h, N) integer :: N, i real(8) :: a, b, eps, err, h real(8) :: int1, inta, intb, prevint prevint = 0d0 int1 = 100d0 N = 1 do while (dabs(int1 - prevint) / 15 > eps) N = N * 2 h = (b - a) / N inta = 0.5d0 * (f(a) + f(b)) do i = 1, N - 1 inta = inta + f(a + i * h) end do intb = 0 do i = 0, N - 1 intb = intb + f(a + (i + 0.5d0) * h) end do prevint = int1 int1 = ( inta + 2 * intb) * h / 3.0d0 end do err = dabs((F1(b) - F1(a)) - int1) write(*,*) N, eps, err end subroutine end module