LCOV - code coverage report
Current view: top level - force - stern.f90 (source / functions) Hit Total Coverage
Test: combined.info Lines: 0 28 0.0 %
Date: 2019-09-08 04:53:50 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             :     IMPLICIT NONE
      12             :     TYPE(t_sym),INTENT(IN)   :: sym
      13             :     TYPE(t_cell),INTENT(IN)   :: cell
      14             :     !     ..
      15             :     !     .. Arguments
      16             :     INTEGER, INTENT (IN)  :: g(3) 
      17             : 
      18             :     INTEGER, INTENT (OUT) :: nst,stg(3,sym%nop)
      19             :     REAL,    INTENT (OUT) :: gl,rstg(3,sym%nop)
      20             :     COMPLEX, INTENT (OUT) :: taup(sym%nop)
      21             :     !     ..
      22             :     !     .. Local Variables
      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             :           ENDDO
      41           0 :           stg(j,i)=k                                                  
      42             :        ENDDO
      43           0 :        IF (nst.NE.0) THEN                                              
      44           0 :           DO m = 1,nst                                                   
      45           0 :                IF (ALL(stg(:,m)==stg(:,i))) THEN
      46           0 :                   ind(m)=ind(m)+1
      47           0 :                   taup(m)=taup(m) + CMPLX(COS(tk),SIN(tk))
      48           0 :                   CYCLE i_loop
      49             :                ENDIF
      50             :             ENDDO
      51             :          ENDIF 
      52           0 :          nst=nst+1
      53           0 :          stg(:,nst)=stg(:,i)
      54           0 :          DO j = 1,3
      55           0 :             rstg(j,nst) = DOT_PRODUCT(stg(:,nst),cell%bmat(:,j))
      56             :          ENDDO
      57           0 :          ind(nst)  = 1
      58           0 :          taup(nst) = CMPLX(COS(tk),SIN(tk))
      59             :       ENDDO i_loop                                                        
      60             :                               
      61           0 :       taup(:nst)=taup(:nst)/ind(:nst)                                            
      62             : 
      63           0 :       RETURN
      64             :    END SUBROUTINE stern
      65             : END MODULE m_stern

Generated by: LCOV version 1.13