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, TOL, ABS_ERROR) RESULT (RESULT) REAL, EXTERNAL :: F REAL, INTENT (IN) :: A, B, TOL REAL, INTENT (OUT) :: ABS_ERROR REAL :: RESULT END FUNCTION ADAPTIVE_QUAD END INTERFACE REAL :: A, B, 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 RESULT = ADAPTIVE_QUAD (F, A, B, 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