Commit 10a7d4db authored by Stefan Rost's avatar Stefan Rost

Merge branch 'develop' of iffgit.fz-juelich.de:fleur/fleur into develop

parents 9ed3bc96 f72baf97
...@@ -49,24 +49,24 @@ CONTAINS ...@@ -49,24 +49,24 @@ CONTAINS
! .. ! ..
! .. Allocatable Arrays .. ! .. Allocatable Arrays ..
REAL, ALLOCATABLE :: f(:,:,:,:),g(:,:,:,:) REAL, ALLOCATABLE :: f(:,:,:,:),g(:,:,:,:)
COMPLEX, ALLOCATABLE :: rho21(:,:,:) COMPLEX :: rho21
! !
CALL timestart("cdnmt") CALL timestart("cdnmt")
IF (noco%l_mperp) THEN IF (noco%l_mperp) THEN
IF (denCoeffsOffdiag%l_fmpl) THEN IF (denCoeffsOffdiag%l_fmpl) THEN
ALLOCATE ( rho21(atoms%jmtd,0:sphhar%nlhd,atoms%ntype) ) !ALLOCATE ( rho21(atoms%jmtd,0:sphhar%nlhd,atoms%ntype) )
rho21(:,:,:) = cmplx(0.0,0.0) rho(:,:,:,3:4) = CMPLX(0.0,0.0)
ENDIF ENDIF
ENDIF ENDIF
!$OMP PARALLEL DEFAULT(none) & !$OMP PARALLEL DEFAULT(none) &
!$OMP SHARED(usdus,rho,moments,rho21,qmtl) & !$OMP SHARED(usdus,rho,moments,qmtl) &
!$OMP SHARED(atoms,jsp_start,jsp_end,enpara,vr,denCoeffs,sphhar)& !$OMP SHARED(atoms,jsp_start,jsp_end,enpara,vr,denCoeffs,sphhar)&
!$OMP SHARED(orb,noco,denCoeffsOffdiag,jspd)& !$OMP SHARED(orb,noco,denCoeffsOffdiag,jspd)&
!$OMP PRIVATE(itype,na,ispin,l,f,g,nodeu,noded,wronk,i,j,s,qmtllo,qmtt,nd,lh,lp,llp,cs) !$OMP PRIVATE(itype,na,ispin,l,rho21,f,g,nodeu,noded,wronk,i,j,s,qmtllo,qmtt,nd,lh,lp,llp,cs)
IF (noco%l_mperp) THEN IF (noco%l_mperp) THEN
ALLOCATE ( f(atoms%jmtd,2,0:atoms%lmaxd,jspd),g(atoms%jmtd,2,0:atoms%lmaxd,jspd) ) ALLOCATE ( f(atoms%jmtd,2,0:atoms%lmaxd,jspd),g(atoms%jmtd,2,0:atoms%lmaxd,jspd) )
ELSE ELSE
...@@ -187,7 +187,10 @@ CONTAINS ...@@ -187,7 +187,10 @@ CONTAINS
+ denCoeffsOffdiag%ud21(l,itype)*( f(j,1,l,2)*g(j,1,l,1) +f(j,2,l,2)*g(j,2,l,1) )& + denCoeffsOffdiag%ud21(l,itype)*( f(j,1,l,2)*g(j,1,l,1) +f(j,2,l,2)*g(j,2,l,1) )&
+ denCoeffsOffdiag%du21(l,itype)*( g(j,1,l,2)*f(j,1,l,1) +g(j,2,l,2)*f(j,2,l,1) )& + denCoeffsOffdiag%du21(l,itype)*( g(j,1,l,2)*f(j,1,l,1) +g(j,2,l,2)*f(j,2,l,1) )&
+ denCoeffsOffdiag%dd21(l,itype)*( g(j,1,l,2)*g(j,1,l,1) +g(j,2,l,2)*g(j,2,l,1) ) + denCoeffsOffdiag%dd21(l,itype)*( g(j,1,l,2)*g(j,1,l,1) +g(j,2,l,2)*g(j,2,l,1) )
rho21(j,0,itype) = rho21(j,0,itype)+ conjg(cs)/(atoms%neq(itype)*sfp_const) !rho21(j,0,itype) = rho21(j,0,itype)+ conjg(cs)/(atoms%neq(itype)*sfp_const)
rho21=CONJG(cs)/(atoms%neq(itype)*sfp_const)
rho(j,0,itype,3)=rho(j,0,itype,3)+REAL(rho21)
rho(j,0,itype,4)=rho(j,0,itype,4)+imag(rho21)
ENDDO ENDDO
ENDDO ENDDO
...@@ -203,7 +206,10 @@ CONTAINS ...@@ -203,7 +206,10 @@ CONTAINS
+ f(j,2,lp,2)*g(j,2,l,1) )+ denCoeffsOffdiag%dunmt21(llp,lh,itype)*(g(j,1,lp,2)*f(j,1,l,1)& + f(j,2,lp,2)*g(j,2,l,1) )+ denCoeffsOffdiag%dunmt21(llp,lh,itype)*(g(j,1,lp,2)*f(j,1,l,1)&
+ g(j,2,lp,2)*f(j,2,l,1) )+ denCoeffsOffdiag%ddnmt21(llp,lh,itype)*(g(j,1,lp,2)*g(j,1,l,1)& + g(j,2,lp,2)*f(j,2,l,1) )+ denCoeffsOffdiag%ddnmt21(llp,lh,itype)*(g(j,1,lp,2)*g(j,1,l,1)&
+ g(j,2,lp,2)*g(j,2,l,1) ) + g(j,2,lp,2)*g(j,2,l,1) )
rho21(j,lh,itype)= rho21(j,lh,itype)+ conjg(cs)/atoms%neq(itype) !rho21(j,lh,itype)= rho21(j,lh,itype)+ CONJG(cs)/atoms%neq(itype)
rho21=CONJG(cs)/atoms%neq(itype)
rho(j,lh,itype,3)=rho(j,lh,itype,3)+REAL(rho21)
rho(j,lh,itype,4)=rho(j,lh,itype,4)+imag(rho21)
ENDDO ENDDO
ENDDO ENDDO
ENDDO ENDDO
...@@ -241,15 +247,6 @@ CONTAINS ...@@ -241,15 +247,6 @@ CONTAINS
CALL timestop("cdnmt") CALL timestop("cdnmt")
!---> for testing: to plot the offdiag. part of the density matrix it
!---> is written to the file rhomt21. This file can read in pldngen.
IF (denCoeffsOffdiag%l_fmpl) THEN
OPEN (26,file='rhomt21',form='unformatted',status='unknown')
WRITE (26) rho21
CLOSE (26)
DEALLOCATE ( rho21 )
ENDIF
!---> end of test output
END SUBROUTINE cdnmt END SUBROUTINE cdnmt
END MODULE m_cdnmt END MODULE m_cdnmt
...@@ -12,14 +12,17 @@ ...@@ -12,14 +12,17 @@
export FC=$MPIFC export FC=$MPIFC
export CC=$MPICC export CC=$MPICC
fi fi
#ELPA
if [ $ELPA_MODULES ]
then
CLI_ELPA_OPENMP=1
FLEUR_LIBDIR="$FLEUR_LIBDIR $ELPA_LIB"
FLEUR_INCLUDEDIR="$FLEUR_INCLUDEDIR $ELPA_MODULES"
fi
elif module list 2>&1 | grep -q pgi elif module list 2>&1 | grep -q pgi
then then
echo "found PGI compiler" echo "found PGI compiler"
fi fi
#ELPA
if [ $ELPA_MODULES ]
then
CLI_ELPA_OPENMP=1
FLEUR_LIBDIR="$FLEUR_LIBDIR $ELPA_LIB"
FLEUR_INCLUDEDIR="$FLEUR_INCLUDEDIR $ELPA_MODULES"
fi
...@@ -4,9 +4,12 @@ LINK_LIBRARIES ${FLEUR_LIBRARIES}) ...@@ -4,9 +4,12 @@ LINK_LIBRARIES ${FLEUR_LIBRARIES})
if (NOT FLEUR_USE_ELPA_ONENODE) if (NOT FLEUR_USE_ELPA_ONENODE)
if (DEFINED CLI_ELPA_OPENMP) if (DEFINED CLI_ELPA_OPENMP)
message ("FLEUR_USE_GPU: ${FLEUR_USES_GPU}")
if (FLEUR_USE_GPU)
set(TEST_LIBRARIES "-lelpa_onenode;${FLEUR_LIBRARIES}")
else()
set(TEST_LIBRARIES "-lelpa_onenode_openmp;${FLEUR_LIBRARIES}") set(TEST_LIBRARIES "-lelpa_onenode_openmp;${FLEUR_LIBRARIES}")
#else() endif()
# set(TEST_LIBRARIES "-lelpa;${FLEUR_LIBRARIES}")
endif() endif()
try_compile(FLEUR_USE_ELPA_ONENODE ${CMAKE_BINARY_DIR} ${CMAKE_SOURCE_DIR}/cmake/tests/test_ELPA.f90 try_compile(FLEUR_USE_ELPA_ONENODE ${CMAKE_BINARY_DIR} ${CMAKE_SOURCE_DIR}/cmake/tests/test_ELPA.f90
LINK_LIBRARIES ${TEST_LIBRARIES}) LINK_LIBRARIES ${TEST_LIBRARIES})
......
...@@ -11,9 +11,11 @@ if (CLI_FLEUR_USE_GPU) ...@@ -11,9 +11,11 @@ if (CLI_FLEUR_USE_GPU)
elseif(${CLI_FLEUR_USE_GPU} MATCHES "cuda9.1") elseif(${CLI_FLEUR_USE_GPU} MATCHES "cuda9.1")
set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -Mcuda=cuda9.1,cc60 -Mcuda=rdc -Mcudalib=cublas") set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -Mcuda=cuda9.1,cc60 -Mcuda=rdc -Mcudalib=cublas")
elseif(${CLI_FLEUR_USE_GPU} MATCHES "nvtx") elseif(${CLI_FLEUR_USE_GPU} MATCHES "nvtx")
set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -Mcuda=cuda9.1,cc60 -Mcuda=rdc -Mcudalib=cublas -lnvToolsExt ") #set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -Mcuda=cuda9.1,cc60,ptxinfo,lineinfo -Mcuda=rdc -Mcudalib=cublas -lnvToolsExt ")
set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -Mcuda=cuda9.1,cc60 -Mcuda=rdc -Mcudalib=cublas -lnvToolsExt ")
elseif(${CLI_FLEUR_USE_GPU} MATCHES "emu") elseif(${CLI_FLEUR_USE_GPU} MATCHES "emu")
set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -Mcuda=emu -Mcudalib=cublas -Minfo=accel ") #set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -Mcuda=emu -Mcudalib=cublas -Minfo=accel ")
set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -Mcuda=emu -Mcudalib=cublas ")
endif() endif()
set(FLEUR_MPI_DEFINITIONS ${FLEUR_MPI_DEFINITIONS} "CPP_GPU" "CPP_MANAGED=,MANAGED") set(FLEUR_MPI_DEFINITIONS ${FLEUR_MPI_DEFINITIONS} "CPP_GPU" "CPP_MANAGED=,MANAGED")
set(FLEUR_DEFINITIONS ${FLEUR_DEFINITIONS} "CPP_GPU" "CPP_MANAGED=,MANAGED") set(FLEUR_DEFINITIONS ${FLEUR_DEFINITIONS} "CPP_GPU" "CPP_MANAGED=,MANAGED")
......
...@@ -45,6 +45,7 @@ CONTAINS ...@@ -45,6 +45,7 @@ CONTAINS
INTEGER :: kernel INTEGER :: kernel
CLASS(elpa_t),pointer :: elpa_obj CLASS(elpa_t),pointer :: elpa_obj
print*, "ELPA 20180525 started"
err = elpa_init(20180525) err = elpa_init(20180525)
elpa_obj => elpa_allocate() elpa_obj => elpa_allocate()
...@@ -60,6 +61,9 @@ CONTAINS ...@@ -60,6 +61,9 @@ CONTAINS
CALL elpa_obj%set("local_ncols", hmat%matsize2, err) CALL elpa_obj%set("local_ncols", hmat%matsize2, err)
CALL elpa_obj%set("nblk",hmat%matsize1, err) CALL elpa_obj%set("nblk",hmat%matsize1, err)
CALL elpa_obj%set("blacs_context", -1, err) CALL elpa_obj%set("blacs_context", -1, err)
#ifdef CPP_GPU
CALL elpa_obj%set("gpu",1,err)
#endif
err = elpa_obj%setup() err = elpa_obj%setup()
CALL hmat%add_transpose(hmat) CALL hmat%add_transpose(hmat)
......
set(fleur_F77 ${fleur_F77} set(fleur_F77 ${fleur_F77}
) )
set(fleur_F90 ${fleur_F90} set(fleur_F90 ${fleur_F90}
eigen/hsmt_mtNocoPot_offdiag.F90
eigen/eigen.F90 eigen/eigen.F90
eigen/hlomat.F90 eigen/hlomat.F90
eigen/hs_int.F90 eigen/hs_int.F90
......
...@@ -70,15 +70,15 @@ CONTAINS ...@@ -70,15 +70,15 @@ CONTAINS
!$OMP MASTER !$OMP MASTER
IF ((atoms%invsat(na).EQ.0) .OR. (atoms%invsat(na).EQ.1)) THEN IF ((atoms%invsat(na) == 0) .OR. (atoms%invsat(na) == 1)) THEN
!---> if this atom is the first of two atoms related by inversion, !---> if this atom is the first of two atoms related by inversion,
!---> the contributions to the overlap matrix of both atoms are added !---> the contributions to the overlap matrix of both atoms are added
!---> at once. where it is made use of the fact, that the sum of !---> at once. where it is made use of the fact, that the sum of
!---> these contributions is twice the real part of the contribution !---> these contributions is twice the real part of the contribution
!---> of each atom. note, that in this case there are twice as many !---> of each atom. note, that in this case there are twice as many
!---> (2*(2*l+1)) k-vectors (compare abccoflo and comments there). !---> (2*(2*l+1)) k-vectors (compare abccoflo and comments there).
IF (atoms%invsat(na).EQ.0) invsfct = 1 IF (atoms%invsat(na) == 0) invsfct = 1
IF (atoms%invsat(na).EQ.1) invsfct = 2 IF (atoms%invsat(na) == 1) invsfct = 2
! !
DO lo = 1,atoms%nlo(ntyp) DO lo = 1,atoms%nlo(ntyp)
...@@ -127,7 +127,7 @@ CONTAINS ...@@ -127,7 +127,7 @@ CONTAINS
!+t3e !+t3e
DO nkvec = 1,invsfct* (2*l+1) DO nkvec = 1,invsfct* (2*l+1)
locol= lapw%nv(jintsp)+lapw%index_lo(lo,na)+nkvec !this is the column of the matrix locol= lapw%nv(jintsp)+lapw%index_lo(lo,na)+nkvec !this is the column of the matrix
IF (MOD(locol-1,mpi%n_size).EQ.mpi%n_rank) THEN IF (MOD(locol-1,mpi%n_size) == mpi%n_rank) THEN
locol=(locol-1)/mpi%n_size+1 !this is the column in local storage locol=(locol-1)/mpi%n_size+1 !this is the column in local storage
!-t3e !-t3e
IF (hmat%l_real) THEN IF (hmat%l_real) THEN
...@@ -174,7 +174,7 @@ CONTAINS ...@@ -174,7 +174,7 @@ CONTAINS
!---> local orbitals at the same atom and with itself !---> local orbitals at the same atom and with itself
DO nkvec = 1,invsfct* (2*l+1) DO nkvec = 1,invsfct* (2*l+1)
locol = lapw%nv(jintsp)+lapw%index_lo(lo,na)+nkvec !this is the column of the matrix locol = lapw%nv(jintsp)+lapw%index_lo(lo,na)+nkvec !this is the column of the matrix
IF (MOD(locol-1,mpi%n_size).EQ.mpi%n_rank) THEN IF (MOD(locol-1,mpi%n_size) == mpi%n_rank) THEN
locol=(locol-1)/mpi%n_size+1 !this is the column in local storage locol=(locol-1)/mpi%n_size+1 !this is the column in local storage
!-t3e !-t3e
!---> calculate the hamiltonian matrix elements with other !---> calculate the hamiltonian matrix elements with other
......
!--------------------------------------------------------------------------------
! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
! This file is part of FLEUR and available as free software under the conditions
! of the MIT license as expressed in the LICENSE file in more detail.
!--------------------------------------------------------------------------------
MODULE m_hsmt MODULE m_hsmt
USE m_juDFT USE m_juDFT
IMPLICIT NONE IMPLICIT NONE
...@@ -25,6 +30,7 @@ CONTAINS ...@@ -25,6 +30,7 @@ CONTAINS
USE m_hsmt_fjgj USE m_hsmt_fjgj
USE m_hsmt_spinor USE m_hsmt_spinor
USE m_hsmt_soc_offdiag USE m_hsmt_soc_offdiag
USE m_hsmt_mtNocoPot_offdiag
USE m_hsmt_offdiag USE m_hsmt_offdiag
IMPLICIT NONE IMPLICIT NONE
TYPE(t_mpi),INTENT(IN) :: mpi TYPE(t_mpi),INTENT(IN) :: mpi
...@@ -84,15 +90,18 @@ CONTAINS ...@@ -84,15 +90,18 @@ CONTAINS
!global spin-matrices. !global spin-matrices.
CALL hmat_tmp%clear();CALL smat_tmp%clear() CALL hmat_tmp%clear();CALL smat_tmp%clear()
CALL hsmt_sph(n,atoms,mpi,ispin,input,noco,1,1,chi_one,lapw,enpara%el0,td%e_shift(n,ispin),& CALL hsmt_sph(n,atoms,mpi,ispin,input,noco,1,1,chi_one,lapw,enpara%el0,td%e_shift(n,ispin),&
usdus,fj(:,0:,ispin,:),gj(:,0:,ispin,:),smat_tmp,hmat_tmp) usdus,fj(:,0:,ispin,:),gj(:,0:,ispin,:),smat_tmp,hmat_tmp)
CALL hsmt_nonsph(n,mpi,sym,atoms,ispin,1,1,chi_one,noco,cell,lapw,td,& CALL hsmt_nonsph(n,mpi,sym,atoms,ispin,1,1,chi_one,noco,cell,lapw,td,&
fj(:,0:,ispin,:),gj(:,0:,ispin,:),hmat_tmp) fj(:,0:,ispin,:),gj(:,0:,ispin,:),hmat_tmp)
CALL hsmt_lo(input,atoms,sym,cell,mpi,noco,lapw,usdus,td,fj(:,0:,ispin,:),gj(:,0:,ispin,:),& CALL hsmt_lo(input,atoms,sym,cell,mpi,noco,lapw,usdus,td,fj(:,0:,ispin,:),gj(:,0:,ispin,:),&
n,chi_one,ispin,iintsp,jintsp,hmat_tmp,smat_tmp) n,chi_one,ispin,iintsp,jintsp,hmat_tmp,smat_tmp)
CALL hsmt_spinor(ispin,n,noco,chi) CALL hsmt_spinor(ispin,n,noco,chi)
CALL hsmt_distspins(chi,smat_tmp,smat) CALL hsmt_distspins(chi,smat_tmp,smat)
CALL hsmt_distspins(chi,hmat_tmp,hmat) CALL hsmt_distspins(chi,hmat_tmp,hmat)
!Add off-diagonal contributions to Hamiltonian if needed !Add off-diagonal contributions to Hamiltonian if needed
IF (ispin==1.AND.noco%l_mtNocoPot) THEN
CALL hsmt_mtNocoPot_offdiag(n,mpi,sym,atoms,noco,cell,lapw,td,fj,gj,hmat_tmp,hmat)
ENDIF
IF (ispin==1.and.noco%l_soc) & IF (ispin==1.and.noco%l_soc) &
CALL hsmt_soc_offdiag(n,atoms,mpi,noco,lapw,usdus,td,fj(:,0:,:,iintsp),gj(:,0:,:,iintsp),hmat) CALL hsmt_soc_offdiag(n,atoms,mpi,noco,lapw,usdus,td,fj(:,0:,:,iintsp),gj(:,0:,:,iintsp),hmat)
IF (noco%l_constr) & IF (noco%l_constr) &
......
!--------------------------------------------------------------------------------
! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
! This file is part of FLEUR and available as free software under the conditions
! of the MIT license as expressed in the LICENSE file in more detail.
!--------------------------------------------------------------------------------
MODULE m_hsmt_mtNocoPot_offdiag
USE m_juDFT
IMPLICIT NONE
CONTAINS
SUBROUTINE hsmt_mtNocoPot_offdiag(n,mpi,sym,atoms,noco,cell,lapw,td,fj,gj,hmat_tmp,hmat)
!Calculate the contribution from the local-spin-offdiagonal potential
!The following idea is used:
!Calculate the matrix by using non-spherical algorithm. This is done only once, since
!this sets up both the local spin-up-down and the spin-down-up part (it calculates the
!full matrix). So both can be updated from this matrix. But since the off-diagonal
!local potential is real we have to call the routine twice and use the chi_one factor
!to get the imaginary contribution
USE m_types
USE m_hsmt_nonsph
USE m_hsmt_distspins
USE m_hsmt_spinor
IMPLICIT NONE
TYPE(t_mpi),INTENT(IN) :: mpi
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_lapw),INTENT(IN) :: lapw
TYPE(t_tlmplm),INTENT(IN) :: td
REAL,INTENT(IN) :: fj(:,0:,:,:),gj(:,0:,:,:)
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: n
COMPLEX :: chi_one,chi(2,2)
CLASS(t_mat),INTENT(INOUT) :: hmat(:,:),hmat_tmp
chi_one=1.0
CALL hmat_tmp%clear()
!The spin1,2 matrix is calculated(real part of potential)
CALL hsmt_nonsph(n,mpi,sym,atoms,3,1,1,chi_one,noco,cell,lapw,td,&
fj(:,0:,1,:),gj(:,0:,2,:),hmat_tmp)
CALL hsmt_spinor(3,n,noco,chi) !spinor for off-diagonal part
CALL hsmt_distspins(chi,hmat_tmp,hmat)
CALL hmat_tmp%TRANSPOSE()
hmat_tmp%data_c=CONJG(hmat_tmp%data_c)
CALL hsmt_spinor(4,n,noco,chi) !spinor for off-diagonal part
CALL hsmt_distspins(chi,hmat_tmp,hmat)
CALL hmat_tmp%clear()
!The spin1,2 matrix is calculated(imag part of potential)
chi_one=CMPLX(0.,1.)
CALL hsmt_nonsph(n,mpi,sym,atoms,4,1,1,chi_one,noco,cell,lapw,td,&
fj(:,0:,1,:),gj(:,0:,2,:),hmat_tmp)
CALL hsmt_spinor(3,n,noco,chi)
CALL hsmt_distspins(chi,hmat_tmp,hmat)
CALL hmat_tmp%TRANSPOSE()
hmat_tmp%data_c=CONJG(hmat_tmp%data_c)
CALL hsmt_spinor(4,n,noco,chi)
CALL hsmt_distspins(chi,hmat_tmp,hmat)
END SUBROUTINE hsmt_mtNocoPot_offdiag
END MODULE m_hsmt_mtNocoPot_offdiag
...@@ -197,7 +197,13 @@ CONTAINS ...@@ -197,7 +197,13 @@ CONTAINS
td%h_loc(0:,0:,n,isp),SIZE(td%h_loc,1),CMPLX(0.,0.),ab1,SIZE(ab1,1)) td%h_loc(0:,0:,n,isp),SIZE(td%h_loc,1),CMPLX(0.,0.),ab1,SIZE(ab1,1))
!ab1=MATMUL(ab(:lapw%nv(iintsp),:ab_size),td%h_loc(:ab_size,:ab_size,n,isp)) !ab1=MATMUL(ab(:lapw%nv(iintsp),:ab_size),td%h_loc(:ab_size,:ab_size,n,isp))
IF (iintsp==jintsp) THEN IF (iintsp==jintsp) THEN
CALL ZHERK("U","N",lapw%nv(iintsp),ab_size,Rchi,CONJG(ab1),SIZE(ab1,1),1.0,hmat%data_c,SIZE(hmat%data_c,1)) IF (isp<3) THEN
CALL ZHERK("U","N",lapw%nv(iintsp),ab_size,Rchi,CONJG(ab1),SIZE(ab1,1),1.0,hmat%data_c,SIZE(hmat%data_c,1))
ELSE !This is the case of a local off-diagonal contribution.
!It is not Hermitian, so we need to USE zgemm CALL
CALL zgemm("N","T",lapw%nv(iintsp),lapw%nv(jintsp),ab_size,chi,CONJG(ab),SIZE(ab,1),&
ab1,SIZE(ab1,1),CMPLX(1.0,0.0),hmat%data_c,SIZE(hmat%data_c,1))
ENDIF
ELSE !here the l_ss off-diagonal part starts ELSE !here the l_ss off-diagonal part starts
!Second set of ab is needed !Second set of ab is needed
CALL hsmt_ab(sym,atoms,noco,isp,iintsp,n,na,cell,lapw,fj,gj,ab,ab_size,.TRUE.) CALL hsmt_ab(sym,atoms,noco,isp,iintsp,n,na,cell,lapw,fj,gj,ab,ab_size,.TRUE.)
......
This diff is collapsed.
...@@ -30,10 +30,21 @@ CONTAINS ...@@ -30,10 +30,21 @@ CONTAINS
chi(2,2) = exp(ImagUnit*noco%alph(n)/2)*cos(noco%beta(n)/2) chi(2,2) = exp(ImagUnit*noco%alph(n)/2)*cos(noco%beta(n)/2)
!---> and determine the prefactors for the Hamitonian- and !---> and determine the prefactors for the Hamitonian- and
!---> overlapp-matrix elements !---> overlapp-matrix elements
chi_mat(1,1) = chi(1,isp)*CONJG(chi(1,isp)) IF (isp<3) THEN
chi_mat(2,1) = chi(2,isp)*CONJG(chi(1,isp)) isp1=isp
chi_mat(2,2) = chi(2,isp)*CONJG(chi(2,isp)) isp2=isp
chi_mat(1,2) = chi(1,isp)*CONJG(chi(2,isp)) ELSEIF(isp==3) THEN
isp1=1
isp2=2
ELSE
isp1=2
isp2=1
ENDIF
chi_mat(1,1) = chi(1,isp1)*CONJG(chi(1,isp2))
chi_mat(2,1) = chi(2,isp1)*CONJG(chi(1,isp2))
chi_mat(2,2) = chi(2,isp1)*CONJG(chi(2,isp2))
chi_mat(1,2) = chi(1,isp1)*CONJG(chi(2,isp2))
......
...@@ -36,10 +36,10 @@ CONTAINS ...@@ -36,10 +36,10 @@ CONTAINS
CALL timestart("tlmplm") CALL timestart("tlmplm")
CALL td%init(DIMENSION%lmplmd,DIMENSION%lmd,atoms%ntype,atoms%lmaxd,atoms%llod,SUM(atoms%nlo),& CALL td%init(DIMENSION%lmplmd,DIMENSION%lmd,atoms%ntype,atoms%lmaxd,atoms%llod,SUM(atoms%nlo),&
DOT_PRODUCT(atoms%nlo,atoms%nlo+1)/2,input%jspins,& DOT_PRODUCT(atoms%nlo,atoms%nlo+1)/2,MERGE(4,input%jspins,noco%l_mtNocoPot),&
(noco%l_noco.AND.noco%l_soc.AND..NOT.noco%l_ss).OR.noco%l_constr)!l_offdiag (noco%l_noco.AND.noco%l_soc.AND..NOT.noco%l_ss).OR.noco%l_constr)!l_offdiag
DO jsp=1,input%jspins DO jsp=1,MERGE(4,input%jspins,noco%l_mtNocoPot)
!CALL tlmplm_cholesky(sphhar,atoms,DIMENSION,enpara, jsp,1,mpi,vTot%mt(:,0,1,jsp),input,vTot%mmpMat, td,ud) !CALL tlmplm_cholesky(sphhar,atoms,DIMENSION,enpara, jsp,1,mpi,vTot%mt(:,0,1,jsp),input,vTot%mmpMat, td,ud)
CALL tlmplm_cholesky(sphhar,atoms,noco,enpara,jsp,jsp,mpi,vTot,input,td,ud) CALL tlmplm_cholesky(sphhar,atoms,noco,enpara,jsp,jsp,mpi,vTot,input,td,ud)
IF (input%l_f) CALL write_tlmplm(td,vTot%mmpMat,atoms%n_u>0,jsp,jsp,input%jspins) IF (input%l_f) CALL write_tlmplm(td,vTot%mmpMat,atoms%n_u>0,jsp,jsp,input%jspins)
......
...@@ -58,15 +58,15 @@ CONTAINS ...@@ -58,15 +58,15 @@ CONTAINS
CALL lapw%phase_factors(i,atoms%taual(:,na),noco%qss,cph(:,i)) CALL lapw%phase_factors(i,atoms%taual(:,na),noco%qss,cph(:,i))
ENDDO ENDDO
IF ((atoms%invsat(na).EQ.0) .OR. (atoms%invsat(na).EQ.1)) THEN IF ((atoms%invsat(na) == 0) .OR. (atoms%invsat(na) == 1)) THEN
!---> if this atom is the first of two atoms related by inversion, !---> if this atom is the first of two atoms related by inversion,
!---> the contributions to the overlap matrix of both atoms are added !---> the contributions to the overlap matrix of both atoms are added
!---> at once. where it is made use of the fact, that the sum of !---> at once. where it is made use of the fact, that the sum of
!---> these contributions is twice the real part of the contribution !---> these contributions is twice the real part of the contribution
!---> of each atom. note, that in this case there are twice as many !---> of each atom. note, that in this case there are twice as many
!---> (2*(2*l+1)) k-vectors (compare abccoflo and comments there). !---> (2*(2*l+1)) k-vectors (compare abccoflo and comments there).
IF (atoms%invsat(na).EQ.0) invsfct = 1 IF (atoms%invsat(na) == 0) invsfct = 1
IF (atoms%invsat(na).EQ.1) invsfct = 2 IF (atoms%invsat(na) == 1) invsfct = 2
con = fpi_const/SQRT(cell%omtil)* ((atoms%rmt(ntyp))**2)/2.0 con = fpi_const/SQRT(cell%omtil)* ((atoms%rmt(ntyp))**2)/2.0
...@@ -82,7 +82,7 @@ CONTAINS ...@@ -82,7 +82,7 @@ CONTAINS
DO nkvec = 1,invsfct* (2*l+1) !Each LO can have several functions DO nkvec = 1,invsfct* (2*l+1) !Each LO can have several functions
!+t3e !+t3e
locol = lapw%nv(jintsp)+lapw%index_lo(lo,na)+nkvec !this is the column of the matrix locol = lapw%nv(jintsp)+lapw%index_lo(lo,na)+nkvec !this is the column of the matrix
IF (MOD(locol-1,mpi%n_size).EQ.mpi%n_rank) THEN IF (MOD(locol-1,mpi%n_size) == mpi%n_rank) THEN
locol=(locol-1)/mpi%n_size+1 !this is the column in local storage locol=(locol-1)/mpi%n_size+1 !this is the column in local storage
!-t3e !-t3e
k = lapw%kvec(nkvec,lo,na) k = lapw%kvec(nkvec,lo,na)
...@@ -107,7 +107,7 @@ CONTAINS ...@@ -107,7 +107,7 @@ CONTAINS
!---> orbitals at the same atom, if they have the same l !---> orbitals at the same atom, if they have the same l
DO lop = 1, (lo-1) DO lop = 1, (lo-1)
lp = atoms%llo(lop,ntyp) lp = atoms%llo(lop,ntyp)
IF (l.EQ.lp) THEN IF (l == lp) THEN
fact3 = con**2 * fl2p1 * (& fact3 = con**2 * fl2p1 * (&
alo1(lop)*(alo1(lo) + & alo1(lop)*(alo1(lo) + &
clo1(lo)*ud%uulon(lo,ntyp,isp))+& clo1(lo)*ud%uulon(lo,ntyp,isp))+&
......
...@@ -48,7 +48,7 @@ SUBROUTINE hsfock(nk,atoms,hybrid,lapw,dimension,kpts,jsp,input,hybdat,eig_irr,s ...@@ -48,7 +48,7 @@ SUBROUTINE hsfock(nk,atoms,hybrid,lapw,dimension,kpts,jsp,input,hybdat,eig_irr,s
results,it,mnobd,xcpot,mpi,irank2,isize2,comm) results,it,mnobd,xcpot,mpi,irank2,isize2,comm)
USE m_types USE m_types
USE m_symm_hf ,ONLY: symm_hf USE m_symm_hf
USE m_util ,ONLY: intgrf,intgrf_init USE m_util ,ONLY: intgrf,intgrf_init
USE m_exchange_valence_hf USE m_exchange_valence_hf
USE m_exchange_core USE m_exchange_core
...@@ -98,12 +98,12 @@ SUBROUTINE hsfock(nk,atoms,hybrid,lapw,dimension,kpts,jsp,input,hybdat,eig_irr,s ...@@ -98,12 +98,12 @@ SUBROUTINE hsfock(nk,atoms,hybrid,lapw,dimension,kpts,jsp,input,hybdat,eig_irr,s
REAL :: a_ex REAL :: a_ex
! local arrays ! local arrays
INTEGER :: gpt(3,lapw%nv(jsp))
INTEGER :: degenerat(hybrid%ne_eig(nk)) INTEGER :: degenerat(hybrid%ne_eig(nk))
INTEGER :: nsest(hybrid%nbands(nk)),indx_sest(hybrid%nbands(nk),hybrid%nbands(nk)) INTEGER :: nsest(hybrid%nbands(nk)),indx_sest(hybrid%nbands(nk),hybrid%nbands(nk))
INTEGER :: rrot(3,3,sym%nsym)
INTEGER :: psym(sym%nsym) ! Note: psym is only filled up to index nsymop
INTEGER,ALLOCATABLE :: parent(:),symop(:) INTEGER,ALLOCATABLE :: parent(:),symop(:)
INTEGER,ALLOCATABLE :: psym(:)
INTEGER,ALLOCATABLE :: pointer_EIBZ(:) INTEGER,ALLOCATABLE :: pointer_EIBZ(:)
INTEGER,ALLOCATABLE :: n_q(:) INTEGER,ALLOCATABLE :: n_q(:)
...@@ -115,7 +115,6 @@ SUBROUTINE hsfock(nk,atoms,hybrid,lapw,dimension,kpts,jsp,input,hybdat,eig_irr,s ...@@ -115,7 +115,6 @@ SUBROUTINE hsfock(nk,atoms,hybrid,lapw,dimension,kpts,jsp,input,hybdat,eig_irr,s
COMPLEX,ALLOCATABLE :: rep_c(:,:,:,:,:) COMPLEX,ALLOCATABLE :: rep_c(:,:,:,:,:)
CALL timestart("total time hsfock") CALL timestart("total time hsfock")
CALL timestart("symm_hf")
! preparations ! preparations
...@@ -125,11 +124,6 @@ SUBROUTINE hsfock(nk,atoms,hybrid,lapw,dimension,kpts,jsp,input,hybdat,eig_irr,s ...@@ -125,11 +124,6 @@ SUBROUTINE hsfock(nk,atoms,hybrid,lapw,dimension,kpts,jsp,input,hybdat,eig_irr,s
! initialize weighting factor for HF exchange part ! initialize weighting factor for HF exchange part
a_ex=xcpot%get_exchange_weight() a_ex=xcpot%get_exchange_weight()
! write k1,k2,k3 in gpt
DO i=1,lapw%nv(jsp)
gpt(:,i) = (/lapw%k1(i,jsp),lapw%k2(i,jsp),lapw%k3(i,jsp)/)
END DO
! read in lower triangle part of overlap matrix from direct acces file olap ! read in lower triangle part of overlap matrix from direct acces file olap
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*atoms%nlotot,lapw%nv(1)+atoms%nlotot,noco%l_noco)
call olap%alloc(sym%invs,nbasfcn) call olap%alloc(sym%invs,nbasfcn)
...@@ -159,10 +153,16 @@ SUBROUTINE hsfock(nk,atoms,hybrid,lapw,dimension,kpts,jsp,input,hybdat,eig_irr,s ...@@ -159,10 +153,16 @@ SUBROUTINE hsfock(nk,atoms,hybrid,lapw,dimension,kpts,jsp,input,hybdat,eig_irr,s
IF( ok .ne. 0 ) STOP 'mhsfock: failure allocation parent/symop' IF( ok .ne. 0 ) STOP 'mhsfock: failure allocation parent/symop'
parent = 0 ; symop = 0 parent = 0 ; symop = 0
CALL symm_hf(kpts,nk,sym,dimension,hybdat,eig_irr,atoms,hybrid,cell,lapw,jsp,gpt,mpi,irank2,& CALL timestart("symm_hf")
nsymop,psym,nkpt_EIBZ,n_q,parent,symop,degenerat,pointer_EIBZ,maxndb,nddb,nsest,indx_sest,rep_c) CALL symm_hf_init(sym,kpts,nk,irank2,nsymop,rrot,psym)
ALLOCATE(rep_c(-hybdat%lmaxcd:hybdat%lmaxcd,-hybdat%lmaxcd:hybdat%lmaxcd,0:hybdat%lmaxcd,nsymop,atoms%nat), stat=ok)
IF(ok.NE.0) STOP 'hsfock: failure allocation rep_c'
CALL symm_hf(kpts,nk,sym,dimension,hybdat,eig_irr,atoms,hybrid,cell,lapw,jsp,mpi,irank2,&
rrot,nsymop,psym,nkpt_EIBZ,n_q,parent,symop,degenerat,pointer_EIBZ,maxndb,nddb,nsest,indx_sest,rep_c)
CALL timestop("symm_hf") CALL timestop("symm_hf")
! remove weights(wtkpt) in w_iks ! remove weights(wtkpt) in w_iks
DO ikpt=1,kpts%nkptf DO ikpt=1,kpts%nkptf
DO iband=1,dimension%neigd DO iband=1,dimension%neigd
...@@ -174,15 +174,24 @@ SUBROUTINE hsfock(nk,atoms,hybrid,lapw,dimension,kpts,jsp,input,hybdat,eig_irr,s ...@@ -174,15 +174,24 @@ SUBROUTINE hsfock(nk,atoms,hybrid,lapw,dimension,kpts,jsp,input,hybdat,eig_irr,s
! calculate contribution from valence electrons to the ! calculate contribution from valence electrons to the
! HF exchange ! HF exchange
CALL timestart("valence exchange calculation") CALL timestart("valence exchange calculation")
ex%l_real=sym%invs ex%l_real=sym%invs
CALL exchange_valence_hf(nk,kpts,nkpt_EIBZ, sym,atoms,hybrid,cell,dimension,input,jsp,hybdat,mnobd,lapw,& CALL exchange_valence_hf(nk,kpts,nkpt_EIBZ, sym,atoms,hybrid,cell,dimension,input,jsp,hybdat,mnobd,lapw,&
eig_irr,results,parent,pointer_EIBZ,n_q,wl_iks,it,xcpot,noco,nsest,indx_sest,& eig_irr,results,parent,pointer_EIBZ,n_q,wl_iks,it,xcpot,noco,nsest,indx_sest,&
mpi,irank2,isize2,comm,ex) mpi,irank2,isize2,comm,ex)
DEALLOCATE (rep_c) DEALLOCATE (rep_c)
CALL timestop("valence exchange calculation") CALL timestop("valence exchange calculation")
WRITE(1224,'(a,i7)') 'kpoint: ', nk
DO i = 1, ex%matsize1
DO j = 1, i
IF (ex%l_real) THEN
WRITE(1224,'(2i7,2f15.8)') i, j, ex%data_r(j,i) !ex%data_r(i,j), ex%data_r(j,i)
ELSE
WRITE(1224,'(2i7,4f15.8)') i, j, ex%data_c(j,i) !ex%data_c(i,j), ex%data_c(j,i)
ENDIF
END DO
END DO
CALL timestart("core exchange calculation") CALL timestart("core exchange calculation")
! do the rest of the calculation only on master ! do the rest of the calculation only on master
IF (irank2 /= 0) RETURN IF (irank2 /= 0) RETURN
...@@ -227,12 +236,45 @@ SUBROUTINE hsfock(nk,atoms,hybrid,lapw,dimension,kpts,jsp,input,hybdat,eig_irr,s ...@@ -227,12 +236,45 @@ SUBROUTINE hsfock(nk,atoms,hybrid,lapw,dimension,kpts,jsp,input,hybdat,eig_irr,s
ENDDO ENDDO
ENDDO ENDDO
WRITE(1225,'(a,i7)') 'kpoint: ', nk
DO i = 1, ex%matsize1
DO j = 1, i
IF (ex%l_real) THEN
WRITE(1225,'(2i7,2f15.8)') i, j, ex%data_r(i,j), ex%data_r(j,i)
ELSE
WRITE(1225,'(2i7,4f15.8)') i, j, ex%data_c(i,j), ex%data_c(j,i)
ENDIF
END DO
END DO
CALL ex%multiply(invtrafo,tmp) CALL ex%multiply(invtrafo,tmp)
CALL trafo%multiply(tmp,v_x) CALL trafo%multiply(tmp,v_x)