Commit 5d763443 authored by Matthias Redies's avatar Matthias Redies

first implementation of FFT (not working)

parent 96415bba
......@@ -9,7 +9,7 @@ MODULE m_calc_hybrid
CONTAINS
SUBROUTINE calc_hybrid(eig_id,fi,mpdata,hybdat,mpi,nococonv,enpara,&
SUBROUTINE calc_hybrid(eig_id,fi,mpdata,hybdat,mpi,nococonv,stars,enpara,&
results,xcpot,v,iterHF)
USE m_types_hybdat
......@@ -31,6 +31,7 @@ CONTAINS
TYPE(t_hybdat), INTENT(INOUT) :: hybdat
TYPE(t_mpi), INTENT(IN) :: mpi
TYPE(t_nococonv), INTENT(IN) :: nococonv
type(t_stars), intent(in) :: stars
TYPE(t_enpara), INTENT(IN) :: enpara
TYPE(t_results), INTENT(INOUT) :: results
TYPE(t_xcpot_inbuild), INTENT(IN) :: xcpot
......@@ -128,7 +129,7 @@ CONTAINS
nk = my_k_list(i)
CALL lapw%init(fi%input, fi%noco, nococonv,fi%kpts, fi%atoms, fi%sym, nk, fi%cell, l_zref)
CALL hsfock(fi,nk, mpdata, lapw, jsp, hybdat, eig_irr, &
nococonv, results, xcpot, mpi)
nococonv, stars, results, xcpot, mpi)
END DO
END DO
CALL timestop("Calculation of non-local HF potential")
......
......@@ -60,7 +60,7 @@ MODULE m_exchange_valence_hf
CONTAINS
SUBROUTINE exchange_valence_hf(ik, fi, z_k, c_phase_k, nkpt_EIBZ, mpdata, jsp, hybdat, lapw, eig_irr, results, &
pointer_EIBZ, n_q, wl_iks, xcpot, nococonv, nsest, indx_sest, mpi, mat_ex)
pointer_EIBZ, n_q, wl_iks, xcpot, nococonv, stars, nsest, indx_sest, mpi, mat_ex)
USE m_wrapper
USE m_trafo
......@@ -81,6 +81,7 @@ CONTAINS
TYPE(t_mpdata), intent(inout) :: mpdata
TYPE(t_nococonv), INTENT(IN) :: nococonv
TYPE(t_lapw), INTENT(IN) :: lapw
type(t_stars), intent(in) :: stars
TYPE(t_mat), INTENT(INOUT) :: mat_ex
TYPE(t_hybdat), INTENT(INOUT) :: hybdat
......@@ -174,7 +175,7 @@ CONTAINS
IF (mat_ex%l_real) THEN
CALL wavefproducts_inv(fi, ik, z_k, iq, jsp, ibando, ibando+psize-1, lapw, hybdat, mpdata, nococonv, nkqpt, cprod_vv)
ELSE
CALL wavefproducts_noinv(fi, ik, z_k, iq, jsp, ibando, ibando+psize-1, lapw, hybdat, mpdata, nococonv, nkqpt, cprod_vv)
CALL wavefproducts_noinv(fi, ik, z_k, iq, jsp, ibando, ibando+psize-1, lapw, hybdat, mpdata, nococonv, stars, nkqpt, cprod_vv)
END IF
! The sparse matrix technique is not feasible for the HSE
......
......@@ -43,7 +43,7 @@ MODULE m_hsfock
CONTAINS
SUBROUTINE hsfock(fi, nk, mpdata, lapw, jsp, hybdat, &
eig_irr, nococonv, &
eig_irr, nococonv, stars, &
results, xcpot, mpi)
use m_ex_to_vx
......@@ -64,6 +64,7 @@ CONTAINS
TYPE(t_mpi), INTENT(IN) :: mpi
TYPE(t_nococonv), INTENT(IN) :: nococonv
TYPE(t_lapw), INTENT(IN) :: lapw
type(t_stars), intent(in) :: stars
TYPE(t_mpdata), intent(inout) :: mpdata
TYPE(t_hybdat), INTENT(INOUT) :: hybdat
TYPE(t_results), INTENT(INOUT) :: results
......@@ -152,7 +153,7 @@ CONTAINS
! HF exchange
ex%l_real = fi%sym%invs
CALL exchange_valence_hf(nk, fi, z_k, c_phase_k, nkpt_EIBZ, mpdata, jsp, hybdat, lapw, eig_irr, results, &
pointer_EIBZ, n_q, wl_iks, xcpot, nococonv, nsest, indx_sest, mpi, ex)
pointer_EIBZ, n_q, wl_iks, xcpot, nococonv, stars, nsest, indx_sest, mpi, ex)
CALL timestart("core exchange calculation")
......
module m_wavefproducts_aux
CONTAINS
subroutine prep_list_of_gvec(lapw, mpdata, g_bounds, g_t, iq,jsp, pointer,gpt0, ngpt0)
subroutine prep_list_of_gvec(lapw, mpdata, g_bounds, g_t, iq, jsp, pointer, gpt0, ngpt0)
use m_types
use m_juDFT
implicit none
type(t_lapw), intent(in) :: lapw
type(t_lapw), intent(in) :: lapw
TYPE(t_mpdata), intent(in) :: mpdata
integer, intent(in) :: g_bounds(:), g_t(:), iq, jsp
integer, allocatable, intent(inout) :: pointer(:,:,:), gpt0(:,:)
integer, intent(inout) :: ngpt0
integer, intent(in) :: g_bounds(:), g_t(:), iq, jsp
integer, allocatable, intent(inout) :: pointer(:, :, :), gpt0(:, :)
integer, intent(inout) :: ngpt0
integer :: ic, ig1, igptm, iigptm, ok, g(3)
allocate(pointer(-g_bounds(1):g_bounds(1), &
-g_bounds(2):g_bounds(2),&
allocate (pointer(-g_bounds(1):g_bounds(1), &
-g_bounds(2):g_bounds(2), &
-g_bounds(3):g_bounds(3)), stat=ok)
IF (ok /= 0) call juDFT_error('wavefproducts_noinv2: error allocation pointer')
allocate(gpt0(3, size(pointer)), stat=ok)
allocate (gpt0(3, size(pointer)), stat=ok)
IF (ok /= 0) call juDFT_error('wavefproducts_noinv2: error allocation gpt0')
call timestart("prep list of Gvec")
......@@ -27,7 +26,7 @@ CONTAINS
DO ig1 = 1, lapw%nv(jsp)
DO igptm = 1, mpdata%n_g(iq)
iigptm = mpdata%gptm_ptr(igptm, iq)
g = lapw%gvec(:,ig1,jsp) + mpdata%g(:, iigptm) - g_t
g = lapw%gvec(:, ig1, jsp) + mpdata%g(:, iigptm) - g_t
IF (pointer(g(1), g(2), g(3)) == 0) THEN
ic = ic + 1
gpt0(:, ic) = g
......@@ -47,25 +46,55 @@ CONTAINS
type(t_noco), intent(in) :: noco
integer :: nbasfcn
if(noco%l_noco) then
if (noco%l_noco) then
nbasfcn = lapw%nv(1) + lapw%nv(2) + 2*atoms%nlotot
else
nbasfcn = lapw%nv(1) + atoms%nlotot
endif
end function calc_number_of_basis_functions
function outer_prod(x,y) result(outer)
function outer_prod(x, y) result(outer)
implicit NONE
complex, intent(in) :: x(:), y(:)
complex :: outer(size(x),size(y))
integer :: i,j
complex :: outer(size(x), size(y))
integer :: i, j
do j = 1,size(y)
do i = 1,size(x)
outer(i,j) = x(i) * y(j)
do j = 1, size(y)
do i = 1, size(x)
outer(i, j) = x(i)*y(j)
enddo
enddo
end function outer_prod
subroutine wavef2rs_cmplx(fi, lapw, stars, zmat, bandoi, bandof, jspin, psi)
use m_types
use m_fft_interface
implicit none
type(t_fleurinput), intent(in) :: fi
type(t_lapw), intent(in) :: lapw
type(t_mat), intent(in) :: zmat
type(t_stars), intent(in) :: stars
integer, intent(in) :: jspin, bandoi, bandof
complex, intent(inout) :: psi(0:,bandoi:) ! (nv,ne)
integer :: ivmap(SIZE(lapw%gvec, 2))
integer :: iv, nu
integer :: length_zfft(3), fft_idx(3)
DO iv = 1, lapw%nv(jspin)
ivmap(iv) = stars%g2fft(lapw%gvec(:, iv, jspin))
ENDDO
psi = 0.0
do nu = bandoi, bandof
!------> map WF nto FFTbox
DO iv = 1, lapw%nv(jspin)
psi(ivmap(iv), nu) = zMat%data_c(iv, nu)
ENDDO
length_zfft = [stars%kq1_fft, stars%kq2_fft, stars%kq3_fft]
call fft_interface(3, length_zfft, psi(:,nu), .false., ivmap(1:lapw%nv(jspin)))
enddo
end subroutine wavef2rs_cmplx
end module m_wavefproducts_aux
This diff is collapsed.
......@@ -260,7 +260,7 @@ END IF
IF (fi%hybinp%l_hybrid) THEN
SELECT TYPE(xcpot)
TYPE IS(t_xcpot_inbuild)
CALL calc_hybrid(eig_id,fi,mpdata,hybdat,mpi,nococonv,enpara,&
CALL calc_hybrid(eig_id,fi,mpdata,hybdat,mpi,nococonv, stars,enpara,&
results,xcpot,vTot,iterHF)
END SELECT
IF(hybdat%l_calhf) THEN
......
......@@ -545,7 +545,7 @@ SUBROUTINE rdmft(eig_id,mpi,fi,enpara,stars,&
exMat%l_real=fi%sym%invs
CALL exchange_valence_hf(ikpt,fi,zMat, c_phase,nkpt_EIBZ,mpdata,jspin,hybdat,lapw,&
eig_irr,results,pointer_EIBZ,n_q,wl_iks,xcpot,nococonv,nsest,indx_sest,&
eig_irr,results,pointer_EIBZ,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