Commit c61cd491 authored by Henning Janssen's avatar Henning Janssen

Merge remote-tracking branch 'origin/develop' into develop

parents 5d6ef3d4 118ef83c
......@@ -79,9 +79,7 @@ CONTAINS
ENDDO;ENDDO
CALL hsmt(atoms,sym,enpara,isp,input,mpi,noco,nococonv,cell,lapw,ud,td,smat,hmat)
DO i=1,nspins;DO j=1,nspins;if (hmat(1,1)%l_real) THEN
print *,"Trying",i,j
!$acc exit data copyout(hmat(i,j)%data_r,smat(i,j)%data_r)
print*,"copyout:", i,j
ELSE
!$acc exit data copyout(hmat(i,j)%data_c,smat(i,j)%data_c)
ENDIF;ENDDO;ENDDO
......
......@@ -69,7 +69,6 @@ SUBROUTINE hsmt_sph_acc(n,atoms,mpi,isp,input,nococonv,iintsp,jintsp,chi,lapw,el
END DO ! l
qssbti=MERGE(- nococonv%qss/2,+ nococonv%qss/2,jintsp.EQ.1)
qssbtj=MERGE(- nococonv%qss/2,+ nococonv%qss/2,iintsp.EQ.1)
print *,"hssph:",mpi%irank
!$acc data &
!$acc& copyin(jintsp,iintsp,n,fleg1,fleg2,isp,fl2p1,el,e_shift,chi,qssbti,qssbtj)&
!$acc& copyin(lapw,atoms,mpi,input,usdus)&
......@@ -237,7 +236,6 @@ SUBROUTINE hsmt_sph_cpu(n,atoms,mpi,isp,input,nococonv,iintsp,jintsp,chi,lapw,el
ALLOCATE(VecHelpS(NVEC),VecHelpH(NVEC))
qssbti=MERGE(- nococonv%qss/2,+ nococonv%qss/2,jintsp.EQ.1)
qssbtj=MERGE(- nococonv%qss/2,+ nococonv%qss/2,iintsp.EQ.1)
print *,"hssph:",mpi%irank
!$OMP DO SCHEDULE(DYNAMIC,1)
DO ki = mpi%n_rank+1, lapw%nv(jintsp), mpi%n_size
kj_end=min(ki,lapw%nv(iintsp))
......
......@@ -371,9 +371,14 @@ CONTAINS
CHARACTER(len=100):: xPathA
CHARACTER(len=255):: valueString
CHARACTER(len=30):: jobname
CHARACTER(len=30):: param
INTEGER :: parampos
INTEGER :: stat
INTEGER :: numberNodes,i,n,numtokens
LOGICAL,ALLOCATABLE:: wannAtomList(:)
LOGICAL :: l_param
REAL :: version_real
xPathA = '/fleurInput/output/wannier'
numberNodes = xml%getNumberOfNodes(xPathA)
......@@ -424,6 +429,15 @@ CONTAINS
DO i = 1, numTokens
this%jobList(i) = xml%popFirstStringToken(valueString)
IF(this%jobList(i)(1:1).EQ.'!')cycle
parampos=index(this%jobList(i),'=')
if(parampos.gt.1)then
jobname=this%jobList(i)(1:parampos-1)
param=this%jobList(i)(parampos+1:)
l_param=.true.
else
jobname=this%jobList(i)
l_param=.false.
endif
IF(this%jobList(i).EQ.'socmat')THEN
this%l_socmat=.TRUE.
ELSEIF(this%jobList(i).EQ.'socmatvec')THEN
......@@ -499,8 +513,30 @@ CONTAINS
this%l_wann_plot=.TRUE.
ELSEIF(this%jobList(i).EQ.'bynumber')THEN
this%l_bynumber=.TRUE.
ELSEIF(this%jobList(i).EQ.'matrixmmn')THEN
this%l_matrixmmn=.TRUE.
ELSEIF(jobname.EQ.'matrixmmn')THEN
this%l_matrixmmn=.TRUE.
if(l_param)then
read(param,*,iostat=stat) this%matrixmmnfmt
if(stat/=0)then
CALL juDFT_error("problem with jobparam=",calledby="wann_read_inp")
endif
endif
ELSEIF(jobname.EQ.'perpmag')THEN
this%l_perpmag=.TRUE.
if(l_param)then
read(param,*,iostat=stat) this%perpmagfmt
if(stat/=0)then
CALL juDFT_error("problem with jobparam=",calledby="wann_read_inp")
endif
endif
ELSEIF(jobname.EQ.'perpmagrs')THEN
this%l_perpmagrs=.TRUE.
if(l_param)then
read(param,*,iostat=stat) this%perpmagrsfmt
if(stat/=0)then
CALL juDFT_error("problem with jobparam=",calledby="wann_read_inp")
endif
endif
ELSEIF(this%jobList(i).EQ.'projmethod')THEN
this%l_projmethod=.TRUE.
ELSEIF(this%jobList(i).EQ.'matrixamn')THEN
......@@ -561,20 +597,28 @@ CONTAINS
this%l_matrixuHu=.TRUE.
ELSEIF(this%jobList(i).EQ.'matrixuhu-dmi') THEN
this%l_matrixuHu_dmi=.TRUE.
!Not done
! ELSEIF(this%jobList(i).EQ.'wan90version')THEN
! backspace(916)
! read(916,*,iostat=ios)task,version_real
! if (ios /= 0) CALL judft_error("error reading wan90version", calledby="wann_read_inp")
! if(abs(version_real-1.1).lt.1.e-9)THEN
! this%wan90version=1
! ELSEIF(abs(version_real-1.2).lt.1.e-9)THEN
! this%wan90version=2
! ELSEIF(abs(version_real-2.0).lt.1.e-9)THEN
! this%wan90version=3
! ELSE
! CALL judft_error ("chosen w90 version unknown", calledby="wann_read_inp")
! endif
ELSEIF(jobname.EQ.'wan90version')THEN
if(l_param)then
read(param,*,iostat=stat) version_real
if(stat/=0)then
write(*,*)"problem with jobparam=",param
CALL juDFT_error ("problem with jobparam", calledby="wann_read_inp")
endif
else
CALL juDFT_error ("parameter needed in wan90version", calledby="wann_read_inp")
endif
if(abs(version_real-1.1).lt.1.e-9)THEN
this%wan90version=1
ELSEIF(abs(version_real-1.2).lt.1.e-9)THEN
this%wan90version=2
ELSEIF(abs(version_real-2.0).lt.1.e-9)THEN
this%wan90version=3
ELSE
CALL judft_error ("chosen w90 version unknown", calledby="wann_read_inp")
endif
!Not done
! ELSEIF(this%jobList(i).EQ.'ikptstart')THEN
! this%l_ikptstart=.TRUE.
......
......@@ -49,7 +49,7 @@ CONTAINS
INTEGER, ALLOCATABLE :: my_k_list(:), k_owner(:)
CALL timestart("hybrid code")
call sync_eig(eig_id, fi)
call sync_eig(eig_id, fi, .True.)
call hybmpi%copy_mpi(mpi)
call split_k_to_comm(fi, hybmpi, my_k_list, k_owner)
......@@ -67,79 +67,77 @@ CONTAINS
hybdat%l_calhf = (results%last_distance >= 0.0) .AND. (results%last_distance < fi%input%minDistance)
IF (.NOT. hybdat%l_calhf) THEN
hybdat%l_subvxc = hybdat%l_subvxc .AND. hybdat%l_addhf
CALL timestop("hybrid code")
RETURN
ENDIF
results%te_hfex%core = 0
!Check if we are converged well enough to calculate a new potential
hybdat%l_addhf = .TRUE.
!In first iteration allocate some memory
IF (init_vex) THEN
call first_iteration_alloc(fi, hybdat)
init_vex = .FALSE.
END IF
else
results%te_hfex%core = 0
hybdat%l_subvxc = (hybdat%l_subvxc .AND. hybdat%l_addhf)
IF (.NOT. ALLOCATED(results%w_iks)) allocate(results%w_iks(fi%input%neig, fi%kpts%nkpt, fi%input%jspins))
!Check if we are converged well enough to calculate a new potential
hybdat%l_addhf = .TRUE.
iterHF = iterHF + 1
!In first iteration allocate some memory
IF (init_vex) THEN
call first_iteration_alloc(fi, hybdat)
init_vex = .FALSE.
END IF
!Delete broyd files
CALL system("rm -f broyd*")
hybdat%l_subvxc = (hybdat%l_subvxc .AND. hybdat%l_addhf)
IF (.NOT. ALLOCATED(results%w_iks)) allocate(results%w_iks(fi%input%neig, fi%kpts%nkpt, fi%input%jspins))
!check if z-reflection trick can be used
iterHF = iterHF + 1
l_zref = (fi%sym%zrfs .AND. (SUM(ABS(fi%kpts%bk(3, :fi%kpts%nkpt))) < 1e-9) .AND. .NOT. fi%noco%l_noco)
!Delete broyd files
CALL system("rm -f broyd*")
CALL timestart("Preparation for hybrid functionals")
!construct the mixed-basis
CALL timestart("generation of mixed basis")
if(hybmpi%rank == 0) write (*,*) "iterHF = ", iterHF
CALL mixedbasis(fi%atoms, fi%kpts, fi%input, fi%cell, xcpot, fi%mpinp, mpdata, fi%hybinp, hybdat,&
enpara, mpi, v, iterHF)
CALL timestop("generation of mixed basis")
!check if z-reflection trick can be used
l_zref = (fi%sym%zrfs .AND. (SUM(ABS(fi%kpts%bk(3, :fi%kpts%nkpt))) < 1e-9) .AND. .NOT. fi%noco%l_noco)
if(.not. allocated(hybdat%coul)) allocate(hybdat%coul(fi%kpts%nkpt))
do i =1,fi%kpts%nkpt
call hybdat%coul(i)%alloc(fi, mpdata%num_radbasfn, mpdata%n_g, i)
enddo
CALL timestart("Preparation for hybrid functionals")
!construct the mixed-basis
CALL timestart("generation of mixed basis")
if(hybmpi%rank == 0) write (*,*) "iterHF = ", iterHF
CALL mixedbasis(fi%atoms, fi%kpts, fi%input, fi%cell, xcpot, fi%mpinp, mpdata, fi%hybinp, hybdat,&
enpara, mpi, v, iterHF)
CALL timestop("generation of mixed basis")
CALL coulombmatrix(mpi, fi, mpdata, hybdat, xcpot, my_k_list)
do i =1,fi%kpts%nkpt
call hybdat%coul(i)%mpi_ibc(fi, hybmpi, k_owner(i))
enddo
if(.not. allocated(hybdat%coul)) allocate(hybdat%coul(fi%kpts%nkpt))
do i =1,fi%kpts%nkpt
call hybdat%coul(i)%alloc(fi, mpdata%num_radbasfn, mpdata%n_g, i)
enddo
CALL hf_init(eig_id, mpdata, fi, hybdat)
CALL timestop("Preparation for hybrid functionals")
CALL coulombmatrix(mpi, fi, mpdata, hybdat, xcpot, my_k_list)
CALL timestart("Calculation of non-local HF potential")
DO jsp = 1, fi%input%jspins
call timestart("HF_setup")
CALL HF_setup(mpdata,fi%hybinp, fi%input, fi%sym, fi%kpts, fi%atoms, &
mpi, fi%noco, nococonv,fi%cell, fi%oneD, results, jsp, enpara, &
hybdat, fi%sym%invs, v%mt(:, 0, :, :), eig_irr)
call timestop("HF_setup")
do i =1,fi%kpts%nkpt
call hybdat%coul(i)%mpi_ibc(fi, hybmpi, k_owner(i))
enddo
DO i = 1,size(my_k_list)
nk = my_k_list(i)
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)
CALL hf_init(eig_id, mpdata, fi, hybdat)
CALL timestop("Preparation for hybrid functionals")
CALL timestart("Calculation of non-local HF potential")
DO jsp = 1, fi%input%jspins
call timestart("HF_setup")
CALL HF_setup(mpdata,fi%hybinp, fi%input, fi%sym, fi%kpts, fi%atoms, &
mpi, fi%noco, nococonv,fi%cell, fi%oneD, results, jsp, enpara, &
hybdat, fi%sym%invs, v%mt(:, 0, :, :), eig_irr)
call timestop("HF_setup")
DO i = 1,size(my_k_list)
nk = my_k_list(i)
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)
END DO
END DO
END DO
CALL timestop("Calculation of non-local HF potential")
CALL timestop("Calculation of non-local HF potential")
#ifdef CPP_MPI
call timestart("Hybrid imbalance")
call MPI_Barrier(mpi%mpi_comm, err)
call timestop("Hybrid imbalance")
call timestart("Hybrid imbalance")
call MPI_Barrier(mpi%mpi_comm, err)
call timestop("Hybrid imbalance")
#endif
call sync_eig(eig_id, fi)
ENDIF
call sync_eig(eig_id, fi, .False.)
CALL timestop("hybrid code")
CONTAINS
subroutine first_iteration_alloc(fi, hybdat)
......
......@@ -176,7 +176,7 @@ CONTAINS
slot = d%slot_basis(nk, jspin)
IF (PRESENT(neig)) THEN
IF (d%read_epoch) THEN
#ifdef CPP_MPI3
#ifdef CPP_MPI
CALL MPI_RGET(neig, 1, MPI_INTEGER, pe, slot, 1, MPI_INTEGER, d%neig_handle, req, e)
CALL MPI_WAIT(req, MPI_STATUS_IGNORE, e)
#endif
......@@ -191,7 +191,7 @@ CONTAINS
ALLOCATE (tmp_real(MIN(SIZE(eig), d%size_eig)))
IF (PRESENT(eig)) THEN
IF (d%read_epoch) THEN
#ifdef CPP_MPI3
#ifdef CPP_MPI
CALL MPI_RGET(tmp_real, SIZE(tmp_real), MPI_DOUBLE_PRECISION, pe, slot, SIZE(tmp_real), MPI_DOUBLE_PRECISION, d%eig_handle, req, e)
CALL MPI_WAIT(req, MPI_STATUS_IGNORE, e)
#endif
......@@ -204,7 +204,7 @@ CONTAINS
END IF
IF (PRESENT(w_iks)) THEN
IF (d%read_epoch) THEN
#ifdef CPP_MPI3
#ifdef CPP_MPI
CALL MPI_RGET(tmp_real, SIZE(tmp_real), MPI_DOUBLE_PRECISION, pe, slot, SIZE(tmp_real), MPI_DOUBLE_PRECISION, d%w_iks_handle, req, e)
CALL MPI_WAIT(req, MPI_STATUS_IGNORE, e)
#endif
......@@ -234,7 +234,7 @@ CONTAINS
IF (zmat%l_real) THEN
IF (.NOT. d%l_real) THEN
IF (d%read_epoch) THEN
#ifdef CPP_MPI3
#ifdef CPP_MPI
CALL MPI_RGET(tmp_cmplx, tmp_size, MPI_DOUBLE_COMPLEX, pe, slot, tmp_size, MPI_DOUBLE_COMPLEX, d%zc_handle, req, e)
CALL MPI_WAIT(req, MPI_STATUS_IGNORE, e)
#endif
......@@ -247,7 +247,7 @@ CONTAINS
zmat%data_r(:, n) = REAL(tmp_cmplx)
ELSE
IF (d%read_epoch) THEN
#ifdef CPP_MPI3
#ifdef CPP_MPI
CALL MPI_RGET(tmp_real, tmp_size, MPI_DOUBLE_PRECISION, pe, slot, tmp_size, MPI_DOUBLE_PRECISION, d%zr_handle, req, e)
CALL MPI_WAIT(req, MPI_STATUS_IGNORE, e)
#endif
......@@ -264,7 +264,7 @@ CONTAINS
IF (d%l_real) CALL judft_error("Could not read complex data, only real data is stored", calledby="eig66_mpi%read_eig")
IF (d%read_epoch) THEN
#ifdef CPP_MPI3
#ifdef CPP_MPI
CALL MPI_RGET(tmp_cmplx, tmp_size, MPI_DOUBLE_COMPLEX, pe, slot, tmp_size, MPI_DOUBLE_COMPLEX, d%zc_handle, req, e)
CALL MPI_WAIT(req, MPI_STATUS_IGNORE, e)
......@@ -283,56 +283,59 @@ CONTAINS
#endif
END SUBROUTINE read_eig
SUBROUTINE sync_eig(id, fi)
SUBROUTINE sync_eig(id, fi, start_read_only)
use m_judft
#ifdef CPP_MPI
use mpi
#endif
type(t_fleurinput) :: fi
INTEGER, INTENT(IN) :: id
type(t_fleurinput) :: fi
INTEGER, INTENT(IN) :: id
logical, intent(in) :: start_read_only
logical :: l_real, l_soc
TYPE(t_data_MPI), POINTER, ASYNCHRONOUS :: d
INTEGER:: err
#if defined(CPP_MPI3) && defined(CPP_MPI)
CALL priv_find_data(id, d)
l_real=fi%sym%invs.AND..NOT.fi%noco%l_noco.AND..NOT.(fi%noco%l_soc.AND.fi%atoms%n_u+fi%atoms%n_hia>0)
l_soc =fi%noco%l_soc
IF (d%read_epoch) THEN
d%read_epoch = .FALSE.
CALL MPI_Win_fence(MPI_MODE_NOSTORE, d%eig_handle, err)
if(err /= 0) call juDFT_error("MPI_Win_fence isn't happy. No. 1")
IF (l_real .AND. .NOT. l_soc) THEN
CALL MPI_Win_fence(MPI_MODE_NOSTORE, d%zr_handle, err)
if(err /= 0) call juDFT_error("MPI_Win_fence isn't happy. No. 2")
#ifdef(CPP_MPI)
if(eig66_data_mode(id) == MPI_mode) then
CALL priv_find_data(id, d)
l_real=fi%sym%invs.AND..NOT.fi%noco%l_noco.AND..NOT.(fi%noco%l_soc.AND.fi%atoms%n_u+fi%atoms%n_hia>0)
l_soc =fi%noco%l_soc
IF (start_read_only) THEN
d%read_epoch = .TRUE.
CALL MPI_Win_fence(MPI_MODE_NOPUT, d%eig_handle, err)
if(err /= 0) call juDFT_error("MPI_Win_fence isn't happy. No. 6")
IF (l_real .AND. .NOT. l_soc) THEN
CALL MPI_Win_fence(MPI_MODE_NOPUT, d%zr_handle, err)
if(err /= 0) call juDFT_error("MPI_Win_fence isn't happy. No. 7")
ELSE
CALL MPI_Win_fence(MPI_MODE_NOPUT, d%zc_handle, err)
if(err /= 0) call juDFT_error("MPI_Win_fence isn't happy. No. 8")
ENDIF
CALL MPI_Win_fence(MPI_MODE_NOPUT, d%neig_handle, err)
if(err /= 0) call juDFT_error("MPI_Win_fence isn't happy. No. 9")
CALL MPI_Win_fence(MPI_MODE_NOPUT, d%w_iks_handle, err)
if(err /= 0) call juDFT_error("MPI_Win_fence isn't happy. No. 10")
ELSE
CALL MPI_Win_fence(MPI_MODE_NOSTORE, d%zc_handle, err)
if(err /= 0) call juDFT_error("MPI_Win_fence isn't happy. No. 3")
ENDIF
d%read_epoch = .FALSE.
CALL MPI_Win_fence(MPI_MODE_NOSTORE, d%eig_handle, err)
if(err /= 0) call juDFT_error("MPI_Win_fence isn't happy. No. 1")
CALL MPI_Win_fence(MPI_MODE_NOSTORE, d%neig_handle, err)
if(err /= 0) call juDFT_error("MPI_Win_fence isn't happy. No. 4")
CALL MPI_Win_fence(MPI_MODE_NOSTORE, d%w_iks_handle, err)
if(err /= 0) call juDFT_error("MPI_Win_fence isn't happy. No. 5")
ELSE
d%read_epoch = .TRUE.
CALL MPI_Win_fence(MPI_MODE_NOPUT, d%eig_handle, err)
if(err /= 0) call juDFT_error("MPI_Win_fence isn't happy. No. 6")
IF (l_real .AND. .NOT. l_soc) THEN
CALL MPI_Win_fence(MPI_MODE_NOPUT, d%zr_handle, err)
if(err /= 0) call juDFT_error("MPI_Win_fence isn't happy. No. 7")
ELSE
CALL MPI_Win_fence(MPI_MODE_NOPUT, d%zc_handle, err)
if(err /= 0) call juDFT_error("MPI_Win_fence isn't happy. No. 8")
IF (l_real .AND. .NOT. l_soc) THEN
CALL MPI_Win_fence(MPI_MODE_NOSTORE, d%zr_handle, err)
if(err /= 0) call juDFT_error("MPI_Win_fence isn't happy. No. 2")
ELSE
CALL MPI_Win_fence(MPI_MODE_NOSTORE, d%zc_handle, err)
if(err /= 0) call juDFT_error("MPI_Win_fence isn't happy. No. 3")
ENDIF
CALL MPI_Win_fence(MPI_MODE_NOSTORE, d%neig_handle, err)
if(err /= 0) call juDFT_error("MPI_Win_fence isn't happy. No. 4")
CALL MPI_Win_fence(MPI_MODE_NOSTORE, d%w_iks_handle, err)
if(err /= 0) call juDFT_error("MPI_Win_fence isn't happy. No. 5")
ENDIF
CALL MPI_Win_fence(MPI_MODE_NOPUT, d%neig_handle, err)
if(err /= 0) call juDFT_error("MPI_Win_fence isn't happy. No. 9")
CALL MPI_Win_fence(MPI_MODE_NOPUT, d%w_iks_handle, err)
if(err /= 0) call juDFT_error("MPI_Win_fence isn't happy. No. 10")
ENDIF
endif
#endif
END SUBROUTINE sync_eig
......
......@@ -2339,7 +2339,7 @@ CONTAINS
mpi%mpi_comm,jspin2,l_p0,fullnkpts,nntot,wann,&
maptopair,pair_to_do,nbnd,bpt,gb,&
mpi%isize,mpi%irank," ",&
mmnk,wann%l_unformatted)
mmnk,wann%matrixmmnfmt==2) ! wann%l_unformatted)
ENDIF !wann%l_matrixmmn
912 CONTINUE
......
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