VMAT_lab1_20

program lab1
  interface
    real function G(t)
    real t
    end function G
    real function lagrange (ARR_X, ARR_Y, X)
        real ARR_X(9),ARR_Y(9),X
    end function lagrange

  end interface

  integer NOFUN,  I, N
  real A,RELERR,ABSERR,RESULT,ERREST,FLAG,X,ARR_X(9), ARR_Y(9), B(9), C(9), D(9)
  DATA A/1.0/,RELERR/1.E-06/,ABSERR/0.0/, X/3.0/
  I = 1
  N = 11
  do  while(X < 5.2)
  write(*,*) "X = ", X
    ARR_X(I) = X
    CALL QUANC8(G,A,X,ABSERR,RELERR,RESULT,ERREST,NOFUN,FLAG)
    ARR_Y(I) = RESULT
    I = I + 1
    X = X + 0.25
    write(*,*) "RESULT = ", RESULT
  end do

  CALL SPLINE (N,ARR_X,ARR_Y,B,C,D)

  do k=0, 7
    X = 3.125 + 0.25 * k
    write(*,*) "----------------------------------------------"
    write(*,*) "X = ", X
    CALL QUANC8(G,A,X,ABSERR,RELERR,RESULT,ERREST,NOFUN,FLAG)
    write(*,*) "QUANC8   = ", RESULT
    write(*,*) "Lagrange = ", lagrange(ARR_X, ARR_Y, X), "   Q - L = ", RESULT - lagrange(ARR_X, ARR_Y, X)
    write(*,*) "Spline   = ", SEVAL(N,X,ARR_X,ARR_Y,B,C,D), "   Q - S = ", RESULT - SEVAL(N,X,ARR_X,ARR_Y,B,C,D)
  end do

end program lab1

real function G(t)
    real t
    G = cos(t) / t
end function G

real function lagrange (ARR_X, ARR_Y, X)
real ARR_X(9),ARR_Y(9),X, part, res
res = 0
do i = 1,9
  part = ARR_Y(i)
  do j = 1, 9
    if (i .ne. j) then
       part = part * (X-ARR_X(j)) / (ARR_X(I) - ARR_X(j))
    end if
  end do
  res = res + part
end do
lagrange = res

end function lagrange