Line data    Source code

       1             : MODULE m_starf
       2             :     ! Construct the 2D and 3D star functions for a real space point r
       3             :     ! given in internal coordinates.
       4             :     ! Formula:
       5             :     ! sf(k) = 1/N_{op} \sum_{op(k)} e^{i * (\mat{R}_{op}\vec{G}_{k})^T
       6             :     !                                      \cdot (\vec{r} - \vec{\tau}_{op})}
       7             : 
       8             :     USE m_constants
       9             :     USE m_spgrot
      10             : 
      11             :     IMPLICIT NONE
      12             : 
      13             : CONTAINS
      14           0 :     SUBROUTINE starf2(nop2, ng2, kv2, mrot, symor, tau, r, invtab, sf, center)
      15             : 
      16             :         ! Scalar arguments:
      17             :         INTEGER, INTENT(IN) :: nop2, ng2
      18             :         LOGICAL, INTENT(IN) :: symor
      19             : 
      20             :         ! Array arguments:
      21             :         INTEGER, INTENT(IN)  :: kv2(2, ng2), mrot(3, 3, nop2)
      22             :         INTEGER, INTENT(IN)  :: invtab(nop2)
      23             : 
      24             :         REAL,    INTENT(IN)  :: r(3), tau(3, nop2)
      25             :         COMPLEX, INTENT(OUT) :: sf(ng2)
      26             :         REAL, INTENT(IN), OPTIONAL :: center(3)
      27             : 
      28             :         ! Local scalars:
      29             :         INTEGER :: k, n
      30             :         REAL    :: arg
      31             : 
      32             :         ! Local arrays:
      33           0 :         INTEGER :: kr(3, nop2), kv(3)
      34           0 :         COMPLEX :: ph(nop2)
      35             : 
      36           0 :         DO k = 1,ng2
      37           0 :             kv(1) = kv2(1, k)
      38           0 :             kv(2) = kv2(2, k)
      39           0 :             kv(3) = 0
      40             : 
      41           0 :             CALL spgrot(nop2, symor, mrot, tau, invtab, kv, kr, ph)
      42             : 
      43           0 :             sf(k) = 0.0
      44             : 
      45           0 :             DO n = 1, nop2
      46           0 :                 IF (.NOT. PRESENT(center)) THEN
      47           0 :                     arg = tpi_const * ( (kr(1, n))* r(1) + kr(2, n) * r(2) ) 
      48             :                 ELSE
      49           0 :                     arg = tpi_const * ( (kr(1, n) + center(1) )* r(1) + (kr(2, n) + center(2)) * r(2) ) 
      50             :                 END IF 
      51             :                 ! Sum up e^{i * \vec{G}_{op}^T
      52             :                 !               \cdot (\vec{r} - \vec{\tau}_{op})}
      53           0 :                     sf(k) = sf(k) + ph(n) * cmplx( cos(arg), sin(arg) )
      54             :             END DO
      55             : 
      56           0 :             sf(k) = sf(k) / nop2
      57             : 
      58             :         END DO
      59             : 
      60           0 :     END SUBROUTINE starf2
      61             : 
      62        8400 :     SUBROUTINE starf3(nop,ng3,symor,kv3,mrot,tau,r,invtab,sf,center)
      63             : 
      64             :         ! Scalar arguments:
      65             :         INTEGER, INTENT(IN) :: nop, ng3
      66             :         LOGICAL, INTENT(IN) :: symor
      67             : 
      68             :         ! Array arguments:
      69             :         INTEGER, INTENT(IN) :: kv3(3, ng3), mrot(3, 3, nop)
      70             :         INTEGER, INTENT(IN) :: invtab(nop)
      71             : 
      72             :         REAL,    INTENT(IN)   :: tau(3, nop), r(3)
      73             :         COMPLEX, INTENT (OUT) :: sf(ng3)
      74             :         REAL, INTENT(IN), OPTIONAL :: center(3)
      75             :         ! Local scalars:
      76             :         INTEGER :: k,n
      77             :         REAL    :: arg
      78             : 
      79             :         ! Local arrays:
      80        8400 :         INTEGER :: kr(3,nop)
      81        8400 :         COMPLEX :: ph(nop)
      82             : 
      83     5594400 :         DO k = 1, ng3
      84             : 
      85     5586000 :             CALL spgrot(nop, symor, mrot, tau, invtab, kv3(:, k), kr, ph)
      86             : 
      87     5586000 :             sf(k) = 0.0
      88             : 
      89    94962000 :             DO n = 1, nop
      90    89376000 :                 IF (PRESENT(center)) THEN
      91           0 :                     arg = tpi_const * dot_product( real(kr(:, n)) + center , r )   !! if flags + center
      92             :                 ELSE
      93   357504000 :                     arg = tpi_const * dot_product( real(kr(:, n)) , r ) 
      94             :                 END IF 
      95             :                 ! Sum up e^{i * \vec{G}_{op}^T
      96             :                 !               \cdot (\vec{r} - \vec{\tau}_{op})}
      97    94962000 :                 sf(k) = sf(k) + ph(n) * cmplx( cos(arg), sin(arg) )   
      98             :             END DO
      99             : 
     100     5594400 :             sf(k) = sf(k) / nop
     101             : 
     102             :         END DO
     103             : 
     104        8400 :     END SUBROUTINE starf3
     105             : 
     106             : END MODULE m_starf