Документ взят из кэша поисковой машины. Адрес оригинального документа : http://crydee.sai.msu.ru/f90/code/quad.f90 Дата изменения: Tue Jan 9 15:01:36 1996 Дата индексирования: Mon Oct 1 21:49:42 2012 Кодировка: Поисковые слова: annular solar eclipse

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