RECURSIVE FUNCTION ADAPTIVE_QUAD (F, A, B, TOL, ABS_ERROR) & RESULT (RESULT) IMPLICIT NONE INTERFACE FUNCTION F(X) RESULT (FUNCTION_VALUE) REAL, INTENT(IN) :: X REAL :: FUNCTION_VALUE END FUNCTION F END INTERFACE REAL, INTENT(IN) :: A, B, TOL REAL, INTENT(OUT) :: ABS_ERROR REAL :: RESULT REAL :: STEP, MIDDLE_POINT REAL :: ONE_TRAPEZOIDAL_AREA, TWO_TRAPEZOIDAL_AREAS REAL :: LEFT_AREA, RIGHT_AREA REAL :: DIFF, ABS_ERROR_L, ABS_ERROR_R STEP = B-A MIDDLE_POINT= 0.5 * (A+B) ONE_TRAPEZOIDAL_AREA = STEP * 0.5 * (F(A)+ F(B)) TWO_TRAPEZOIDAL_AREAS = STEP * 0.25 * (F(A) + F(MIDDLE_POINT))+& STEP * 0.25 * (F(MIDDLE_POINT) + F(B)) DIFF = TWO_TRAPEZOIDAL_AREAS - ONE_TRAPEZOIDAL_AREA IF ( ABS (DIFF) < TOL ) THEN RESULT = TWO_TRAPEZOIDAL_AREAS + DIFF/3.0 ABS_ERROR = ABS(DIFF) ELSE LEFT_AREA = ADAPTIVE_QUAD (F, A, MIDDLE_POINT, & 0.5*TOL, ABS_ERROR_L) RIGHT_AREA = ADAPTIVE_QUAD (F, MIDDLE_POINT, B, & 0.5*TOL, ABS_ERROR_R) RESULT = LEFT_AREA + RIGHT_AREA ABS_ERROR = ABS_ERROR_L + ABS_ERROR_R END IF END FUNCTION ADAPTIVE_QUAD