Commit 57242738 authored by Matthias Redies's avatar Matthias Redies

add work_packages everywhere

parent 4beb52ad
......@@ -41,20 +41,18 @@ CONTAINS
! local variables
type(t_hybmpi) :: hybmpi
type(t_work_package) :: work_pack
INTEGER :: jsp, nk, err, i, j, n_work_pack
INTEGER :: jsp, nk, err, i, j
type(t_lapw) :: lapw
LOGICAL :: init_vex = .TRUE. !In first call we have to init v_nonlocal
LOGICAL :: l_zref
character(len=999):: msg
REAL, ALLOCATABLE :: eig_irr(:, :)
INTEGER, ALLOCATABLE :: my_k_list(:), k_owner(:)
CALL timestart("hybrid code")
call sync_eig(eig_id, fi, .True.)
call hybmpi%copy_mpi(mpi)
call work_pack%init(fi, hybmpi%rank, hybmpi%size)
call split_k_to_comm(fi, hybmpi, my_k_list, k_owner)
INQUIRE (file="v_x.1", exist=hybdat%l_addhf)
......@@ -107,7 +105,7 @@ CONTAINS
call hybdat%coul(i)%alloc(fi, mpdata%num_radbasfn, mpdata%n_g, i)
enddo
CALL coulombmatrix(mpi, fi, mpdata, hybdat, xcpot, my_k_list)
CALL coulombmatrix(mpi, fi, mpdata, hybdat, xcpot, work_pack)
do i =1,fi%kpts%nkpt
call hybdat%coul(i)%mpi_ibc(fi, hybmpi, work_pack%owner_nk(i))
......@@ -126,7 +124,7 @@ CONTAINS
DO i = 1,work_pack%k_packs(1)%size
nk = work_pack%k_packs(i)%n_k
nk = work_pack%k_packs(i)%nk
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, stars, results, xcpot, mpi)
......
......@@ -35,7 +35,8 @@ MODULE m_coulombmatrix
CONTAINS
SUBROUTINE coulombmatrix(mpi, fi, mpdata, hybdat, xcpot, my_k_list)
SUBROUTINE coulombmatrix(mpi, fi, mpdata, hybdat, xcpot, work_pack)
use m_work_package
use m_structureconstant
USE m_types
USE m_types_hybdat
......@@ -58,7 +59,7 @@ CONTAINS
type(t_fleurinput), intent(in) :: fi
TYPE(t_mpdata), intent(in) :: mpdata
TYPE(t_hybdat), INTENT(INOUT) :: hybdat
integer, intent(in) :: my_k_list(:)
type(t_work_package), intent(in) :: work_pack
! - local scalars -
INTEGER :: inviop
......@@ -153,15 +154,15 @@ CONTAINS
call coul_mtmt%alloc(.False., maxval(hybdat%nbasm), maxval(hybdat%nbasm))
allocate(coulomb(fi%kpts%nkpt))
DO im = 1, size(my_k_list)
ikpt = my_k_list(im)
DO im = 1, work_pack%k_packs(1)%size
ikpt = work_pack%k_packs(im)%nk
call coulomb(ikpt)%alloc(.False., hybdat%nbasm(ikpt), hybdat%nbasm(ikpt))
enddo
call timestop("coulomb allocation")
IF (mpi%irank == 0) then
write (oUnit,*) "Size of coulomb matrix: " //&
float2str(sum([(coulomb(my_k_list(i))%size_mb(), i=1,size(my_k_list))])) // " MB"
float2str(sum([(coulomb(work_pack%k_packs(i)%nk)%size_mb(), i=1,work_pack%k_packs(1)%size)])) // " MB"
endif
! Generate Symmetry:
......@@ -427,8 +428,8 @@ CONTAINS
call coulmat%alloc(.False., hybdat%nbasp, hybdat%nbasp)
DO im = 1, size(my_k_list)
ikpt = my_k_list(im)
DO im = 1, work_pack%k_packs(1)%size
ikpt = work_pack%k_packs(im)%nk
! only the first rank handles the MT-MT part
call timestart("MT-MT part")
......@@ -502,8 +503,8 @@ CONTAINS
! (2c) r,r' in different MT
call timestart("loop over interst.")
DO im = 1, size(my_k_list)
ikpt = my_k_list(im)
DO im = 1, work_pack%k_packs(1)%size
ikpt = work_pack%k_packs(im)%nk
call loop_over_interst(fi, hybdat, mpdata, structconst, sphbesmoment, moment, moment2, &
qnrm, facc, gmat, integral, olap, pqnrm, pgptm1, ngptm1, ikpt, coulomb(ikpt))
......@@ -522,8 +523,8 @@ CONTAINS
! Coulomb matrix, contribution (3a)
call timestart("coulomb matrix 3a")
DO im = 1, size(my_k_list)
ikpt = my_k_list(im)
DO im = 1, work_pack%k_packs(1)%size
ikpt = work_pack%k_packs(im)%nk
DO igpt0 = 1, ngptm1(ikpt)
igpt2 = pgptm1(igpt0, ikpt)
......@@ -563,8 +564,8 @@ CONTAINS
! (3b) r,r' in different MT
call timestart("coulomb matrix 3b")
DO im = 1, size(my_k_list)
ikpt = my_k_list(im)
DO im = 1, work_pack%k_packs(1)%size
ikpt = work_pack%k_packs(im)%nk
if (mpi%is_root()) write (*, *) "coulomb pw-loop nk: ("//int2str(ikpt)//"/"//int2str(fi%kpts%nkpt)//")"
! group together quantities which depend only on l,m and igpt -> carr2a
allocate (carr2a((fi%hybinp%lexp + 1)**2, maxval(mpdata%n_g)), carr2b(fi%atoms%nat, maxval(mpdata%n_g)))
......@@ -661,7 +662,8 @@ CONTAINS
END DO !ikpt
call timestop("coulomb matrix 3b")
if(any(my_k_list == 1)) then
! check if I own the gamma point
if(work_pack%has_nk(1)) then
! Add corrections from higher orders in (3b) to coulomb(:,1)
! (1) igpt1 > 1 , igpt2 > 1 (finite G vectors)
call timestart("add corrections from higher orders")
......@@ -757,8 +759,7 @@ CONTAINS
END DO
call coulomb(1)%u2l()
call timestop("add corrections from higher orders")
endif ! 1 in my_k_list
endif
! (3c) r,r' in same MT
......@@ -777,8 +778,8 @@ CONTAINS
call timestop("sphbesintegral")
call timestart("loop 2")
DO im = 1, size(my_k_list)
ikpt = my_k_list(im)
DO im = 1, work_pack%k_packs(1)%size
ikpt = work_pack%k_packs(im)%nk
call timestart("harmonics setup")
DO igpt = 1, mpdata%n_g(ikpt)
igptp = mpdata%gptm_ptr(igpt, ikpt)
......@@ -804,8 +805,8 @@ CONTAINS
sym_gpt(MAXVAL(nsym1), mpdata%num_gpts(), fi%kpts%nkpt))
nsym_gpt = 0; sym_gpt = 0
call timestart("loop 3")
DO im = 1, size(my_k_list)
ikpt = my_k_list(im)
DO im = 1, work_pack%k_packs(1)%size
ikpt = work_pack%k_packs(im)%nk
carr2 = 0; iarr = 0
iarr(pgptm1(:ngptm1(ikpt), ikpt)) = 1
DO igpt0 = 1, ngptm1(ikpt)
......@@ -858,7 +859,8 @@ CONTAINS
!
call judft_error("HSE is not implemented")
ELSE
if(any(my_k_list == 1)) then
! check for gamma
if(work_pack%has_nk(1)) then
CALL subtract_sphaverage(fi%sym, fi%cell, fi%atoms, mpdata, &
fi%hybinp, hybdat, hybdat%nbasm, gridf, coulomb(1))
endif
......@@ -868,8 +870,8 @@ CONTAINS
! REFACTORING HINT: THIS IS DONE WTIH THE INVERSE OF OLAP
! IT CAN EASILY BE REWRITTEN AS A LINEAR SYSTEM
call timestop("gap 1:")
DO im = 1, size(my_k_list)
ikpt = my_k_list(im)
DO im = 1, work_pack%k_packs(1)%size
ikpt = work_pack%k_packs(im)%nk
call apply_inverse_olaps(mpdata, fi%atoms, fi%cell, hybdat, fi%sym, fi%kpts, ikpt, coulomb(ikpt))
call coulomb(ikpt)%u2l()
enddo
......@@ -884,8 +886,8 @@ CONTAINS
call hybdat%coul(ikpt)%init()
enddo
DO im = 1, size(my_k_list)
ikpt = my_k_list(im)
DO im = 1, work_pack%k_packs(1)%size
ikpt = work_pack%k_packs(im)%nk
! unpack coulomb into coulomb(ikpt)
! only one processor per k-point calculates MT convolution
......
......@@ -8,10 +8,11 @@ module m_work_package
procedure :: init => t_work_package_init
procedure :: print => t_work_package_print
procedure :: owner_nk => t_work_package_owner_nk
procedure :: has_nk => t_work_package_has_nk
end type t_work_package
type t_k_package
integer :: n_k, rank, size
integer :: nk, rank, size
type(t_q_package), allocatable :: q_packs(:)
contains
procedure :: init => t_k_package_init
......@@ -40,15 +41,15 @@ contains
end subroutine
subroutine t_k_package_init(k_pack, fi, n_k)
subroutine t_k_package_init(k_pack, fi, nk)
implicit none
class(t_k_package), intent(inout) :: k_pack
type(t_fleurinput), intent(in) :: fi
integer, intent(in) :: n_k
integer, intent(in) :: nk
integer :: nkpt_eibz
k_pack%n_k = n_k
allocate(k_pack%q_packs(fi%kpts%nkpt_EIBZ(n_k)))
k_pack%nk = nk
allocate(k_pack%q_packs(fi%kpts%nkpt_EIBZ(nk)))
end subroutine
subroutine t_work_package_print(work_pack)
......@@ -67,7 +68,7 @@ contains
class(t_k_package), intent(in) :: k_pack
write (*,*) "kpoint: "
write (*,*) "nk = ", k_pack%n_k
write (*,*) "nk = ", k_pack%nk
end subroutine t_k_package_print
subroutine split_into_work_packages(work_pack, fi)
......@@ -108,4 +109,20 @@ contains
owner = modulo(nk-1, work_pack%size)
end function t_work_package_owner_nk
function t_work_package_has_nk(work_pack, nk) result(has_nk)
implicit none
class(t_work_package), intent(in) :: work_pack
integer, intent(in) :: nk
logical :: has_nk
integer :: i
has_nk = .false.
do i = 1, work_pack%k_packs(1)%size
if (work_pack%k_packs(i)%nk == nk) then
has_nk = .True.
exit
endif
enddo
end function t_work_package_has_nk
end module m_work_package
......@@ -11,7 +11,7 @@ CONTAINS
SUBROUTINE rdmft(eig_id,mpi,fi,enpara,stars,&
sphhar,vTot,vCoul,nococonv,xcpot,mpdata,hybdat,&
results,archiveType,outDen)
use m_work_package
USE m_types
USE m_juDFT
USE m_constants
......@@ -72,6 +72,7 @@ SUBROUTINE rdmft(eig_id,mpi,fi,enpara,stars,&
TYPE(t_moments) :: moments
TYPE(t_mat) :: exMat, zMat, olap, trafo, invtrafo, tmpMat, exMatLAPW
TYPE(t_lapw) :: lapw
type(t_work_package) :: work_pack
INTEGER :: ikpt, ikpt_i, iBand, jkpt, jBand, iAtom, na, itype, lh, iGrid
INTEGER :: jspin, jspmax, jsp, isp, ispin, nbasfcn, nbands
INTEGER :: nsymop, ikptf, iterHF
......@@ -390,9 +391,12 @@ SUBROUTINE rdmft(eig_id,mpi,fi,enpara,stars,&
CALL hybdat%coul(ikpt)%alloc(fi, mpdata%num_radbasfn, mpdata%n_g, ikpt)
END DO
CALL coulombmatrix(mpi, fi, mpdata, hybdat, xcpot, [(ikpt,ikpt=1,fi%kpts%nkpt)])
CALL hybmpi%copy_mpi(mpi)
call work_pack%init(fi, hybmpi%rank, hybmpi%size)
CALL coulombmatrix(mpi, fi, mpdata, hybdat, xcpot, work_pack)
DO ikpt = 1, fi%kpts%nkpt
CALL hybdat%coul(ikpt)%mpi_ibc(fi, hybmpi, 0)
END DO
......
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