Line data    Source code

       1             :       MODULE m_dr2fdr
       2             :       CONTAINS
       3             : 
       4           0 :       SUBROUTINE dr2fdr(function,rmsh,jri,
       5           0 :      <                  deriv)
       6             : c
       7             : c     Construct r**2 * df(r)/dr ; input 'function' is on a mesh (rmsh)
       8             : c     with 'jri' points and is assumed to be multiplied by r**2.
       9             : c     difcub performs analytic derivative of Lagrangian of 3rd order.
      10             : c
      11             :       USE m_differentiate,ONLY:difcub
      12             :       IMPLICIT NONE
      13             : 
      14             : ! Arguments ...
      15             : 
      16             :       INTEGER, INTENT (IN)  :: jri
      17             :       REAL,    INTENT (IN)  :: function(jri),rmsh(jri)
      18             :       REAL,    INTENT (OUT) :: deriv(jri)
      19             : 
      20             : ! Locals ...
      21             : 
      22             :       INTEGER ir
      23           0 :       REAL faux(jri),xi
      24             : 
      25             : 
      26             : c
      27             : c take derivative of r**2 f(r): faux = d[r^2 f(r)]/dr
      28             : c first point
      29             : c
      30           0 :       xi = rmsh(1)
      31           0 :       faux(1) = difcub(rmsh(1),function(1),xi)
      32             : c
      33             : c 2nd to last-2 
      34             : c
      35           0 :       DO ir = 2, jri - 2
      36           0 :          xi = rmsh(ir)
      37           0 :          faux(ir) = difcub(rmsh(ir-1),function(ir-1),xi)
      38             :       END DO
      39             : c
      40             : c last-1
      41             : c
      42           0 :       ir = jri - 1
      43           0 :       xi = rmsh(ir)
      44           0 :       faux(ir) = difcub(rmsh(jri-3),function(jri-3),xi)
      45             : c
      46             : c last point
      47             : c
      48           0 :       ir = jri
      49           0 :       xi = rmsh(ir)
      50           0 :       faux(ir) = difcub(rmsh(jri-3),function(jri-3),xi)
      51             : c
      52             : c calculate r^2 df(r)/dr = d[r^2 f(r)]/dr - 2 r f(r) 
      53             : c
      54           0 :       DO ir = 1, jri
      55           0 :          deriv(ir) = faux(ir) - 2.0 * function(ir) / rmsh(ir)
      56             :       END DO
      57             :  
      58           0 :       RETURN
      59             :       END SUBROUTINE dr2fdr
      60             :       END MODULE m_dr2fdr