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

          Line data    Source code
       1             :       MODULE m_starf
       2             : !     ********************************************************
       3             : !     synthesize 2-d and 3-d star function at point r, which
       4             : !     is given in internal coordinates
       5             : !     ********************************************************    
       6             :       USE m_constants
       7             :       USE m_spgrot
       8             :       IMPLICIT NONE
       9             :       CONTAINS
      10             : !     ********************************************************
      11        1200 :       SUBROUTINE starf2(
      12        2400 :      >                  nop2,ng2,kv2,mrot,symor,tau,r,invtab,
      13        1200 :      <                  sf)
      14             : !     ..
      15             : !     .. Scalar Arguments ..
      16             :       INTEGER, INTENT (IN) :: nop2,ng2
      17             :       LOGICAL, INTENT (IN) :: symor
      18             : !     ..
      19             : !     .. Array Arguments ..
      20             :       INTEGER, INTENT (IN) :: kv2(2,ng2),mrot(3,3,nop2)
      21             :       INTEGER, INTENT (IN) :: invtab(nop2)
      22             :       REAL,    INTENT (IN) :: r(3),tau(3,nop2)
      23             :       COMPLEX, INTENT (OUT):: sf(ng2)
      24             : !     ..
      25             : !     .. Local Arrays ..
      26        2400 :       INTEGER kr(3,nop2),kv(3),k,n
      27             :       REAL    arg
      28        2400 :       COMPLEX ph(nop2)
      29             : 
      30             :     
      31      103200 :       DO k = 1,ng2
      32      102000 :          kv(1) = kv2(1,k)
      33      102000 :          kv(2) = kv2(2,k)
      34      102000 :          kv(3) = 0
      35      102000 :          sf(k) = 0.0
      36             : 
      37             :          CALL spgrot(
      38             :      >               nop2,symor,mrot,tau,invtab,
      39             :      >               kv,
      40      102000 :      <               kr,ph)
      41             : 
      42      714000 :          DO n = 1,nop2
      43      612000 :             arg = tpi_const* (kr(1,n)*r(1)+kr(2,n)*r(2))
      44      714000 :             sf(k) = sf(k) + ph(n) * cmplx(cos(arg),sin(arg))
      45             :          ENDDO
      46      103200 :          sf(k) = sf(k)/nop2
      47             :       ENDDO
      48             : 
      49        1200 :       END SUBROUTINE starf2
      50             : !     ********************************************************
      51       12588 :       SUBROUTINE starf3(
      52       12588 :      >                  nop,ng3,symor,kv3,mrot,tau,r,invtab,
      53       12588 :      <                  sf)
      54             : !     ..
      55             : !     .. Scalar Arguments ..
      56             :       INTEGER, INTENT (IN) :: nop,ng3
      57             :       LOGICAL, INTENT (IN) :: symor
      58             : !     ..
      59             : !     .. Array Arguments ..
      60             :       INTEGER, INTENT (IN) :: kv3(3,ng3),mrot(3,3,nop)
      61             :       INTEGER, INTENT (IN) :: invtab(nop)
      62             : 
      63             :       REAL,    INTENT (IN) :: tau(3,nop),r(3)
      64             :       COMPLEX, INTENT (OUT):: sf(ng3)
      65             : !     ..
      66             : !     .. Local Arrays ..
      67       25176 :       INTEGER kr(3,nop),k,n
      68             :       REAL    arg
      69       25176 :       COMPLEX ph(nop)
      70             : 
      71             :     
      72    13919064 :       DO k = 1,ng3
      73             :          CALL spgrot(
      74             :      >               nop,symor,mrot,tau,invtab,
      75             :      >               kv3(1,k),
      76    13906476 :      <               kr,ph)
      77    13906476 :          sf(k) = 0.0
      78   204990188 :          DO n = 1,nop
      79   191083712 :             arg = tpi_const* (kr(1,n)*r(1)+kr(2,n)*r(2)+kr(3,n)*r(3))
      80   204990188 :             sf(k) = sf(k) + ph(n) * cmplx(cos(arg),sin(arg))
      81             :          ENDDO
      82    13919064 :          sf(k) = sf(k)/nop
      83             :       ENDDO
      84             : 
      85       12588 :       END SUBROUTINE starf3
      86             : !     ********************************************************
      87             :       END MODULE m_starf

Generated by: LCOV version 1.13