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
|