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