include 'mkl_df.f90' subroutine thr_interp(n, x, y, order, coeff, m, site, r) USE MKL_DF_TYPE USE MKL_DF integer :: n integer :: ny real(8) :: x(n), y(n) integer :: order real(8) :: coeff((n-1)*order) integer :: m real(8) :: site(m), r(m) ! Data Fitting task descriptor TYPE (DF_TASK) task integer :: xhint, yhint, stype, itype, method, sitehint integer :: ndorder integer :: dorder(1) integer :: errcode !***** Create Data Fitting task ***** xhint = DF_NON_UNIFORM_PARTITION yhint = DF_NO_HINT ny = 1 errcode = dfdnewtask1d( task, n, x, xhint, ny, y, yhint ) if (errcode /= 0) then print 100, "Error in dfdnewtask1d, code = ", errcode end if !***** Edit task parameters for linear spline construction ***** stype = DF_PP_DEFAULT errcode = dfdeditppspline1d( task, order, stype, scoeff=coeff ) if (errcode /= 0) then print 100, "Error in dfdeditppspline1d, code = ", errcode end if !***** Construct linear spline using STD method ***** itype = DF_PP_SPLINE method = DF_METHOD_STD errcode = dfdconstruct1d( task, itype, method ) if (errcode /= 0) then print 100, "Error in dfdconstruct1d, code = ", errcode end if !***** Calculate interpolation results ***** itype = DF_INTERP method = DF_METHOD_PP sitehint = DF_NON_UNIFORM_PARTITION ndorder = 1 dorder(1) = 1 errcode = dfdinterpolate1d( task, itype, method, & & m, site, sitehint, ndorder, dorder, r=r ) if (errcode /= 0) then print 100, "Error in dfdInterpolate1D, code = ", errcode end if !***** Delete Data Fitting task ***** errcode = dfdeletetask( task ) 100 format (A, I5) end subroutine