gen_bz.F90 3.96 KB
Newer Older
1 2 3 4 5 6
!--------------------------------------------------------------------------------
! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
! This file is part of FLEUR and available as free software under the conditions
! of the MIT license as expressed in the LICENSE file in more detail.
!--------------------------------------------------------------------------------

Daniel Wortmann's avatar
Daniel Wortmann committed
7 8 9 10 11 12 13 14
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! gen_bz generates the (whole) Brillouin zone from the          !
! (irreducible) k-points given in the kpts file.                !
!                                                               !
!                                     M.Betzinger (09/07)       !
!                                                               !
!                        Refactored in 2017 by G.M.             !
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
15 16

 
Daniel Wortmann's avatar
Daniel Wortmann committed
17
MODULE m_gen_bz
18

Daniel Wortmann's avatar
Daniel Wortmann committed
19
CONTAINS
20

Daniel Wortmann's avatar
Daniel Wortmann committed
21
SUBROUTINE gen_bz( kpts,sym)
22

Daniel Wortmann's avatar
Daniel Wortmann committed
23 24 25 26 27 28 29
   !     bk     ::    irreducible k-points
   !     nkpt   ::    number of irr. k-points
   !     bkf    ::    all k-points
   !     nkptf  ::    number of all k-points
   !     bkp    ::    k-point parent
   !     bksym  ::    symmetry operation, that connects the parent
   !                  k-point with the current one
30

Daniel Wortmann's avatar
Daniel Wortmann committed
31 32 33
   USE m_juDFT
   USE m_util, ONLY: modulo1
   USE m_types
34

Daniel Wortmann's avatar
Daniel Wortmann committed
35
   IMPLICIT NONE
36

Daniel Wortmann's avatar
Daniel Wortmann committed
37 38 39 40 41 42
   TYPE(t_kpts),INTENT(INOUT) :: kpts
   TYPE(t_sym),INTENT(IN)     :: sym

!  - local scalars -
   INTEGER                 ::  ic,iop,ikpt,ikpt1
   LOGICAL                 ::  l_found
43
      
Daniel Wortmann's avatar
Daniel Wortmann committed
44 45
!  - local arrays - 
   INTEGER,ALLOCATABLE     ::  iarr(:)
Daniel Wortmann's avatar
Daniel Wortmann committed
46
   REAL                    ::  rrot(3,3,2*sym%nop),rotkpt(3)
Daniel Wortmann's avatar
Daniel Wortmann committed
47
   REAL,ALLOCATABLE        ::  rarr1(:,:)
Daniel Wortmann's avatar
Daniel Wortmann committed
48 49 50 51 52 53 54 55
   INTEGER:: nsym
   
   nsym=sym%nop
   if (.not.sym%invs) nsym=2*sym%nop
   
   ALLOCATE (kpts%bkf(3,nsym*kpts%nkpt))
   ALLOCATE (kpts%bkp(nsym*kpts%nkpt))
   ALLOCATE (kpts%bksym(nsym*kpts%nkpt))
56
      
Daniel Wortmann's avatar
Daniel Wortmann committed
57
   ! Generate symmetry operations in reciprocal space
Daniel Wortmann's avatar
Daniel Wortmann committed
58
   DO iop=1,nsym
Daniel Wortmann's avatar
Daniel Wortmann committed
59
      IF( iop .le. sym%nop ) THEN
Daniel Wortmann's avatar
Daniel Wortmann committed
60
         rrot(:,:,iop) = transpose( sym%mrot(:,:,iop) )
Daniel Wortmann's avatar
Daniel Wortmann committed
61 62 63 64 65 66 67 68 69 70 71 72
      ELSE
         rrot(:,:,iop) = -rrot(:,:,iop-sym%nop)
      END IF
   END DO

   ! Set target number for k points in full BZ
   kpts%nkptf = kpts%nkpt3(1)*kpts%nkpt3(2)*kpts%nkpt3(3)
   IF(kpts%l_gamma) THEN
      IF (ANY(MODULO(kpts%nkpt3(:),2).EQ.0)) THEN
         kpts%nkptf = kpts%nkptf + 1
      END IF
   END IF
73

Daniel Wortmann's avatar
Daniel Wortmann committed
74 75 76
   ! Apply symmetrie operations to all k-points of IBZ, test whether
   ! generated k-point already is in the full BZ set of k-points, and
   ! add it if it is not yet in this set.
77

Daniel Wortmann's avatar
Daniel Wortmann committed
78
   kpts%bkf = 0
Daniel Wortmann's avatar
Daniel Wortmann committed
79 80 81 82 83 84 85 86 87 88 89
  
   !Add existing vectors to list of full vectors
   print *,"WARNING from gen_bz"
   print *,"Assuming Identity to be fist symmetry op!"
   DO ic=1,kpts%nkpt
      kpts%bkf(:,ic) = kpts%bk(:,ic)
      kpts%bkp(ic)  = ic
      kpts%bksym(ic) = 1
   ENDDO
   ic=ic-1
   
Daniel Wortmann's avatar
Daniel Wortmann committed
90
   DO iop=1,nsym
Daniel Wortmann's avatar
Daniel Wortmann committed
91 92 93 94 95 96 97 98 99
      DO ikpt=1,kpts%nkpt
         l_found = .FALSE.
         rotkpt = MATMUL(rrot(:,:,iop), kpts%bk(:,ikpt))
         !transform back into IBZ
         rotkpt = modulo1(rotkpt,kpts%nkpt3)
         DO ikpt1=1,ic
            IF (MAXVAL(ABS(kpts%bkf(:,ikpt1) - rotkpt)).LE.1e-08) THEN
               l_found = .TRUE.
               EXIT
100
            END IF
Daniel Wortmann's avatar
Daniel Wortmann committed
101
         END DO
102
          
Daniel Wortmann's avatar
Daniel Wortmann committed
103
         IF(.NOT.l_found) THEN
104 105
            ic = ic + 1
            kpts%bkf(:,ic) = rotkpt
Daniel Wortmann's avatar
Daniel Wortmann committed
106 107 108
            kpts%bkp(ic) = ikpt
            kpts%bksym(ic) = iop
         END IF
109
      END DO
Daniel Wortmann's avatar
Daniel Wortmann committed
110 111
   END DO

Daniel Wortmann's avatar
Daniel Wortmann committed
112
   kpts%nkptf = ic
Daniel Wortmann's avatar
Daniel Wortmann committed
113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132

   ! Reallocate bkf, bkp, bksym
   ALLOCATE (iarr(kpts%nkptf))
   iarr = kpts%bkp(:kpts%nkptf)
   DEALLOCATE(kpts%bkp)
   ALLOCATE (kpts%bkp(kpts%nkptf))
   kpts%bkp = iarr
   iarr= kpts%bksym(:kpts%nkptf)
   DEALLOCATE (kpts%bksym )
   ALLOCATE (kpts%bksym(kpts%nkptf))
   kpts%bksym = iarr
   DEALLOCATE(iarr)
   ALLOCATE (rarr1(3,kpts%nkptf))
   rarr1 = kpts%bkf(:,:kpts%nkptf)
   DEALLOCATE (kpts%bkf )
   ALLOCATE (kpts%bkf(3,kpts%nkptf))
   kpts%bkf = rarr1
   DEALLOCATE(rarr1)
      
END SUBROUTINE gen_bz
133

Daniel Wortmann's avatar
Daniel Wortmann committed
134
END MODULE m_gen_bz