! !======================================================================= ! 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