Commit d05a6b57 authored by Matthias Redies's avatar Matthias Redies

move pointer_eibz to kpts

parent bca26a59
......@@ -15,7 +15,7 @@ MODULE m_types_kpts
contains
PROCEDURE :: init => init_eibz
procedure :: calc_nkpt_EIBZ => calc_nkpt_EIBZ
! procedure :: calc_pointer_EIBZ => calc_pointer_EIBZ
procedure :: calc_pointer_EIBZ => calc_pointer_EIBZ
end type t_eibz
TYPE, EXTENDS(t_fleurinput_base):: t_kpts
......@@ -294,8 +294,7 @@ CONTAINS
integer, intent(in) :: nk
call eibz%calc_nkpt_EIBZ(kpts, sym, nk)
call eibz%calc_pointer_EIBZ(kpts, sym, nk)
end subroutine init_EIBZ
SUBROUTINE init_kpts(kpts, cell, sym, film)
......@@ -529,68 +528,71 @@ CONTAINS
EIBZ%nkpt = ic
END subroutine calc_nkpt_EIBZ
! subroutine calc_pointer_EIBZ_kpts(kpts, sym)
! USE m_types_sym
! implicit none
! class(t_kpts), INTENT(INOUT) :: kpts
! type(t_sym), intent(in) :: sym
! INTEGER :: list(kpts%nkptf), parent(kpts%nkptf)
! integer :: nk, isym, i
! INTEGER :: rrot(3, 3, sym%nsym)
! do nk = 1, kpts%nkpt
! parent = 0
! DO isym = 1, sym%nsym
! IF (isym <= sym%nop) THEN
! rrot(:, :, isym) = transpose(sym%mrot(:, :, sym%invtab(isym)))
! ELSE
! rrot(:, :, isym) = -rrot(:, :, isym - sym%nop)
! END IF
! END DO
! ! determine extented irreducible BZ of k ( EIBZ(k) ), i.e.
! ! those k-points, which can generate the whole BZ by
! ! applying the symmetry operations of the little group of k
! call timestart("calc EIBZ")
! DO i = 1, kpts%nkptf
! list(i) = i - 1
! END DO
! ! calc numsymop
! call calc_psym_nsymop(kpts, sym, nk, psym, nsymop)
! DO ikpt = 2, kpts%nkptf
! DO iop = 1, nsymop
! rotkpt = matmul(rrot(:, :, psym(iop)), kpts%bkf(:, ikpt))
! !determine number of rotkpt
! nrkpt = kpts%get_nk(rotkpt)
! IF(nrkpt == 0) call judft_error('symm: Difference vector not found !')
! IF(list(nrkpt) /= 0) THEN
! list(nrkpt) = 0
! parent(nrkpt) = ikpt
! END IF
! IF(all(list == 0)) EXIT
! END DO
! END DO
! ! for the Gamma-point holds:
! parent(1) = 1
! IF(ALLOCATED(pointer_EIBZ)) DEALLOCATE(pointer_EIBZ)
! allocate(pointer_EIBZ(kpts%nkpt_EIBZ(nk)), source=0)
! ic = 0
! DO ikpt = 1, kpts%nkptf
! IF(parent(ikpt) == ikpt) THEN
! ic = ic + 1
! pointer_EIBZ(ic) = ikpt
! END IF
! END DO
! enddo
! end subroutine calc_pointer_EIBZ_kpts
subroutine calc_pointer_EIBZ(eibz, kpts, sym, nk)
USE m_types_sym
implicit none
class(t_eibz), intent(inout) :: eibz
type(t_kpts), INTENT(IN) :: kpts
type(t_sym), intent(in) :: sym
integer, intent(in) :: nk
INTEGER :: list(kpts%nkptf), parent(kpts%nkptf)
integer :: isym, i, nsymop, ic, ikpt, iop, nrkpt
INTEGER :: rrot(3, 3, sym%nsym)
INTEGER, ALLOCATABLE :: psym(:)
REAL :: rotkpt(3)
allocate (psym(sym%nsym))
parent = 0
DO isym = 1, sym%nsym
IF (isym <= sym%nop) THEN
rrot(:, :, isym) = transpose(sym%mrot(:, :, sym%invtab(isym)))
ELSE
rrot(:, :, isym) = -rrot(:, :, isym - sym%nop)
END IF
END DO
! determine extented irreducible BZ of k ( EIBZ(k) ), i.e.
! those k-points, which can generate the whole BZ by
! applying the symmetry operations of the little group of k
DO i = 1, kpts%nkptf
list(i) = i - 1
END DO
! calc numsymop
call calc_psym_nsymop(kpts, sym, nk, psym, nsymop)
DO ikpt = 2, kpts%nkptf
DO iop = 1, nsymop
rotkpt = matmul(rrot(:, :, psym(iop)), kpts%bkf(:, ikpt))
!determine number of rotkpt
nrkpt = kpts%get_nk(rotkpt)
IF(nrkpt == 0) call judft_error('symm: Difference vector not found !')
IF(list(nrkpt) /= 0) THEN
list(nrkpt) = 0
parent(nrkpt) = ikpt
END IF
IF(all(list == 0)) EXIT
END DO
END DO
! for the Gamma-point holds:
parent(1) = 1
IF(ALLOCATED(eibz%pointer)) DEALLOCATE(eibz%pointer)
allocate(eibz%pointer(eibz%nkpt), source=0)
ic = 0
DO ikpt = 1, kpts%nkptf
IF(parent(ikpt) == ikpt) THEN
ic = ic + 1
eibz%pointer(ic) = ikpt
END IF
END DO
end subroutine calc_pointer_EIBZ
subroutine calc_psym_nsymop(kpts, sym, nk, psym, nsymop)
USE m_types_sym
......
......@@ -60,7 +60,7 @@ MODULE m_exchange_valence_hf
CONTAINS
SUBROUTINE exchange_valence_hf(ik, fi, z_k, c_phase_k, mpdata, jsp, hybdat, lapw, eig_irr, results, &
pointer_EIBZ, n_q, wl_iks, xcpot, nococonv, stars, nsest, indx_sest, mpi, mat_ex)
n_q, wl_iks, xcpot, nococonv, stars, nsest, indx_sest, mpi, mat_ex)
USE m_wrapper
USE m_trafo
......@@ -95,8 +95,6 @@ CONTAINS
! arrays
INTEGER, INTENT(IN) :: n_q(:)
INTEGER, INTENT(IN) :: pointer_EIBZ(:)
INTEGER, INTENT(IN) :: nsest(:)
INTEGER, INTENT(IN) :: indx_sest(:, :)
......@@ -153,7 +151,7 @@ CONTAINS
exch_vv = 0
DO jq = 1,fi%kpts%EIBZ(ik)%nkpt
iq = pointer_EIBZ(jq)
iq = fi%kpts%EIBZ(ik)%pointer(jq)
iq_p = fi%kpts%bkp(iq)
......
......@@ -92,7 +92,6 @@ CONTAINS
INTEGER :: psym(fi%sym%nsym) ! Note: psym is only filled up to index nsymop
INTEGER, ALLOCATABLE :: parent(:)
INTEGER, ALLOCATABLE :: pointer_EIBZ(:)
INTEGER, ALLOCATABLE :: n_q(:)
complex :: c_phase_k(hybdat%nbands(nk))
......@@ -120,7 +119,7 @@ CONTAINS
CALL symm_hf_init(fi, nk, nsymop, rrot, psym)
CALL symm_hf(fi, nk, hybdat, eig_irr, mpdata, lapw, nococonv, z_k, c_phase_k, jsp, &
rrot, nsymop, psym, n_q, parent, pointer_EIBZ, nsest, indx_sest)
rrot, nsymop, psym, n_q, parent, nsest, indx_sest)
! remove weights(wtkpt) in w_iks
DO ikpt = 1, fi%kpts%nkptf
......@@ -134,7 +133,7 @@ CONTAINS
! HF exchange
ex%l_real = fi%sym%invs
CALL exchange_valence_hf(nk, fi, z_k, c_phase_k, mpdata, jsp, hybdat, lapw, eig_irr, results, &
pointer_EIBZ, n_q, wl_iks, xcpot, nococonv, stars, nsest, indx_sest, mpi, ex)
n_q, wl_iks, xcpot, nococonv, stars, nsest, indx_sest, mpi, ex)
CALL timestart("core exchange calculation")
......
......@@ -73,7 +73,7 @@ CONTAINS
END SUBROUTINE symm_hf_init
SUBROUTINE symm_hf(fi, nk, hybdat, eig_irr, mpdata, lapw, nococonv, zmat, c_phase, jsp, &
rrot, nsymop, psym, n_q, parent, pointer_EIBZ, nsest, indx_sest)
rrot, nsymop, psym, n_q, parent, nsest, indx_sest)
USE m_olap
USE m_trafo
......@@ -102,7 +102,6 @@ CONTAINS
INTEGER, INTENT(INOUT) :: parent(fi%kpts%nkptf)
INTEGER, INTENT(INOUT) :: nsest(hybdat%nbands(nk))
INTEGER, INTENT(INOUT) :: indx_sest(hybdat%nbands(nk), hybdat%nbands(nk))
INTEGER, ALLOCATABLE, INTENT(INOUT) :: pointer_EIBZ(:)
INTEGER, ALLOCATABLE, INTENT(INOUT) :: n_q(:)
REAL, INTENT(IN) :: eig_irr(:, :)
......@@ -180,16 +179,6 @@ CONTAINS
parent(1) = 1
neqvkpt(1) = 1
IF(ALLOCATED(pointer_EIBZ)) DEALLOCATE(pointer_EIBZ)
allocate(pointer_EIBZ(fi%kpts%EIBZ(nk)%nkpt), source=0)
ic = 0
DO ikpt = 1, fi%kpts%nkptf
IF(parent(ikpt) == ikpt) THEN
ic = ic + 1
pointer_EIBZ(ic) = ikpt
END IF
END DO
WRITE(oUnit, '(A,i5)') ' Number of k-points in the EIBZ', fi%kpts%EIBZ(nk)%nkpt
call timestop("calc EIBZ")
......
......@@ -550,11 +550,11 @@ SUBROUTINE rdmft(eig_id,mpi,fi,enpara,stars,&
call symm_hf_init(fi,ikpt,nsymop,rrot,psym)
call symm_hf(fi,ikpt,hybdat,eig_irr,mpdata,lapw,nococonv, zMat, c_phase,jspin,&
rrot,nsymop,psym,n_q,parent,pointer_EIBZ,nsest,indx_sest)
rrot,nsymop,psym,n_q,parent,nsest,indx_sest)
exMat%l_real=fi%sym%invs
CALL exchange_valence_hf(ikpt,fi,zMat, c_phase,mpdata,jspin,hybdat,lapw,&
eig_irr,results,pointer_EIBZ,n_q,wl_iks,xcpot,nococonv,stars,nsest,indx_sest,&
eig_irr,results,n_q,wl_iks,xcpot,nococonv,stars,nsest,indx_sest,&
mpi,exMat)
CALL exchange_vccv1(ikpt,fi%input,fi%atoms,fi%cell, fi%kpts, fi%sym, fi%noco,nococonv, fi%oned,&
mpdata,fi%hybinp,hybdat,jspin,lapw,nsymop,nsest,indx_sest,mpi,&
......
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