Commit 05f859e0 authored by Matthias Redies's avatar Matthias Redies

Merge branch 'RMA_olap' into 'develop'

Rma olap

See merge request fleur/fleur!120
parents dba22843 d0536308
......@@ -30,12 +30,9 @@ CONTAINS
USE m_eigen_hssetup
USE m_pot_io
USE m_eigen_diag
USE m_add_vnonlocal
USE m_subvxc
!USE m_hsefunctional
USE m_mt_setup
USE m_util
USE m_io_hybinp
!USE m_icorrkeys
USE m_eig66_io, ONLY : open_eig, write_eig, read_eig
USE m_xmlOutput
......@@ -134,27 +131,11 @@ CONTAINS
! Set up lapw list
CALL lapw%init(fi%input,fi%noco,nococonv, fi%kpts,fi%atoms,fi%sym,nk,fi%cell,l_zref, fmpi)
call timestart("Setup of H&S matrices")
CALL eigen_hssetup(jsp,fmpi,fi%hybinp,enpara,fi%input,fi%vacuum,fi%noco,nococonv,fi%sym,&
stars,fi%cell,sphhar,fi%atoms,ud,td,v,lapw,l_real,smat,hmat)
CALL eigen_hssetup(jsp,fmpi,fi,mpdata,results,vx,xcpot,enpara,nococonv,stars,sphhar,hybdat,ud,td,v,lapw,l_real,nk,smat,hmat)
CALL timestop("Setup of H&S matrices")
nvBuffer(nk,jsp) = lapw%nv(jsp)
IF(fi%hybinp%l_hybrid.OR.fi%input%l_rdmft) THEN
CALL write_eig(eig_id, nk,jsp, smat=smat)
END IF
IF(fi%hybinp%l_hybrid) THEN
IF (hybdat%l_addhf) CALL add_Vnonlocal(nk,lapw,fi%atoms,fi%cell,fi%sym,mpdata,fi%hybinp,hybdat,&
fi%input,fi%kpts,jsp,results,xcpot,fi%noco,nococonv,hmat)
IF(hybdat%l_subvxc) THEN
CALL subvxc(lapw,fi%kpts%bk(:,nk),fi%input,jsp,v%mt(:,0,:,:),fi%atoms,ud,&
mpdata,fi%hybinp,hybdat,enpara%el0,enpara%ello0,fi%sym,&
fi%cell,sphhar,stars,xcpot,fmpi,fi%oneD,hmat,vx)
END IF
END IF ! fi%hybinp%l_hybrid
l_wu=.FALSE.
ne_all=fi%input%neig
IF(ne_all < 0) ne_all = lapw%nmat
......
......@@ -9,14 +9,14 @@ CONTAINS
!> The setup of the Hamiltonian and Overlap matrices are performed here
!!
!! The following steps are executed:
!! 1. The matrices are a allocated (in the noco-case these are 2x2-arrays of matrices)
!! 1. The matrices are a allocated (in the fi%noco-case these are 2x2-arrays of matrices)
!! 2. The Interstitial contribution is calculated (in hs_int())
!! 3. The MT-part is calculated (in hsmt() )
!! 4. The vacuum part is added (in hsvac())
!! 5. The matrices are copied to the final matrix, in the noco-case the full matrix is constructed from the 4-parts.
!! 5. The matrices are copied to the final matrix, in the fi%noco-case the full matrix is constructed from the 4-parts.
SUBROUTINE eigen_hssetup(isp,fmpi,hybinp,enpara,input,vacuum,noco,nococonv,sym,&
stars,cell,sphhar,atoms,ud,td,v,lapw,l_real,smat_final,hmat_final)
SUBROUTINE eigen_hssetup(isp,fmpi,fi,mpdata,results,vx,xcpot,enpara,nococonv,stars,sphhar,hybdat,&
ud,td,v,lapw,l_real,nk,smat_final,hmat_final)
USE m_types
USE m_types_mpimat
USE m_types_gpumat
......@@ -25,25 +25,26 @@ CONTAINS
USE m_od_hsvac
USE m_hsmt
USE m_eigen_redist_matrix
USE m_add_vnonlocal
USE m_subvxc
USE m_eig66_io, ONLY : open_eig, write_eig, read_eig
IMPLICIT NONE
INTEGER,INTENT(IN) :: isp
TYPE(t_mpi),INTENT(IN) :: fmpi
TYPE(t_hybinp),INTENT(IN) :: hybinp
TYPE(t_enpara),INTENT(IN) :: enpara
TYPE(t_input),INTENT(IN) :: input
TYPE(t_vacuum),INTENT(IN) :: vacuum
TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_nococonv),INTENT(IN) :: nococonv
TYPE(t_sym),INTENT(IN) :: sym
type(t_fleurinput), intent(in) :: fi
type(t_mpdata), intent(inout):: mpdata
type(t_results),intent(inout):: results
class(t_xcpot), intent(in) :: xcpot
TYPE(t_stars),INTENT(IN) :: stars
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_enpara),INTENT(IN) :: enpara
TYPE(t_nococonv),INTENT(IN) :: nococonv
TYPE(t_sphhar),INTENT(IN) :: sphhar
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_usdus),INTENT(IN) :: ud
type(t_hybdat), intent(inout):: hybdat
TYPE(t_usdus),INTENT(INout) :: ud
TYPE(t_tlmplm),INTENT(IN) :: td
TYPE(t_lapw),INTENT(IN) :: lapw
TYPE(t_potden),INTENT(IN) :: v
TYPE(t_potden),INTENT(IN) :: v, vx
integer, intent(in) :: nk
CLASS(t_mat),ALLOCATABLE,INTENT(INOUT) :: smat_final,hmat_final
LOGICAL,INTENT(IN) :: l_real
......@@ -53,8 +54,8 @@ CONTAINS
INTEGER :: i,j,ispin,nspins
!Matrices for Hamiltonian and Overlapp
!In noco case we need 4-matrices for each spin channel
nspins=MERGE(2,1,noco%l_noco)
!In fi%noco case we need 4-matrices for each spin channel
nspins=MERGE(2,1,fi%noco%l_noco)
IF (fmpi%n_size==1) THEN
ALLOCATE(t_mat::smat(nspins,nspins),hmat(nspins,nspins))
ELSE
......@@ -62,7 +63,7 @@ CONTAINS
ENDIF
DO i=1,nspins
DO j=1,nspins
CALL smat(i,j)%init(l_real,lapw%nv(i)+atoms%nlotot,lapw%nv(j)+atoms%nlotot,fmpi%sub_comm,.false.)
CALL smat(i,j)%init(l_real,lapw%nv(i)+fi%atoms%nlotot,lapw%nv(j)+fi%atoms%nlotot,fmpi%sub_comm,.false.)
CALL hmat(i,j)%init(smat(i,j))
ENDDO
ENDDO
......@@ -70,14 +71,14 @@ CONTAINS
CALL timestart("Interstitial part")
!Generate interstitial part of Hamiltonian
CALL hs_int(input,noco,stars,lapw,fmpi,cell,isp,v%pw_w,smat,hmat)
CALL hs_int(fi%input,fi%noco,stars,lapw,fmpi,fi%cell,isp,v%pw_w,smat,hmat)
CALL timestop("Interstitial part")
CALL timestart("MT part")
!MT-part of Hamiltonian. In case of noco, we need an loop over the local spin of the atoms
!MT-part of Hamiltonian. In case of fi%noco, we need an loop over the local spin of the fi%atoms
DO i=1,nspins;DO j=1,nspins
!$acc enter data copyin(hmat(i,j),smat(i,j),hmat(i,j)%data_r,smat(i,j)%data_r,hmat(i,j)%data_c,smat(i,j)%data_c)
ENDDO;ENDDO
CALL hsmt(atoms,sym,enpara,isp,input,fmpi,noco,nococonv,cell,lapw,ud,td,smat,hmat)
CALL hsmt(fi%atoms,fi%sym,enpara,isp,fi%input,fmpi,fi%noco,nococonv,fi%cell,lapw,ud,td,smat,hmat)
DO i=1,nspins;DO j=1,nspins;if (hmat(1,1)%l_real) THEN
!$acc exit data copyout(hmat(i,j)%data_r,smat(i,j)%data_r)
ELSE
......@@ -86,21 +87,41 @@ CONTAINS
CALL timestop("MT part")
!Vacuum contributions
IF (input%film) THEN
IF (fi%input%film) THEN
CALL timestart("Vacuum part")
CALL hsvac(vacuum,stars,fmpi,isp,input,v,enpara%evac,cell,&
lapw,sym, noco,nococonv,hmat,smat)
CALL hsvac(fi%vacuum,stars,fmpi,isp,fi%input,v,enpara%evac,fi%cell,&
lapw,fi%sym, fi%noco,nococonv,hmat,smat)
CALL timestop("Vacuum part")
ENDIF
!Deal with hybrid code
IF(fi%hybinp%l_hybrid.OR.fi%input%l_rdmft) THEN
if(any(shape(smat) /= 1)) then
call judft_error("Hybrid doesn't do noco.")
endif
CALL write_eig(hybdat%eig_id, nk,isp, smat=smat(1,1))
END IF
IF(fi%hybinp%l_hybrid) THEN
IF (hybdat%l_addhf) CALL add_Vnonlocal(nk,lapw,fi,hybdat,isp,results,xcpot,fmpi,nococonv,hmat(1,1))
IF(hybdat%l_subvxc) THEN
CALL subvxc(lapw,fi%kpts%bk(:,nk),fi%input,isp,v%mt(:,0,:,:),fi%atoms,ud,&
mpdata,hybdat,enpara%el0,enpara%ello0,fi%sym,&
fi%cell,sphhar,stars,xcpot,fmpi,fi%oneD,hmat(1,1),vx)
END IF
END IF ! fi%hybinp%l_hybrid
!Now copy the data into final matrix
! Collect the four noco parts into a single matrix
! Collect the four fi%noco parts into a single matrix
! In collinear case only a copy is done
! In the parallel case also a redistribution happens
ALLOCATE(smat_final,mold=smat(1,1))
ALLOCATE(hmat_final,mold=smat(1,1))
CALL timestart("Matrix redistribution")
CALL eigen_redist_matrix(fmpi,lapw,atoms,smat,smat_final)
CALL eigen_redist_matrix(fmpi,lapw,atoms,hmat,hmat_final,smat_final)
CALL eigen_redist_matrix(fmpi,lapw,fi%atoms,smat,smat_final)
CALL eigen_redist_matrix(fmpi,lapw,fi%atoms,hmat,hmat_final,smat_final)
CALL timestop("Matrix redistribution")
END SUBROUTINE eigen_hssetup
......
......@@ -28,7 +28,6 @@ CONTAINS
call hybdat%free()
call hybdat%allocate(fi, mpdata%num_radfun_per_l)
hybdat%eig_id = eig_id
! pre-calculate gaunt coefficients
hybdat%fac(0) = 1
hybdat%sfac(0) = 1
......
......@@ -26,8 +26,8 @@ MODULE m_add_vnonlocal
! | 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
......@@ -41,10 +41,8 @@ MODULE m_add_vnonlocal
! M.Betzinger (09/07) c
! c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c
CONTAINS
SUBROUTINE add_vnonlocal(nk, lapw, atoms, cell, sym, mpdata, hybinp, hybdat, &
input, kpts, jsp, results,&
xcpot, noco,nococonv, hmat)
SUBROUTINE add_vnonlocal(nk, lapw, fi, hybdat, jsp, results,&
xcpot, fmpi, nococonv, hmat)
USE m_types
USE m_constants
......@@ -60,18 +58,12 @@ CONTAINS
IMPLICIT NONE
TYPE(t_atoms), INTENT(IN) :: atoms
type(t_cell), intent(in) :: cell
type(t_sym), intent(in) :: sym
type(t_mpdata), intent(in) :: mpdata
type(t_fleurinput), intent(in) :: fi
TYPE(t_results), INTENT(INOUT) :: results
CLASS(t_xcpot), INTENT(IN) :: xcpot
TYPE(t_input), INTENT(IN) :: input
TYPE(t_hybdat), INTENT(INOUT) :: hybdat
TYPE(t_hybinp), INTENT(IN) :: hybinp
TYPE(t_kpts), INTENT(IN) :: kpts
TYPE(t_lapw), INTENT(IN) :: lapw
TYPE(t_noco), INTENT(IN) :: noco
type(t_mpi), intent(in) :: fmpi
type(t_nococonv),intent(in) :: nococonv
TYPE(t_mat), INTENT(INOUT) :: hmat
......@@ -79,44 +71,54 @@ CONTAINS
INTEGER, INTENT(IN) :: nk
! local scalars
INTEGER :: n, nn, iband, nbasfcn
INTEGER :: n, nn, iband, nbasfcn, i, i0, j
REAL :: a_ex
TYPE(t_mat) :: tmp, v_x, z
COMPLEX :: exch(input%neig, input%neig)
COMPLEX :: exch(fi%input%neig, fi%input%neig)
call timestart("add_vnonlocal")
! initialize weighting factor for HF exchange part
a_ex = xcpot%get_exchange_weight()
nbasfcn = MERGE(lapw%nv(1) + lapw%nv(2) + 2*atoms%nlotot, lapw%nv(1) + atoms%nlotot, noco%l_noco)
nbasfcn = MERGE(lapw%nv(1) + lapw%nv(2) + 2*fi%atoms%nlotot, lapw%nv(1) + fi%atoms%nlotot, fi%noco%l_noco)
CALL v_x%init(hmat%l_real, nbasfcn, nbasfcn)
CALL read_v_x(v_x, fi%kpts%nkpt*(jsp - 1) + nk)
CALL read_v_x(v_x, kpts%nkpt*(jsp - 1) + nk)
! add non-local x-potential to the hamiltonian hmat
DO n = 1, v_x%matsize1
DO nn = 1, n
IF (hmat%l_real) THEN
hmat%data_r(nn, n) = hmat%data_r(nn, n) - a_ex*v_x%data_r(nn, n)
v_x%data_r(n, nn) = v_x%data_r(nn, n)
ELSE
hmat%data_c(nn, n) = hmat%data_c(nn, n) - a_ex*v_x%data_c(nn, n)
v_x%data_c(n, nn) = CONJG(v_x%data_c(nn, n))
ENDIF
END DO
END DO
#ifdef CPP_EXPLICIT_HYB
! calculate HF energy
IF (hybdat%l_calhf) THEN
WRITE (oUnit, '(A)') new_line('n')//new_line('n')//' ### '//' diagonal HF exchange elements (eV) ###'
WRITE (oUnit, '(A)') new_line('n')//' k-point '//'band tail pole total(valence+core)'
END IF
#endif
CALL z%init(hmat%l_real, nbasfcn, input%neig)
call read_z(atoms, cell, hybdat, kpts, sym, noco, nococonv, input, nk, jsp, z)
! write (*,*) "shape(hmat%data_r)", shape(hmat%data_r)
! write (*,*) "shape(v_x%data_r)", shape(v_x%data_r)
! if(any( shape(hmat%data_r) /= shape(v_x%data_r) ) ) then
! if(all(shape(v_x%data_r) /= 0)) then
! call judft_error("shapes don't agree")
! endif
! endif
if(v_x%matsize1 > 0) then
call v_x%u2l()
endif
IF (hmat%l_real) THEN
DO i = fmpi%n_rank+1,v_x%matsize1,fmpi%n_size
i0=(i-1)/fmpi%n_size+1
DO j = 1,MIN(i,v_x%matsize1)
hmat%data_r(j,i0) = hmat%data_r(j, i0) - a_ex * v_x%data_r(j, i)
enddo
enddo
else
DO i = fmpi%n_rank+1,v_x%matsize1,fmpi%n_size
i0=(i-1)/fmpi%n_size+1
DO j = 1,MIN(i,v_x%matsize1)
hmat%data_c(j,i0) = hmat%data_c(j, i0) - a_ex * v_x%data_c(j, i)
enddo
enddo
endif
CALL z%init(hmat%l_real, nbasfcn, fi%input%neig)
call read_z(fi%atoms, fi%cell, hybdat, fi%kpts, fi%sym, fi%noco, nococonv, fi%input, nk, jsp, z)
! calculate exchange contribution of current k-point nk to total energy (te_hfex)
! in the case of a spin-unpolarized calculation the factor 2 is added in eigen.F90
......@@ -137,7 +139,7 @@ CONTAINS
END IF
IF (hybdat%l_calhf) THEN
WRITE (oUnit, '( '' ('',F5.3,'','',F5.3,'','',F5.3,'')'',I4,4X,3F15.5)') &
kpts%bkf(:, nk), iband, (REAL(exch(iband, iband)) - hybdat%div_vv(iband, nk, jsp))*(-hartree_to_ev_const), &
fi%kpts%bkf(:, nk), iband, (REAL(exch(iband, iband)) - hybdat%div_vv(iband, nk, jsp))*(-hartree_to_ev_const), &
hybdat%div_vv(iband, nk, jsp)*(-hartree_to_ev_const), REAL(exch(iband, iband))*(-hartree_to_ev_const)
END IF
END DO
......
......@@ -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, j
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()
......@@ -118,15 +120,16 @@ CONTAINS
CALL hf_init(eig_id, mpdata, fi, hybdat)
CALL timestop("Preparation for hybrid functionals")
!call balance_kpts(fi, glob_mpi, wp_mpi)
call distrib_mpis(fi, glob_mpi, wp_mpi, wp_rank, wp_size)
CALL timestart("Calculation of non-local HF potential")
DO jsp = 1, fi%input%jspins
call timestart("HF_setup")
CALL HF_setup(mpdata,fi, fmpi, nococonv, results, jsp, enpara, &
hybdat, v%mt(:, 0, :, :), eig_irr)
call work_pack%init(fi, hybdat, jsp, glob_mpi%rank, glob_mpi%size)
call timestop("HF_setup")
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
......@@ -174,71 +177,48 @@ CONTAINS
allocate(hybdat%div_vv(fi%input%neig, fi%kpts%nkpt, fi%input%jspins), source=0.0)
end subroutine first_iteration_alloc
! subroutine distribute_mpis(fi, glob_mpi)
! use types
! implicit none
! type(t_fleurinput), intent(in) :: fi
! type(t_hybmpi), intent(in) :: glob_mpi
! integer :: color(hybmpi%size), my_color, n_wps
! integer, allocatable :: n_procs(:), weights(:)
! n_wps = min(fi%kpts%nkpt, glob_mpi%size)
! allocate(n_procs(n_wps), source=0)
! allocate(weights(n_wps), source=0)
! do rank = 0,n_wps-1
! do ik = rank+1, fi%kpts%nkpts, n_wps
! weights(rank+1) = weights(rank+1) + fi%kpts%eibz(ik)%nkpt
! enddo
! enddo
! call judft_error("no mas")
! end subroutine distribute_mpis
END SUBROUTINE calc_hybrid
subroutine balance_kpts(fi, glob_mpi, wp_mpi, wp_root_comm, wp_rank, wp_size)
USE m_types
implicit none
type(t_fleurinput), intent(in) :: fi
type(t_hybmpi), intent(in) :: glob_mpi
type(t_hybmpi), intent(inout) :: wp_mpi, wp_root_comm
integer, intent(inout) :: wp_rank, wp_size
integer :: n_wps, i, j, cnt, j_wp, ik, idx(1), new_comm, my_color
integer, allocatable :: nprocs(:), weights(:), color(:)
n_wps = min(glob_mpi%size, fi%kpts%nkpt)
allocate(nprocs(n_wps), source=0)
allocate(weights(n_wps), source=0)
allocate(color(glob_mpi%size), source=0)
do j_wp = 1, n_wps
do ik = j_wp, fi%kpts%nkpt, n_wps
weights(j_wp) = weights(j_wp) + fi%kpts%eibz(ik)%nkpt
subroutine distrib_mpis(fi, glob_mpi, wp_mpi, wp_rank, wp_size)
USE m_types
implicit none
type(t_fleurinput), intent(in) :: fi
type(t_hybmpi), intent(in) :: glob_mpi
type(t_hybmpi), intent(inout) :: wp_mpi
integer, intent(inout) :: wp_rank, wp_size
integer :: n_wps, i, j, cnt, j_wp, ik, idx(1), new_comm
integer, allocatable :: nprocs(:), weights(:), color(:)
n_wps = min(glob_mpi%size, fi%kpts%nkpt)
allocate(nprocs(n_wps), source=0)
allocate(weights(n_wps), source=0)
allocate(color(glob_mpi%size), source=0)
do j_wp = 1, n_wps
do ik = j_wp, fi%kpts%nkpt, n_wps
weights(j_wp) = weights(j_wp) + fi%kpts%eibz(ik)%nkpt
enddo
enddo
do i = 1,glob_mpi%size
idx = minloc(1.0*nprocs/weights)
nprocs(idx(1)) = nprocs(idx(1)) + 1
enddo
enddo
do i = 1,glob_mpi%size
idx = minloc(1.0*nprocs/weights)
nprocs(idx(1)) = nprocs(idx(1)) + 1
enddo
cnt = 1
do i = 1,n_wps
do j = 1,nprocs(i)
color(cnt) = i
cnt = cnt + 1
enddo
enddo
wp_rank = color(glob_mpi%rank+1)
wp_size = n_wps
call judft_comm_split(glob_mpi%comm, my_color, glob_mpi%rank, new_comm)
call wp_mpi%init(new_comm)
end subroutine balance_kpts
cnt = 1
do i = 1,n_wps
do j = 1,nprocs(i)
color(cnt) = i - 1
cnt = cnt + 1
enddo
enddo
wp_rank = color(glob_mpi%rank+1)
wp_size = n_wps
call judft_comm_split(glob_mpi%comm, wp_rank, glob_mpi%rank, new_comm)
call wp_mpi%init(new_comm)
end subroutine distrib_mpis
END SUBROUTINE calc_hybrid
END MODULE m_calc_hybrid
......@@ -154,7 +154,7 @@ CONTAINS
call coul_mtmt%alloc(.False., maxval(hybdat%nbasm), maxval(hybdat%nbasm))
allocate(coulomb(fi%kpts%nkpt))
DO im = 1, work_pack%k_packs(1)%size
DO im = 1, work_pack%n_kpacks
ikpt = work_pack%k_packs(im)%nk
call coulomb(ikpt)%alloc(.False., hybdat%nbasm(ikpt), hybdat%nbasm(ikpt))
enddo
......@@ -162,7 +162,7 @@ CONTAINS
IF (fmpi%irank == 0) then
write (oUnit,*) "Size of coulomb matrix: " //&
float2str(sum([(coulomb(work_pack%k_packs(i)%nk)%size_mb(), i=1,work_pack%k_packs(1)%size)])) // " MB"
float2str(sum([(coulomb(work_pack%k_packs(i)%nk)%size_mb(), i=1,work_pack%n_kpacks)])) // " MB"
endif
! Generate Symmetry:
......@@ -428,7 +428,7 @@ CONTAINS
call coulmat%alloc(.False., hybdat%nbasp, hybdat%nbasp)
DO im = 1, work_pack%k_packs(1)%size
DO im = 1, work_pack%n_kpacks
ikpt = work_pack%k_packs(im)%nk
! only the first rank handles the MT-MT part
......@@ -503,7 +503,7 @@ CONTAINS
! (2c) r,r' in different MT
call timestart("loop over interst.")
DO im = 1, work_pack%k_packs(1)%size
DO im = 1, work_pack%n_kpacks
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))
......@@ -523,7 +523,7 @@ CONTAINS
! Coulomb matrix, contribution (3a)
call timestart("coulomb matrix 3a")
DO im = 1, work_pack%k_packs(1)%size
DO im = 1, work_pack%n_kpacks
ikpt = work_pack%k_packs(im)%nk
DO igpt0 = 1, ngptm1(ikpt)
......@@ -564,7 +564,7 @@ CONTAINS
! (3b) r,r' in different MT
call timestart("coulomb matrix 3b")
DO im = 1, work_pack%k_packs(1)%size
DO im = 1, work_pack%n_kpacks
ikpt = work_pack%k_packs(im)%nk
if (fmpi%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
......@@ -778,7 +778,7 @@ CONTAINS
call timestop("sphbesintegral")
call timestart("loop 2")
DO im = 1, work_pack%k_packs(1)%size
DO im = 1, work_pack%n_kpacks
ikpt = work_pack%k_packs(im)%nk
call timestart("harmonics setup")
DO igpt = 1, mpdata%n_g(ikpt)
......@@ -805,7 +805,7 @@ CONTAINS
sym_gpt(MAXVAL(nsym1), mpdata%num_gpts(), fi%kpts%nkpt))
nsym_gpt = 0; sym_gpt = 0
call timestart("loop 3")
DO im = 1, work_pack%k_packs(1)%size
DO im = 1, work_pack%n_kpacks
ikpt = work_pack%k_packs(im)%nk
carr2 = 0; iarr = 0
iarr(pgptm1(:ngptm1(ikpt), ikpt)) = 1
......@@ -870,7 +870,7 @@ 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, work_pack%k_packs(1)%size
DO im = 1, work_pack%n_kpacks
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()
......@@ -886,7 +886,7 @@ CONTAINS
call hybdat%coul(ikpt)%init()
enddo
DO im = 1, work_pack%k_packs(1)%size
DO im = 1, work_pack%n_kpacks
ikpt = work_pack%k_packs(im)%nk
! unpack coulomb into coulomb(ikpt)
......
......@@ -77,7 +77,7 @@ CONTAINS
COMPLEX :: cmt(hybdat%nbands(nk), hybdat%maxlmindx, atoms%nat)
COMPLEX :: exchange(hybdat%nbands(nk), hybdat%nbands(nk))
complex :: c_phase(hybdat%nbands(nk)), cdum
complex :: c_phase(hybdat%nbands(nk))
COMPLEX, ALLOCATABLE :: carr2(:, :), carr3(:, :), ctmp_vec(:)
type(t_mat) :: zmat, integral, carr, tmp, dot_result
......@@ -235,7 +235,7 @@ CONTAINS
ic = 0
sum_offdia = 0
IF (mat_ex%l_real) THEN
mat_ex%data_r = real(mat_ex%data_r + exchange/nsymop)
mat_ex%data_r = mat_ex%data_r + real(exchange/nsymop)
ELSE
mat_ex%data_c = mat_ex%data_c + CONJG(exchange)/nsymop
END IF
......
......@@ -109,7 +109,7 @@ CONTAINS
! local scalars