gen_bz.F90 4.08 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
   USE m_closure
35

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

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

!  - local scalars -
   INTEGER                 ::  ic,iop,ikpt,ikpt1
   LOGICAL                 ::  l_found
44
      
Daniel Wortmann's avatar
Daniel Wortmann committed
45 46
!  - local arrays - 
   INTEGER,ALLOCATABLE     ::  iarr(:)
Daniel Wortmann's avatar
Daniel Wortmann committed
47
   REAL                    ::  rrot(3,3,2*sym%nop),rotkpt(3)
Daniel Wortmann's avatar
Daniel Wortmann committed
48
   REAL,ALLOCATABLE        ::  rarr1(:,:)
49 50 51 52 53 54 55 56 57

   INTEGER:: nsym,ID_mat(3,3)

   !As we might be early in init process, the inverse operation might not be available in sym. Hence
   !we calculate it here
   INTEGER                 :: inv_op(sym%nop),optype(sym%nop)
   INTEGER                 :: multtab(sym%nop,sym%nop)

   CALL check_close(sym%nop,sym%mrot,sym%tau,multtab,inv_op,optype)
Daniel Wortmann's avatar
Daniel Wortmann committed
58 59 60
   
   nsym=sym%nop
   if (.not.sym%invs) nsym=2*sym%nop
61 62 63 64 65

   IF (ANY(kpts%nkpt3==0)) THEN
      CALL judft_warn("Generating kpoints in full BZ failed. You have to specify nx,ny,nz in the kpoint-grid section of inp.xml")
      RETURN ! you skipped the error, so you get what you deserve...
   END IF
Daniel Wortmann's avatar
Daniel Wortmann committed
66 67 68
   ALLOCATE (kpts%bkf(3,nsym*kpts%nkpt))
   ALLOCATE (kpts%bkp(nsym*kpts%nkpt))
   ALLOCATE (kpts%bksym(nsym*kpts%nkpt))
69
      
Daniel Wortmann's avatar
Daniel Wortmann committed
70
   ! Generate symmetry operations in reciprocal space
Daniel Wortmann's avatar
Daniel Wortmann committed
71
   DO iop=1,nsym
Daniel Wortmann's avatar
Daniel Wortmann committed
72
      IF( iop .le. sym%nop ) THEN
73
         rrot(:,:,iop) = TRANSPOSE( sym%mrot(:,:,inv_op(iop)) )
Daniel Wortmann's avatar
Daniel Wortmann committed
74 75 76 77
      ELSE
         rrot(:,:,iop) = -rrot(:,:,iop-sym%nop)
      END IF
   END DO
78 79

    
Daniel Wortmann's avatar
Daniel Wortmann committed
80
   !Add existing vectors to list of full vectors
81 82 83
   id_mat=0
   ID_mat(1,1)=1;ID_mat(2,2)=1;ID_mat(3,3)=1
   IF (ANY(sym%mrot(:,:,1).NE.ID_mat)) CALL judft_error("Identity must be first symmetry operation",calledby="gen_bz")
Daniel Wortmann's avatar
Daniel Wortmann committed
84
   
85
   ic=0
Daniel Wortmann's avatar
Daniel Wortmann committed
86
   DO iop=1,nsym
Daniel Wortmann's avatar
Daniel Wortmann committed
87 88 89 90 91 92 93 94 95
      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
96
            END IF
Daniel Wortmann's avatar
Daniel Wortmann committed
97
         END DO
98
          
Daniel Wortmann's avatar
Daniel Wortmann committed
99
         IF(.NOT.l_found) THEN
100 101
            ic = ic + 1
            kpts%bkf(:,ic) = rotkpt
Daniel Wortmann's avatar
Daniel Wortmann committed
102 103 104
            kpts%bkp(ic) = ikpt
            kpts%bksym(ic) = iop
         END IF
105
      END DO
Daniel Wortmann's avatar
Daniel Wortmann committed
106 107
   END DO

Daniel Wortmann's avatar
Daniel Wortmann committed
108
   kpts%nkptf = ic
Daniel Wortmann's avatar
Daniel Wortmann committed
109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128

   ! 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
129

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