Commit b0eca425 authored by Gregor Michalicek's avatar Gregor Michalicek

Fix kpoints/kptgen_hybrid.f for cases in which no k point mesh is provided

parent 8ded3989
......@@ -35,20 +35,20 @@ contains
END IF
END IF
IF (.NOT.l_kpts) THEN
IF (.NOT.l_kpts) THEN
IF (.NOT.oneD%odd%d1) THEN
IF (input%l_wann) THEN
sym_hlp=sym
sym_hlp%nop=1
sym_hlp%nop2=1
CALL kptgen_hybrid(kpts,sym_hlp%invs,noco%l_soc,sym_hlp%nop,sym_hlp%mrot,sym_hlp%tau)
CALL kptgen_hybrid(input,cell,sym_hlp,kpts,noco%l_soc)
ELSE IF (.FALSE.) THEN !this was used to generate q-points in jij case
sym_hlp=sym
sym_hlp%nop=1
sym_hlp%nop2=1
CALL julia(sym_hlp,cell,input,noco,banddos,kpts,.FALSE.,.TRUE.)
ELSE IF (kpts%l_gamma.and.(banddos%ndir.eq.0)) THEN
CALL kptgen_hybrid(kpts,sym%invs,noco%l_soc,sym%nop,sym%mrot,sym%tau)
CALL kptgen_hybrid(input,cell,sym,kpts,noco%l_soc)
ELSE
IF (banddos%unfoldband) THEN
CALL unfold_band_kpts(banddos,p_cell,cell,p_kpts,kpts)
......@@ -64,19 +64,19 @@ contains
CALL od_kptsgen (kpts%nkpt)
END IF
!Rescale weights and kpoints
IF (.not.banddos%unfoldband) THEN
kpts%wtkpt(:) = kpts%wtkpt(:) / sum(kpts%wtkpt)
!Rescale weights and kpoints
IF (.not.banddos%unfoldband) THEN
kpts%wtkpt(:) = kpts%wtkpt(:) / sum(kpts%wtkpt)
END IF
kpts%bk(:,:) = kpts%bk(:,:) / kpts%posScale
kpts%posScale = 1.0
IF (kpts%nkpt3(3).EQ.0) kpts%nkpt3(3) = 1
ELSE
IF (banddos%unfoldband) THEN
CALL unfold_band_kpts(banddos,p_cell,cell,p_kpts,kpts)
CALL find_supercell_kpts(banddos,p_cell,cell,p_kpts,kpts)
END IF
END IF
kpts%bk(:,:) = kpts%bk(:,:) / kpts%posScale
kpts%posScale = 1.0
IF (kpts%nkpt3(3).EQ.0) kpts%nkpt3(3) = 1
ELSE
IF (banddos%unfoldband) THEN
CALL unfold_band_kpts(banddos,p_cell,cell,p_kpts,kpts)
CALL find_supercell_kpts(banddos,p_cell,cell,p_kpts,kpts)
END IF
END IF
end subroutine kpoints
end module m_kpoints
......@@ -16,18 +16,19 @@
!Modified for types D.W.
SUBROUTINE kptgen_hybrid(kpts,invs,l_soc,nop,mrot,tau)
SUBROUTINE kptgen_hybrid(input,cell,sym,kpts,l_soc)
USE m_types
USE m_divi
IMPLICIT NONE
TYPE(t_kpts),INTENT(INOUT)::kpts
TYPE(t_input), INTENT(IN) :: input
TYPE(t_cell), INTENT(IN) :: cell
TYPE(t_sym), INTENT(IN) :: sym
TYPE(t_kpts), INTENT(INOUT) :: kpts
! - scalars -
INTEGER, INTENT(IN) :: nop
LOGICAL, INTENT(IN) :: invs
LOGICAL, INTENT(IN) :: l_soc
! - local arrays -
INTEGER, INTENT(IN) :: mrot(3,3,nop)
REAL , INTENT(IN) :: tau(3,nop)
! - local scalars -
INTEGER :: i,j,k,nkpt
INTEGER :: ikpt,ikpt0,nkpti
......@@ -43,6 +44,11 @@
REAL,ALLOCATABLE :: rarr(:)
LOGICAL :: ldum
IF (sum(kpts%nkpt3).EQ.0) THEN
CALL divi(kpts%nkpt,cell%bmat,input%film,sym%nop,
& sym%nop2,kpts%nkpt3)
END IF
nkpt=kpts%nkpt3(1)*kpts%nkpt3(2)*kpts%nkpt3(3)
ALLOCATE( bk(3,nkpt),bkhlp(3,nkpt) )
......@@ -59,22 +65,22 @@
IF( ikpt .ne. nkpt) STOP 'failure: number of k-points'
IF( invs .or. l_soc ) THEN
nsym = nop
IF( sym%invs .or. l_soc ) THEN
nsym = sym%nop
ELSE
nsym = 2*nop
nsym = 2*sym%nop
END IF
ALLOCATE( rot(3,3,nsym),rtau(3,nsym) )
DO i=1,nop
rot(:,:,i) = mrot(:,:,i)
rtau( :,i) = tau(:,i)
DO i=1,sym%nop
rot(:,:,i) = sym%mrot(:,:,i)
rtau( :,i) = sym%tau(:,i)
END DO
DO i = nop+1,nsym
rot(:,:,i) = rot(:,:,i-nop)
rtau( :,i) = rtau( :,i-nop)
DO i = sym%nop+1,nsym
rot(:,:,i) = rot(:,:,i-sym%nop)
rtau( :,i) = rtau( :,i-sym%nop)
END DO
IF(any(rot(:,:,1)-reshape((/1,0,0,0,1,0,0,0,1/),(/3,3/)).ne.0))
......@@ -84,8 +90,8 @@
invtab = 0
DO i = 1,nop
DO j = 1,nop
DO i = 1,sym%nop
DO j = 1,sym%nop
IF( all( matmul(rot(:,:,i),rot(:,:,j))
& .eq.reshape((/1,0,0,0,1,0,0,0,1/),(/3,3/)))
......@@ -102,8 +108,8 @@
END DO
DO i = nop+1,nsym
rrot(:,:,i) = - rrot(:,:,i-nop)
DO i = sym%nop+1,nsym
rrot(:,:,i) = - rrot(:,:,i-sym%nop)
END DO
ALLOCATE ( kptp(nkpt),symkpt(nkpt),rarr(3),iarr2(3),iarr(nkpt) )
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment