Commit d05a6b57 authored by Matthias Redies's avatar Matthias Redies

move pointer_eibz to kpts

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