Commit dfb8695f authored by Matthias Redies's avatar Matthias Redies

move olap to RMA

parent bad26db6
......@@ -141,18 +141,8 @@ CONTAINS
nvBuffer(nk,jsp) = lapw%nv(jsp)
IF(fi%hybinp%l_hybrid.OR.fi%input%l_rdmft) THEN
! Write overlap matrix smat to direct access file olap
! print *,"Wrong overlap matrix used, fix this later"
if(.not. allocated(hybdat%olap)) THEN
allocate(hybdat%olap(fi%input%jspins, fi%kpts%nkpt))
endif
if(.not. hybdat%olap(jsp,nk)%allocated()) call hybdat%olap(jsp,nk)%init(smat)
call hybdat%olap(jsp,nk)%copy(smat,1,1)
call hybdat%olap(jsp,nk)%u2l()
if(.not. smat%l_real) hybdat%olap(jsp,nk)%data_c = conjg(hybdat%olap(jsp,nk)%data_c)
END IF ! fi%hybinp%l_hybrid.OR.fi%input%l_rdmft
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,&
......
......@@ -6,6 +6,7 @@ module m_ex_to_vx
contains
subroutine ex_to_vx(fi, nk, jsp, nsymop, psym, hybdat, lapw, z, ex, v_x)
use m_juDFT
use m_eig66_io
implicit none
type(t_fleurinput), intent(in) :: fi
......@@ -17,8 +18,8 @@ contains
type(t_mat), intent(inout) :: ex
type(t_mat), intent(inout) :: v_x
integer :: i, j, nbasfcn
type(t_mat) :: trafo, tmp
integer :: nbasfcn
type(t_mat) :: trafo, tmp, olap
CALL timestart("T^-1*mat_ex*T^-1*")
nbasfcn = lapw%hyb_num_bas_fun(fi)
......@@ -27,8 +28,13 @@ contains
IF (fi%input%neig < hybdat%nbands(nk)) call judft_error(' mhsfock: neigd < nbands(nk) ;trafo from wavefunctions to APW requires at least nbands(nk)')
call ex%u2l()
if(.not. hybdat%olap(jsp, nk)%allocated()) call judft_error("olap is not on this rank. You need to add this communication pattern")
call hybdat%olap(jsp, nk)%multiply(z, trafo)
call olap%init(z%l_real, z%matsize1, z%matsize1)
CALL read_eig(hybdat%eig_id,nk,jsp, smat=olap)
call olap%u2l()
call olap%conjg()
call olap%multiply(z, trafo)
CALL ex%multiply(trafo, res=tmp, transB="C")
CALL trafo%multiply(tmp, res=v_x)
......
......@@ -34,9 +34,9 @@ CONTAINS
END SELECT
END SUBROUTINE priv_find_data
SUBROUTINE open_eig(id, nmat, neig, nkpts, jspins, create, l_real, l_soc, filename)
SUBROUTINE open_eig(id, nmat, neig, nkpts, jspins, create, l_real, l_soc, l_olap, filename)
INTEGER, INTENT(IN) :: id, nmat, neig, nkpts, jspins
LOGICAL, INTENT(IN) :: create, l_real, l_soc
LOGICAL, INTENT(IN) :: create, l_real, l_soc, l_olap
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: filename
!locals
LOGICAL :: l_file
......@@ -45,6 +45,8 @@ CONTAINS
COMPLEX :: c1
TYPE(t_data_DA), POINTER:: d
if(l_olap) call judft_error("olap not implemented for DA")
CALL priv_find_data(id, d)
IF (PRESENT(filename)) d%fname = filename
......@@ -115,13 +117,13 @@ CONTAINS
d%fname = "eig"
CALL eig66_remove_data(id)
END SUBROUTINE close_eig
SUBROUTINE read_eig(id, nk, jspin, neig, eig, w_iks, list, zmat)
SUBROUTINE read_eig(id, nk, jspin, neig, eig, w_iks, list, zmat, smat)
IMPLICIT NONE
INTEGER, INTENT(IN) :: id, nk, jspin
INTEGER, INTENT(OUT), OPTIONAL :: neig
REAL, INTENT(OUT), OPTIONAL :: eig(:), w_iks(:)
INTEGER, INTENT(IN), OPTIONAL :: list(:)
TYPE(t_mat), OPTIONAL :: zmat
TYPE(t_mat), OPTIONAL :: zmat, smat
!Local variables
INTEGER:: nv_s, nmat_s, n, nrec, neig_s
......@@ -130,6 +132,7 @@ CONTAINS
COMPLEX, ALLOCATABLE::zc_s(:, :)
TYPE(t_data_DA), POINTER:: d
if(present(smat)) call juDFT_error("reading smat not supported for DA")
CALL priv_find_data(id, d)
! check if io is performed correctly
IF (PRESENT(list)) THEN
......@@ -174,18 +177,20 @@ CONTAINS
END SUBROUTINE read_eig
SUBROUTINE write_eig(id, nk, jspin, neig, neig_total, eig, w_iks, n_size, n_rank, zmat)
SUBROUTINE write_eig(id, nk, jspin, neig, neig_total, eig, w_iks, n_size, n_rank, zmat, smat)
INTEGER, INTENT(IN) :: id, nk, jspin
INTEGER, INTENT(IN), OPTIONAL :: n_size, n_rank
INTEGER, INTENT(IN), OPTIONAL :: neig, neig_total
REAL, INTENT(IN), OPTIONAL :: eig(:), w_iks(:)
TYPE(t_mat), INTENT(IN), OPTIONAL :: zmat
TYPE(t_mat), INTENT(IN), OPTIONAL :: zmat, smat
INTEGER:: nrec, r_len
INTEGER:: nv_s, nmat_s
REAL :: bkpt(3), wtkpt
TYPE(t_data_DA), POINTER:: d
if(present(smat)) call juDFT_error("writing smat in DA not supported yet")
CALL priv_find_data(id, d)
!This mode requires all data to be written at once!!
......
......@@ -26,13 +26,14 @@ module m_eig66_data
TYPE, extends(t_data):: t_data_MPI
INTEGER :: n_size = 1
INTEGER :: size_k, size_eig
INTEGER :: eig_handle, zr_handle, zc_handle, neig_handle, w_iks_handle
INTEGER :: eig_handle, zr_handle, zc_handle, neig_handle, w_iks_handle, olap_r_handle, olap_c_handle
INTEGER, ALLOCATABLE :: pe_basis(:, :), slot_basis(:, :)
INTEGER, ALLOCATABLE :: pe_ev(:, :, :), slot_ev(:, :, :)
integer, allocatable :: pe_olap(:,:,:), slot_olap(:,:,:)
INTEGER :: irank
INTEGER, POINTER :: neig_data(:)
REAL, POINTER :: eig_data(:), zr_data(:), w_iks_data(:)
COMPLEX, POINTER :: zc_data(:)
REAL, POINTER :: eig_data(:), zr_data(:), w_iks_data(:), olap_r_data(:)
COMPLEX, POINTER :: zc_data(:), olap_c_data(:)
END TYPE
TYPE, EXTENDS(t_data):: t_data_hdf
#ifdef CPP_HDF
......
......@@ -57,7 +57,7 @@ CONTAINS
END SELECT
END SUBROUTINE priv_find_data
!----------------------------------------------------------------------
SUBROUTINE open_eig(id, mpi_comm, nmat, neig, nkpts, jspins, create, l_real, l_soc, readonly, filename)
SUBROUTINE open_eig(id, mpi_comm, nmat, neig, nkpts, jspins, create, l_real, l_soc, readonly, l_olap, filename)
!*****************************************************************
! opens hdf-file for eigenvectors+values
......@@ -66,7 +66,7 @@ CONTAINS
INTEGER, INTENT(IN) :: id, mpi_comm
INTEGER, INTENT(IN) :: nmat, neig, nkpts, jspins
LOGICAL, INTENT(IN) :: create, readonly, l_real, l_soc
LOGICAL, INTENT(IN) :: create, readonly, l_real, l_soc, l_olap
CHARACTER(LEN=*), OPTIONAL :: filename
#ifdef CPP_HDF
......@@ -77,6 +77,7 @@ CONTAINS
INTEGER(HSIZE_T):: dims(7)
TYPE(t_data_HDF), POINTER::d
!Set creation and access properties
#ifdef CPP_HDFMPI
INCLUDE 'mpif.h'
IF (readonly) THEN
......@@ -93,6 +94,9 @@ CONTAINS
access_prp = H5P_DEFAULT_f
creation_prp = H5P_DEFAULT_f
#endif
if(l_olap) call juDFT_error("olap not implemented for hdf5")
CALL priv_find_data(id, d)
IF (PRESENT(filename)) d%fname = filename
CALL eig66_data_storedefault(d, jspins, nkpts, nmat, neig, l_real, l_soc)
......@@ -211,7 +215,7 @@ CONTAINS
#endif
SUBROUTINE write_eig(id, nk, jspin, neig, neig_total, eig, w_iks, n_size, n_rank, zmat)
SUBROUTINE write_eig(id, nk, jspin, neig, neig_total, eig, w_iks, n_size, n_rank, zmat, smat)
!*****************************************************************
! writes all eignevecs for the nk-th kpoint
......@@ -222,12 +226,13 @@ CONTAINS
INTEGER, INTENT(IN), OPTIONAL :: n_size, n_rank
INTEGER, INTENT(IN), OPTIONAL :: neig, neig_total
REAL, INTENT(IN), OPTIONAL :: eig(:), w_iks(:)
TYPE(t_mat), INTENT(IN), OPTIONAL :: zmat
TYPE(t_mat), INTENT(IN), OPTIONAL :: zmat, smat
INTEGER i, j, k, nv_local, n1, n2, ne
TYPE(t_data_HDF), POINTER::d
CALL priv_find_data(id, d)
if(present(smat)) call juDFT_error("writing smat in HDF not supported yet")
#ifdef CPP_HDF
!
!write enparas
......@@ -324,17 +329,18 @@ CONTAINS
#endif
SUBROUTINE read_eig(id, nk, jspin, neig, eig, w_iks, list, zMat)
SUBROUTINE read_eig(id, nk, jspin, neig, eig, w_iks, list, zMat, smat)
IMPLICIT NONE
INTEGER, INTENT(IN) :: id, nk, jspin
INTEGER, INTENT(OUT), OPTIONAL :: neig
REAL, INTENT(OUT), OPTIONAL :: eig(:), w_iks(:)
INTEGER, INTENT(IN), OPTIONAL :: list(:)
TYPE(t_mat), OPTIONAL :: zmat
TYPE(t_mat), OPTIONAL :: zmat, smat
#ifdef CPP_HDF
INTEGER:: n1, n, k
TYPE(t_data_HDF), POINTER::d
if(present(smat)) call juDFT_error("reading smat not supported for HDF")
CALL priv_find_data(id, d)
IF (PRESENT(neig)) THEN
......
......@@ -16,7 +16,7 @@ MODULE m_eig66_io
CONTAINS
FUNCTION open_eig(mpi_comm, nmat, neig, nkpts, jspins, &
l_noco, l_create, l_real, l_soc, l_readonly, n_size, mode_in, filename) &
l_noco, l_create, l_real, l_soc, l_readonly, l_olap, n_size, mode_in, filename) &
RESULT(id)
USE m_eig66_hdf, ONLY: open_eig_hdf => open_eig
USE m_eig66_DA, ONLY: open_eig_DA => open_eig
......@@ -24,7 +24,7 @@ CONTAINS
USE m_eig66_MPI, ONLY: open_eig_mpi => open_eig
IMPLICIT NONE
INTEGER, INTENT(IN) :: nmat, neig, nkpts, jspins, mpi_comm
LOGICAL, INTENT(IN) :: l_noco, l_readonly, l_create, l_real, l_soc
LOGICAL, INTENT(IN) :: l_noco, l_readonly, l_create, l_real, l_soc, l_olap
INTEGER, INTENT(IN), OPTIONAL :: n_size, mode_in
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: filename
INTEGER:: id, mode
......@@ -75,13 +75,13 @@ CONTAINS
CALL timestart("Open file/memory for IO of eig66")
SELECT CASE (eig66_data_mode(id))
CASE (DA_mode)
CALL open_eig_DA(id, nmat, neig_local, nkpts, jspins, l_create, l_real, l_soc, filename)
CALL open_eig_DA(id, nmat, neig_local, nkpts, jspins, l_create, l_real, l_soc, l_olap, filename)
CASE (hdf_mode)
CALL open_eig_HDF(id, mpi_comm, nmat, neig_local, nkpts, jspins, l_create, l_real, l_soc, l_readonly, filename)
CALL open_eig_HDF(id, mpi_comm, nmat, neig_local, nkpts, jspins, l_create, l_real, l_soc, l_readonly, l_olap, filename)
CASE (mem_mode)
CALL open_eig_MEM(id, nmat, neig_local, nkpts, jspins, l_create, l_real, l_soc, l_noco, filename)
CALL open_eig_MEM(id, nmat, neig_local, nkpts, jspins, l_create, l_real, l_soc, l_noco, l_olap, filename)
CASE (mpi_mode)
CALL open_eig_MPI(id, mpi_comm, nmat, neig_local, nkpts, jspins, l_create, l_real, l_soc, l_noco, n_size, filename)
CALL open_eig_MPI(id, mpi_comm, nmat, neig_local, nkpts, jspins, l_create, l_real, l_soc, l_noco, l_olap, n_size, filename)
CASE DEFAULT
CALL juDFT_error("Invalid IO-mode in eig66_io")
END SELECT
......@@ -114,7 +114,7 @@ CONTAINS
END SUBROUTINE close_eig
SUBROUTINE read_eig(id, nk, jspin, neig, eig, w_iks, list, zmat)
SUBROUTINE read_eig(id, nk, jspin, neig, eig, w_iks, list, zmat, smat)
USE m_eig66_hdf, ONLY: read_eig_hdf => read_eig
USE m_eig66_DA, ONLY: read_eig_DA => read_eig
USE m_eig66_mem, ONLY: read_eig_mem => read_eig
......@@ -124,25 +124,25 @@ CONTAINS
INTEGER, INTENT(OUT), OPTIONAL :: neig
REAL, INTENT(OUT), OPTIONAL :: eig(:), w_iks(:)
INTEGER, INTENT(IN), OPTIONAL :: list(:)
TYPE(t_mat), INTENT(INOUT), OPTIONAL :: zmat
TYPE(t_mat), INTENT(INOUT), OPTIONAL :: zmat, smat
INTEGER::n
CALL timestart("IO (read)")
SELECT CASE (eig66_data_mode(id))
CASE (DA_mode)
CALL read_eig_DA(id, nk, jspin, neig, eig, w_iks, list, zmat)
CALL read_eig_DA(id, nk, jspin, neig, eig, w_iks, list, zmat, smat)
CASE (hdf_mode)
CALL read_eig_hdf(id, nk, jspin, neig, eig, w_iks, list, zmat)
CALL read_eig_hdf(id, nk, jspin, neig, eig, w_iks, list, zmat, smat)
CASE (mem_mode)
CALL read_eig_mem(id, nk, jspin, neig, eig, w_iks, list, zmat)
CALL read_eig_mem(id, nk, jspin, neig, eig, w_iks, list, zmat, smat)
CASE (mpi_mode)
CALL read_eig_mpi(id, nk, jspin, neig, eig, w_iks, list, zmat)
CALL read_eig_mpi(id, nk, jspin, neig, eig, w_iks, list, zmat, smat)
CASE (-1)
CALL juDFT_error("Could not read eig-file before opening", calledby="eig66_io")
END SELECT
CALL timestop("IO (read)")
END SUBROUTINE read_eig
SUBROUTINE write_eig(id, nk, jspin, neig, neig_total, eig, w_iks, n_start, n_end, zmat)
SUBROUTINE write_eig(id, nk, jspin, neig, neig_total, eig, w_iks, n_start, n_end, zmat, smat)
USE m_eig66_hdf, ONLY: write_eig_hdf => write_eig
USE m_eig66_DA, ONLY: write_eig_DA => write_eig
USE m_eig66_mem, ONLY: write_eig_MEM => write_eig
......@@ -151,17 +151,17 @@ CONTAINS
INTEGER, INTENT(IN) :: id, nk, jspin
INTEGER, INTENT(IN), OPTIONAL :: neig, neig_total, n_start, n_end
REAL, INTENT(IN), OPTIONAL :: eig(:), w_iks(:)
TYPE(t_Mat), INTENT(IN), OPTIONAL :: zmat
TYPE(t_Mat), INTENT(IN), OPTIONAL :: zmat, smat
CALL timestart("IO (write)")
SELECT CASE (eig66_data_mode(id))
CASE (da_mode)
CALL write_eig_DA(id, nk, jspin, neig, neig_total, eig, w_iks, n_start, n_end, zmat)
CALL write_eig_DA(id, nk, jspin, neig, neig_total, eig, w_iks, n_start, n_end, zmat, smat)
CASE (hdf_mode)
CALL write_eig_HDF(id, nk, jspin, neig, neig_total, eig, w_iks, n_start, n_end, zmat)
CALL write_eig_HDF(id, nk, jspin, neig, neig_total, eig, w_iks, n_start, n_end, zmat, smat)
CASE (mem_mode)
CALL write_eig_Mem(id, nk, jspin, neig, neig_total, eig, w_iks, n_start, n_end, zmat)
CALL write_eig_Mem(id, nk, jspin, neig, neig_total, eig, w_iks, n_start, n_end, zmat, smat)
CASE (MPI_mode)
CALL write_eig_MPI(id, nk, jspin, neig, neig_total, eig, w_iks, n_start, n_end, zmat)
CALL write_eig_MPI(id, nk, jspin, neig, neig_total, eig, w_iks, n_start, n_end, zmat, smat)
CASE (-1)
CALL juDFT_error("Could not write eig-file before opening", calledby="eig66_io")
END SELECT
......
......@@ -25,9 +25,9 @@ CONTAINS
END SELECT
END SUBROUTINE priv_find_data
SUBROUTINE open_eig(id, nmat, neig, nkpts, jspins, l_create, l_real, l_soc, l_noco, filename)
SUBROUTINE open_eig(id, nmat, neig, nkpts, jspins, l_create, l_real, l_soc, l_noco, l_olap, filename)
INTEGER, INTENT(IN) :: id, nmat, neig, nkpts, jspins
LOGICAL, INTENT(IN) :: l_noco, l_create, l_real, l_soc
LOGICAL, INTENT(IN) :: l_noco, l_create, l_real, l_soc, l_olap
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: filename
!locals
INTEGER:: length
......@@ -55,8 +55,19 @@ CONTAINS
!d%eig_vec
if (l_real .and. .not. l_soc) THEN
ALLOCATE (d%eig_vecr(nmat*neig, length*nkpts))
ALLOCATE (d%olap_r(nmat**2, length*nkpts))
else
ALLOCATE (d%eig_vecc(nmat*neig, length*nkpts))
ALLOCATE (d%olap_c(nmat**2, length*nkpts))
endif
!d%olap
if(l_olap) then
if (l_real .and. .not. l_soc) THEN
ALLOCATE (d%olap_r(nmat**2, length*nkpts))
else
ALLOCATE (d%olap_c(nmat**2, length*nkpts))
endif
endif
length = length*nkpts
IF (PRESENT(filename)) CALL priv_readfromfile()
......@@ -74,7 +85,7 @@ CONTAINS
ALLOCATE (zmat%data_r(nmat, neig), zmat%data_c(nmat, neig))
tmp_id = eig66_data_newid(DA_mode)
CALL open_eig_IO(tmp_id, nmat, neig, nkpts, jspins, .FALSE., l_real, l_soc, filename)
CALL open_eig_IO(tmp_id, nmat, neig, nkpts, jspins, .FALSE., l_real, l_soc, .false., filename)
DO jspin = 1, jspins
DO nk = 1, nkpts
CALL read_eig_IO(tmp_id, nk, jspin, i, eig, w_iks, zmat=zmat)
......@@ -97,10 +108,12 @@ CONTAINS
IF (PRESENT(delete)) THEN
IF (delete) THEN
IF (ALLOCATED(d%eig_int)) DEALLOCATE (d%eig_int)
IF (ALLOCATED(d%eig_eig)) DEALLOCATE (d%eig_eig)
IF (ALLOCATED(d%eig_int)) DEALLOCATE (d%eig_int)
IF (ALLOCATED(d%eig_eig)) DEALLOCATE (d%eig_eig)
IF (ALLOCATED(d%eig_vecr)) DEALLOCATE (d%eig_vecr)
IF (ALLOCATED(d%eig_vecc)) DEALLOCATE (d%eig_vecc)
if (allocated(d%olap_r)) deallocate (d%olap_r)
if (allocated(d%olap_c)) deallocate (d%olap_c)
ENDIF
ENDIF
CONTAINS
......@@ -117,7 +130,7 @@ CONTAINS
zmat%matsize2 = SIZE(d%eig_eig, 1)
ALLOCATE (zmat%data_r(d%nmat, SIZE(d%eig_eig, 1)), zmat%data_c(d%nmat, SIZE(d%eig_eig, 1)))
tmp_id = eig66_data_newid(DA_mode)
CALL open_eig_DA(tmp_id, d%nmat, d%neig, d%nkpts, d%jspins, .FALSE., d%l_real, d%l_soc, filename)
CALL open_eig_DA(tmp_id, d%nmat, d%neig, d%nkpts, d%jspins, .FALSE., d%l_real, d%l_soc, .false., filename)
DO jspin = 1, d%jspins
DO nk = 1, d%nkpts
!TODO this code is no longer working
......@@ -131,13 +144,13 @@ CONTAINS
END SUBROUTINE priv_writetofile
END SUBROUTINE close_eig
SUBROUTINE read_eig(id, nk, jspin, neig, eig, w_iks, list, zmat)
SUBROUTINE read_eig(id, nk, jspin, neig, eig, w_iks, list, zmat, smat)
IMPLICIT NONE
INTEGER, INTENT(IN) :: id, nk, jspin
INTEGER, INTENT(OUT), OPTIONAL :: neig
REAL, INTENT(OUT), OPTIONAL :: eig(:), w_iks(:)
INTEGER, INTENT(IN), OPTIONAL :: list(:)
TYPE(t_mat), OPTIONAL :: zmat
TYPE(t_mat), OPTIONAL :: zmat, smat
INTEGER::nrec, arrayStart, arrayStop, i
INTEGER, ALLOCATABLE :: ind(:)
......@@ -193,14 +206,48 @@ CONTAINS
END DO
END IF
ENDIF
!data from d%eig_vec
IF (PRESENT(smat)) THEN
IF (PRESENT(list)) THEN
ind = list
ELSE
ALLOCATE (ind(smat%matsize2))
ind = [(i, i=1, SIZE(ind))]
END IF
IF (smat%l_real) THEN
IF (.NOT. ALLOCATED(d%olap_r)) THEN
IF (.NOT. ALLOCATED(d%olap_c)) CALL juDFT_error("BUG: can not read real/complex vectors from memory")
DO i = 1, SIZE(ind)
arrayStart = (ind(i) - 1)*smat%matsize1 + 1
arrayStop = ind(i)*smat%matsize1
smat%data_r(:, i) = REAL(d%olap_c(arrayStart:arrayStop, nrec))
ENDDO
ELSE
DO i = 1, SIZE(ind)
arrayStart = (ind(i) - 1)*smat%matsize1 + 1
arrayStop = ind(i)*smat%matsize1
smat%data_r(:, i) = d%olap_r(arrayStart:arrayStop, nrec)
ENDDO
ENDIF
ELSE !TYPE is (COMPLEX)
IF (.NOT. ALLOCATED(d%olap_c)) CALL juDFT_error("BUG: can not read complex vectors from memory", calledby="eig66_mem")
DO i = 1, SIZE(ind)
arrayStart = (ind(i) - 1)*smat%matsize1 + 1
arrayStop = ind(i)*smat%matsize1
smat%data_c(:, i) = d%olap_c(arrayStart:arrayStop, nrec)
END DO
END IF
ENDIF
END SUBROUTINE read_eig
SUBROUTINE write_eig(id, nk, jspin, neig, neig_total, eig, w_iks, n_size, n_rank, zmat)
SUBROUTINE write_eig(id, nk, jspin, neig, neig_total, eig, w_iks, n_size, n_rank, zmat, smat)
INTEGER, INTENT(IN) :: id, nk, jspin
INTEGER, INTENT(IN), OPTIONAL :: n_size, n_rank
INTEGER, INTENT(IN), OPTIONAL :: neig, neig_total
REAL, INTENT(IN), OPTIONAL :: eig(:), w_iks(:)
TYPE(t_mat), INTENT(IN), OPTIONAL :: zmat
TYPE(t_mat), INTENT(IN), OPTIONAL :: zmat, smat
INTEGER::nrec
TYPE(t_data_mem), POINTER:: d
CALL priv_find_data(id, d)
......@@ -228,16 +275,28 @@ CONTAINS
IF (zmat%l_real) THEN
IF (.NOT. ALLOCATED(d%eig_vecr)) THEN
IF (.NOT. ALLOCATED(d%eig_vecc)) CALL juDFT_error("BUG: can not write complex vectors to memory")
d%eig_vecc(:SIZE(zmat%data_r), nrec) = RESHAPE(CMPLX(zmat%data_r), (/SIZE(zmat%data_r)/)) !Type cast here
d%eig_vecc(:SIZE(zmat%data_r), nrec) = RESHAPE(CMPLX(zmat%data_r), [SIZE(zmat%data_r)]) !Type cast here
ELSE
d%eig_vecr(:SIZE(zmat%data_r), nrec) = RESHAPE(REAL(zmat%data_r), (/SIZE(zmat%data_r)/))
d%eig_vecr(:SIZE(zmat%data_r), nrec) = RESHAPE(REAL(zmat%data_r), [SIZE(zmat%data_r)])
ENDIF
ELSE
IF (.NOT. ALLOCATED(d%eig_vecc)) CALL juDFT_error("BUG: can not write complex vectors to memory")
d%eig_vecc(:SIZE(zmat%data_c), nrec) = RESHAPE(zmat%data_c, (/SIZE(zmat%data_c)/))
d%eig_vecc(:SIZE(zmat%data_c), nrec) = RESHAPE(zmat%data_c, [SIZE(zmat%data_c)])
END IF
ENDIF
IF (PRESENT(smat)) THEN
IF (smat%l_real) THEN
IF (.NOT. ALLOCATED(d%olap_r)) THEN
IF (.NOT. ALLOCATED(d%olap_c)) CALL juDFT_error("BUG: can not write complex vectors to memory (olap)")
d%olap_c(:SIZE(smat%data_r), nrec) = RESHAPE(CMPLX(smat%data_r), [SIZE(smat%data_r)]) !Type cast here
ELSE
d%olap_r(:SIZE(smat%data_r), nrec) = RESHAPE(REAL(smat%data_r), [SIZE(smat%data_r)])
ENDIF
ELSE
IF (.NOT. ALLOCATED(d%olap_c)) CALL juDFT_error("BUG: can not write complex vectors to memory (olap)")
d%olap_c(:SIZE(smat%data_c), nrec) = RESHAPE(smat%data_c, [SIZE(smat%data_c)])
END IF
ENDIF
END SUBROUTINE write_eig
END MODULE m_eig66_mem
......@@ -25,11 +25,11 @@ CONTAINS
END SELECT
END SUBROUTINE priv_find_data
SUBROUTINE open_eig(id, mpi_comm, nmat, neig, nkpts, jspins, create, l_real, l_soc, l_noco, n_size_opt, filename)
SUBROUTINE open_eig(id, mpi_comm, nmat, neig, nkpts, jspins, create, l_real, l_soc, l_noco, l_olap, n_size_opt, filename)
USE, INTRINSIC::iso_c_binding
IMPLICIT NONE
INTEGER, INTENT(IN) :: id, mpi_comm, nmat, neig, nkpts, jspins
LOGICAL, INTENT(IN) :: l_noco, create, l_real, l_soc
LOGICAL, INTENT(IN) :: l_noco, create, l_real, l_soc, l_olap
INTEGER, INTENT(IN), OPTIONAL:: n_size_opt
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: filename
#ifdef CPP_MPI
......@@ -51,7 +51,7 @@ CONTAINS
CALL MPI_COMM_RANK(MPI_COMM, d%irank, e)
CALL MPI_COMM_SIZE(MPI_COMM, isize, e)
CALL create_maps(d, isize, nkpts, jspins, neig, d%n_size)
CALL create_maps(d, isize, nkpts, jspins, neig, d%n_size, nmat)
local_slots = COUNT(d%pe_basis == d%irank)
!Now create the windows
......@@ -76,6 +76,16 @@ CONTAINS
ELSE
CALL priv_create_memory(slot_size, local_slots, d%zc_handle, cmplx_data_ptr=d%zc_data)
ENDIF
!The eigenvectors
local_slots = COUNT(d%pe_olap == d%irank)
slot_size = nmat
IF (l_real .AND. .NOT. l_soc) THEN
CALL priv_create_memory(slot_size, local_slots, d%olap_r_handle, real_data_ptr=d%olap_r_data)
ELSE
CALL priv_create_memory(slot_size, local_slots, d%olap_c_handle, cmplx_data_ptr=d%olap_c_data)
ENDIF
IF (PRESENT(filename) .AND. .NOT. create) CALL judft_error("Storing of data not implemented for MPI case", calledby="eig66_mpi.F")
CALL MPI_BARRIER(MPI_COMM, e)
CALL timestop("create data spaces in ei66_mpi")
......@@ -155,13 +165,13 @@ CONTAINS
IF (PRESENT(filename)) CALL judft_error("Storing of data not implemented for MPI case", calledby="eig66_mpi.F")
END SUBROUTINE close_eig
SUBROUTINE read_eig(id, nk, jspin, neig, eig, w_iks, list, zmat)
SUBROUTINE read_eig(id, nk, jspin, neig, eig, w_iks, list, zmat, smat)
IMPLICIT NONE
INTEGER, INTENT(IN) :: id, nk, jspin
INTEGER, INTENT(OUT), OPTIONAL :: neig
REAL, INTENT(OUT), OPTIONAL :: eig(:), w_iks(:)
INTEGER, INTENT(IN), OPTIONAL :: list(:)
TYPE(t_mat), OPTIONAL :: zmat
TYPE(t_mat), OPTIONAL :: zmat, smat
#ifdef CPP_MPI
INTEGER :: pe, tmp_size, e, req
......@@ -235,15 +245,56 @@ CONTAINS
ENDDO
ENDIF
if(allocated(tmp_real)) deallocate(tmp_real)
if(allocated(tmp_cmplx)) deallocate(tmp_cmplx)
IF (PRESENT(smat)) THEN
tmp_size = smat%matsize1
ALLOCATE (tmp_real(tmp_size))
ALLOCATE (tmp_cmplx(tmp_size))
DO n = 1, smat%matsize2
n1 = n
IF (PRESENT(list)) THEN
IF (n > SIZE(list)) CYCLE
n1 = list(n)
END IF
slot = d%slot_olap(nk, jspin, n1)
pe = d%pe_olap(nk, jspin, n1)
IF (smat%l_real) THEN
IF (.NOT. d%l_real) THEN
CALL MPI_WIN_LOCK(MPI_LOCK_SHARED, pe, 0, d%olap_c_handle, e)
CALL MPI_GET(tmp_cmplx, tmp_size, MPI_DOUBLE_COMPLEX, pe, slot, tmp_size, MPI_DOUBLE_COMPLEX, d%olap_c_handle, e)
CALL MPI_WIN_UNLOCK(pe, d%olap_c_handle, e)
!print *, nk,jspin,n1,"r PE:",pe," Slot: ",slot," Size:",tmp_size,tmp_cmplx(1)
smat%data_r(:, n) = REAL(tmp_cmplx)
ELSE
CALL MPI_WIN_LOCK(MPI_LOCK_SHARED, pe, 0, d%olap_r_handle, e)
CALL MPI_GET(tmp_real, tmp_size, MPI_DOUBLE_PRECISION, pe, slot, tmp_size, MPI_DOUBLE_PRECISION, d%olap_r_handle, e)
CALL MPI_WIN_UNLOCK(pe, d%olap_r_handle, e)
!print *, nk,jspin,n1,"r PE:",pe," Slot: ",slot," Size:",tmp_size,tmp_real(1)
smat%data_r(:, n) = tmp_real
ENDIF
ELSE
IF (d%l_real) CALL judft_error("Could not read complex data, only real data is stored", calledby="eig66_mpi%read_eig")
CALL MPI_WIN_LOCK(MPI_LOCK_SHARED, pe, 0, d%olap_c_handle, e)
CALL MPI_GET(tmp_cmplx, tmp_size, MPI_DOUBLE_COMPLEX, pe, slot, tmp_size, MPI_DOUBLE_COMPLEX, d%olap_c_handle, e)
CALL MPI_WIN_UNLOCK(pe, d%olap_c_handle, e)
!print *, nk,jspin,n1,"r PE:",pe," Slot: ",slot," Size:",tmp_size,tmp_cmplx(1)
smat%data_c(:, n) = tmp_cmplx
ENDIF
ENDDO
ENDIF
#endif
END SUBROUTINE read_eig
SUBROUTINE write_eig(id, nk, jspin, neig, neig_total, eig, w_iks, n_size, n_rank, zmat)
SUBROUTINE write_eig(id, nk, jspin, neig, neig_total, eig, w_iks, n_size, n_rank, zmat, smat)