Документ взят из кэша поисковой машины. Адрес оригинального документа : http://star.arm.ac.uk/f77to90/code/test_qu2.f90 Дата изменения: Tue Jan 9 17:03:56 1996 Дата индексирования: Tue Oct 2 03:22:36 2012 Кодировка: Поисковые слова: п п п п п п п п п п п п п п п п п п п п п р п р п р п р п р п р п р п р п р п р п р п р п р п р п р п р п р п

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