542 lines
18 KiB
Fortran
542 lines
18 KiB
Fortran
!
|
|
!=======================================================================
|
|
!
|
|
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
|