Line data    Source code

       1             : !--------------------------------------------------------------------------------
       2             : ! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
       3             : ! This file is part of FLEUR and available as free software under the conditions
       4             : ! of the MIT license as expressed in the LICENSE file in more detail.
       5             : !--------------------------------------------------------------------------------
       6             : 
       7             : MODULE m_differentiate
       8             : CONTAINS
       9    29297692 :   REAL FUNCTION difcub(x,f,xi)
      10             :     !     **********************************************************
      11             :     !     differentiate the function f, given at the
      12             :     !     points x0,x1,x2,x3 at the point xi by lagrange
      13             :     !     interpolation for polynomial of 3rd order
      14             :     !     r.p.
      15             :     !     ***********************************************************
      16             :     IMPLICIT NONE
      17             :     !     .. Scalar Arguments ..
      18             :     REAL,INTENT(IN):: xi
      19             :     !     ..
      20             :     !     .. Array Arguments ..
      21             :     REAL,INTENT(IN):: f(0:3),x(0:3)
      22             :     !     ..
      23             :     difcub = ((xi-x(1))* (xi-x(2))+ (xi-x(1))* (xi-x(3))+&
      24             :          (xi-x(2))* (xi-x(3)))*f(0)/ ((x(0)-x(1))* (x(0)-x(2))*&
      25             :          (x(0)-x(3))) + ((xi-x(0))* (xi-x(2))+&
      26             :          (xi-x(0))* (xi-x(3))+ (xi-x(2))* (xi-x(3)))*f(1)/&
      27             :          ((x(1)-x(0))* (x(1)-x(2))* (x(1)-x(3))) +&
      28             :          ((xi-x(0))* (xi-x(1))+ (xi-x(0))* (xi-x(3))+&
      29             :          (xi-x(1))* (xi-x(3)))*f(2)/ ((x(2)-x(0))* (x(2)-x(1))*&
      30             :          (x(2)-x(3))) + ((xi-x(0))* (xi-x(1))+&
      31             :          (xi-x(0))* (xi-x(2))+ (xi-x(1))* (xi-x(2)))*f(3)/&
      32    29297692 :          ((x(3)-x(0))* (x(3)-x(1))* (x(3)-x(2)))
      33             :     RETURN
      34             :   END FUNCTION difcub
      35       11734 :   SUBROUTINE diff3(&
      36       11734 :        f,dx,&
      37       11734 :        df)
      38             :     !********************************************************************
      39             :     !     differetiation via 3-points
      40             :     !********************************************************************
      41             : 
      42             :     IMPLICIT NONE
      43             : 
      44             :     !     .. Scalar Arguments ..
      45             :     REAL,    INTENT (IN) :: dx
      46             :     !     ..
      47             :     !     .. Array Arguments ..
      48             :     REAL, INTENT (IN)  ::  f(:)
      49             :     REAL, INTENT (OUT) :: df(:)
      50             :     !     ..
      51             :     !     .. Local Scalars ..
      52             :     INTEGER i,jri
      53             :     REAL tdx_i
      54             :     !     ..
      55       11734 :     jri=size(f)
      56       11734 :     tdx_i = 1./(2.*dx)
      57             :     !
      58             :     !---> first point
      59       11734 :     df(1) = -tdx_i * (-3.*f(1)+4.*f(2)-f(3))
      60             :     !
      61             :     !---> central point formula in charge
      62    37483584 :     DO i = 2,jri - 1
      63    37483584 :        df(i) = tdx_i * (f(i+1)-f(i-1))
      64             :     END DO
      65             :     !
      66             :     !---> last point
      67       11734 :     df(jri) = tdx_i * (3.*f(jri)-4.*f(jri-1)+f(jri-2))
      68             :     !
      69       11734 :     RETURN
      70             :   END SUBROUTINE diff3
      71             : 
      72             : END MODULE m_differentiate