! !======================================================================= ! MODULE DERIVATION ! ! This module containes subroutines to perform ! calculations of the first derivative of a function ! ! ! Modules used: ACCURACY_REAL ! USE ACCURACY_REAL ! CONTAINS ! ! !======================================================================= ! SUBROUTINE DERIV_1(F,N,IDERIV,H,F1) ! ! This subroutine is the driver program for the derivation of ! f(x) by x ! ! Input parameters: ! ! F : y coordinates of the input file ! N : dimension of the array F ! IDERIV : number of point used in the derivation ! H : x step of the input file ! ! ! Output parameters: ! ! F1 : first derivative of F ! ! ! Author : D. Sébilleau ! Last version : 10 Jun 2021 ! ! ! IMPLICIT NONE ! INTEGER, INTENT(IN) :: N,IDERIV ! REAL (WP), INTENT(IN) :: F(N) REAL (WP), INTENT(IN) :: H REAL (WP), INTENT(OUT) :: F1(N) ! IF(IDERIV == 2) THEN ! CALL DERIV_2P(F,N,F1,H) ! ELSE IF(IDERIV == 3) THEN ! CALL DERIV_3P(F,N,F1,H) ! ELSE IF(IDERIV == 4) THEN ! CALL DERIV_4P(F,N,F1,H) ! ELSE IF(IDERIV == 5) THEN ! CALL DERIV_5P(F,N,F1,H) ! ELSE IF(IDERIV == 6) THEN ! CALL DERIV_6P(F,N,F1,H) ! END IF ! ! END SUBROUTINE DERIV_1 ! !======================================================================= ! SUBROUTINE DERIV_2P(F,N,F1,H) ! ! This subroutine computes the first derivative F1 of function F, ! using a 2-point formula. ! ! The general formula used is a central difference formula, ! except for the first two points (forward difference formula) ! and for the last two points (backward difference formula). ! ! Input parameters: ! ! F : y coordinates of the input file ! N : dimension of the arrays ! H : step of the input file ! ! ! Output parameters: ! ! F1 : order 1 derivative of F ! ! ! ! References : A. K. Singh and G. R. Thorpe, ! RGMIA Res. Rep. Coll., 2(6), Article 7, 1999. ! ! T. F. Guidry, ! http://www.trentfguidry.net/post/2010/09/04/Numerical-differentiation-formulas.aspx ! ! ! Author : D. Sébilleau ! Last version : 10 Jun 2021 ! ! IMPLICIT NONE ! INTEGER, INTENT(IN) :: N ! INTEGER :: N_POINTS,JP ! REAL (WP), INTENT(IN) :: F(N) REAL (WP), INTENT(IN) :: H REAL (WP), INTENT(OUT) :: F1(N) ! REAL (WP) :: STEP1 REAL (WP) :: A(10,0:10),B(10,-10:0),C(10,-10:10) ! STEP1 = H ! ! N_POINTS = 2 ! ! CALL COEF_DERIV(N_POINTS,A,B,C) ! ! ! First derivative for the extremal point 1 ! F1(1) = (A(1,0) * F(1) + A(1,1) * F(2)) / STEP1 ! ! ! First derivative for the other points ! DO JP = 2, N ! F1(JP) = ( B(1,0) * F(JP) + B(1,-1) * F(JP-1) ) / STEP1 ! END DO ! ! END SUBROUTINE DERIV_2P ! !======================================================================= ! SUBROUTINE DERIV_3P(F,N,F1,H) ! ! This subroutine computes the first derivative F1 of function F, ! using a 3-point formula. ! ! The general formula used is a central difference formula, ! except for the first two points (forward difference formula) ! and for the last two points (backward difference formula). ! ! Input parameters: ! ! F : y coordinates of the input file ! N : dimension of the arrays ! H : step of the input file ! ! ! Output parameters: ! ! F1 : order 1 derivative of F ! ! ! ! References : A. K. Singh and G. R. Thorpe, ! RGMIA Res. Rep. Coll., 2(6), Article 7, 1999. ! ! T. F. Guidry, ! http://www.trentfguidry.net/post/2010/09/04/Numerical-differentiation-formulas.aspx ! ! ! Author : D. Sébilleau ! Last version : 10 Jun 2021 ! USE REAL_NUMBERS, ONLY : TWO ! IMPLICIT NONE ! INTEGER, INTENT(IN) :: N ! INTEGER :: N_POINTS,JP ! REAL (WP), INTENT(IN) :: F(N) REAL (WP), INTENT(IN) :: H REAL (WP), INTENT(OUT) :: F1(N) ! REAL (WP) :: STEP1 REAL (WP) :: A(10,0:10),B(10,-10:0),C(10,-10:10) ! STEP1 = TWO * H ! ! N_POINTS = 3 ! ! CALL COEF_DERIV(N_POINTS,A,B,C) ! ! ! First derivative for the extremal points 1 and N ! F1(1) = ( A(1,0) * F(1) + A(1,1) * F(2) + A(1,2) * F(3) ) & ! / STEP1 ! ! F1(N) = ( B(1,0) * F(N) + B(1,-1) * F(N-1) + B(1,-2) * & ! F(N-2) ) / STEP1 ! ! ! First derivative for the other points ! DO JP = 2, N-1 ! ! F1(JP) = ( C(1,-1) * F(JP-1) + C(1,0) * F(JP) + C(1,1) * & ! F(JP+1) ) / STEP1 ! ! END DO ! ! END SUBROUTINE DERIV_3P ! !======================================================================= ! SUBROUTINE DERIV_4P(F,N,F1,H) ! ! This subroutine computes the first derivative F1 of function F, ! using a 4-point formula. ! ! The general formula used is a central difference formula, ! except for the first two points (forward difference formula) ! and for the last two points (backward difference formula). ! ! Input parameters: ! ! F : y coordinates of the input file ! N : dimension of the arrays ! H : step of the input file ! ! ! Output parameters: ! ! F1 : order 1 derivative of F ! ! ! ! References : A. K. Singh and G. R. Thorpe, ! RGMIA Res. Rep. Coll., 2(6), Article 7, 1999. ! ! T. F. Guidry, ! http://www.trentfguidry.net/post/2010/09/04/Numerical-differentiation-formulas.aspx ! ! ! Author : D. Sébilleau ! Last version : 4 Jun 2020 ! ! IMPLICIT NONE ! INTEGER :: N,N_POINTS,JP ! REAL (WP) :: F(N),F1(N) REAL (WP) :: H,STEP1 REAL (WP) :: A(10,0:10),B(10,-10:0),C(10,-10:10) ! STEP1=H ! ! N_POINTS=4 ! ! CALL COEF_DERIV(N_POINTS,A,B,C) ! ! ! First derivative for the extremal points 1 and N ! F1(1)=(A(1,0)*F(1)+A(1,1)*F(2)+A(1,2)*F(3)+A(1,3)*F(4))/STEP1 ! F1(2)=(A(1,0)*F(2)+A(1,1)*F(3)+A(1,2)*F(4)+A(1,3)*F(5))/STEP1 ! F1(3)=(A(1,0)*F(3)+A(1,1)*F(4)+A(1,2)*F(5)+A(1,3)*F(6))/STEP1 ! ! ! First derivative for the other points ! DO JP=4,N ! ! F1(JP)=(B(1,0)*F(JP)+B(1,-1)*F(JP-1)+B(1,-2)*F(JP-2)+ & ! B(1,-3)*F(JP-3))/STEP1 ! ! END DO ! ! END SUBROUTINE DERIV_4P ! !======================================================================= ! SUBROUTINE DERIV_5P(F,N,F1,H) ! ! This subroutine computes the first derivative F1 of function F, ! using a 5-point formula. ! ! The general formula used is a central difference formula, ! except for the first two points (forward difference formula) ! and for the last two points (backward difference formula). ! ! Input parameters: ! ! F : y coordinates of the input file ! N : dimension of the arrays ! H : step of the input file ! ! ! Output parameters: ! ! F1 : order 1 derivative of F ! ! ! ! References : A. K. Singh and G. R. Thorpe, ! RGMIA Res. Rep. Coll., 2(6), Article 7, 1999. ! ! T. F. Guidry, ! http://www.trentfguidry.net/post/2010/09/04/Numerical-differentiation-formulas.aspx ! ! ! Author : D. Sébilleau ! Last version : 4 Jun 2020 ! ! IMPLICIT NONE ! INTEGER :: N,N_POINTS,JP ! REAL (WP) :: F(N),F1(N) REAL (WP) :: H,STEP1 REAL (WP) :: A(10,0:10),B(10,-10:0),C(10,-10:10) ! STEP1=12.E0_WP*H ! ! N_POINTS=5 ! ! CALL COEF_DERIV(N_POINTS,A,B,C) ! ! ! First derivative for the extremal points 1, 2, N-1 and N ! F1(1)=(A(1,0)*F(1)+A(1,1)*F(2)+A(1,2)*F(3)+A(1,3)*F(4)+ & ! A(1,4)*F(5))/STEP1 ! F1(2)=(A(1,0)*F(2)+A(1,1)*F(3)+A(1,2)*F(4)+A(1,3)*F(5)+ & ! A(1,4)*F(6))/STEP1 ! ! F1(N-1)=(B(1,0)*F(N-1)+B(1,-1)*F(N-2)+B(1,-2)*F(N-3)+ & ! B(1,-3)*F(N-4)+B(1,-4)*F(N-5))/STEP1 ! F1(N)=(B(1,0)*F(N)+B(1,-1)*F(N-1)+B(1,-2)*F(N-2)+ & ! B(1,-3)*F(N-3)+B(1,-4)*F(N-4))/STEP1 ! ! ! First derivative for the other points ! DO JP=3,N-2 ! ! F1(JP)=(C(1,-2)*F(JP-2)+C(1,-1)*F(JP-1)+C(1,0)*F(JP)+ & ! C(1,1)*F(JP+1)+C(1,2)*F(JP+2))/STEP1 ! ! END DO ! ! END SUBROUTINE DERIV_5P ! !======================================================================= ! SUBROUTINE DERIV_6P(F,N,F1,H) ! ! This subroutine computes the first derivative F1 of function F, ! using a 6-point formula. ! ! The general formula used is a central difference formula, ! except for the first two points (forward difference formula) ! and for the last two points (backward difference formula). ! ! Input parameters: ! ! F : y coordinates of the input file ! N : dimension of the arrays ! H : step of the input file ! ! ! Output parameters: ! ! F1 : order 1 derivative of F ! ! ! ! References : A. K. Singh and G. R. Thorpe, ! RGMIA Res. Rep. Coll., 2(6), Article 7, 1999. ! ! T. F. Guidry, ! http://www.trentfguidry.net/post/2010/09/04/Numerical-differentiation-formulas.aspx ! ! ! Author : D. Sébilleau ! Last version : 4 Jun 2020 ! ! IMPLICIT NONE ! INTEGER :: N,N_POINTS,JP ! REAL (WP) :: F(N),F1(N) REAL (WP) :: H,STEP1 REAL (WP) :: A(10,0:10),B(10,-10:0),C(10,-10:10) ! STEP1=60.E0_WP*H ! ! N_POINTS=6 ! ! CALL COEF_DERIV(N_POINTS,A,B,C) ! ! ! First derivative for the extremal points 1, 2, 3, 4 and 5 ! F1(1)=(A(1,0)*F(1)+A(1,1)*F(2)+A(1,2)*F(3)+A(1,3)*F(4)+ & ! A(1,4)*F(5)+A(1,5)*F(6))/STEP1 ! F1(2)=(A(1,0)*F(2)+A(1,1)*F(3)+A(1,2)*F(4)+A(1,3)*F(5)+ & ! A(1,4)*F(6)+A(1,5)*F(7))/STEP1 ! F1(3)=(A(1,0)*F(3)+A(1,1)*F(4)+A(1,2)*F(5)+A(1,3)*F(6)+ & ! A(1,4)*F(7)+A(1,5)*F(8))/STEP1 ! F1(4)=(A(1,0)*F(4)+A(1,1)*F(5)+A(1,2)*F(6)+A(1,3)*F(7)+ & ! A(1,4)*F(8)+A(1,5)*F(9))/STEP1 ! F1(5)=(A(1,0)*F(5)+A(1,1)*F(6)+A(1,2)*F(7)+A(1,3)*F(8)+ & ! A(1,4)*F(9)+A(1,5)*F(10))/STEP1 ! ! ! First derivative for the other points ! DO JP=6,N ! ! F1(JP)=(B(1,0)*F(JP)+B(1,-1)*F(JP-1)+B(1,-2)*F(JP-2)+ & ! B(1,-3)*F(JP-3)+B(1,-4)*F(JP-4)+ & ! B(1,-5)*F(JP-5))/STEP1 ! ! END DO ! ! END SUBROUTINE DERIV_6P ! !======================================================================= ! SUBROUTINE COEF_DERIV(NP,A,B,C) ! ! This subroutine computes the coefficients for the ! NP-point derivation with 1 < NP < 8 ! ! Derivatives up to order (NP-1) can be computed from ! these coefficients (limited to order 5) ! ! Input parameters: ! ! * NP : number of points of the derivation ! ! ! Output parameters: ! ! * A(ND,NP) : coefficients of the derivation for the forward ! difference scheme ! * B(ND,NP) : coefficients of the derivation for the backward ! difference scheme ! * C(ND,NP) : coefficients of the derivation for the central ! difference scheme ! ! with ND the order of the derivation ! ! References: T. F. Guidry, ! http://www.trentfguidry.net/post/2010/09/04/Numerical-differentiation-formulas.aspx ! ! ! Note: the coefficients are computed for three different schemes: ! ! = F : forward difference ! = B : backward difference ! = C : central difference (Stirling) ! ! The order of the coefficients is the following: ! ! = F : A(0)*F(I) + A(1)*F(I+1) + ... ! = B : B(0)*F(I) + B(-1)*F(I-1) + ... ! = C : ... + C(-1)*F(I-1) + C(0)*F(I) + C(1)*F(I+1) + ... ! ! ! Author : D. Sébilleau ! ! Last modified : 4 Jun 2020 ! IMPLICIT NONE ! INTEGER :: NP INTEGER :: I,J,K ! REAL (WP) :: A(10,0:10),B(10,-10:0),C(10,-10:10) ! ! Initializations ! DO J=1,10 ! DO K=0,10 ! A(J,K)=0.0E0_WP ! END DO ! DO K=-10,0 ! B(J,K)=0.0E0_WP ! END DO ! DO K=-10,10 ! C(J,K)=0.0E0_WP ! END DO ! END DO ! ! IF(NP == 2) THEN ! ! ! Forward difference scheme ! A(1,0)=-1.0E0_WP ! A(1,1)=1.0E0_WP ! ! ! Backward difference scheme ! B(1,0)=1.0E0_WP ! B(1,-1)=-1.0E0_WP ! ! ELSE IF(NP == 3) THEN ! ! ! Forward difference scheme ! A(1,0)=-3.0E0_WP ! A(1,1)=4.0E0_WP ! A(1,2)=-1.0E0_WP ! ! A(2,0)=1.0E0_WP ! A(2,1)=-2.0E0_WP ! A(2,2)=1.0E0_WP ! ! ! Backward difference scheme ! B(1,0)=3.0E0_WP ! B(1,-1)=-4.0E0_WP ! B(1,-2)=1.0E0_WP ! ! B(2,0)=1.0E0_WP ! B(2,-1)=-2.0E0_WP ! B(2,-2)=1.0E0_WP ! ! ! Central difference scheme ! C(1,-1)=-1.0E0_WP ! C(1,0)=0.0E0_WP ! C(1,1)=1.0E0_WP ! ! C(2,-1)=1.0E0_WP ! C(2,0)=-2.0E0_WP ! C(2,1)=1.0E0_WP ! ! ELSE IF(NP == 4) THEN ! ! ! Forward difference scheme ! A(1,0)=-11.0E0_WP ! A(1,1)=18.0E0_WP ! A(1,2)=-9.0E0_WP ! A(1,3)=2.0E0_WP ! ! A(2,0)=2.0E0_WP ! A(2,1)=-5.0E0_WP ! A(2,2)=4.0E0_WP ! A(2,3)=-1.0E0_WP ! ! A(3,0)=-1.0E0_WP ! A(3,1)=3.0E0_WP ! A(3,2)=-3.0E0_WP ! A(3,3)=1.0E0_WP ! ! ! Backward difference scheme ! B(1,0)=11.0E0_WP ! B(1,-1)=-18.0E0_WP ! B(1,-2)=9.0E0_WP ! B(1,-3)=-2.0E0_WP ! ! B(2,0)=2.0E0_WP ! B(2,-1)=-5.0E0_WP ! B(2,-2)=4.0E0_WP ! B(2,-3)=-1.0E0_WP ! ! B(3,0)=1.0E0_WP ! B(3,-1)=-3.0E0_WP ! B(3,-2)=3.0E0_WP ! B(3,-3)=-1.0E0_WP ! ! ELSE IF(NP == 5) THEN ! ! ! Forward difference scheme ! A(1,0)=-25.0E0_WP ! A(1,1)=48.0E0_WP ! A(1,2)=-36.0E0_WP ! A(1,3)=16.0E0_WP ! A(1,4)=-3.0E0_WP ! ! A(2,0)=35.0E0_WP ! A(2,1)=-104.0E0_WP ! A(2,2)=114.0E0_WP ! A(2,3)=-56.0E0_WP ! A(2,4)=11.0E0_WP ! ! A(3,0)=-5.0E0_WP ! A(3,1)=18.0E0_WP ! A(3,2)=-24.0E0_WP ! A(3,3)=14.0E0_WP ! A(3,4)=-3.0E0_WP ! ! A(4,0)=1.0E0_WP ! A(4,1)=-4.0E0_WP ! A(4,2)=6.0E0_WP ! A(4,3)=-4.0E0_WP ! A(4,4)=1.0E0_WP ! ! ! Backward difference scheme ! B(1,0)=25.0E0_WP ! B(1,-1)=-48.0E0_WP ! B(1,-2)=36.0E0_WP ! B(1,-3)=-16.0E0_WP ! B(1,-4)=3.0E0_WP ! ! B(2,0)=35.0E0_WP ! B(2,-1)=-104.0E0_WP ! B(2,-2)=114.0E0_WP ! B(2,-3)=-56.0E0_WP ! B(2,-4)=11.0E0_WP ! ! B(3,0)=5.0E0_WP ! B(3,-1)=-18.0E0_WP ! B(3,-2)=24.0E0_WP ! B(3,-3)=-14.0E0_WP ! B(3,-4)=3.0E0_WP ! ! B(4,0)=1.0E0_WP ! B(4,-1)=-4.0E0_WP ! B(4,-2)=6.0E0_WP ! B(4,-3)=-4.0E0_WP ! B(4,-4)=1.0E0_WP ! ! ! Central difference scheme ! C(1,-2)=1.0E0_WP ! C(1,-1)=-8.0E0_WP ! C(1,0)=0.0E0_WP ! C(1,1)=8.0E0_WP ! C(1,2)=-1.0E0_WP ! ! C(2,-2)=-1.0E0_WP ! C(2,-1)=16.0E0_WP ! C(2,0)=-30.0E0_WP ! C(2,1)=16.0E0_WP ! C(2,2)=-1.0E0_WP ! ! C(3,-2)=-1.0E0_WP ! C(3,-1)=2.0E0_WP ! C(3,0)=0.0E0_WP ! C(3,1)=-2.0E0_WP ! C(3,2)=1.0E0_WP ! ! C(4,-2)=1.0E0_WP ! C(4,-1)=-4.0E0_WP ! C(4,0)=6.0E0_WP ! C(4,1)=-4.0E0_WP ! C(4,2)=1.0E0_WP ! ! ELSE IF(NP == 6) THEN ! ! ! Forward difference scheme ! A(1,0)=-137.0E0_WP ! A(1,1)=300.0E0_WP ! A(1,2)=-300.0E0_WP ! A(1,3)=200.0E0_WP ! A(1,4)=-75.0E0_WP ! A(1,5)=12.0E0_WP ! ! A(2,0)=45.0E0_WP ! A(2,1)=-154.0E0_WP ! A(2,2)=214.0E0_WP ! A(2,3)=-156.0E0_WP ! A(2,4)=61.0E0_WP ! A(2,5)=-10.0E0_WP ! ! A(3,0)=-17.0E0_WP ! A(3,1)=71.0E0_WP ! A(3,2)=-118.0E0_WP ! A(3,3)=98.0E0_WP ! A(3,4)=-41.0E0_WP ! A(3,5)=7.0E0_WP ! ! A(4,0)=3.0E0_WP ! A(4,1)=-14.0E0_WP ! A(4,2)=26.0E0_WP ! A(4,3)=-24.0E0_WP ! A(4,4)=11.0E0_WP ! A(4,5)=-2.0E0_WP ! ! A(5,0)=-1.0E0_WP ! A(5,1)=5.0E0_WP ! A(5,2)=-10.0E0_WP ! A(5,3)=10.0E0_WP ! A(5,4)=-5.0E0_WP ! A(5,5)=1.0E0_WP ! ! ! Backward difference scheme ! B(1,0)=137.0E0_WP ! B(1,-1)=-300.0E0_WP ! B(1,-2)=300.0E0_WP ! B(1,-3)=-200.0E0_WP ! B(1,-4)=75.0E0_WP ! B(1,-5)=-12.0E0_WP ! ! B(2,0)=45.0E0_WP ! B(2,-1)=-154.0E0_WP ! B(2,-2)=214.0E0_WP ! B(2,-3)=-156.0E0_WP ! B(2,-4)=61.0E0_WP ! B(2,-5)=-10.0E0_WP ! ! B(3,0)=17.0E0_WP ! B(3,-1)=-71.0E0_WP ! B(3,-2)=118.0E0_WP ! B(3,-3)=-98.0E0_WP ! B(3,-4)=41.0E0_WP ! B(3,-5)=-7.0E0_WP ! ! B(4,0)=3.0E0_WP ! B(4,-1)=-14.0E0_WP ! B(4,-2)=26.0E0_WP ! B(4,-3)=-24.0E0_WP ! B(4,-4)=11.0E0_WP ! B(4,-5)=-2.0E0_WP ! ! B(5,0)=1.0E0_WP ! B(5,-1)=-5.0E0_WP ! B(5,-2)=10.0E0_WP ! B(5,-3)=-10.0E0_WP ! B(5,-4)=5.0E0_WP ! B(5,-5)=-1.0E0_WP ! ! ELSE IF(NP == 7) THEN ! ! ! Forward difference scheme ! A(1,0)=-147.0E0_WP ! A(1,1)=360.0E0_WP ! A(1,2)=-450.0E0_WP ! A(1,3)=400.0E0_WP ! A(1,4)=-225.0E0_WP ! A(1,5)=72.0E0_WP ! A(1,6)=-10.0E0_WP ! ! A(2,0)=812.0E0_WP ! A(2,1)=-3132.0E0_WP ! A(2,2)=5265.0E0_WP ! A(2,3)=-5080.0E0_WP ! A(2,4)=2970.0E0_WP ! A(2,5)=-972.0E0_WP ! A(2,6)=137.0E0_WP ! ! A(3,0)=-49.0E0_WP ! A(3,1)=232.0E0_WP ! A(3,2)=-461.0E0_WP ! A(3,3)=496.0E0_WP ! A(3,4)=-307.0E0_WP ! A(3,5)=104.0E0_WP ! A(3,6)=-15.0E0_WP ! ! A(4,0)=35.0E0_WP ! A(4,1)=-186.0E0_WP ! A(4,2)=411.0E0_WP ! A(4,3)=-484.0E0_WP ! A(4,4)=321.0E0_WP ! A(4,5)=-114.0E0_WP ! A(4,6)=17.0E0_WP ! ! A(5,0)=-7.0E0_WP ! A(5,1)=40.0E0_WP ! A(5,2)=-95.0E0_WP ! A(5,3)=120.0E0_WP ! A(5,4)=-85.0E0_WP ! A(5,5)=32.0E0_WP ! A(5,6)=-5.0E0_WP ! ! ! Backward difference scheme ! B(1,0)=147.0E0_WP ! B(1,-1)=-360.0E0_WP ! B(1,-2)=450.0E0_WP ! B(1,-3)=-400.0E0_WP ! B(1,-4)=225.0E0_WP ! B(1,-5)=-72.0E0_WP ! B(1,-6)=10.0E0_WP ! ! B(2,0)=812.0D0 B(2,-1)=-3132.0D0 B(2,-2)=5265.0D0 B(2,-3)=-5080.0D0 B(2,-4)=2970.0D0 B(2,-5)=-972.0D0 B(2,-6)=137.0D0 ! B(3,0)=49.0E0_WP ! B(3,-1)=-232.0E0_WP ! B(3,-2)=461.0E0_WP ! B(3,-3)=-496.0E0_WP ! B(3,-4)=307.0E0_WP ! B(3,-5)=-104.0E0_WP ! B(3,-6)=15.0E0_WP ! ! B(4,0)=35.0E0_WP ! B(4,-1)=-186.0E0_WP ! B(4,-2)=411.0E0_WP ! B(4,-3)=-484.0E0_WP ! B(4,-4)=321.0E0_WP ! B(4,-5)=-114.0E0_WP ! B(4,-6)=17.0E0_WP ! ! B(5,0)=7.0E0_WP ! B(5,-1)=-40.0E0_WP ! B(5,-2)=95.0E0_WP ! B(5,-3)=-120.0E0_WP ! B(5,-4)=85.0E0_WP ! B(5,-5)=-32.0E0_WP ! B(5,-6)=5.0E0_WP ! ! ! Central difference scheme ! C(1,-3)=-1.0E0_WP ! C(1,-2)=9.0E0_WP ! C(1,-1)=-45.0E0_WP ! C(1,0)=0.0E0_WP ! C(1,1)=45.0E0_WP ! C(1,2)=-9.0E0_WP ! C(1,3)=1.0E0_WP ! ! C(2,-3)=2.0E0_WP ! C(2,-2)=-27.0E0_WP ! C(2,-1)=270.0E0_WP ! C(2,0)=-490.0E0_WP ! C(2,1)=270.0E0_WP ! C(2,2)=-27.0E0_WP ! C(2,3)=2.0E0_WP ! ! C(3,-3)=1.0E0_WP ! C(3,-2)=-8.0E0_WP ! C(3,-1)=13.0E0_WP ! C(3,0)=0.0E0_WP ! C(3,1)=-13.0E0_WP ! C(3,2)=8.0E0_WP ! C(3,3)=-1.0E0_WP ! ! C(4,-3)=-1.0E0_WP ! C(4,-2)=12.0E0_WP ! C(4,-1)=-39.0E0_WP ! C(4,0)=56.0E0_WP ! C(4,1)=-39.0E0_WP ! C(4,2)=12.0E0_WP ! C(4,3)=-1.0E0_WP ! ! C(5,-3)=-1.0E0_WP ! C(5,-2)=4.0E0_WP ! C(5,-1)=-5.0E0_WP ! C(5,0)=0.0E0_WP ! C(5,1)=5.0E0_WP ! C(5,2)=-4.0E0_WP ! C(5,3)=1.0E0_WP ! ! END IF ! ! END SUBROUTINE COEF_DERIV ! END MODULE DERIVATION