PROGRAM TEST_ADAPTIV_KVAD ! I DENNA VERSION ÄR HELTALET NANTAL INKLUDERAT I ETT BLANKT COMMON ! FÖR ATT KUNNA GE INFORMATION OM ANTALET FUNKTIONSBERÄKNINGAR. ! DETTA COMMON BLOCK MÅSTE FINNAS BÅDE I HUVUDPROGRAMMET OCH I FUNKTIONEN IMPLICIT NONE INTERFACE FUNCTION F(X) RESULT (FUNKTIONSVAERDE) REAL, INTENT(IN) :: X REAL :: FUNKTIONSVAERDE END FUNCTION F END INTERFACE INTERFACE RECURSIVE FUNCTION ADAPTIV_KVAD (F, A, B, FA, FB, TOL, ABS_FEL) RESULT (RESULTAT) REAL, EXTERNAL :: F REAL, INTENT(IN) :: A, B, TOL, FA, FB REAL, INTENT(OUT) :: ABS_FEL REAL :: RESULTAT END FUNCTION ADAPTIV_KVAD END INTERFACE REAL :: A, B, TOL, FA, FB REAL :: ABS_FEL REAL :: RESULTAT, PI INTEGER :: I, NANTAL COMMON NANTAL INTEGER :: COUNT1, COUNT2, COUNT_RATE REAL :: TID PI = 4.0 * ATAN(1.0) A = -5.0 ; B = +5.0 TOL = 0.1 CALL SYSTEM_CLOCK(COUNT=COUNT1, COUNT_RATE=COUNT_RATE) DO I = 1, 5 TOL = TOL/10.0 NANTAL = 0 FA = F(A) FB = F(B) RESULTAT = ADAPTIV_KVAD (F, A, B, FA, FB, TOL, ABS_FEL) WRITE(*,*) WRITE(*,"(A, F15.10, A, F15.10)") "Integralen aer approximativt ", & RESULTAT, " med approximativ feluppskattning ", ABS_FEL WRITE(*,"(A, F15.10, A, F15.10)") "Integralen aer mer exakt ", & SQRT(PI), " med verkligt fel ", RESULTAT - SQRT(PI) WRITE(*,"(A, I10)") "Antalet funktionsberaekningar ", NANTAL END DO CALL SYSTEM_CLOCK(COUNT=COUNT2) TID = REAL(COUNT2 - COUNT1)/REAL(COUNT_RATE) WRITE(*,*) 'Beraekningen tar ', TID ,' sekunder.' END PROGRAM TEST_ADAPTIV_KVAD FUNCTION F(X) RESULT (FUNKTIONSVAERDE) IMPLICIT NONE REAL, INTENT(IN) :: X REAL :: FUNKTIONSVAERDE INTEGER :: NANTAL COMMON NANTAL FUNKTIONSVAERDE = EXP(-X**2) NANTAL = NANTAL + 1 END FUNCTION F