LCOV - code coverage report
Current view: top level - dos - smooth.f (source / functions) Hit Total Coverage
Test: combined.info Lines: 24 24 100.0 %
Date: 2019-09-08 04:53:50 Functions: 1 1 100.0 %

          Line data    Source code
       1             :       MODULE m_smooth
       2             : !
       3             : !     the function f(x), defined on a linear mesh,
       4             : !     is smoothened by a gaussian
       5             : !
       6             :       CONTAINS
       7          72 :       SUBROUTINE smooth(e,
       8          72 :      X                  f,
       9             :      >                  sigma,n)
      10             : 
      11             :       USE m_constants, ONLY: tpi_const
      12             :       IMPLICIT NONE
      13             : 
      14             : !    Arguments
      15             :       INTEGER, INTENT(IN)    :: n
      16             :       REAL,    INTENT(INOUT) :: f(n)
      17             :       REAL,    INTENT(IN)    :: sigma , e(n)
      18             : 
      19             : !    Locals
      20         144 :       REAL :: c , c2 , dx  , f0(n)
      21             :       INTEGER :: i , j , j1 , j2 , m1, m
      22             : 
      23          72 :       REAL, ALLOCATABLE :: ee(:)
      24             :  
      25          72 :       dx = e(2) - e(1)
      26          72 :       c = dx/(sigma*sqrt(tpi_const))
      27          72 :       c2 = -0.5*(dx/sigma)**2
      28             : 
      29          72 :       m = NINT(sqrt(log(1.0e-8/c)/c2))+1
      30          72 :       ALLOCATE ( ee(m) )
      31       15540 :       DO i = 1, m
      32        7734 :          ee(i) = c * exp(c2*(i-1)**2)
      33        7806 :          IF ( ee(i).LT.1.E-8 ) EXIT
      34             :       ENDDO
      35          72 :       m1=i-1
      36       93744 :       f0 = f
      37       93744 :       f = 0.
      38             :      
      39      187416 :       DO i = 1 , N
      40       93672 :          j1 = i - m1 + 1
      41       93672 :          IF ( j1.LT.1 ) j1 = 1
      42       93672 :          j2 = i + m1 - 1
      43       93672 :          IF ( j2.GT.N ) j2 = N
      44    19299324 :          DO j = j1 , j2
      45    19299252 :             f(i) = f(i) + ee(IABS(j-i)+1)*f0(j)
      46             :          ENDDO
      47             :       ENDDO
      48          72 :       DEALLOCATE ( ee )
      49             : 
      50          72 :       END SUBROUTINE smooth
      51             :       END MODULE m_smooth

Generated by: LCOV version 1.13