Ticket #46626: quadpack_example.f90

program main

!*****************************************************************************80
!
!! MAIN is the main program for QUADPACK_PRB.
!
!  Discussion:
!
!    QUADPACK_PRB tests the QUADPACK library.
!
!  Modified:
!
!    03 February 2007
!
!  Author:
!
!    John Burkardt
!
  implicit none

 
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'QUADPACK_PRB'
  write ( *, '(a)' ) '  FORTRAN90 version'
  write ( *, '(a)' ) '  Test the QUADPACK library.'

  call test01 ( )

!
!  Terminate.
!
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'QUADPACK_PRB'
  write ( *, '(a)' ) '  Normal end of execution.'
  write ( *, '(a)' ) ' '
 
  stop
end


subroutine test01 ( )

!*****************************************************************************80
!
!! TEST01 tests QAG.
!
!  Discussion:
!
!    QAG is an adaptive automatic integrator using a Gauss-Kronrod rule.
!
!    integrate cos(100*sin(x)) from 0 to pi.
!
!    The exact answer is pi * j0(100), or roughly 0.06278740.
!
!    KEY chooses the order of the integration rule, from 1 to 6.
!
  implicit none

  real, parameter :: a = 0.0E+00
  real abserr
  real b
  real, parameter :: epsabs = 0.0E+00
  real, parameter :: epsrel = 0.001E+00
  real, external :: f02
  integer ier
  integer, parameter :: key = 6
  integer neval
  real, parameter :: pi = 3.141592653589793E+00
  real result
  real, parameter :: true = 0.06278740E+00
  real, parameter :: limit = 200
 

  b = pi

  
  

  call qag ( f02, a, b, epsabs, epsrel, key, result, abserr, neval, ier) 

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'TEST01'
  write ( *, '(a)' ) '  Test QAG'
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '  Integrand is COS(100*SIN(X))'
  write ( *, '(a,g14.6)' ) '  Integral left endpoint A =    ', a
  write ( *, '(a,g14.6)' ) '  Integral right endpoint B =   ', b
  write ( *, '(a,g14.6)' ) '  Exact integral is             ', true
  write ( *, '(a,g14.6)' ) '  Estimated integral is         ', result
  write ( *, '(a,g14.6)' ) '  Estimated integral error =    ', abserr
  write ( *, '(a,g14.6)' ) '  Exact integral error =        ', true - result
  write ( *, '(a,i8)' ) '  Number of function evaluations, NEVAL = ', neval
  write ( *, '(a,i8)' ) '  Error return code IER = ', ier

  return
end



function f02 ( x )

  !*****************************************************************************80
  ! F02 is the integrand function COS(100*SIN(X)).
  !*****************************************************************************80

  implicit none
  real f02
  real x

  f02 = cos ( 100.0E+00 * sin ( x ) )

  return
end function f02