Commit 068d0fe1 authored by Matthias Redies's avatar Matthias Redies

Merge branch 'RMA_olap' into 'develop'

Rma olap

See merge request fleur/fleur!123
parents 715be85d 5eef93e7
......@@ -108,7 +108,7 @@ CONTAINS
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)
fi%cell,sphhar,stars,xcpot,fmpi,fi%oneD,hmat(1,1),vx, nk)
END IF
END IF ! fi%hybinp%l_hybrid
......
......@@ -71,9 +71,9 @@ CONTAINS
INTEGER, INTENT(IN) :: nk
! local scalars
INTEGER :: n, nn, iband, nbasfcn, i, i0, j
INTEGER :: iband, nbasfcn, i, i0, j
REAL :: a_ex
TYPE(t_mat) :: tmp, v_x, z
TYPE(t_mat) :: tmp, z
COMPLEX :: exch(fi%input%neig, fi%input%neig)
call timestart("add_vnonlocal")
......@@ -81,52 +81,38 @@ CONTAINS
! initialize weighting factor for HF exchange part
a_ex = xcpot%get_exchange_weight()
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)
! add non-local x-potential to the hamiltonian hmat
! 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
nbasfcn = MERGE(lapw%nv(1) + lapw%nv(2) + 2*fi%atoms%nlotot, lapw%nv(1) + fi%atoms%nlotot, fi%noco%l_noco)
IF (hmat%l_real) THEN
DO i = fmpi%n_rank+1,v_x%matsize1,fmpi%n_size
DO i = fmpi%n_rank+1,hybdat%v_x(nk, jsp)%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)
DO j = 1,MIN(i,hybdat%v_x(nk, jsp)%matsize1)
hmat%data_r(j,i0) = hmat%data_r(j, i0) - a_ex * hybdat%v_x(nk, jsp)%data_r(j, i)
enddo
enddo
else
DO i = fmpi%n_rank+1,v_x%matsize1,fmpi%n_size
DO i = fmpi%n_rank+1,hybdat%v_x(nk, jsp)%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)
DO j = 1,MIN(i,hybdat%v_x(nk, jsp)%matsize1)
hmat%data_c(j,i0) = hmat%data_c(j, i0) - a_ex * hybdat%v_x(nk, jsp)%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
IF (.NOT. v_x%l_real) v_x%data_c = conjg(v_x%data_c)
exch = 0
z%matsize1 = MIN(z%matsize1, v_x%matsize2)
CALL v_x%multiply(z, tmp)
z%matsize1 = MIN(z%matsize1, hybdat%v_x(nk, jsp)%matsize2)
IF (hybdat%v_x(nk, jsp)%l_real) then
CALL hybdat%v_x(nk, jsp)%multiply(z, tmp)
else
! used to be v_x%data_c = conjg(v_x%data_c)
CALL hybdat%v_x(nk, jsp)%multiply(z, tmp, transA="T")
endif
DO iband = 1, hybdat%nbands(nk)
IF (z%l_real) THEN
......
......@@ -53,8 +53,6 @@ CONTAINS
CALL timestart("hybrid code")
INQUIRE (file="v_x.1", exist=hybdat%l_addhf)
IF (fi%kpts%nkptf == 0) THEN
CALL judft_error("kpoint-set of full BZ not available", &
hint="to generate fi%kpts in the full BZ you should specify a k-mesh in inp.xml")
......
......@@ -97,7 +97,7 @@ CONTAINS
complex :: c_phase_k(hybdat%nbands(k_pack%nk ))
REAL :: wl_iks(fi%input%neig, fi%kpts%nkptf)
TYPE(t_mat) :: ex, v_x, z_k
TYPE(t_mat) :: ex, z_k
CALL timestart("total time hsfock")
nk = k_pack%nk
......@@ -137,6 +137,7 @@ CONTAINS
CALL exchange_valence_hf(k_pack, fi, z_k, c_phase_k, mpdata, jsp, hybdat, lapw, eig_irr, results, &
n_q, wl_iks, xcpot, nococonv, stars, nsest, indx_sest, fmpi, ex)
if(.not. allocated(hybdat%v_x)) allocate(hybdat%v_x(fi%kpts%nkpt, fi%input%jspins))
if(k_pack%submpi%root()) then
! calculate contribution from the core states to the HF exchange
CALL timestart("core exchange calculation")
......@@ -151,10 +152,15 @@ CONTAINS
CALL timestop("core exchange calculation")
call ex_to_vx(fi, nk, jsp, nsymop, psym, hybdat, lapw, z_k, ex, v_x)
CALL write_v_x(v_x, fi%kpts%nkpt*(jsp - 1) + nk)
endif
call ex%save_npy("ex_nk=" // int2str(nk) // "_rank=" // int2str(fmpi%n_rank) // ".npy")
! call MPI_Barrier(MPI_COMM_WORLD, ok)
! call judft_error("stopit: add_Vnonl")
call ex_to_vx(fi, nk, jsp, nsymop, psym, hybdat, lapw, z_k, ex, hybdat%v_x(nk, jsp))
call hybdat%v_x(nk, jsp)%u2l()
endif
call hybdat%v_x(nk,jsp)%bcast(0, k_pack%submpi%comm)
hybdat%l_addhf = .True.
CALL timestop("total time hsfock")
END SUBROUTINE hsfock
END MODULE m_hsfock
This diff is collapsed.
......@@ -263,10 +263,6 @@ MODULE m_cdnpot_io_hdf
INTEGER(HID_T) :: ft2_gfxSpaceID, ft2_gfxSetID
INTEGER(HID_T) :: ft2_gfySpaceID, ft2_gfySetID
#ifdef CPP_DEBUG
WRITE(*,*) 'Writing stars, index: ', starsIndex
#endif
WRITE(groupname,'(a,i0)') '/stars-', starsIndex
l_exist = io_groupexists(fileID,TRIM(ADJUSTL(groupName)))
......@@ -470,10 +466,6 @@ MODULE m_cdnpot_io_hdf
INTEGER(HID_T) :: ft2_gfxSetID
INTEGER(HID_T) :: ft2_gfySetID
#ifdef CPP_DEBUG
WRITE(*,*) 'Reading stars, index: ', starsIndex
#endif
CALL h5gopen_f(fileID, '/general', generalGroupID, hdfError)
! read in file format version from the header '/general'
CALL io_read_attint0(generalGroupID,'fileFormatVersion',fileFormatVersion)
......@@ -674,10 +666,6 @@ MODULE m_cdnpot_io_hdf
INTEGER :: dimsInt(7)
LOGICAL :: l_exist
#ifdef CPP_DEBUG
WRITE(*,*) 'Writing step function, index: ', stepfunctionIndex
#endif
WRITE(groupname,'(a,i0)') '/stepfunction-', stepfunctionIndex
l_exist = io_groupexists(fileID,TRIM(ADJUSTL(groupName)))
......@@ -737,10 +725,6 @@ MODULE m_cdnpot_io_hdf
INTEGER(HID_T) :: ustepSetID
INTEGER(HID_T) :: ufftSetID
#ifdef CPP_DEBUG
WRITE(*,*) 'Reading step function, index: ', stepfunctionIndex
#endif
WRITE(groupname,'(a,i0)') '/stepfunction-', stepfunctionIndex
l_exist = io_groupexists(fileID,TRIM(ADJUSTL(groupName)))
......@@ -829,10 +813,6 @@ MODULE m_cdnpot_io_hdf
INTEGER :: dimsInt(7)
LOGICAL :: l_exist
#ifdef CPP_DEBUG
WRITE(*,*) 'Writing lattice harmonics, index: ', latharmsIndex
#endif
WRITE(groupname,'(a,i0)') '/latharms-', latharmsIndex
l_exist = io_groupexists(fileID,TRIM(ADJUSTL(groupName)))
......@@ -909,10 +889,6 @@ MODULE m_cdnpot_io_hdf
INTEGER :: dimsInt(7)
LOGICAL :: l_exist
#ifdef CPP_DEBUG
WRITE(*,*) 'Reading lattice harmonics, index: ', latharmsIndex
#endif
WRITE(groupname,'(a,i0)') '/latharms-', latharmsIndex
l_exist = io_groupexists(fileID,TRIM(ADJUSTL(groupName)))
......@@ -1046,10 +1022,6 @@ MODULE m_cdnpot_io_hdf
INTEGER(HID_T) :: ldau_JSpaceID, ldau_JSetID
!LDA+U IDs (end)
#ifdef CPP_DEBUG
WRITE(*,*) 'Writing structure, index: ', structureIndex
#endif
WRITE(groupname,'(a,i0)') '/structure-', structureIndex
l_exist = io_groupexists(fileID,TRIM(ADJUSTL(groupName)))
......@@ -1352,10 +1324,6 @@ MODULE m_cdnpot_io_hdf
INTEGER(HID_T) :: ldau_JSetID
!LDA+U IDs (end)
#ifdef CPP_DEBUG
WRITE(*,*) 'Reading structure, index: ', structureIndex
#endif
CALL h5gopen_f(fileID, '/general', generalGroupID, hdfError)
! read in file format version from the header '/general'
CALL io_read_attint0(generalGroupID,'fileFormatVersion',fileFormatVersion)
......@@ -2377,10 +2345,6 @@ MODULE m_cdnpot_io_hdf
COMPLEX, ALLOCATABLE :: cdomTemp(:), cdomvzTemp(:,:), cdomvxyTemp(:,:,:)
COMPLEX, ALLOCATABLE :: mmpMatTemp(:,:,:,:)
#ifdef CPP_DEBUG
WRITE(*,*) 'Reading density, archiveName: ', TRIM(ADJUSTL(archiveName))
#endif
den%pw = CMPLX(0.0,0.0)
den%vacz = CMPLX(0.0,0.0)
den%vacxy = CMPLX(0.0,0.0)
......@@ -2467,14 +2431,6 @@ MODULE m_cdnpot_io_hdf
CALL io_read_attint0(archiveID,'spins',jspins)
CALL io_read_attint0(archiveID,'iter',den%iter)
#ifdef CPP_DEBUG
WRITE(*,*) ' previousDensityIndex: ', previousDensityIndex
WRITE(*,*) ' starsIndex: ', starsIndex
WRITE(*,*) ' latharmsIndex: ', latharmsIndex
WRITE(*,*) ' structureIndex: ', structureIndex
WRITE(*,*) ' stepfunctionIndex: ', stepfunctionIndex
#endif
WRITE(groupBName,'(a,i0)') '/structure-', structureIndex
l_exist = io_groupexists(fileID,TRIM(ADJUSTL(groupBName)))
IF(.NOT.l_exist) THEN
......
......@@ -110,28 +110,4 @@ contains
endif
call timestop("read_z")
END subroutine read_z
subroutine read_v_x(mat, rec)
implicit none
TYPE(t_mat), INTENT(INOUT) :: mat
INTEGER, INTENT(IN) :: rec
integer :: id
id = open_matrix(mat%l_real, mat%matsize1, 1, 1, "v_x." // int2str(rec))
CALL read_matrix(mat, 1, id)
call close_matrix(id)
END subroutine read_v_x
subroutine write_v_x(mat, rec)
use m_juDFT
implicit none
TYPE(t_mat), INTENT(IN) :: mat
INTEGER, INTENT(IN) :: rec
integer :: id
id = open_matrix(mat%l_real, mat%matsize1, 1, 1, "v_x." // int2str(rec))
CALL write_matrix(mat, 1, id)
call close_matrix(id)
END subroutine write_v_x
end module m_io_hybinp
......@@ -282,6 +282,9 @@ END IF
CALL calc_hybrid(eig_id,fi,mpdata,hybdat,fmpi,nococonv, stars,enpara,&
results,xcpot,vTot,iterHF)
END SELECT
#ifdef CPP_MPI
call MPI_Barrier(fmpi%mpi_comm, ierr)
#endif
IF(hybdat%l_calhf) THEN
call mixing_history_reset(fmpi)
iter = 0
......
......@@ -393,20 +393,20 @@ CONTAINS
END SUBROUTINE init_metric
SUBROUTINE init_storage_mpi(mpi_comm)
SUBROUTINE init_storage_mpi(comm_mpi)
IMPLICIT NONE
INTEGER, INTENT(in):: mpi_comm
INTEGER, INTENT(in):: comm_mpi
INTEGER :: irank, isize, err, js, new_comm
mix_mpi_comm = mpi_comm
mix_mpi_comm = comm_mpi
#ifdef CPP_MPI
CALL mpi_comm_rank(mpi_comm, irank, err)
CALL mpi_comm_size(mpi_comm, isize, err)
CALL mpi_comm_rank(comm_mpi, irank, err)
CALL mpi_comm_size(comm_mpi, isize, err)
IF (isize == 1) RETURN !No parallelization
js = MERGE(jspins, 3,.NOT. l_noco)!distribute spins
js = MIN(js, isize)
CALL judft_comm_split(mpi_comm, MOD(irank, js), irank, new_comm)
CALL judft_comm_split(comm_mpi, MOD(irank, js), irank, new_comm)
spin_here = (/MOD(irank, js) == 0, MOD(irank, js) == 1, (isize == 2 .AND. irank == 0) .OR. MOD(irank, js) == 2/)
CALL mpi_comm_rank(new_comm, irank, err)
......@@ -437,10 +437,10 @@ CONTAINS
#endif
END SUBROUTINE init_storage_mpi
SUBROUTINE mixvector_init(mpi_comm, l_densitymatrix, oneD, input, vacuum, noco, stars_i, cell_i, sphhar_i, atoms_i, sym_i)
SUBROUTINE mixvector_init(comm_mpi, l_densitymatrix, oneD, input, vacuum, noco, stars_i, cell_i, sphhar_i, atoms_i, sym_i)
USE m_types
IMPLICIT NONE
INTEGER, INTENT(IN) :: mpi_comm
INTEGER, INTENT(IN) :: comm_mpi
LOGICAL, INTENT(IN) :: l_densitymatrix
TYPE(t_oneD), INTENT(IN) :: oneD
TYPE(t_input), INTENT(IN) :: input
......@@ -465,7 +465,7 @@ CONTAINS
vac_here = input%film
misc_here = l_densitymatrix
CALL init_storage_mpi(mpi_comm)
CALL init_storage_mpi(comm_mpi)
pw_length = 0; mt_length = 0; vac_length = 0; misc_length = 0
mt_length_g = 0; vac_length_g = 0; misc_length_g = 0
......
......@@ -55,7 +55,8 @@ MODULE m_types_hybdat
! coulomb matrix stuff
type(t_coul), allocatable :: coul(:)
type(t_usdus) :: usdus
type(t_usdus) :: usdus
type(t_mat), allocatable :: v_x(:,:) ! nkpt, jsp
contains
procedure :: set_stepfunction => set_stepfunction
procedure :: free => free_hybdat
......@@ -205,7 +206,7 @@ contains
class(t_coul), intent(inout) :: coul
type(t_fleurinput), intent(in) :: fi
integer, intent(in) :: num_radbasfn(:, :), n_g(:), ikpt
integer :: idum, info, isize, l, itype
integer :: info, isize, l, itype
isize = sum([(((2*l + 1)*fi%atoms%neq(itype), l=0, fi%hybinp%lcutm1(itype)),&
itype=1, fi%atoms%ntype)]) &
......
......@@ -44,9 +44,46 @@ MODULE m_types_mat
procedure :: print_type => t_mat_print_type
procedure :: conjugate => t_mat_conjg
procedure :: reset => t_mat_reset
procedure :: bcast => t_mat_bcast
END type t_mat
PUBLIC t_mat
CONTAINS
subroutine t_mat_bcast(mat, root, comm)
#ifdef CPP_MPI
use mpi
#endif
implicit none
CLASS(t_mat), INTENT(INOUT) :: mat
integer, intent(in) :: root, comm
integer :: ierr, full_shape(2), me
#ifdef CPP_MPI
call MPI_Comm_rank(comm, me, ierr)
call MPI_Bcast(mat%l_real, 1, MPI_LOGICAL, root, comm, ierr)
!alloc mat same as root
if(me == root) then
full_shape = merge(shape(mat%data_r), shape(mat%data_c), mat%l_real)
call MPI_Bcast(full_shape, 2, MPI_INTEGER, root, comm, ierr)
else
call MPI_Bcast(full_shape, 2, MPI_INTEGER, root, comm, ierr)
call mat%alloc(mat%l_real, full_shape(1), full_shape(2))
endif
! overwrite matsize as needed
call MPI_Bcast(mat%matsize1, 1, MPI_INTEGER, root, comm, ierr)
call MPI_Bcast(mat%matsize2, 1, MPI_INTEGER, root, comm, ierr)
if(mat%l_real) then
call MPI_Bcast(mat%data_r, product(full_shape), MPI_REAL8, root, comm, ierr)
else
call MPI_Bcast(mat%data_c, product(full_shape), MPI_COMPLEX8, root, comm, ierr)
endif
#endif
end subroutine t_mat_bcast
subroutine t_mat_reset(mat, val)
implicit none
CLASS(t_mat), INTENT(INOUT) :: mat
......
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