LCOV - code coverage report
Current view: top level - force - stern.f90 (source / functions) Hit Total Coverage
Test: FLEUR test coverage Lines: 0 28 0.0 %
Date: 2024-04-26 04:44:34 Functions: 0 1 0.0 %

          Line data    Source code
       1             : MODULE m_stern
       2             :    !-----------------------------------------------------------------------------
       3             :    ! Returns star of recipocal space vector g
       4             :    ! called by force_a8 - APW+LO package
       5             :    !-----------------------------------------------------------------------------
       6             : CONTAINS
       7           0 :    SUBROUTINE stern(sym,cell,g, nst,stg,taup,gl,rstg)
       8             : 
       9             :       USE m_constants, ONLY : tpi_const
      10             :       USE m_types
      11             : 
      12             :       IMPLICIT NONE
      13             : 
      14             :       TYPE(t_sym),  INTENT(IN) :: sym
      15             :       TYPE(t_cell), INTENT(IN) :: cell
      16             : 
      17             :       INTEGER,      INTENT(IN) :: g(3) 
      18             : 
      19             :       INTEGER,      INTENT (OUT) :: nst, stg(3,sym%nop)
      20             :       REAL,         INTENT (OUT) :: gl, rstg(3,sym%nop)
      21             :       COMPLEX,      INTENT (OUT) :: taup(sym%nop)
      22             : 
      23           0 :       INTEGER :: i, m, j, k, l, ind(sym%nop)
      24             :       REAL    :: tk, s, rg(3)
      25             : 
      26           0 :       ind(1:sym%nop)  = 0
      27           0 :       taup(1:sym%nop) = 0.0
      28           0 :       nst = 0                                                             
      29             : 
      30           0 :       rg(:) = REAL( g(:) )
      31           0 :       gl = SQRT( DOT_PRODUCT(rg,MATMUL(rg,cell%bbmat)))
      32             : 
      33           0 :       i_loop:DO i = 1,sym%nop
      34             :          tk=0.                                                          
      35           0 :          DO j=1,3                                                     
      36           0 :             tk=tk+sym%tau(j,i)*g(j)*tpi_const                                     
      37           0 :             k=0                                                         
      38           0 :             DO l=1,3
      39           0 :                k=sym%mrot(l,j,i)*g(l)+k                                       
      40             :             END DO
      41           0 :             stg(j,i)=k                                                  
      42             :          END DO
      43             : 
      44           0 :          IF (nst.NE.0) THEN                                              
      45           0 :             DO m = 1,nst                                                   
      46           0 :                IF (ALL(stg(:,m)==stg(:,i))) THEN
      47           0 :                   ind(m)=ind(m)+1
      48           0 :                   taup(m)=taup(m) + CMPLX(COS(tk),SIN(tk))
      49           0 :                   CYCLE i_loop
      50             :                END IF
      51             :             END DO
      52             :          END IF 
      53           0 :          nst=nst+1
      54           0 :          stg(:,nst)=stg(:,i)
      55             : 
      56           0 :          DO j = 1,3
      57           0 :             rstg(j,nst) = DOT_PRODUCT(stg(:,nst),cell%bmat(:,j))
      58             :          END DO
      59             : 
      60           0 :          ind(nst)  = 1
      61           0 :          taup(nst) = CMPLX(COS(tk),SIN(tk))
      62             :       END DO i_loop                                                        
      63             :                               
      64           0 :       taup(:nst)=taup(:nst)/ind(:nst)                                            
      65             : 
      66           0 :       RETURN
      67             :    END SUBROUTINE stern
      68             : 
      69             : END MODULE m_stern

Generated by: LCOV version 1.14