PROGRAM TEST_ADAPTIVE_QUAD
IMPLICIT NONE
       INTERFACE
              FUNCTION F(X) RESULT (FUNCTION_VALUE)
              REAL, INTENT(IN) :: X
              REAL             :: FUNCTION_VALUE
              END FUNCTION F
       END INTERFACE
       INTERFACE
              RECURSIVE FUNCTION ADAPTIVE_QUAD &
                      (F, A, B, FA, FB, TOL, ABS_ERROR) RESULT (RESULT)
              REAL, EXTERNAL     :: F
              REAL, INTENT (IN)  :: A, B, FA, FB, TOL
              REAL, INTENT (OUT) :: ABS_ERROR
              REAL               :: RESULT
              END FUNCTION ADAPTIVE_QUAD
       END INTERFACE
       REAL    :: A, B, FA, FB, TOL
       REAL    :: ABS_ERROR
       REAL    :: RESULT, PI
       INTEGER :: I

       PI = 4.0 * ATAN(1.0)
       A= -5.0 
       B = +5.0
       TOL =0.1

       DO I = 1, 5
              TOL = TOL/10.0
              FA = F(A)
              FB = F(B)
              RESULT = ADAPTIVE_QUAD (F, A, B, FA, FB, TOL, ABS_ERROR)
              WRITE(*,*)
              WRITE(*,"(A, F15.10, A, F15.10)") &
               "The integral is approximately ", &
              RESULT, " with approximate error estimate ", &
              ABS_ERROR
              WRITE(*,"(A, F15.10, A, F15.10)") &
              "The integral is more exactly    ", &
                SQRT(PI), " with real error            ", &
               RESULT - SQRT(PI)
       END DO
END PROGRAM TEST_ADAPTIVE_QUAD

       FUNCTION F(X) RESULT (FUNCTION_VALUE)
       IMPLICIT NONE
       REAL, INTENT(IN)       :: X
       REAL                   :: FUNCTION_VALUE
       FUNCTION_VALUE = EXP(-X**2)
       END FUNCTION F
