Commit c29d2eed authored by Matthias Redies's avatar Matthias Redies

use fi in symm_hf aswell

parent 7caa8b7f
......@@ -136,8 +136,7 @@ CONTAINS
CALL symm_hf_init(fi, nk, nsymop, rrot, psym)
CALL symm_hf(fi%kpts, nk, fi%sym, hybdat, eig_irr, fi%input, fi%atoms, mpdata, fi%hybinp, fi%cell, lapw, &
fi%noco, nococonv, fi%oneD, 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, nkpt_EIBZ, n_q, parent, pointer_EIBZ, nsest, indx_sest)
! remove weights(wtkpt) in w_iks
......
......@@ -72,9 +72,8 @@ CONTAINS
CALL timestop("symm_hf_init")
END SUBROUTINE symm_hf_init
SUBROUTINE symm_hf(kpts, nk, sym, hybdat, eig_irr, input, atoms, mpdata, hybinp, cell, &
lapw, noco, nococonv,oneD, zmat, c_phase, jsp, rrot, nsymop, psym, nkpt_EIBZ, n_q, parent, &
pointer_EIBZ, nsest, indx_sest)
SUBROUTINE symm_hf(fi, nk, hybdat, eig_irr, mpdata, lapw, nococonv, zmat, c_phase, jsp, &
rrot, nsymop, psym, nkpt_EIBZ, n_q, parent, pointer_EIBZ, nsest, indx_sest)
USE m_olap
USE m_trafo
......@@ -83,19 +82,12 @@ CONTAINS
IMPLICIT NONE
type(t_fleurinput), intent(in) :: fi
TYPE(t_hybdat), INTENT(IN) :: hybdat
TYPE(t_input), INTENT(IN) :: input
TYPE(t_mpdata), intent(in) :: mpdata
TYPE(t_hybinp), INTENT(IN) :: hybinp
TYPE(t_sym), INTENT(IN) :: sym
TYPE(t_cell), INTENT(IN) :: cell
TYPE(t_kpts), INTENT(IN) :: kpts
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_lapw), INTENT(IN) :: lapw
type(t_noco), intent(in) :: noco
type(t_nococonv), intent(in):: nococonv
type(t_oneD), intent(in) :: oneD
type(t_mat), intent(in) :: zmat
! - scalars -
......@@ -108,7 +100,7 @@ CONTAINS
complex, intent(in) :: c_phase(hybdat%nbands(nk))
INTEGER, INTENT(IN) :: rrot(:, :, :)
INTEGER, INTENT(IN) :: psym(:)
INTEGER, INTENT(INOUT) :: parent(kpts%nkptf)
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(:)
......@@ -134,15 +126,15 @@ CONTAINS
COMPLEX, PARAMETER :: img = (0.0, 1.0)
! - local arrays -
INTEGER :: neqvkpt(kpts%nkptf)
INTEGER :: list(kpts%nkptf)
INTEGER :: neqvkpt(fi%kpts%nkptf)
INTEGER :: list(fi%kpts%nkptf)
INTEGER :: degenerat(hybdat%ne_eig(nk))
REAL :: rotkpt(3), g(3)
REAL, ALLOCATABLE :: olapmt(:, :, :, :)
COMPLEX :: cmt(hybdat%nbands(nk), hybdat%maxlmindx, atoms%nat)
COMPLEX :: carr1(hybdat%maxlmindx, atoms%nat)
COMPLEX :: cmt(hybdat%nbands(nk), hybdat%maxlmindx, fi%atoms%nat)
COMPLEX :: carr1(hybdat%maxlmindx, fi%atoms%nat)
COMPLEX, ALLOCATABLE :: carr(:), wavefolap(:, :)
COMPLEX, ALLOCATABLE :: cmthlp(:, :, :)
COMPLEX, ALLOCATABLE :: cpwhlp(:, :)
......@@ -162,17 +154,17 @@ CONTAINS
call timestart("calc EIBZ")
neqvkpt = 0
DO i = 1, kpts%nkptf
DO i = 1, fi%kpts%nkptf
list(i) = i - 1
END DO
DO ikpt = 2, kpts%nkptf
DO ikpt = 2, fi%kpts%nkptf
DO iop = 1, nsymop
rotkpt = matmul(rrot(:, :, psym(iop)), kpts%bkf(:, ikpt))
rotkpt = matmul(rrot(:, :, psym(iop)), fi%kpts%bkf(:, ikpt))
!determine number of rotkpt
nrkpt = kpts%get_nk(rotkpt)
nrkpt = fi%kpts%get_nk(rotkpt)
IF(nrkpt == 0) call judft_error('symm: Difference vector not found !')
IF(list(nrkpt) /= 0) THEN
......@@ -191,7 +183,7 @@ CONTAINS
! determine number of members in the EIBZ(k)
ic = 0
DO ikpt = 1, kpts%nkptf
DO ikpt = 1, fi%kpts%nkptf
IF(parent(ikpt) == ikpt) ic = ic + 1
END DO
nkpt_EIBZ = ic
......@@ -199,7 +191,7 @@ CONTAINS
IF(ALLOCATED(pointer_EIBZ)) DEALLOCATE(pointer_EIBZ)
allocate(pointer_EIBZ(nkpt_EIBZ), source=0)
ic = 0
DO ikpt = 1, kpts%nkptf
DO ikpt = 1, fi%kpts%nkptf
IF(parent(ikpt) == ikpt) THEN
ic = ic + 1
pointer_EIBZ(ic) = ikpt
......@@ -217,18 +209,18 @@ CONTAINS
ic = 0
n_q = 0
DO ikpt = 1, kpts%nkptf
DO ikpt = 1, fi%kpts%nkptf
IF(parent(ikpt) == ikpt) THEN
ic = ic + 1
DO iop = 1, nsymop
isym = psym(iop)
rotkpt = matmul(rrot(:, :, isym), kpts%bkf(:, ikpt))
rotkpt = matmul(rrot(:, :, isym), fi%kpts%bkf(:, ikpt))
!transfer rotkpt into BZ
rotkpt = kpts%to_first_bz(rotkpt)
rotkpt = fi%kpts%to_first_bz(rotkpt)
!check if rotkpt is identical to bk(:,ikpt)
IF(maxval(abs(rotkpt - kpts%bkf(:, ikpt))) <= 1E-06) THEN
IF(maxval(abs(rotkpt - fi%kpts%bkf(:, ikpt))) <= 1E-06) THEN
n_q(ic) = n_q(ic) + 1
END IF
END DO
......@@ -274,24 +266,24 @@ CONTAINS
END DO
#endif
! read in cmt and z at current k-point (nk)
call calc_cmt(atoms, cell, input, noco,nococonv, hybinp, hybdat, mpdata, kpts, &
sym, oneD, zmat, jsp, nk, c_phase, cmt)
call calc_cmt(fi%atoms, fi%cell, fi%input, fi%noco,nococonv, fi%hybinp, hybdat, mpdata, fi%kpts, &
fi%sym, fi%oned, zmat, jsp, nk, c_phase, cmt)
IF(allocated(olapmt)) deallocate(olapmt)
allocate(olapmt(maxval(mpdata%num_radfun_per_l), maxval(mpdata%num_radfun_per_l), 0:atoms%lmaxd, atoms%ntype), stat=ok)
allocate(olapmt(maxval(mpdata%num_radfun_per_l), maxval(mpdata%num_radfun_per_l), 0:fi%atoms%lmaxd, fi%atoms%ntype), stat=ok)
IF(ok /= 0) call judft_error('symm: failure allocation olapmt')
olapmt = 0
call timestart("calc olapmt")
DO itype = 1, atoms%ntype
DO l = 0, atoms%lmax(itype)
DO itype = 1, fi%atoms%ntype
DO l = 0, fi%atoms%lmax(itype)
nn = mpdata%num_radfun_per_l(l, itype)
DO n2 = 1, nn
DO n1 = 1, nn
olapmt(n1, n2, l, itype) = intgrf( &
hybdat%bas1(:, n1, l, itype)*hybdat%bas1(:, n2, l, itype) &
+ hybdat%bas2(:, n1, l, itype)*hybdat%bas2(:, n2, l, itype), &
atoms, itype, hybdat%gridf)
fi%atoms, itype, hybdat%gridf)
END DO
END DO
END DO
......@@ -304,11 +296,11 @@ CONTAINS
call timestart("calc wavefolap")
iatom = 0
DO itype = 1, atoms%ntype
DO ieq = 1, atoms%neq(itype)
DO itype = 1, fi%atoms%ntype
DO ieq = 1, fi%atoms%neq(itype)
iatom = iatom + 1
lm = 0
DO l = 0, atoms%lmax(itype)
DO l = 0, fi%atoms%lmax(itype)
DO M = -l, l
nn = mpdata%num_radfun_per_l(l, itype)
DO iband1 = 1, hybdat%nbands(nk)
......@@ -403,31 +395,31 @@ CONTAINS
pi = pimach()
call timestart("calc core repr")
IF(hybdat%lmaxcd > atoms%lmaxd) then
call judft_error('symm_hf: The very impropable case that hybdat%lmaxcd > atoms%lmaxd occurs')
IF(hybdat%lmaxcd > fi%atoms%lmaxd) then
call judft_error('symm_hf: The very impropable case that hybdat%lmaxcd > fi%atoms%lmaxd occurs')
endif
iatom = 0
iatom0 = 0
DO itype = 1, atoms%ntype
DO ieq = 1, atoms%neq(itype)
DO itype = 1, fi%atoms%ntype
DO ieq = 1, fi%atoms%neq(itype)
iatom = iatom + 1
DO iop = 1, nsymop
isym = psym(iop)
IF(isym <= sym%nop) THEN
IF(isym <= fi%sym%nop) THEN
iisym = isym
ELSE
iisym = isym - sym%nop
iisym = isym - fi%sym%nop
END IF
ratom = hybinp%map(iatom, isym)
rotkpt = matmul(rrot(:, :, isym), kpts%bkf(:, nk))
g = nint(rotkpt - kpts%bkf(:, nk))
ratom = fi%hybinp%map(iatom, isym)
rotkpt = matmul(rrot(:, :, isym), fi%kpts%bkf(:, nk))
g = nint(rotkpt - fi%kpts%bkf(:, nk))
cdum = exp(-2*pi*img*dot_product(rotkpt, sym%tau(:, iisym)))* &
exp(2*pi*img*dot_product(g, atoms%taual(:, ratom)))
cdum = exp(-2*pi*img*dot_product(rotkpt, fi%sym%tau(:, iisym)))* &
exp(2*pi*img*dot_product(g, fi%atoms%taual(:, ratom)))
END DO
END DO
iatom0 = iatom0 + atoms%neq(itype)
iatom0 = iatom0 + fi%atoms%neq(itype)
END DO
call timestop("calc core repr")
......
......@@ -544,8 +544,7 @@ SUBROUTINE rdmft(eig_id,mpi,fi,enpara,stars,&
indx_sest = 0
call symm_hf_init(fi,ikpt,nsymop,rrot,psym)
call symm_hf(fi%kpts,ikpt,fi%sym,hybdat,eig_irr,fi%input,fi%atoms,mpdata,fi%hybinp,fi%cell,lapw,&
fi%noco,nococonv, fi%oned, zMat, c_phase,jspin,&
call symm_hf(fi,ikpt,hybdat,eig_irr,mpdata,lapw,nococonv, zMat, c_phase,jspin,&
rrot,nsymop,psym,nkpt_EIBZ,n_q,parent,pointer_EIBZ,nsest,indx_sest)
exMat%l_real=fi%sym%invs
......
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