Commit 14e7b223 authored by Matthias Redies's avatar Matthias Redies

status quo

parent a18333d8
......@@ -42,9 +42,9 @@ CONTAINS
INTEGER, INTENT(INOUT) :: iterHF
! local variables
type(t_hybmpi) :: glob_mpi, wp_mpi
type(t_hybmpi) :: glob_mpi, wp_mpi, tmp_mpi
type(t_work_package) :: work_pack
INTEGER :: jsp, nk, err, i, wp_rank, wp_size
INTEGER :: jsp, nk, err, i, wp_rank, wp_size, tmp_comm
type(t_lapw) :: lapw
LOGICAL :: init_vex = .TRUE. !In first call we have to init v_nonlocal
LOGICAL :: l_zref
......@@ -107,7 +107,9 @@ CONTAINS
! use jsp=1 for coulomb work-planning
call hybdat%set_states(fi, results, 1)
call work_pack%init(fi, hybdat, 1, glob_mpi%rank, glob_mpi%size)
call judft_comm_split(glob_mpi%comm, glob_mpi%rank, 1, tmp_comm)
call tmp_mpi%init(tmp_comm)
call work_pack%init(fi, hybdat, tmp_mpi, 1, glob_mpi%rank, glob_mpi%size)
CALL coulombmatrix(fmpi, fi, mpdata, hybdat, xcpot, work_pack)
call work_pack%free()
......@@ -127,8 +129,7 @@ CONTAINS
hybdat, v%mt(:, 0, :, :), eig_irr)
call timestop("HF_setup")
!call work_pack%init(fi, hybdat, jsp, glob_mpi%rank, glob_mpi%size)
call work_pack%init(fi, hybdat, jsp, wp_rank, wp_size)
call work_pack%init(fi, hybdat, wp_mpi, jsp, wp_rank, wp_size)
DO i = 1,work_pack%k_packs(1)%size
nk = work_pack%k_packs(i)%nk
......
......@@ -109,7 +109,7 @@ CONTAINS
! local scalars
INTEGER :: iband, iband1, jq, iq
INTEGER :: i, ierr, ik
INTEGER :: j, iq_p
INTEGER :: j, iq_p, start, stride
INTEGER :: n1, n2, nn2, cnt_read_z
INTEGER :: ikqpt, iob, m,n,k,lda,ldb,ldc
INTEGER :: ok, psize, n_parts, ipart, ibando
......@@ -163,7 +163,9 @@ CONTAINS
ikqpt = fi%kpts%get_nk(fi%kpts%to_first_bz(fi%kpts%bkf(:,ik) + fi%kpts%bkf(:,iq)))
n_parts = size(k_pack%q_packs(jq)%band_packs)
do ipart = 1, n_parts
start = k_pack%q_packs(jq)%submpi%rank+1
stride = k_pack%q_packs(jq)%submpi%size
do ipart = start, n_parts, stride
if(n_parts > 1) write (*,*) "Part (" // int2str(ipart) //"/"// int2str(n_parts) // ") ik= " // int2str(ik) // " jq= " // int2str(jq)
psize = k_pack%q_packs(jq)%band_packs(ipart)%psize
ibando = k_pack%q_packs(jq)%band_packs(ipart)%start_idx
......@@ -418,11 +420,18 @@ CONTAINS
! END DO
! write exch_vv in mat_ex
CALL mat_ex%alloc(matsize1=hybdat%nbands(ik))
if(k_pack%q_packs(jq)%submpi%root()) then
CALL mat_ex%alloc(matsize1=hybdat%nbands(ik))
else
CALL mat_ex%alloc(matsize1=1)
endif
IF (mat_ex%l_real) THEN
mat_ex%data_r = exch_vv
call MPI_Reduce(real(exch_vv), mat_ex%data_r, hybdat%nbands(ik)**2, MPI_DOUBLE_PRECISION, MPI_SUM, 0, k_pack%q_packs(jq)%submpi%comm, ierr)
!mat_ex%data_r = exch_vv
ELSE
mat_ex%data_c = exch_vv
call MPI_Reduce(exch_vv, mat_ex%data_c, hybdat%nbands(ik)**2, MPI_DOUBLE_COMPLEX, MPI_SUM, 0, k_pack%q_packs(jq)%submpi%comm, ierr)
!mat_ex%data_c = exch_vv
END IF
CALL timestop("valence exchange calculation")
......
......@@ -10,6 +10,7 @@ module m_work_package
type t_q_package
integer :: rank, size, ptr
type(t_hybmpi) :: submpi
type(t_band_package), allocatable :: band_packs(:)
contains
procedure :: init => t_q_package_init
......@@ -18,6 +19,7 @@ module m_work_package
type t_k_package
integer :: nk, rank, size
type(t_hybmpi) :: submpi
type(t_q_package), allocatable :: q_packs(:)
contains
procedure :: init => t_k_package_init
......@@ -28,6 +30,7 @@ module m_work_package
type t_work_package
integer :: rank, size, n_kpacks
type(t_k_package), allocatable :: k_packs(:)
type(t_hybmpi) :: submpi
contains
procedure :: init => t_work_package_init
procedure :: print => t_work_package_print
......@@ -70,49 +73,56 @@ contains
if(allocated(q_pack%band_packs)) deallocate(q_pack%band_packs)
end subroutine t_q_package_free
subroutine t_work_package_init(work_pack, fi, hybdat, jsp, rank, size)
subroutine t_work_package_init(work_pack, fi, hybdat, wp_mpi, jsp, rank, size)
implicit none
class(t_work_package), intent(inout) :: work_pack
type(t_fleurinput), intent(in) :: fi
type(t_hybdat), intent(in) :: hybdat
type(t_hybmpi), intent(in) :: wp_mpi
integer, intent(in) :: rank, size, jsp
work_pack%rank = rank
work_pack%size = size
work_pack%rank = rank
work_pack%size = size
work_pack%submpi = wp_mpi
call split_into_work_packages(work_pack, fi, hybdat, jsp)
end subroutine
end subroutine t_work_package_init
subroutine t_k_package_init(k_pack, fi, hybdat, jsp, nk)
subroutine t_k_package_init(k_pack, fi, hybdat, k_wide_mpi, jsp, nk)
implicit none
class(t_k_package), intent(inout) :: k_pack
type(t_fleurinput), intent(in) :: fi
type(t_hybdat), intent(in) :: hybdat
type(t_hybmpi), intent(in) :: k_wide_mpi
integer, intent(in) :: nk, jsp
integer :: iq, jq
k_pack%submpi = k_wide_mpi
k_pack%nk = nk
allocate(k_pack%q_packs(fi%kpts%EIBZ(nk)%nkpt))
do iq = 1,fi%kpts%EIBZ(nk)%nkpt
jq = fi%kpts%EIBZ(nk)%pointer(iq)
call k_pack%q_packs(iq)%init(fi, hybdat, jsp, nk, iq, jq)
call k_pack%q_packs(iq)%init(fi, hybdat, k_pack%submpi, jsp, nk, iq, jq)
enddo
end subroutine t_k_package_init
subroutine t_q_package_init(q_pack, fi, hybdat, jsp, nk, rank, ptr)
subroutine t_q_package_init(q_pack, fi, hybdat, q_wide_mpi, jsp, nk, rank, ptr)
implicit none
class(t_q_package), intent(inout) :: q_pack
type(t_fleurinput), intent(in) :: fi
type(t_hybdat), intent(in) :: hybdat
type(t_hybmpi), intent(in) :: q_wide_mpi
integer, intent(in) :: rank, ptr, jsp, nk
real :: target_psize
integer :: n_parts, ikqpt, i
integer, allocatable :: start_idx(:), psize(:)
q_pack%rank = rank
q_pack%size = fi%kpts%EIBZ(nk)%nkpt
q_pack%ptr = ptr
q_pack%submpi = q_wide_mpi
q_pack%rank = rank
q_pack%size = fi%kpts%EIBZ(nk)%nkpt
q_pack%ptr = ptr
! arrays should be less than 5 gb
if(fi%sym%invs) then
......@@ -124,6 +134,9 @@ contains
ikqpt = fi%kpts%get_nk(fi%kpts%to_first_bz(fi%kpts%bkf(:,nk) + fi%kpts%bkf(:,ptr)))
n_parts = ceiling(hybdat%nobd(ikqpt, jsp)/target_psize)
if(mod(n_parts, q_pack%submpi%size) /= 0) then
n_parts = n_parts + q_pack%submpi%size - mod(n_parts, q_pack%submpi%size)
endif
allocate(start_idx(n_parts), psize(n_parts))
allocate(q_pack%band_packs(n_parts))
......@@ -186,7 +199,7 @@ contains
work_pack%k_packs(k_cnt)%rank = k_cnt -1
work_pack%k_packs(k_cnt)%size = work_pack%n_kpacks
call work_pack%k_packs(k_cnt)%init(fi, hybdat, jsp, i)
call work_pack%k_packs(k_cnt)%init(fi, hybdat, work_pack%submpi, jsp, i)
k_cnt = k_cnt + 1
enddo
end subroutine split_into_work_packages
......
......@@ -392,7 +392,7 @@ SUBROUTINE rdmft(eig_id,fmpi,fi,enpara,stars,&
END DO
CALL glob_mpi%copy_mpi(fmpi)
call work_pack%init(fi, hybdat, jsp, glob_mpi%rank, glob_mpi%size)
call work_pack%init(fi, hybdat, glob_mpi, jsp, glob_mpi%rank, glob_mpi%size)
CALL coulombmatrix(fmpi, fi, mpdata, hybdat, xcpot, work_pack)
......
......@@ -15,17 +15,26 @@ MODULE m_types_hybmpi
procedure :: copy_mpi => t_hybmpi_copy_mpi
procedure :: barrier => t_hybmpi_barrier
procedure :: init => t_hybmpi_init
procedure :: root => t_hybmpi_root
END TYPE t_hybmpi
contains
subroutine t_hybmpi_copy_mpi(glob_mpi, mpi)
function t_hybmpi_root(mpi_var) result(l_root)
implicit none
class(t_hybmpi), intent(in) :: mpi_var
logical :: l_root
l_root = mpi_var%rank == 0
end function t_hybmpi_root
subroutine t_hybmpi_copy_mpi(glob_mpi, mpi_var)
use m_types_mpi
implicit none
class(t_hybmpi), intent(inout) :: glob_mpi
type(t_mpi), intent(in) :: mpi
type(t_mpi), intent(in) :: mpi_var
glob_mpi%comm = mpi%mpi_comm
glob_mpi%size = mpi%isize
glob_mpi%rank = mpi%irank
glob_mpi%comm = mpi_var%mpi_comm
glob_mpi%size = mpi_var%isize
glob_mpi%rank = mpi_var%irank
end subroutine
subroutine t_hybmpi_barrier(glob_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