! !======================================================================= ! MODULE INTEGRATION4 ! ! This module contains integration routines in order to integrate ! a function F over the interval [A,B]. ! ! These routines are: ! ! ! * Newton-Cotes/Euler-Mac Laurin : INTEGR_I(X,F,F_1,F_3,F_5,N_BEG, ! N_END,N_POINTS,METH,N_RULE,RES) ! ! USE ACCURACY_REAL ! CONTAINS ! !======================================================================= ! SUBROUTINE INTEGR_I(X,F,F_1,F_3,F_5,N_BEG,N_END,N_POINTS, & METH,N_RULE,RES) ! ! This is the driver routine that calls the subroutine that ! integrates a function F(X), defined over ! the interval [1,N_POINTS] with constant step H ! over the interval [N_BEG,N_END] ! ! To increase the accuracy, it computes the integral according ! to different schemes. There are four ways to compute the ! integral: ! int[N_BEG,N_END] (1) ! int[1,N_END]-int[1,N_BEG] (2) ! int[N_BEG,N_POINTS]-int[N_END,N_POINTS] (3) ! int[1,N_POINTS]-int[1,N_BEG]-int[N_END,N_POINTS] (4) ! ! Method (4) is never used as it is equivalent either to method (2) ! or to method (3) in terms of accuracy ! ! This subroutine selects the method involving the larger number ! of points, i.e. max([N_BEG,N_END],int[1,N_BEG],[N_END,N_POINTS]) ! ! ! Input parameters: ! ! * X : X point of function to be integrated ! * F : function to be integrated ! * F_1 : first order derivative of F ! * F_3 : third order derivative of F ! * F_5 : fifth order derivative of F ! * N_BEG : starting X point for integration of F ! * N_END : end X point for integration of F ! * N_POINTS : dimensioning of F (1 to N_POINTS) ! * METH : integration method used ! ! = 'NCQ' : Newton-Cotes ! = 'EMS' : Euler-Mac Laurin summation ! ! * N_RULE : number of points used in the quadrature formula ! ! NCQ : Newton-Cotes quadrature rule | Accuracy ! ! --> N_RULE = 2 : trapezoidal | H^3 ! --> N_RULE = 3 : Simpson 1/3 | H^5 ! --> N_RULE = 4 : Simpson 3/8 | H^5 ! --> N_RULE = 5 : Boole/Milne | H^7 ! --> N_RULE = 6 : Weddle | H^7 ! ! EMS : Euler-Mac Laurin summation | Accuracy ! ! --> N_RULE = 2 (uses F_1) | H^5 ! --> N_RULE = 3 (uses F_1,F_3) | H^7 ! --> N_RULE = 4 (uses F_1,F_3,F_5) | H^9 ! ! BN(J) is a Bernoulli number ! ! ! Output parameters: ! ! * RES : result of the integration of F over the whole ! interval [1,N_END] ! ! ! Author : D. Sébilleau ! ! Last modified : 6 Aug 2020 ! ! IMPLICIT NONE ! REAL (WP) :: F(N_POINTS),F_1(N_POINTS) REAL (WP) :: F_3(N_POINTS),F_5(N_POINTS) REAL (WP) :: X(N_POINTS) REAL (WP) :: RES,RES1,RES2 ! INTEGER :: N_BEG,N_END,N_POINTS,N_RULE INTEGER :: N_SIZE_I,N_SIZE_L,N_SIZE_U INTEGER :: N_HALF ! CHARACTER (LEN = 3) :: METH ! ! Checking the number of points in the integration interval ! with respect to that over which the function F(X) is defined ! N_SIZE_I=N_END-N_BEG+1 ! N_SIZE_L=N_BEG ! N_SIZE_U=N_POINTS-N_END+1 ! ! N_HALF=N_POINTS/2 ! ! IF(N_SIZE_I >= N_HALF) THEN ! ! !........... Interval of integration larger than half of ........... !........... the interval of definition of F(X) ........... ! ! Using method (1) ! CALL INTEGR_INT(X,F,F_1,F_3,F_5,N_BEG,N_END,N_POINTS, & ! METH,N_RULE,RES) ! ! ELSE ! ! !........... Interval of integration smaller than half of ........... !........... the interval of definition of F(X) ........... ! IF(N_SIZE_U >= N_SIZE_L) THEN ! ! ! Using method (3) ! CALL INTEGR_INT(X,F,F_1,F_3,F_5,N_BEG,N_POINTS,N_POINTS,& ! METH,N_RULE,RES1) ! CALL INTEGR_INT(X,F,F_1,F_3,F_5,N_END,N_POINTS,N_POINTS,& ! METH,N_RULE,RES2) ! ! RES=RES1-RES2 ! ! ELSE ! ! ! Using method (2) ! CALL INTEGR_INT(X,F,F_1,F_3,F_5,1,N_END,N_POINTS, & ! METH,N_RULE,RES1) ! CALL INTEGR_INT(X,F,F_1,F_3,F_5,1,N_BEG,N_POINTS, & ! METH,N_RULE,RES2) ! ! RES=RES1-RES2 ! ! END IF ! ! END IF ! ! END SUBROUTINE INTEGR_I ! !======================================================================= ! SUBROUTINE INTEGR_INT(X,F,F_1,F_3,F_5,N_BEG,N_END,N_POINTS, & METH,N_RULE,RES) ! ! This subroutine integrates the function F(X), defined over ! the interval [1,N_POINTS] with constant step H ! over the interval [N_BEG,N_END]. ! ! ! Input parameters: ! ! * X : X point of function to be integrated ! * F : function to be integrated ! * F_1 : first order derivative of F ! * F_3 : third order derivative of F ! * F_5 : fifth order derivative of F ! * N_BEG : starting X point for integration of F ! * N_END : end X point for integration of F ! * N_POINTS : dimensioning of F (1 to N_POINTS) ! * METH : integration method used ! ! = 'NCQ' : Newton-Cotes ! = 'EMS' : Euler-Mac Laurin summation ! ! * N_RULE : number of points used in the quadrature formula ! ! NCQ : Newton-Cotes quadrature rule | Accuracy ! ! --> N_RULE = 2 : trapezoidal | H^3 ! --> N_RULE = 3 : Simpson 1/3 | H^5 ! --> N_RULE = 4 : Simpson 3/8 | H^5 ! --> N_RULE = 5 : Boole/Milne | H^7 ! --> N_RULE = 6 : Weddle | H^7 ! ! EMS : Euler-Mac Laurin summation | Accuracy ! ! --> N_RULE = 2 (uses F_1) | H^5 ! --> N_RULE = 3 (uses F_1,F_3) | H^7 ! --> N_RULE = 4 (uses F_1,F_3,F_5) | H^9 ! ! BN(J) is a Bernoulli number ! ! ! Output parameters: ! ! * RES : result of the integration of F over the whole ! interval [1,N_END] ! ! ! References: M. Abramowitz and I. A. Stegun, "Handbook of Mathematical ! "Functions", 9th Dover printing, pp.886-887, Dover ! ! P. A. Almeida Magalhaes Jr and C. Almeida Magalhaes, ! J. Math. Stat. 6, 193-204 (2010) ! ! This version: closed Newton-Cotes formula limited to N_RULE = 6 ! no open Newton-Cotes formula included ! Euler-MacLaurin formula limited to N_RULE = 3 ! ! Author : D. Sébilleau ! ! Last modified : 6 Aug 2020 ! ! ! USE REAL_NUMBERS, ONLY : ZERO,ONE,TWO,THREE,FOUR,FIVE, & HALF,THIRD,FOURTH,FIFTH ! IMPLICIT NONE ! REAL (WP) :: F(N_POINTS),F_1(N_POINTS) REAL (WP) :: F_3(N_POINTS),F_5(N_POINTS) REAL (WP) :: X(N_POINTS) REAL (WP) :: F_INT1,F_INT2,F_INT3,F_INT4 REAL (WP) :: RES,RES0,RES1,C_H REAL (WP) :: BN(0:6),H,H1 REAL (WP) :: CNC2(2),CNC3(3),CNC4(4),CNC5(5),CNC6(6) REAL (WP) :: CN(6) REAL (WP) :: P,A(10) ! REAL (WP) :: DFLOAT ! INTEGER :: N_BEG,N_END,N_POINTS,N_RULE INTEGER :: I_FLAG INTEGER :: J INTEGER :: N_REM,N_FIN INTEGER :: LOGF ! CHARACTER (LEN = 3) :: METH ! ! Bernouilli numbers ! DATA BN /1.0E0_WP,-0.50E0_WP, & 0.166666666666666666666666667E0_WP,0.0E0_WP, & 0.000000000000000000000000000E0_WP,0.0E0_WP, & 0.023809523809523809523809524E0_WP / ! ! Closed formula Newton-Cotes coefficients CNCn for n-point formula ! DATA CNC2 / 1.0E0_WP, 1.0E0_WP/ DATA CNC3 / 1.0E0_WP, 4.0E0_WP, 1.0E0_WP/ DATA CNC4 / 1.0E0_WP ,3.0E0_WP, 3.0E0_WP, 1.0E0_WP/ DATA CNC5 / 7.0E0_WP,32.0E0_WP,12.0E0_WP,32.0E0_WP, 7.0E0_WP/ DATA CNC6 /19.0E0_WP,75.0E0_WP,50.0E0_WP,50.0E0_WP,75.0E0_WP, 19.0E0_WP/ ! DATA CN / 0.0E0_WP, 2.0E0_WP, 6.0E0_WP, 8.0E0_WP,90.0E0_WP,288.0E0_WP/ ! LOGF=6 ! ! ! Checking for consistency of input data ! IF(N_BEG < 1) THEN ! WRITE(6,10) ! STOP ! END IF ! ! IF(N_END > N_POINTS) THEN ! WRITE(6,20) ! STOP ! END IF ! ! IF(METH == 'NCQ') THEN ! IF( (N_RULE < 2) .OR. (N_RULE > 6) ) THEN ! WRITE(6,30) ! STOP ! END IF ! ELSEIF(METH == 'EMS') THEN ! IF( (N_RULE < 2) .OR. (N_RULE > 4) ) THEN ! WRITE(6,40) ! STOP ! END IF ! END IF ! ! H=X(2)-X(1) ! ! I_FLAG=N_RULE-1 ! ! ! ! Computation of Int_{1}^{X} F(X) dX for X in [N_BEG,N_END] ! ! ! The number of points used for each ! formula is N_RULE. (N_END-N_BEG-1) must ! must be divisible by I_FLAG in ! order to fully apply the formula. ! So, the formula is applied in ! the interval [N_BEG,N_END-N_REM], ! where N_REM is the remainder of ! the division of (N_END-N_BEG-1) by I_FLAG, ! and for the remaining interval, ! an interpolation is used to ! obtain exactly I_FLAG+1 points ! (F_INT1,F_INT2,F_INT3,F_INT4). ! We note N_END-N_REM-1 = N_FIN. ! IF(METH == 'NCQ') THEN ! ! N_REM=MOD(N_END-N_BEG,I_FLAG) ! N_FIN=N_END-N_REM-1 ! C_H=DFLOAT(I_FLAG)/CN(N_RULE) ! RES0=ZERO ! ! IF(I_FLAG == 1) THEN ! ! !............. 2-point formula ........ ! DO J=N_BEG,N_FIN,I_FLAG ! RES0=RES0+CNC2(1)*F(J)+CNC2(2)*F(J+1) ! END DO ! RES=RES0*H*C_H ! ! ELSE IF(I_FLAG == 2) THEN ! ! !............. 3-point formula ........ ! IF(N_FIN > N_BEG) THEN ! DO J=N_BEG,N_FIN,I_FLAG ! RES0=RES0+CNC3(1)*F(J)+CNC3(2)*F(J+1)+CNC3(3)*F(J+2) ! END DO ! END IF ! RES0=RES0*H*C_H ! ! IF(N_REM == 0) THEN ! RES=RES0 ! ELSE IF(N_REM == 1) THEN ! ! ! Lagrange 3-point interpolation for step H/2 point ! (or Lagrange 2-point when not possible) ! P=HALF ! IF(N_END > 2) THEN ! CALL LAGR_INTERP(3,P,A) ! F_INT1=A(1)*F(N_END-2)+A(2)*F(N_END-1)+A(3)*F(N_END) ! ELSE ! CALL LAGR_INTERP(2,P,A) ! F_INT1=A(1)*F(N_END-1)+A(2)*F(N_END) ! END IF ! ! RES1=CNC3(1)*F(N_END-1)+CNC3(2)*F_INT1+CNC3(3)*F(N_END) ! H1=H/TWO ! RES=RES0+RES1*H1*C_H ! END IF ! ! ELSE IF(I_FLAG == 3) THEN ! ! !............. 4-point formula ........ ! IF(N_FIN > N_BEG) THEN ! DO J=N_BEG,N_FIN,I_FLAG ! RES0=RES0 + CNC4(1)*F(J) + CNC4(2)*F(J+1) + & ! CNC4(3)*F(J+2) + CNC4(4)*F(J+3) ! END DO ! END IF ! RES0=RES0*H*C_H ! ! IF(N_REM == 0) THEN ! RES=RES0 ! ELSE IF(N_REM == 1) THEN ! ! ! Lagrange 3-point interpolation for step H/3 points ! (or Lagrange 2-point when not possible) ! P=THIRD ! IF(N_END > 2) THEN CALL LAGR_INTERP(3,P,A) ! F_INT1=A(1)*F(N_END-2)+A(2)*F(N_END-1)+A(3)*F(N_END) ! ELSE ! CALL LAGR_INTERP(2,P,A) ! F_INT1=A(1)*F(N_END-1)+A(2)*F(N_END) ! END IF ! ! P=TWO*THIRD ! IF(N_END > 2) THEN ! CALL LAGR_INTERP(3,P,A) ! F_INT2=A(1)*F(N_END-2)+A(2)*F(N_END-1)+A(3)*F(N_END) ! ELSE ! CALL LAGR_INTERP(2,P,A) ! F_INT2=A(1)*F(N_END-1)+A(2)*F(N_END) ! END IF ! ! RES1=CNC4(1)*F(N_END-1) + CNC4(2)*F_INT1 + & ! CNC4(3)*F_INT2 + CNC4(4)*F(N_END) ! H1=H/THREE ! RES=RES0+RES1*H1*C_H ! ! ELSE IF(N_REM == 2) THEN ! ! ! Lagrange 3-point interpolation for step 2H/3 points ! (or Lagrange 2-point when not possible) ! (F(N_END-1) is not used for the calculation of integral) ! P=TWO*THIRD ! IF(N_END > 3) THEN ! CALL LAGR_INTERP(3,P,A) ! F_INT1=A(1)*F(N_END-3)+A(2)*F(N_END-2)+A(3)*F(N_END-1)! ELSE ! CALL LAGR_INTERP(2,P,A) ! F_INT1=A(1)*F(N_END-2)+A(2)*F(N_END-1) ! END IF ! ! P=THIRD ! IF(N_END > 3) THEN ! CALL LAGR_INTERP(3,P,A) ! F_INT2=A(1)*F(N_END-2)+A(2)*F(N_END-1)+A(3)*F(N_END) ! ELSE ! CALL LAGR_INTERP(2,P,A) ! F_INT2=A(1)*F(N_END-1)+A(2)*F(N_END) ! END IF ! ! RES1=CNC4(1)*F(N_END-2) + CNC4(2)*F_INT1 + & ! CNC4(3)*F_INT2 + CNC4(4)*F(N_END) ! H1=TWO*H/THREE ! RES=RES0+RES1*H1*C_H ! ! END IF ! ! ELSE IF(I_FLAG == 4) THEN ! ! !............. 5-point formula ........ ! IF(N_FIN > N_BEG) THEN ! DO J=N_BEG,N_FIN,I_FLAG ! RES0=RES0 + CNC5(1)*F(J) + CNC5(2)*F(J+1) + & ! CNC5(3)*F(J+2) + CNC5(4)*F(J+3) + & ! CNC5(5)*F(J+4) ! END DO ! END IF ! RES0=RES0*H*C_H ! ! IF(N_REM == 0) THEN ! RES=RES0 ! ELSE IF(N_REM == 1) THEN ! ! ! Lagrange 3-point interpolation for step H/4 points ! (or Lagrange 2-point when not possible) ! P=FOURTH ! IF(N_END > 2) THEN ! CALL LAGR_INTERP(3,P,A) ! F_INT1=A(1)*F(N_END-2)+A(2)*F(N_END-1)+A(3)*F(N_END) ! ELSE ! CALL LAGR_INTERP(2,P,A) ! F_INT1=A(1)*F(N_END-1)+A(2)*F(N_END) ! END IF ! ! P=HALF ! IF(N_END > 2) THEN ! CALL LAGR_INTERP(3,P,A) ! F_INT2=A(1)*F(N_END-2)+A(2)*F(N_END-1)+A(3)*F(N_END) ! ELSE ! CALL LAGR_INTERP(2,P,A) ! F_INT2=A(1)*F(N_END-1)+A(2)*F(N_END) ! END IF ! ! P=THREE/FOUR ! IF(N_END > 2) THEN ! CALL LAGR_INTERP(3,P,A) ! F_INT3=A(1)*F(N_END-2)+A(2)*F(N_END-1)+A(3)*F(N_END) ! ELSE ! CALL LAGR_INTERP(2,P,A) ! F_INT3=A(1)*F(N_END-1)+A(2)*F(N_END) ! END IF ! ! RES1=CNC5(1)*F(N_END-1) + CNC5(2)*F_INT1 + & ! CNC5(3)*F_INT2 + CNC5(4)*F_INT3 + & ! CNC5(5)*F(N_END) ! H1=H/FOUR ! RES=RES0+RES1*H1*C_H ! ! ELSE IF(N_REM == 2) THEN ! ! ! Lagrange 3 point interpolation for step 2H/4 points ! (or Lagrange 2-point when not possible) ! P=HALF ! IF(N_END > 3) THEN ! CALL LAGR_INTERP(3,P,A) ! F_INT1=A(1)*F(N_END-3)+A(2)*F(N_END-2)+A(3)*F(N_END-1)! ELSE ! CALL LAGR_INTERP(2,P,A) ! F_INT1=A(1)*F(N_END-2)+A(2)*F(N_END-1) ! END IF ! ! P=HALF ! IF(N_END > 3) THEN ! CALL LAGR_INTERP(3,P,A) ! F_INT3=A(1)*F(N_END-2)+A(2)*F(N_END-1)+A(3)*F(N_END) ! ELSE ! CALL LAGR_INTERP(2,P,A) ! F_INT3=A(1)*F(N_END-1)+A(2)*F(N_END) ! END IF ! ! RES1=CNC5(1)*F(N_END-2) + CNC5(2)*F_INT1 + & ! CNC5(3)*F(N_END-1) + CNC5(4)*F_INT3 + & ! CNC5(5)*F(N_END) ! H1=H/TWO ! RES=RES0+RES1*H1*C_H ! ! ELSE IF(N_REM == 3) THEN ! ! ! Lagrange 3 point interpolation for step 3H/4 points ! P=THREE/FOUR ! CALL LAGR_INTERP(3,P,A) ! F_INT1=A(1)*F(N_END-4)+A(2)*F(N_END-3)+A(3)*F(N_END-2) ! ! P=HALF ! CALL LAGR_INTERP(3,P,A) ! F_INT2=A(1)*F(N_END-3)+A(2)*F(N_END-2)+A(3)*F(N_END-1) ! ! P=FOURTH ! CALL LAGR_INTERP(3,P,A) ! F_INT3=A(1)*F(N_END-2)+A(2)*F(N_END-1)+A(3)*F(N_END) ! ! RES1=CNC5(1)*F(N_END-3) + CNC5(2)*F_INT1 + & ! CNC5(3)*F_INT2 + CNC5(4)*F_INT3 + & ! CNC5(5)*F(N_END) ! H1=THREE*H/FOUR ! RES=RES0+RES1*H1*C_H ! ! END IF ! ! ELSE IF(I_FLAG == 5) THEN ! ! !............. 6-point formula ........ ! IF(N_FIN > N_BEG) THEN ! DO J=N_BEG,N_FIN,I_FLAG ! RES0=RES0 + CNC6(1)*F(J) + CNC6(2)*F(J+1) + & ! CNC6(3)*F(J+2) + CNC6(4)*F(J+3) + & ! CNC6(5)*F(J+4) + CNC6(6)*F(J+5) ! END DO ! END IF ! RES0=RES0*H*C_H ! ! IF(N_REM == 0) THEN ! RES=RES0 ! ELSE IF(N_REM == 1) THEN ! ! ! Lagrange 3-point interpolation for step H/5 points ! (or Lagrange 2-point when not possible) ! P=FIFTH ! IF(N_END > 2) THEN ! CALL LAGR_INTERP(3,P,A) ! F_INT1=A(1)*F(N_END-2)+A(2)*F(N_END-1)+A(3)*F(N_END) ! ELSE ! CALL LAGR_INTERP(2,P,A) ! F_INT1=A(1)*F(N_END-1)+A(2)*F(N_END) ! END IF ! ! P=TWO/FIVE ! IF(N_END > 2) THEN ! CALL LAGR_INTERP(3,P,A) ! F_INT2=A(1)*F(N_END-2)+A(2)*F(N_END-1)+A(3)*F(N_END) ! ELSE ! CALL LAGR_INTERP(2,P,A) ! F_INT2=A(1)*F(N_END-1)+A(2)*F(N_END) ! END IF ! ! P=THREE/FIVE ! IF(N_END > 2) THEN ! CALL LAGR_INTERP(3,P,A) ! F_INT3=A(1)*F(N_END-2)+A(2)*F(N_END-1)+A(3)*F(N_END) ! ELSE ! CALL LAGR_INTERP(2,P,A) ! F_INT3=A(1)*F(N_END-1)+A(2)*F(N_END) ! END IF ! ! P=FOUR/FIVE ! IF(N_END > 2) THEN ! CALL LAGR_INTERP(3,P,A) ! F_INT4=A(1)*F(N_END-2)+A(2)*F(N_END-1)+A(3)*F(N_END) ! ELSE ! CALL LAGR_INTERP(2,P,A) ! F_INT4=A(1)*F(N_END-1)+A(2)*F(N_END) ! END IF ! ! RES1=CNC6(1)*F(N_END-1) + CNC6(2)*F_INT1 + & ! CNC6(3)*F_INT2 + CNC6(4)*F_INT3 + & ! CNC6(5)*F_INT4 + CNC6(6)*F(N_END) ! H1=H/FIVE ! RES=RES0+RES1*H1*C_H ! ! ELSE IF(N_REM == 2) THEN ! ! ! Lagrange 3 point interpolation for step 2H/5 points ! (or Lagrange 2-point when not possible) ! P=TWO/FIVE ! IF(N_END > 3) THEN ! CALL LAGR_INTERP(3,P,A) ! F_INT1=A(1)*F(N_END-3)+A(2)*F(N_END-2)+A(3)*F(N_END-1)! ELSE ! CALL LAGR_INTERP(2,P,A) ! F_INT1=A(1)*F(N_END-2)+A(2)*F(N_END-1) ! END IF ! ! P=FOUR/FIVE ! IF(N_END > 3) THEN ! CALL LAGR_INTERP(3,P,A) ! F_INT2=A(1)*F(N_END-3)+A(2)*F(N_END-2)+A(3)*F(N_END-1)! ELSE ! CALL LAGR_INTERP(2,P,A) ! F_INT2=A(1)*F(N_END-2)+A(2)*F(N_END-1) ! END IF ! ! P=FIFTH ! IF(N_END > 3) THEN ! CALL LAGR_INTERP(3,P,A) ! F_INT3=A(1)*F(N_END-2)+A(2)*F(N_END-1)+A(3)*F(N_END) ! ELSE ! CALL LAGR_INTERP(2,P,A) ! F_INT3=A(1)*F(N_END-1)+A(2)*F(N_END) ! END IF ! ! P=THREE/FIVE ! IF(N_END > 3) THEN ! CALL LAGR_INTERP(3,P,A) ! F_INT4=A(1)*F(N_END-2)+A(2)*F(N_END-1)+A(3)*F(N_END) ! ELSE ! CALL LAGR_INTERP(2,P,A) ! F_INT4=A(1)*F(N_END-1)+A(2)*F(N_END) ! END IF ! ! RES1=CNC6(1)*F(N_END-2) + CNC6(2)*F_INT1 + & ! CNC6(3)*F_INT2 + CNC6(4)*F_INT3 + & ! CNC6(5)*F_INT4 + CNC6(6)*F(N_END) ! H1=TWO*H/FIVE ! RES=RES0+RES1*H1*C_H ! ! ELSE IF(N_REM == 3) THEN ! ! ! Lagrange 3 point interpolation for step 3H/5 points ! (or Lagrange 2-point when not possible) ! P=THREE/FIVE ! IF(N_END > 4) THEN ! CALL LAGR_INTERP(3,P,A) ! F_INT1=A(1)*F(N_END-4)+A(2)*F(N_END-3)+A(3)*F(N_END-2)! ELSE ! CALL LAGR_INTERP(2,P,A) ! F_INT1=A(1)*F(N_END-3)+A(2)*F(N_END-2) ! END IF ! ! P=FIFTH ! IF(N_END > 4) THEN ! CALL LAGR_INTERP(3,P,A) ! F_INT2=A(1)*F(N_END-3)+A(2)*F(N_END-2)+A(3)*F(N_END-1)! ELSE ! CALL LAGR_INTERP(2,P,A) ! F_INT2=A(1)*F(N_END-2)+A(2)*F(N_END-1) ! END IF ! ! P=FOUR/FIVE ! IF(N_END > 4) THEN ! CALL LAGR_INTERP(3,P,A) ! F_INT3=A(1)*F(N_END-3)+A(2)*F(N_END-2)+A(3)*F(N_END-1)! ELSE ! CALL LAGR_INTERP(2,P,A) ! F_INT3=A(1)*F(N_END-2)+A(2)*F(N_END-1) ! END IF ! ! P=TWO/FIVE ! IF(N_END > 4) THEN ! CALL LAGR_INTERP(3,P,A) ! F_INT4=A(1)*F(N_END-2)+A(2)*F(N_END-1)+A(3)*F(N_END) ! ELSE ! CALL LAGR_INTERP(2,P,A) ! F_INT4=A(1)*F(N_END-1)+A(2)*F(N_END) ! END IF ! ! RES1=CNC6(1)*F(N_END-3) + CNC6(2)*F_INT1 + & ! CNC6(3)*F_INT2 + CNC6(4)*F_INT3 + & ! CNC6(5)*F_INT4 + CNC6(6)*F(N_END) ! H1=THREE*H/FIVE ! RES=RES0+RES1*H1*C_H ! ! ELSE IF(N_REM == 4) THEN ! ! ! Lagrange 3 point interpolation for step 4H/5 points ! (or Lagrange 2-point when not possible) ! P=FOUR/FIVE ! IF(N_END > 5) THEN ! CALL LAGR_INTERP(3,P,A) ! F_INT1=A(1)*F(N_END-5)+A(2)*F(N_END-4)+A(3)*F(N_END-3)! ELSE ! CALL LAGR_INTERP(2,P,A) ! F_INT1=A(1)*F(N_END-4)+A(2)*F(N_END-3) ! END IF ! ! P=THREE/FIVE ! IF(N_END > 5) THEN ! CALL LAGR_INTERP(3,P,A) ! F_INT2=A(1)*F(N_END-4)+A(2)*F(N_END-3)+A(3)*F(N_END-2)! ELSE ! CALL LAGR_INTERP(2,P,A) ! F_INT2=A(1)*F(N_END-3)+A(2)*F(N_END-2) ! END IF ! ! P=TWO/FIVE ! IF(N_END > 5) THEN ! CALL LAGR_INTERP(3,P,A) ! F_INT3=A(1)*F(N_END-3)+A(2)*F(N_END-2)+A(3)*F(N_END-1)! ELSE ! CALL LAGR_INTERP(2,P,A) ! F_INT3=A(1)*F(N_END-2)+A(2)*F(N_END-1) ! END IF ! ! P=FIFTH ! IF(N_END > 5) THEN ! CALL LAGR_INTERP(3,P,A) ! F_INT4=A(1)*F(N_END-2)+A(2)*F(N_END-1)+A(3)*F(N_END) ! ELSE ! CALL LAGR_INTERP(2,P,A) ! F_INT4=A(1)*F(N_END-1)+A(2)*F(N_END) ! END IF ! ! RES1=CNC6(1)*F(N_END-4) + CNC6(2)*F_INT1 + & ! CNC6(3)*F_INT2 + CNC6(4)*F_INT3 + & ! CNC6(5)*F_INT4 + CNC6(6)*F(N_END) ! H1=FOUR*H/FIVE ! RES=RES0+RES1*H1*C_H ! ! END IF ! ! END IF ! ! ELSE IF(METH == 'EMS') THEN ! ! IF(N_RULE >= 1) THEN ! RES1=(F(N_BEG)+F(N_END))*HALF ! DO J=N_BEG+1,N_END-1 ! RES1=RES1+F(J) ! END DO ! RES1=RES1*H ! END IF ! IF(N_RULE >= 2) THEN ! RES1=RES1-BN(2)*H*H*(F_1(N_END)-F_1(N_BEG))/TWO ! END IF ! IF(N_RULE >= 3) THEN ! RES1=RES1-BN(4)*H*H*H*H*(F_3(N_END)-F_3(N_BEG))/24.0E0_WP ! END IF ! IF(N_RULE >= 4) THEN ! RES1=RES1-BN(6)*H*H*H*H*H*H*(F_5(N_END)-F_5(N_BEG)) / & ! 720.0E0_WP ! END IF ! RES=RES1 ! ! END IF ! ! ! Formats ! 10 FORMAT(//,10X,'<<<<< Wrong value of N_BEG: >>>>>',/, & 10X,'<<<<< Cannot be lower than 1 >>>>>',//) 20 FORMAT(//,10X,'<<<<< Wrong value of N_END: >>>>>',/, & 10X,'<<<<< Cannot exceed N_POINTS >>>>>',//) 30 FORMAT(//,10X,'<<<<< Wrong value of N_RULE: >>>>>',/, & 10X,'<<<<< Should be in [2,6] >>>>>',//) 40 FORMAT(//,10X,'<<<<< Wrong value of N_RULE: >>>>>',/, & 10X,'<<<<< Should be in [2,4] >>>>>',//) ! END SUBROUTINE INTEGR_INT ! !======================================================================= ! SUBROUTINE LAGR_INTERP(N,P,A) ! ! This subroutine computes the coefficients for the Lagrange ! n-point interpolation, 1 < n < 7 ! ! Input parameters: ! ! * N : number of points of the interpolation ! * P : value of the step fraction ! ! Output parameters: ! ! * A(N) : coefficients of the interpolation ! ! ! References: M. Abramowitz and I. A. Stegun, "Handbook of Mathematical ! "Functions", 9th Dover printing, pp.878-879, Dover ! ! ! Author : D. Sébilleau ! ! Last modified : 6 Aug 2020 ! ! USE REAL_NUMBERS, ONLY : ZERO,ONE,TWO,THREE,FOUR,SIX, & HALF ! IMPLICIT NONE ! REAL (WP) :: P,A(10) ! INTEGER :: N INTEGER :: J ! ! Initialization ! DO J=1,10 ! A(J)=ZERO ! END DO ! ! IF(N == 2) THEN ! ! !.......... 2-point Lagrange interpolation ............ ! A(1)=ONE-P ! A(2)=P ! ! ELSE IF(N == 3) THEN ! ! !.......... 3-point Lagrange interpolation ............ ! A(1)=HALF*P*(P-ONE) ! A(2)=ONE-P*P ! A(3)=HALF*P*(P+ONE) ! ! ELSE IF(N == 4) THEN ! ! !.......... 4-point Lagrange interpolation ............ ! A(1)=-P*(P-ONE)*(P-TWO)/SIX ! A(2)=(P*P-ONE)*(P-TWO)/TWO ! A(3)=-P*(P+ONE)*(P-TWO)/TWO ! A(4)=P*(P*P-ONE)/SIX ! ! ELSE IF(N == 5) THEN ! ! !.......... 5-point Lagrange interpolation ............ ! A(1)=(P*P-ONE)*P*(P-TWO)/24.0E0_WP ! A(2)=-(P-ONE)*P*(P*P-FOUR)/SIX ! A(3)=(P*P-ONE)*(P*P-FOUR)/FOUR ! A(4)=-(P+ONE)*P*(P*P-FOUR)/SIX ! A(5)=(P*P-ONE)*P*(P+TWO)/24.0E0_WP ! ! ELSE IF(N == 6) THEN ! ! !.......... 6-point Lagrange interpolation ............ ! A(1)=-P*(P*P-ONE)*(P-TWO)*(P-THREE)/120.0E0_WP ! A(2)=P*(P-ONE)*(P*P-FOUR)*(P-THREE)/24.0E0_WP ! A(3)=-(P*P-ONE)*(P*P-FOUR)*(P-THREE)/12.0E0_WP ! A(4)=P*(P+ONE)*(P*P-FOUR)*(P-THREE)/12.0E0_WP ! A(5)=-P*(P*P-ONE)*(P+TWO)*(P-THREE)/24.0E0_WP ! A(6)=P*(P*P-ONE)*(P*P-FOUR)/120.0E0_WP ! ! END IF ! ! END SUBROUTINE LAGR_INTERP ! END MODULE INTEGRATION4