Commit 3d17b5a6 authored by Matthias Redies's avatar Matthias Redies

introduce adressbook for k's

parent 90d5326f
......@@ -45,13 +45,13 @@ CONTAINS
LOGICAL :: l_zref
character(len=999):: msg
REAL, ALLOCATABLE :: eig_irr(:, :)
INTEGER, ALLOCATABLE :: k_list(:)
INTEGER, ALLOCATABLE :: my_k_list(:), k_owner(:)
CALL timestart("hybrid code")
call sync_eig(eig_id)
call hybmpi%copy_mpi(mpi)
call split_k_to_comm(fi, hybmpi, k_list)
call split_k_to_comm(fi, hybmpi, my_k_list, k_owner)
INQUIRE (file="v_x.1", exist=hybdat%l_addhf)
......@@ -107,10 +107,10 @@ CONTAINS
call hybdat%coul(i)%alloc(fi, mpdata%num_radbasfn, mpdata%n_g)
enddo
if(mpi%irank == 0) CALL coulombmatrix(mpi, fi, mpdata, hybdat, xcpot)
if(mpi%irank == 0) CALL coulombmatrix(mpi, fi, mpdata, hybdat, xcpot, my_k_list)
do i =1,fi%kpts%nkpt
call hybdat%coul(i)%mpi_ibc(fi, hybmpi)
call hybdat%coul(i)%mpi_ibc(fi, hybmpi, 0)!k_owner(i))
enddo
CALL hf_init(eig_id, mpdata, fi, hybdat)
......@@ -124,8 +124,8 @@ CONTAINS
hybdat, fi%sym%invs, v%mt(:, 0, :, :), eig_irr)
call timestop("HF_setup")
DO i = 1,size(k_list)
nk = k_list(i)
DO i = 1,size(my_k_list)
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)
......@@ -169,22 +169,44 @@ CONTAINS
allocate(hybdat%div_vv(fi%input%neig, fi%kpts%nkpt, fi%input%jspins), source=0.0)
end subroutine first_iteration_alloc
subroutine split_k_to_comm(fi, hybmpi, k_list)
subroutine split_k_to_comm(fi, hybmpi, my_k_list, k_owner)
implicit none
type(t_fleurinput), intent(in) :: fi
type(t_hybmpi), intent(in) :: hybmpi
integer, allocatable, intent(inout) :: k_list(:)
integer :: i
integer, allocatable, intent(inout) :: my_k_list(:)
integer, allocatable, intent(inout) :: k_owner(:)
integer :: i, irank
if(allocated(k_list)) deallocate(k_list)
allocate(k_list(0))
if(allocated(my_k_list)) deallocate(my_k_list)
allocate(my_k_list(0))
if(fi%kpts%nkpt < hybmpi%size) call judft_error("not enough k-points for mpis")
! get my k-list
do i = hybmpi%rank+1,fi%kpts%nkpt,hybmpi%size
k_list = [k_list, i]
my_k_list = [my_k_list, i]
enddo
! findout who's got the other k's
if(.not. allocated(k_owner)) allocate(k_owner(fi%kpts%nkpt), source=-1)
do irank = 0,hybmpi%size-1
do i = irank+1,fi%kpts%nkpt,hybmpi%size
k_owner(i) = irank
enddo
enddo
! sanity check
do i = 1,size(my_k_list)
if(k_owner(my_k_list(i)) /= hybmpi%rank) then
write (*,*) "my_k_list", my_k_list
write (*,*) "i = ", i
write (*,*) "k_owner", k_owner
call judft_error("I should own my own k-point")
endif
enddo
end subroutine split_k_to_comm
END SUBROUTINE calc_hybrid
END MODULE m_calc_hybrid
......@@ -35,7 +35,7 @@ MODULE m_coulombmatrix
CONTAINS
SUBROUTINE coulombmatrix(mpi, fi, mpdata, hybdat, xcpot)
SUBROUTINE coulombmatrix(mpi, fi, mpdata, hybdat, xcpot, my_k_list)
USE m_types
USE m_types_hybdat
USE m_juDFT
......@@ -55,7 +55,8 @@ CONTAINS
TYPE(t_mpi), INTENT(IN) :: mpi
type(t_fleurinput), intent(in) :: fi
TYPE(t_mpdata), intent(in) :: mpdata
TYPE(t_hybdat), INTENT(INOUT) :: hybdat
TYPE(t_hybdat), INTENT(INOUT) :: hybdat
integer, intent(in) :: my_k_list(:)
! - local scalars -
INTEGER :: inviop
......@@ -909,6 +910,8 @@ CONTAINS
if(.not. allocated(hybdat%coul)) allocate(hybdat%coul(fi%kpts%nkpt))
call timestart("loop bla")
DO ikpt = 1, fi%kpts%nkpt
! DO i = 1,size(my_k_list)
! ikpt = my_k_list(i)
! initialize arrays to 0
call hybdat%coul(ikpt)%init()
! unpack coulomb into coulhlp
......
......@@ -381,10 +381,10 @@ SUBROUTINE rdmft(eig_id,mpi,fi,enpara,stars,&
!CALL open_hybinp_io2(mpdata, fi%hybinp,hybdat,fi%input,fi%atoms,fi%sym%invs)
if(mpi%irank == 0) CALL coulombmatrix(mpi, fi, mpdata, hybdat, xcpot)
if(mpi%irank == 0) CALL coulombmatrix(mpi, fi, mpdata, hybdat, xcpot, [(i,i=1,fi%kpts%nkpt)])
call hybmpi%copy_mpi(mpi)
do i =1,fi%kpts%nkpt
call hybdat%coul(i)%mpi_ibc(fi, hybmpi)
call hybdat%coul(i)%mpi_ibc(fi, hybmpi, 0)
enddo
CALL hf_init(eig_id,mpdata,fi,hybdat)
......
......@@ -17,6 +17,7 @@ MODULE m_types_hybdat
procedure :: free => t_coul_free
procedure :: mpi_ibc => t_coul_mpi_ibc
procedure :: mpi_wait => t_coul_mpi_wait
procedure :: size_MB => t_coul_size_MB
end type t_coul
TYPE t_hybdat
......@@ -62,6 +63,27 @@ MODULE m_types_hybdat
END TYPE t_hybdat
contains
function t_coul_size_MB(coul) result(size_MB)
implicit none
class(t_coul), intent(in) :: coul
real :: size_MB
size_MB = 0
! real parts
if(allocated(coul%mt1)) size_MB = size_MB + 8 * 1e-6 * size(coul%mt1)
if(allocated(coul%mt2_r)) size_MB = size_MB + 8 * 1e-6 * size(coul%mt2_r)
if(allocated(coul%mt3_r)) size_MB = size_MB + 8 * 1e-6 * size(coul%mt3_r)
if(allocated(coul%mtir_r)) size_MB = size_MB + 8 * 1e-6 * size(coul%mtir_r)
if(allocated(coul%pmtir_r)) size_MB = size_MB + 8 * 1e-6 * size(coul%pmtir_r)
! complex parts
if(allocated(coul%mt2_c)) size_MB = size_MB + 16 * 1e-6 * size(coul%mt2_r)
if(allocated(coul%mt3_c)) size_MB = size_MB + 16 * 1e-6 * size(coul%mt3_r)
if(allocated(coul%mtir_c)) size_MB = size_MB + 16 * 1e-6 * size(coul%mtir_r)
if(allocated(coul%pmtir_c)) size_MB = size_MB + 16 * 1e-6 * size(coul%pmtir_r)
end function
subroutine t_coul_mpi_wait(coul)
use m_judft
use mpi
......@@ -78,7 +100,7 @@ contains
endif
end subroutine t_coul_mpi_wait
subroutine t_coul_mpi_ibc(coul, fi, hybmpi)
subroutine t_coul_mpi_ibc(coul, fi, hybmpi, root)
use m_types_fleurinput
use m_types_hybmpi
use m_judft
......@@ -87,8 +109,9 @@ contains
class(t_coul) :: coul
type(t_fleurinput), intent(in) :: fi
type(t_hybmpi), intent(in) :: hybmpi
integer, intent(in) :: root
integer :: ierr
integer, parameter :: root = 0
call MPI_IBcast(coul%mt1, size(coul%mt1), MPI_DOUBLE_PRECISION, root, hybmpi%comm, coul%bcast_req(1), ierr)
if(ierr /= 0) call judft_error("MPI_IBcast of coul%mt1 failed")
......
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