stern.f90 2.3 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65
MODULE m_stern
  !     **************************************************************
  !     returns star of recipocal space vector g
  !     called by force_a8 - APW+LO package
  !     *************************************************************
CONTAINS
  SUBROUTINE stern(sym,cell,g, nst,stg,taup,gl,rstg)

    USE m_constants, ONLY : tpi_const
    USE m_types
    IMPLICIT NONE
    TYPE(t_sym),INTENT(IN)   :: sym
    TYPE(t_cell),INTENT(IN)   :: cell
    !     ..
    !     .. Arguments
    INTEGER, INTENT (IN)  :: g(3) 

    INTEGER, INTENT (OUT) :: nst,stg(3,sym%nop)
    REAL,    INTENT (OUT) :: gl,rstg(3,sym%nop)
    COMPLEX, INTENT (OUT) :: taup(sym%nop)
    !     ..
    !     .. Local Variables
    INTEGER               :: i,m,j,k,l,ind(sym%nop)
    REAL                  :: tk,s,rg(3)

    ind(1:sym%nop)  = 0
    taup(1:sym%nop) = 0.0
    nst = 0                                                             

    rg(:) = REAL( g(:) )
    gl = SQRT( DOT_PRODUCT(rg,MATMUL(rg,cell%bbmat)))

    i_loop:DO i = 1,sym%nop
       tk=0.                                                          
       DO j=1,3                                                     
          tk=tk+sym%tau(j,i)*g(j)*tpi_const                                     
          k=0                                                         
          DO l=1,3
             k=sym%mrot(l,j,i)*g(l)+k                                       
          ENDDO
          stg(j,i)=k                                                  
       ENDDO
       IF (nst.NE.0) THEN                                              
          DO m = 1,nst                                                   
               IF (ALL(stg(:,m)==stg(:,i))) THEN
                  ind(m)=ind(m)+1
                  taup(m)=taup(m) + CMPLX(COS(tk),SIN(tk))
                  CYCLE i_loop
               ENDIF
            ENDDO
         ENDIF 
         nst=nst+1
         stg(:,nst)=stg(:,i)
         DO j = 1,3
            rstg(j,nst) = DOT_PRODUCT(stg(:,nst),cell%bmat(:,j))
         ENDDO
         ind(nst)  = 1
         taup(nst) = CMPLX(COS(tk),SIN(tk))
      ENDDO i_loop                                                        
                              
      taup(:nst)=taup(:nst)/ind(:nst)                                            

      RETURN
   END SUBROUTINE stern
END MODULE m_stern