use fi in hsfock

parent 87fda13f
......@@ -139,8 +139,8 @@ CONTAINS
DO nk = 1, fi%kpts%nkpt
!DO nk = mpi%n_start,fi%kpts%nkpt,mpi%n_stride
CALL lapw%init(fi%input, fi%noco, nococonv,fi%kpts, fi%atoms, fi%sym, nk, fi%cell, l_zref)
CALL hsfock(nk, fi%atoms, mpdata, fi%hybinp, lapw, fi%kpts, jsp, fi%input, hybdat, eig_irr, fi%sym, fi%cell, &
fi%noco,nococonv, fi%oneD, results, MAXVAL(hybdat%nobd(:,jsp)), xcpot, mpi)
CALL hsfock(fi,nk, mpdata, lapw, jsp, hybdat, eig_irr, &
nococonv, results, MAXVAL(hybdat%nobd(:,jsp)), xcpot, mpi)
END DO
END DO
CALL timestop("Calculation of non-local HF potential")
......
......@@ -37,8 +37,8 @@ MODULE m_hsfock
! | calculate valence-core contribution c
! c
! variables: c
! kpts%nkptf := number of kpoints c
! kpts%nkpt := number of irreducible kpoints c
! fi%kpts%nkptf := number of kpoints c
! fi%kpts%nkpt := number of irreducible kpoints c
! nbands := number of bands for which the exchange matrix (mat_ex) c
! in the space of the wavefunctions is calculated c
! te_hfex := hf exchange contribution to the total energy c
......@@ -54,25 +54,18 @@ MODULE m_hsfock
CONTAINS
SUBROUTINE hsfock(nk, atoms, mpdata, hybinp, lapw, kpts, jsp, input, hybdat, &
eig_irr, sym, cell, noco,nococonv, oneD,&
SUBROUTINE hsfock(fi, nk, mpdata, lapw, jsp, hybdat, &
eig_irr,nococonv,&
results, mnobd, xcpot, mpi)
IMPLICIT NONE
type(t_fleurinput), intent(in) :: fi
TYPE(t_xcpot_inbuild), INTENT(IN) :: xcpot
TYPE(t_mpi), INTENT(IN) :: mpi
TYPE(t_input), INTENT(IN) :: input
TYPE(t_noco), INTENT(IN) :: noco
TYPE(t_nococonv), INTENT(IN) :: nococonv
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_oneD), intent(in) :: oneD
TYPE(t_mpdata), intent(inout) :: mpdata
TYPE(t_hybinp), INTENT(IN) :: hybinp
TYPE(t_hybdat), INTENT(INOUT) :: hybdat
TYPE(t_results), INTENT(INOUT) :: results
......@@ -97,8 +90,8 @@ CONTAINS
! local arrays
INTEGER :: nsest(hybdat%nbands(nk)), indx_sest(hybdat%nbands(nk), hybdat%nbands(nk))
INTEGER :: rrot(3, 3, sym%nsym)
INTEGER :: psym(sym%nsym) ! Note: psym is only filled up to index nsymop
INTEGER :: rrot(3, 3, fi%sym%nsym)
INTEGER :: psym(fi%sym%nsym) ! Note: psym is only filled up to index nsymop
INTEGER, ALLOCATABLE :: parent(:)
INTEGER, ALLOCATABLE :: pointer_EIBZ(:)
......@@ -106,7 +99,7 @@ CONTAINS
complex :: c_phase(hybdat%nbands(nk))
REAL :: wl_iks(input%neig, kpts%nkptf)
REAL :: wl_iks(fi%input%neig, fi%kpts%nkptf)
TYPE(t_mat) :: olap, trafo, invtrafo, ex, tmp, v_x, z
......@@ -115,16 +108,16 @@ CONTAINS
! preparations
! initialize gridf for radial integration
!CALL intgrf_init(atoms%ntype,atoms%jmtd,atoms%jri,atoms%dx,atoms%rmsh,hybdat%gridf)
!CALL intgrf_init(fi%atoms%ntype,fi%atoms%jmtd,fi%atoms%jri,fi%atoms%dx,fi%atoms%rmsh,hybdat%gridf)
! initialize weighting factor for HF exchange part
a_ex = xcpot%get_exchange_weight()
! read in lower triangle part of overlap matrix from direct acces file olap
call timestart("read in olap")
nbasfcn = MERGE(lapw%nv(1) + lapw%nv(2) + 2*atoms%nlotot, lapw%nv(1) + atoms%nlotot, noco%l_noco)
call olap%alloc(sym%invs, nbasfcn)
call read_olap(olap, kpts%nkpt*(jsp - 1) + nk)
nbasfcn = MERGE(lapw%nv(1) + lapw%nv(2) + 2*fi%atoms%nlotot, lapw%nv(1) + fi%atoms%nlotot, fi%noco%l_noco)
call olap%alloc(fi%sym%invs, nbasfcn)
call read_olap(olap, fi%kpts%nkpt*(jsp - 1) + nk)
IF (olap%l_real) THEN
DO i = 1, nbasfcn
DO j = 1, i
......@@ -142,42 +135,42 @@ CONTAINS
call timestop("read in olap")
IF (hybdat%l_calhf) THEN
ncstd = sum([((hybdat%nindxc(l, itype)*(2*l + 1)*atoms%neq(itype), l=0, hybdat%lmaxc(itype)), itype=1, atoms%ntype)])
ncstd = sum([((hybdat%nindxc(l, itype)*(2*l + 1)*fi%atoms%neq(itype), l=0, hybdat%lmaxc(itype)), itype=1, fi%atoms%ntype)])
IF (nk == 1 .and. mpi%irank == 0) WRITE (*, *) 'calculate new HF matrix'
IF (nk == 1 .and. jsp == 1 .and. input%imix > 10) CALL system('rm -f broyd*')
IF (nk == 1 .and. jsp == 1 .and. fi%input%imix > 10) CALL system('rm -f broyd*')
! calculate all symmetrie operations, which yield k invariant
allocate(parent(kpts%nkptf), stat=ok)
allocate(parent(fi%kpts%nkptf), stat=ok)
IF (ok /= 0) call judft_error('mhsfock: failure allocation parent')
parent = 0
call z%init(olap%l_real, nbasfcn, hybdat%nbands(nk))
if(nk /= kpts%bkp(nk)) call juDFT_error("We should be reading the parent z-mat here!")
call read_z(atoms, cell, hybdat, kpts, sym, noco, nococonv, input, nk, jsp, z, c_phase=c_phase)
if(nk /= fi%kpts%bkp(nk)) call juDFT_error("We should be reading the parent z-mat here!")
call read_z(fi%atoms, fi%cell, hybdat, fi%kpts, fi%sym, fi%noco, nococonv, fi%input, nk, jsp, z, c_phase=c_phase)
CALL timestart("symm_hf")
CALL symm_hf_init(sym, kpts, nk, nsymop, rrot, psym)
CALL symm_hf_init(fi%sym, fi%kpts, nk, nsymop, rrot, psym)
CALL symm_hf(kpts, nk, sym, hybdat, eig_irr, input,atoms, mpdata, hybinp, cell, lapw,&
noco, nococonv, oneD, z, c_phase, jsp, &
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, c_phase, jsp, &
rrot, nsymop, psym, nkpt_EIBZ, n_q, parent, pointer_EIBZ, nsest, indx_sest)
CALL timestop("symm_hf")
! remove weights(wtkpt) in w_iks
DO ikpt = 1, kpts%nkptf
DO iband = 1, input%neig
ikpt0 = kpts%bkp(ikpt)
wl_iks(iband, ikpt) = results%w_iks(iband, ikpt0, jsp)/(kpts%wtkpt(ikpt0)*kpts%nkptf)
DO ikpt = 1, fi%kpts%nkptf
DO iband = 1, fi%input%neig
ikpt0 = fi%kpts%bkp(ikpt)
wl_iks(iband, ikpt) = results%w_iks(iband, ikpt0, jsp)/(fi%kpts%wtkpt(ikpt0)*fi%kpts%nkptf)
END DO
END DO
! calculate contribution from valence electrons to the
! HF exchange
ex%l_real = sym%invs
CALL exchange_valence_hf(nk, kpts, nkpt_EIBZ, sym, atoms, mpdata, hybinp, cell, input, jsp, hybdat, mnobd, lapw, &
eig_irr, results, pointer_EIBZ, n_q, wl_iks, xcpot, noco, nococonv, oneD,nsest, indx_sest, &
ex%l_real = fi%sym%invs
CALL exchange_valence_hf(nk, fi%kpts, nkpt_EIBZ, fi%sym, fi%atoms, mpdata, fi%hybinp, fi%cell, fi%input, jsp, hybdat, mnobd, lapw, &
eig_irr, results, pointer_EIBZ, n_q, wl_iks, xcpot, fi%noco, nococonv, fi%oneD,nsest, indx_sest, &
mpi, ex)
CALL timestart("core exchange calculation")
......@@ -186,10 +179,10 @@ CONTAINS
IF (xcpot%is_name("hse") .OR. xcpot%is_name("vhse")) THEN
call judft_error('HSE not implemented in hsfock')
ELSE
CALL exchange_vccv1(nk, input,atoms,cell, kpts, sym, noco,nococonv, oneD, &
mpdata, hybinp, hybdat, jsp, &
CALL exchange_vccv1(nk, fi%input,fi%atoms,fi%cell, fi%kpts, fi%sym, fi%noco,nococonv, fi%oneD, &
mpdata, fi%hybinp, hybdat, jsp, &
lapw, nsymop, nsest, indx_sest, mpi, a_ex, results, ex)
CALL exchange_cccc(nk, atoms, hybdat, ncstd, sym, kpts, a_ex, results)
CALL exchange_cccc(nk, fi%atoms, hybdat, ncstd, fi%sym, fi%kpts, a_ex, results)
END IF
deallocate(n_q)
......@@ -197,7 +190,7 @@ CONTAINS
CALL timestart("time for performing T^-1*mat_ex*T^-1*")
!calculate trafo from wavefunctions to APW basis
IF (input%neig < hybdat%nbands(nk)) call judft_error(' mhsfock: neigd < nbands(nk) ;trafo from wavefunctions to APW requires at least nbands(nk)')
IF (fi%input%neig < hybdat%nbands(nk)) call judft_error(' mhsfock: neigd < nbands(nk) ;trafo from wavefunctions to APW requires at least nbands(nk)')
call olap%multiply(z, trafo)
......@@ -220,10 +213,10 @@ CONTAINS
CALL timestop("time for performing T^-1*mat_ex*T^-1*")
call timestart("symmetrizeh")
CALL symmetrizeh(atoms, kpts%bkf(:, nk), jsp, lapw, sym, hybdat%kveclo_eig, cell, nsymop, psym, v_x)
CALL symmetrizeh(fi%atoms, fi%kpts%bkf(:, nk), jsp, lapw, fi%sym, hybdat%kveclo_eig, fi%cell, nsymop, psym, v_x)
call timestop("symmetrizeh")
CALL write_v_x(v_x, kpts%nkpt*(jsp - 1) + nk)
CALL write_v_x(v_x, fi%kpts%nkpt*(jsp - 1) + nk)
END IF ! hybdat%l_calhf
CALL timestop("total time hsfock")
......
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