!
!=======================================================================
!
MODULE INTERPOLATION
!
!  This module contains interpolation routines using the 
!     following approaches:
!
!
!   * cubic spline interpolation : CUBIC_SPLINE_INTERP(F,X,N_X,XX)
!
!   * Lagrange interpolation     : LAG_NP_INTERP(X,F,XX) with N = 3-5
!
!
!   where F is the array representing the function to interpolate, 
!   X the abscissae array and XX the interpolation point
!
      USE ACCURACY_REAL
!
CONTAINS
!
!
!=======================================================================
!
      FUNCTION CUBIC_SPLINE_INTERP(F,X,N_X,XX)
!
!  This function takes a user-defined function F 
!    and computes its value at XX
!
!
!  Input parameters:
!
!       * F        : array defining f
!       * X        : array defining the abscissae of f
!       * N_X      : size of the X and F arrays
!       * XX       : value at which F is computed
!
!
!  Output variables :
!
!       * FUNC     : value F(XX)
!
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified :  4 Jun 2020
!
!
      USE DIMENSION_CODE
      USE REAL_NUMBERS,        ONLY : SMALL
!
      IMPLICIT NONE
!
      INTEGER, INTENT(IN)   ::  N_X
!
      INTEGER               ::  I,INTERP,NN
      INTEGER               ::  LOGF
!
      REAL (WP), INTENT(IN) :: F(NSIZE),X(NSIZE)
      REAL (WP), INTENT(IN) :: XX
!
      REAL (WP)             :: CUBIC_SPLINE_INTERP
      REAL (WP)             :: DIFF,RES
!
      REAL (WP)             :: ABS
!
      INTERP = 1                                                    !
      LOGF   = 6                                                    ! index of log file
!
!  Checking if XX is part of the X array
!
      DO I = 1, N_X                                                 !
        DIFF = ABS(X(I) - XX)                                       !
        IF(DIFF < SMALL) THEN                                       !
          INTERP = 0                                                !
          NN     = I                                                !
          GO TO 10                                                  !
        END IF                                                      !
      END DO                                                        !
  10  CONTINUE                                                      !
!
!  Interpolation whenever necessary
!
      IF(INTERP == 1) THEN                                          !
        CALL INTERP_NR(LOGF,X,F,N_X,XX,RES)                         !
        CUBIC_SPLINE_INTERP = RES                                   !
      ELSE                                                          !
        CUBIC_SPLINE_INTERP = F(NN)                                 !
      END IF                                                        !
!
      END FUNCTION CUBIC_SPLINE_INTERP
!
!=======================================================================
!
      SUBROUTINE INTERP_NR(LOGF,X,F,N_POINTS,XG,G)
!
!  This subroutine interpolates a function F(X) at point XG using 
!    the cubic spline interpolation of 
!         
!              "Numerical Recipes in Fortran 77 second edition"
!
!      from W. H. Press, S. A. Teukolsky, W. T. Vetterling 
!      and B. P. Flannery, p. 109
!
!
!  Input parameters:
!
!       LOGF     :  Fortran unit for log file
!       X        :  x coordinates of the input function F
!       F        :  y coordinates of the input function F
!       N_POINTS :  number of points of the input function
!       XG       :  x point at which the interpolation is made
!
!
!  Output parameters:
!
!       G        :  interpolated value of F at x = XG
!
!
!  Intermediate parameters:
!
!       YP1      :  value of first derivative of interpolating function at point 1
!       YPN      :  value of first derivative of interpolating function at point N
!
!  If YP1 and/or YPN are larger or equal than 1.0D+30, the routine will set them 
!     at the boundary condition of a natural spline, with second derivative on 
!     that boundary.
!
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified : 17 Dec 2020
!
!
      IMPLICIT NONE
!
      INTEGER, INTENT(IN)    ::  N_POINTS,LOGF
!
      REAL (WP), INTENT(IN)  ::  X(N_POINTS),F(N_POINTS)
      REAL (WP), INTENT(IN)  ::  XG 
      REAL (WP), INTENT(OUT) ::  G
!
      REAL (WP)              ::  F2(N_POINTS)
      REAL (WP)              ::  YP1,YPN
!
!  Construction of the cubic spline used for the interpolation
!
      YP1 = 2.0E+30_WP                                              !
      YPN = 2.0E+30_WP                                              !
!
      CALL SPLINE(X,F,N_POINTS,YP1,YPN,F2)                          !
!
!  Interpolation at x = XG
!
      CALL SPLINT(X,F,F2,N_POINTS,XG,G,*10)                         !
!
      RETURN                                                        !
!
  10  WRITE(LOGF,11)                                                !
      STOP                                                          !
!
!  Formats
!
  11  FORMAT(//,10X,'<<<<<  WRONG VALUE FOR XA IN SUBROUTINE ', &
             '   SPLINT  >>>>>',//)                                                  
!
      END SUBROUTINE INTERP_NR
!
!=======================================================================
!
      SUBROUTINE SPLINE(X,Y,N,YP1,YPN,Y2)
!
!  This subroutine constructs the second derivative of the 
!    interpolating function for the input function Y = f(X). 
!
!    Taken from "Numerical Recipes in Fortran 77 second edition"
!
!      from W. H. Press, S. A. Teukolsky, W. T. Vetterling 
!      and B. P. Flannery, p. 109
!
!
!  Input parameters:
!
!       X        :  x coordinates of the input function
!       Y        :  y coordinates of the input function  
!       N        :  number of points of the input function
!       YP1      :  value of first derivative of interpolating function at point 1
!       YPN      :  value of first derivative of interpolating function at point N
!
!
!  Output parameters:
!
!       Y2       :  second derivative of the interpolating function on X grid
!
!
!  If YP1 and/or YPN are larger or equal than 1.0D+30, the routine will set them 
!     at the boundary condition of a natural spline, with second derivative on 
!     that boundary.
!
!             ---> This is the double precision version  <---
!
!
!                                           Last modified (DS) : 21 Dec 2020
!
!
      USE REAL_NUMBERS,     ONLY : ZERO,ONE,TWO,THREE,HALF,MIC
      USE DIMENSION_CODE,   ONLY : NZ_MAX
!
      IMPLICIT NONE
!
      INTEGER, INTENT(IN)    ::  N
!
      INTEGER                ::  I,K
!
      REAL (WP), INTENT(IN)  ::  X(N),Y(N)
      REAL (WP), INTENT(IN)  ::  YP1,YPN
      REAL (WP), INTENT(OUT) ::  Y2(N)
!
      REAL (WP)              ::  U(NZ_MAX)
      REAL (WP)              ::  SIG,P,QN,UN
!
!  Lower boundary condition
!
      IF(YP1 > 0.99E+30_WP) THEN                                    !
        Y2(1) = ZERO                                                !
        U(1)  = ZERO                                                !
      ELSE                                                          !
        Y2(1) = - HALF                                              !
        U(1)  = ( THREE / (X(2)-X(1)) ) *                         & !
                ( (Y(2) - Y(1)) / (X(2) - X(1)) - YP1 )             !
      END IF                                                        !
!
!  Decomposition loop of the tridiagonal algorithm
!
      DO I = 2, N-1                                                 !
        SIG   = (X(I) - X(I-1)) / (X(I+1) - X(I-1))                 !
        P     = SIG * Y2(I-1) + TWO                                 !
        Y2(I) = (SIG - ONE) / P                                     ! 
        U(I)  = ( 6.0E0_WP * ( (Y(I+1) - Y(I)) / (X(I+1) - X(I)) - &!
                               (Y(I) - Y(I-1)) / (X(I) - X(I-1))   &!
                             ) / (X(I+1) - X(I-1)) - SIG * U(I-1)  &!
                ) / P                                               !
        IF(U(I) < MIC) U(I) = ZERO                                  !
      END DO                                                        !
!
!  Upper boundary condition
!
      IF(YPN > 0.99E+30_WP) THEN                                    !
        QN = ZERO                                                   !
        UN = ZERO                                                   !
      ELSE                                                          !
        QN = HALF                                                   !
        UN = ( THREE / (X(N) - X(N-1)) ) *                        & !
             ( YPN - (Y(N) - Y(N-1)) / (X(N) - X(N-1)) )            ! 
      END IF                                                        !
!
      Y2(N) = (UN - QN * U(N-1)) / (QN * Y2(N-1) + ONE)             !
!
!  Backsubstitution loop of the tridiagonal algorithm
!
      DO K = N-1, 1, -1                                             !
        Y2(K) = Y2(K) * Y2(K+1) + U(K)                              !
      END DO                                                        !
!
      END SUBROUTINE SPLINE
!
!=======================================================================
!
      SUBROUTINE SPLINT(XA,YA,Y2A,N,X,Y,*)
!
!  This subroutine performs a cubic spline interpolation Y  
!                  of YA(XA) at point X
!
!    Taken from "Numerical Recipes in Fortran 77 second edition"
!
!      from W. H. Press, S. A. Teukolsky, W. T. Vetterling 
!      and B. P. Flannery, p. 110
!
!
!  Input parameters:
!
!       XA       :  x coordinates of the input function
!       YA       :  y coordinates of the input function  
!       Y2A      :  y coordinates second derivative of the interpolating function
!                      (output of subroutine SPLINE)
!       N        :  number of points of the input function
!       X        :  x value at which interpolation is made
!
!
!  Output parameters:
!
!       Y        :  cubic-spline interpolated value
!
!
!             ---> This is the double precision version  <---
!
      USE REAL_NUMBERS,     ONLY : ZERO
!
      IMPLICIT NONE
!
      INTEGER, INTENT(IN)    ::  N
!
      INTEGER                ::  KLO,KHI,K
!
      REAL (WP), INTENT(IN)  ::  XA(N),YA(N),Y2A(N)
      REAL (WP), INTENT(IN)  ::  X
      REAL (WP), INTENT(OUT) ::  Y
!
      REAL (WP)              ::  H,A,B
!
!  Starting values for the points of the XA grid bracketing 
!   the value X at which we interpolate YA
!
      KLO = 1                                                       !
      KHI = N                                                       !
!
!  Bisection algorithm to find the exact values of KLO and KHI
!
   1  IF(KHI - KLO > 1) THEN                                        !
        K = (KHI + KLO) / 2                                         !
        IF(XA(K) > X) THEN                                          !
          KHI = K                                                   !
        ELSE                                                        !
          KLO = K                                                   !
        END IF                                                      !
        GO TO 1                                                     !
      END IF                                                        !
!
!  Now, KLO < X < KHI
!
      H = XA(KHI) - XA(KLO)                                         !
!
      IF(H == ZERO) RETURN 1                                        !
!
!  Evaluation of the cubic spline polynomial
!
      A = (XA(KHI) - X) / H                                         !
      B = (X - XA(KLO)) / H                                         !
      Y = A * YA(KLO) + B * YA(KHI) +                             & !
            ( (A**3 - A) * Y2A(KLO) + (B**3 - B) * Y2A(KHI) ) *   & !
            (H**2) / 6.0E0_WP                                       !
!
      END SUBROUTINE SPLINT
!
!=======================================================================
!
      FUNCTION LAG_3P_INTERP(X,A,XX)
!
!  This function computes a 3-point Lagrange interpolation
! 
!  Reference: (1) https://en.wikipedia.org/wiki/Lagrange_polynomial
!
!  Input parameters :
!
!       * X        : array containing the abscissae of A
!       * A        : function to interpolate
!       * XX       : interpolation point
!
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified :  4 Jun 2020
!
!
      IMPLICIT NONE
!
      REAL (WP), INTENT(IN) ::  X(3),A(3)
      REAL (WP), INTENT(IN) ::  XX
      REAL (WP)             ::  LAG_3P_INTERP
!
      REAL (WP)             ::  L1,L2,L3
!
!  Computing the Lagrange polynomials in XX
!
      L1 = (XX-X(2))/(X(1)-X(2)) * (XX-X(3))/(X(1)-X(3))            !
      L2 = (XX-X(1))/(X(2)-X(1)) * (XX-X(3))/(X(2)-X(3))            ! 
      L3 = (XX-X(1))/(X(3)-X(1)) * (XX-X(2))/(X(3)-X(2))            ! 
!
!  Computing the interpolated value
!
      LAG_3P_INTERP = A(1) * L1 + A(2) * L2 + A(3) * L3             !
!
      END FUNCTION LAG_3P_INTERP
!
!=======================================================================
!
      FUNCTION LAG_4P_INTERP(X,A,XX)
!
!  This function computes a 4-point Lagrange interpolation
! 
!  Reference: (1) https://en.wikipedia.org/wiki/Lagrange_polynomial
!
!  Input parameters :
!
!       * X        : array containing the abscissae of A
!       * A        : function to interpolate
!       * XX       : interpolation point
!
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified :  4 Jun 2020
!
!
      IMPLICIT NONE
!
      REAL (WP)             ::  X(4),A(4)
      REAL (WP)             ::  XX
      REAL (WP)             ::  LAG_4P_INTERP
      REAL (WP)             ::  L1,L2,L3,L4
!
!  Computing the Lagrange polynomials in XX
!
      L1 = (XX-X(2))/(X(1)-X(2)) * (XX-X(3))/(X(1)-X(3)) *   &      !
           (XX-X(4))/(X(1)-X(4))                                    !
      L2 = (XX-X(1))/(X(2)-X(1)) * (XX-X(3))/(X(2)-X(3)) *   &      ! 
           (XX-X(4))/(X(2)-X(4))                                    !
      L3 = (XX-X(1))/(X(3)-X(1)) * (XX-X(2))/(X(3)-X(2)) *   &      ! 
           (XX-X(4))/(X(3)-X(4))                                    !
      L4 = (XX-X(1))/(X(4)-X(1)) * (XX-X(2))/(X(4)-X(2)) *   &      ! 
           (XX-X(3))/(X(4)-X(3))                                    !
!
!  Computing the interpolated value
!
      LAG_4P_INTERP = A(1)*L1 + A(2)*L2 + A(3)*L3 + A(4)*L4         !
!
      END FUNCTION LAG_4P_INTERP
!
!=======================================================================
!
      FUNCTION LAG_5P_INTERP(X,A,XX)
!
!  This function computes a 5-point Lagrange interpolation
! 
!  Reference: (1) https://en.wikipedia.org/wiki/Lagrange_polynomial
!
!  Input parameters :
!
!       * X        : array containing the abscissae of A
!       * A        : function to interpolate
!       * XX       : interpolation point
!
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified :  4 Jun 2020
!
!
      IMPLICIT NONE
!
      REAL (WP)             ::  X(5),A(5)
      REAL (WP)             ::  XX
      REAL (WP)             ::  LAG_5P_INTERP
      REAL (WP)             ::  L1,L2,L3,L4,L5
!
!  Computing the Lagrange polynomials in XX
!
      L1 = (XX-X(2))/(X(1)-X(2)) * (XX-X(3))/(X(1)-X(3)) *   &      !
           (XX-X(4))/(X(1)-X(4)) * (XX-X(5))/(X(1)-X(5))            !
      L2 = (XX-X(1))/(X(2)-X(1)) * (XX-X(3))/(X(2)-X(3)) *   &      ! 
           (XX-X(4))/(X(2)-X(4)) * (XX-X(5))/(X(2)-X(5))            !
      L3 = (XX-X(1))/(X(3)-X(1)) * (XX-X(2))/(X(3)-X(2)) *   &      ! 
           (XX-X(4))/(X(3)-X(4)) * (XX-X(5))/(X(3)-X(5))            !
      L4 = (XX-X(1))/(X(4)-X(1)) * (XX-X(2))/(X(4)-X(2)) *   &      ! 
           (XX-X(3))/(X(4)-X(3)) * (XX-X(5))/(X(4)-X(5))            !
      L5 = (XX-X(1))/(X(5)-X(1)) * (XX-X(2))/(X(5)-X(2)) *   &      ! 
           (XX-X(3))/(X(5)-X(3)) * (XX-X(4))/(X(5)-X(4))            !
!
!  Computing the interpolated value
!
      LAG_5P_INTERP= A(1)*L1 + A(2)*L2 + A(3)*L3 + A(4)*L4 + A(5)*L5!
!
      END FUNCTION LAG_5P_INTERP
!
!=======================================================================
!
      FUNCTION LAG_6P_INTERP(X,A,XX)
!
!  This function computes a 6-point Lagrange interpolation
! 
!  Reference: (1) https://en.wikipedia.org/wiki/Lagrange_polynomial
!
!  Input parameters :
!
!       * X        : array containing the abscissae of A
!       * A        : function to interpolate
!       * XX       : interpolation point
!
!
!
!   Author :  D. Sébilleau
!
!                                           Last modified : 15 Sep 2020
!
!
      IMPLICIT NONE
!
      REAL (WP)             ::  X(6),A(6)
      REAL (WP)             ::  XX
      REAL (WP)             ::  LAG_6P_INTERP
      REAL (WP)             ::  L1,L2,L3,L4,L5,L6
!
!  Computing the Lagrange polynomials in XX
!
      L1 = (XX-X(2))/(X(1)-X(2)) * (XX-X(3))/(X(1)-X(3)) *        & !
           (XX-X(4))/(X(1)-X(4)) * (XX-X(5))/(X(1)-X(5)) *        & !
           (XX-X(6))/(X(1)-X(6))                                    !
!
      L2 = (XX-X(1))/(X(2)-X(1)) * (XX-X(3))/(X(2)-X(3)) *        & ! 
           (XX-X(4))/(X(2)-X(4)) * (XX-X(5))/(X(2)-X(5)) *        & !
           (XX-X(6))/(X(2)-X(6))                                    !
!
      L3 = (XX-X(1))/(X(3)-X(1)) * (XX-X(2))/(X(3)-X(2)) *        & ! 
           (XX-X(4))/(X(3)-X(4)) * (XX-X(5))/(X(3)-X(5)) *        & !
           (XX-X(6))/(X(3)-X(6))                                    !
!
      L4 = (XX-X(1))/(X(4)-X(1)) * (XX-X(2))/(X(4)-X(2)) *        & ! 
           (XX-X(3))/(X(4)-X(3)) * (XX-X(5))/(X(4)-X(5)) *        & !
           (XX-X(6))/(X(4)-X(6))                                    !
!
      L5 = (XX-X(1))/(X(5)-X(1)) * (XX-X(2))/(X(5)-X(2)) *        & ! 
           (XX-X(3))/(X(5)-X(3)) * (XX-X(4))/(X(5)-X(4)) *        & !
           (XX-X(6))/(X(5)-X(6))                                    !
!
      L6 = (XX-X(1))/(X(6)-X(1)) * (XX-X(2))/(X(6)-X(2)) *        & ! 
           (XX-X(3))/(X(6)-X(3)) * (XX-X(4))/(X(6)-X(4)) *        & !
           (XX-X(5))/(X(6)-X(5))                                    !
!
!  Computing the interpolated value
!
      LAG_6P_INTERP = A(1) * L1 + A(2) * L2 + A(3) * L3 +         & !
                      A(4) * L4 + A(5) * L5 + A(6) * L6             !
!
      END FUNCTION LAG_6P_INTERP
!
END MODULE INTERPOLATION
