Commit 1a54b83f authored by Daniel Wortmann's avatar Daniel Wortmann

Merge branch 'FFN' into 'develop'

Fixes for FFN

See merge request fleur/fleur!65
parents f0550691 5f4691ef
......@@ -77,10 +77,8 @@ CONTAINS
CALL hs_int(input,noco,stars,lapw,mpi,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
DO ispin=MERGE(1,isp,noco%l_noco),MERGE(2,isp,noco%l_noco)
CALL hsmt(atoms,sym,enpara,ispin,input,mpi,noco,nococonv,cell,lapw,ud,td,smat,hmat)
ENDDO
!MT-part of Hamiltonian. In case of noco, we need an loop over the local spin of the atoms
CALL hsmt(atoms,sym,enpara,isp,input,mpi,noco,nococonv,cell,lapw,ud,td,smat,hmat)
CALL timestop("MT part")
!Vacuum contributions
......
This diff is collapsed.
......@@ -21,12 +21,12 @@ CONTAINS
!! The off-diagonal contribution in first-variation soc and constraint calculations is still missing
SUBROUTINE hsmt(atoms,sym,enpara,&
ispin,input,mpi,noco,nococonv,cell,lapw,usdus,td,smat,hmat)
isp,input,mpi,noco,nococonv,cell,lapw,usdus,td,smat,hmat)
USE m_types
USE m_types_mpimat
USE m_hsmt_nonsph
USE m_hsmt_sph
use m_hsmt_lo
USE m_hsmt_lo
USE m_hsmt_distspins
USE m_hsmt_fjgj
USE m_hsmt_spinor
......@@ -37,7 +37,7 @@ CONTAINS
TYPE(t_mpi),INTENT(IN) :: mpi
TYPE(t_input),INTENT(IN) :: input
TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_nococonv),INTENT(IN) :: nococonv
TYPE(t_nococonv),INTENT(IN) :: nococonv
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_atoms),INTENT(IN) :: atoms
......@@ -48,15 +48,11 @@ CONTAINS
CLASS(t_mat),INTENT(INOUT) :: smat(:,:),hmat(:,:)
! ..
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: ispin
INTEGER, INTENT (IN) :: isp !This is the global spin in a collinear calculation
!locals
#ifdef CPP_GPU
REAL, ALLOCATABLE,MANAGED :: fj(:,:,:,:),gj(:,:,:,:)
#else
REAL, ALLOCATABLE :: fj(:,:,:,:),gj(:,:,:,:)
#endif
TYPE(t_fjgj)::fjgj
INTEGER :: ispin,jspin !local spin in atom
INTEGER :: iintsp,jintsp,n
COMPLEX :: chi(2,2),chi_one
......@@ -64,75 +60,74 @@ CONTAINS
!
IF (noco%l_noco.AND..NOT.noco%l_ss) THEN
if (mpi%n_size==1) Then
ALLOCATE(t_mat::hmat_tmp,smat_tmp)
ELSE
ALLOCATE(t_mpimat::hmat_tmp,smat_tmp)
endif
CALL smat_tmp%init(hmat(1,1))
CALL hmat_tmp%init(hmat(1,1))
IF (mpi%n_size==1) THEN
ALLOCATE(t_mat::hmat_tmp,smat_tmp)
ELSE
ALLOCATE(t_mpimat::hmat_tmp,smat_tmp)
ENDIF
CALL smat_tmp%init(hmat(1,1))
CALL hmat_tmp%init(hmat(1,1))
ENDIF
ALLOCATE(fj(MAXVAL(lapw%nv),0:atoms%lmaxd,input%jspins,MERGE(2,1,noco%l_noco)))
ALLOCATE(gj(MAXVAL(lapw%nv),0:atoms%lmaxd,input%jspins,MERGE(2,1,noco%l_noco)))
CALL fjgj%alloc(MAXVAL(lapw%nv),atoms%lmaxd,isp,noco)
iintsp=1;jintsp=1;chi_one=1.0 !Defaults in non-noco case
DO n=1,atoms%ntype
DO n=1,atoms%ntype
DO ispin=MERGE(1,isp,noco%l_noco),MERGE(2,isp,noco%l_noco)
CALL timestart("fjgj coefficients")
CALL hsmt_fjgj(input,atoms,cell,lapw,noco,usdus,n,ispin,fj,gj)
CALL fjgj%calculate(input,atoms,cell,lapw,noco,usdus,n,ispin)
CALL timestop("fjgj coefficients")
IF (.NOT.noco%l_noco) THEN
!This is for collinear calculations: the (1,1) element of the matrices is all
!that is needed and allocated
CALL hsmt_sph(n,atoms,mpi,ispin,input,nococonv,1,1,chi_one,lapw,enpara%el0,&
td%e_shift(n,ispin),usdus,fj(:,0:,ispin,:),gj(:,0:,ispin,:),smat(1,1),hmat(1,1))
CALL hsmt_nonsph(n,mpi,sym,atoms,ispin,1,1,chi_one,noco,nococonv,cell,lapw,td,&
fj(:,0:,ispin,:),gj(:,0:,ispin,:),hmat(1,1))
CALL hsmt_lo(input,atoms,sym,cell,mpi,noco,nococonv,lapw,usdus,td,fj(:,0:,ispin,:),gj(:,0:,ispin,:),&
n,chi_one,ispin,iintsp,jintsp,hmat(1,1),smat(1,1))
ELSEIF(noco%l_noco.AND..NOT.noco%l_ss) THEN
!The NOCO but non-spinspiral setup follows:
!The Matrix-elements are first calculated in the local frame of the atom and
!stored in tmp-variables. Then these are distributed (rotated) into the 2x2
!global spin-matrices.
CALL hmat_tmp%clear();CALL smat_tmp%clear()
CALL hsmt_sph(n,atoms,mpi,ispin,input,nococonv,1,1,chi_one,lapw,enpara%el0,td%e_shift(n,ispin),&
usdus,fj(:,0:,ispin,:),gj(:,0:,ispin,:),smat_tmp,hmat_tmp)
CALL hsmt_nonsph(n,mpi,sym,atoms,ispin,1,1,chi_one,noco,nococonv,cell,lapw,td,&
fj(:,0:,ispin,:),gj(:,0:,ispin,:),hmat_tmp)
CALL hsmt_lo(input,atoms,sym,cell,mpi,noco,nococonv,lapw,usdus,td,fj(:,0:,ispin,:),gj(:,0:,ispin,:),&
n,chi_one,ispin,iintsp,jintsp,hmat_tmp,smat_tmp)
CALL hsmt_spinor(ispin,n,nococonv,chi)
CALL hsmt_distspins(chi,smat_tmp,smat)
CALL hsmt_distspins(chi,hmat_tmp,hmat)
!Add off-diagonal contributions to Hamiltonian if needed
IF (ispin==1.AND.noco%l_mtNocoPot) THEN
CALL hsmt_mtNocoPot_offdiag(n,input,mpi,sym,atoms,noco,nococonv,cell,lapw,usdus,td,fj,gj,hmat_tmp,hmat)
ELSEIF(noco%l_constr) THEN
CALL hsmt_offdiag(n,atoms,mpi,ispin,nococonv,lapw,td,usdus,fj(:,0:,ispin,:),gj(:,0:,ispin,:),hmat)
ENDIF
IF (ispin==1.and.noco%l_soc) &
CALL hsmt_soc_offdiag(n,atoms,cell,mpi,nococonv,lapw,sym,usdus,td,fj(:,0:,:,iintsp),gj(:,0:,:,iintsp),hmat)
ELSE
!In the spin-spiral case the loop over the interstitial=global spin has to
!be performed explicitely
CALL hsmt_spinor(ispin,n,nococonv,chi)
DO iintsp=1,2
DO jspin=ispin,MERGE(2,isp,noco%l_noco)
IF (.NOT.noco%l_noco) THEN
!This is for collinear calculations: the (1,1) element of the matrices is all
!that is needed and allocated
CALL hsmt_sph(n,atoms,mpi,ispin,input,nococonv,1,1,chi_one,lapw,enpara%el0,td%e_shift(n,ispin),usdus,fjgj,smat(1,1),hmat(1,1))
CALL hsmt_nonsph(n,mpi,sym,atoms,ispin,jspin,1,1,chi_one,noco,nococonv,cell,lapw,td,fjgj,hmat(1,1))
CALL hsmt_lo(input,atoms,sym,cell,mpi,noco,nococonv,lapw,usdus,td,fjgj,n,chi_one,ispin,jspin,iintsp,jintsp,hmat(1,1),smat(1,1))
ELSEIF(noco%l_noco.AND..NOT.noco%l_ss) THEN
!The NOCO but non-spinspiral setup follows:
!The Matrix-elements are first calculated in the local frame of the atom and
!stored in tmp-variables. Then these are distributed (rotated) into the 2x2
!global spin-matrices.
CALL hmat_tmp%clear();CALL smat_tmp%clear()
IF (ispin==jspin) THEN !local spin-digonal contribution
CALL hsmt_sph(n,atoms,mpi,ispin,input,nococonv,1,1,chi_one,lapw,enpara%el0,td%e_shift(n,ispin),usdus,fjgj,smat_tmp,hmat_tmp)
CALL hsmt_nonsph(n,mpi,sym,atoms,ispin,ispin,1,1,chi_one,noco,nococonv,cell,lapw,td,fjgj,hmat_tmp)
CALL hsmt_lo(input,atoms,sym,cell,mpi,noco,nococonv,lapw,usdus,td,fjgj,n,chi_one,ispin,jspin,iintsp,jintsp,hmat_tmp,smat_tmp)
CALL hsmt_spinor(ispin,n,nococonv,chi)
CALL hsmt_distspins(chi,smat_tmp,smat)
CALL hsmt_distspins(chi,hmat_tmp,hmat)
ELSE !Add off-diagonal contributions to Hamiltonian if needed
IF (noco%l_mtNocoPot) CALL hsmt_mtNocoPot_offdiag(n,input,mpi,sym,atoms,noco,nococonv,cell,lapw,usdus,td,fjgj,iintsp,jintsp,hmat_tmp,hmat)
IF (noco%l_constr) CALL hsmt_offdiag(n,atoms,mpi,nococonv,lapw,td,usdus,fjgj,ispin,jspin,iintsp,jintsp,hmat)
IF (noco%l_soc) CALL hsmt_soc_offdiag(n,atoms,cell,mpi,nococonv,lapw,sym,usdus,td,fjgj,hmat)
ENDIF
ELSE
!In the spin-spiral case the loop over the interstitial=global spin has to
!be performed explicitely
CALL hsmt_spinor(ispin,n,nococonv,chi)
DO iintsp=1,2
DO jintsp=1,2
CALL hsmt_sph(n,atoms,mpi,ispin,input,nococonv,iintsp,jintsp,chi(iintsp,jintsp),&
lapw,enpara%el0,td%e_shift(n,ispin),usdus,fj(:,0:,ispin,:),gj(:,0:,ispin,:),&
smat(iintsp,jintsp),hmat(iintsp,jintsp))
CALL hsmt_nonsph(n,mpi,sym,atoms,ispin,iintsp,jintsp,chi(iintsp,jintsp),noco,nococonv,cell,&
lapw,td,fj(:,0:,ispin,:),gj(:,0:,ispin,:),hmat(iintsp,jintsp))
CALL hsmt_lo(input,atoms,sym,cell,mpi,noco,nococonv,lapw,usdus,td,fj(:,0:,ispin,:),gj(:,0:,ispin,:),&
n,chi(iintsp,jintsp),ispin,iintsp,jintsp,hmat(iintsp,jintsp),smat(iintsp,jintsp))
IF (ispin==jspin) THEN !local diagonal spin
CALL hsmt_sph(n,atoms,mpi,ispin,input,nococonv,iintsp,jintsp,chi(iintsp,jintsp),&
lapw,enpara%el0,td%e_shift(n,ispin),usdus,fjgj,smat(iintsp,jintsp),hmat(iintsp,jintsp))
CALL hsmt_nonsph(n,mpi,sym,atoms,ispin,jspin,iintsp,jintsp,chi(iintsp,jintsp),noco,nococonv,cell,&
lapw,td,fjgj,hmat(iintsp,jintsp))
CALL hsmt_lo(input,atoms,sym,cell,mpi,noco,nococonv,lapw,usdus,td,fjgj,&
n,chi(iintsp,jintsp),ispin,jspin,iintsp,jintsp,hmat(iintsp,jintsp),smat(iintsp,jintsp))
ELSE
IF (noco%l_mtNocoPot) call hsmt_mtNocoPot_offdiag(n,input,mpi,sym,atoms,noco,nococonv,cell,lapw,usdus,td,fjgj,iintsp,jintsp,hmat_tmp,hmat)
IF (noco%l_constr) CALL hsmt_offdiag(n,atoms,mpi,nococonv,lapw,td,usdus,fjgj,ispin,jspin,iintsp,jintsp,hmat)
ENDIF
ENDDO
ENDDO
ENDIF
END DO
ENDDO
ENDIF
ENDDO
ENDDO
END DO
RETURN
END SUBROUTINE hsmt
END MODULE m_hsmt
RETURN
END SUBROUTINE hsmt
END MODULE m_hsmt
......@@ -165,18 +165,20 @@ CONTAINS
END SUBROUTINE hsmt_ab_gpu
#endif
SUBROUTINE hsmt_ab_cpu(sym,atoms,noco,nococonv,ispin,iintsp,n,na,cell,lapw,fj,gj,ab,ab_size,l_nonsph,abclo,alo1,blo1,clo1)
SUBROUTINE hsmt_ab_cpu(sym,atoms,noco,nococonv,ispin,iintsp,n,na,cell,lapw,fjgj,ab,ab_size,l_nonsph,abclo,alo1,blo1,clo1)
!Calculate overlap matrix, CPU vesion
USE m_constants, ONLY : fpi_const,tpi_const
USE m_types
USE m_ylm
USE m_hsmt_fjgj
IMPLICIT NONE
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_lapw),INTENT(IN) :: lapw
TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_nococonv),INTENT(IN) :: nococonv
TYPE(t_nococonv),INTENT(IN) :: nococonv
TYPE(t_fjgj),INTENT(IN) :: fjgj
! ..
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: ispin,n,na,iintsp
......@@ -184,7 +186,6 @@ CONTAINS
INTEGER,INTENT(OUT) :: ab_size
! ..
! .. Array Arguments ..
REAL,INTENT(IN) :: fj(:,0:,:),gj(:,0:,:)
COMPLEX, INTENT (OUT) :: ab(:,:)
!Optional arguments if abc coef for LOs are needed
COMPLEX, INTENT(INOUT),OPTIONAL:: abclo(:,-atoms%llod:,:,:)
......@@ -204,7 +205,7 @@ CONTAINS
lmax=MERGE(atoms%lnonsph(n),atoms%lmax(n),l_nonsph)
ab_size=lmax*(lmax+2)+1
l_apw=ALL(gj==0.0)
l_apw=ALL(fjgj%gj==0.0)
ab=0.0
np = sym%invtab(sym%ngopr(na))
......@@ -224,8 +225,8 @@ CONTAINS
END DO
END IF
!$OMP PARALLEL DO DEFAULT(none) &
!$OMP& SHARED(lapw,gkrot,lmax,c_ph,iintsp,ab,fj,gj,abclo,cell,atoms,sym) &
!$OMP& SHARED(alo1,blo1,clo1,ab_size,na,n) &
!$OMP& SHARED(lapw,gkrot,lmax,c_ph,iintsp,ab,fjgj,abclo,cell,atoms,sym) &
!$OMP& SHARED(alo1,blo1,clo1,ab_size,na,n,ispin) &
!$OMP& PRIVATE(k,vmult,ylm,l,ll1,m,lm,term,invsfct,lo,nkvec)
DO k = 1,lapw%nv(iintsp)
!--> generate spherical harmonics
......@@ -236,8 +237,8 @@ CONTAINS
ll1 = l* (l+1)
DO m = -l,l
term = c_ph(k,iintsp)*ylm(ll1+m+1)
ab(k,ll1+m+1) = fj(k,l,iintsp)*term
ab(k,ll1+m+1+ab_size) = gj(k,l,iintsp)*term
ab(k,ll1+m+1) = fjgj%fj(k,l,ispin,iintsp)*term
ab(k,ll1+m+1+ab_size) = fjgj%gj(k,l,ispin,iintsp)*term
END DO
END DO
IF (SIZE(ab,2) > 2*ab_size) ab(k,2*ab_size+1:) = cmplx(0.0,0.0)
......
......@@ -7,14 +7,27 @@ MODULE m_hsmt_fjgj
USE m_juDFT
IMPLICIT NONE
INTERFACE hsmt_fjgj
module procedure hsmt_fjgj_cpu
#ifdef CPP_GPU
module procedure hsmt_fjgj_gpu
#endif
END INTERFACE
PRIVATE
TYPE t_fjgj
REAL,ALLOCATABLE CPP_MANAGED :: fj(:,:,:,:),gj(:,:,:,:)
CONTAINS
procedure :: alloc
procedure :: calculate => hsmt_fjgj_cpu
END TYPE
PUBLIC t_fjgj
CONTAINS
subroutine alloc(fjgj,nvd,lmaxd,isp,noco)
USE m_types
CLASS(t_fjgj),INTENT(OUT) :: fjgj
INTEGER,INTENT(IN) :: nvd,lmaxd,isp
TYPE(t_noco),INTENT(IN) :: noco
ALLOCATE(fjgj%fj(nvd,0:lmaxd,merge(1,isp,noco%l_noco):merge(2,isp,noco%l_noco),MERGE(2,1,noco%l_ss)))
ALLOCATE(fjgj%gj(nvd,0:lmaxd,merge(1,isp,noco%l_noco):merge(2,isp,noco%l_noco),MERGE(2,1,noco%l_ss)))
end subroutine
#ifdef CPP_GPU
SUBROUTINE synth_fjgj(nv,ispin,jspins,lmax,lmaxd,apw,l_flag,rk,rmt,con1,uds,dus,us,duds,fj,gj)
......@@ -23,7 +36,7 @@ CONTAINS
INTEGER, INTENT(IN) :: nv, ispin, jspins, lmax, lmaxd
LOGICAL, INTENT(IN) :: apw(0:lmaxd), l_flag
REAL, INTENT(IN) :: rk(:),rmt,con1
REAL, INTENT(IN) :: uds(0:lmaxd,jspins),dus(0:lmaxd,jspins),us(0:lmaxd,jspins),duds(0:lmaxd,jspins)
REAL, INTENT(IN) :: uds(0:lmaxd,jspins),dus(0:lmaxd,jspins),us(0:lmaxd,jspins),duds(0:lmaxd,jspins)
REAL,INTENT(OUT),MANAGED :: fj(:,0:,:),gj(:,0:,:)
REAL gb(0:lmaxd), fb(0:lmaxd)
......@@ -77,7 +90,7 @@ CONTAINS
! ..
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: ispin,n
REAL,INTENT(OUT),MANAGED :: fj(:,0:,:,:),gj(:,0:,:,:)
! ..
! .. Local Scalars ..
......@@ -108,7 +121,7 @@ CONTAINS
END SUBROUTINE hsmt_fjgj_gpu
#endif
SUBROUTINE hsmt_fjgj_cpu(input,atoms,cell,lapw,noco,usdus,n,ispin,fj,gj)
SUBROUTINE hsmt_fjgj_cpu(fjgj,input,atoms,cell,lapw,noco,usdus,n,ispin)
!Calculate the fj&gj array which contain the part of the A,B matching coeff. depending on the
!radial functions at the MT boundary as contained in usdus
USE m_constants, ONLY : fpi_const
......@@ -116,6 +129,7 @@ CONTAINS
USE m_dsphbs
USE m_types
IMPLICIT NONE
CLASS(t_fjgj),INTENT(INOUT) :: fjgj
TYPE(t_input),INTENT(IN) :: input
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_noco),INTENT(IN) :: noco
......@@ -125,8 +139,7 @@ CONTAINS
! ..
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: ispin,n
REAL,INTENT(OUT) :: fj(:,0:,:,:),gj(:,0:,:,:)
! ..
! .. Local Scalars ..
REAL con1,ff,gg,gs
......@@ -147,11 +160,11 @@ CONTAINS
DO lo = 1,atoms%nlo(n)
IF (atoms%l_dulo(lo,n)) apw(atoms%llo(lo,n)) = .TRUE.
ENDDO
DO intspin=1,MERGE(2,1,noco%l_noco)
DO intspin=1,MERGE(2,1,noco%l_ss)
!$OMP PARALLEL DO DEFAULT(NONE) &
!$OMP PRIVATE(l,gs,fb,gb,ws,ff,gg,jspin)&
!$OMP SHARED(lapw,atoms,con1,usdus,l_socfirst,noco,input)&
!$OMP SHARED(fj,gj,intspin,n,ispin,apw)
!$OMP SHARED(fjgj,intspin,n,ispin,apw)
DO k = 1,lapw%nv(intspin)
gs = lapw%rk(k,intspin)*atoms%rmt(n)
CALL sphbes(atoms%lmax(n),gs, fb)
......@@ -166,17 +179,17 @@ CONTAINS
ff = fb(l)
gg = lapw%rk(k,intspin)*gb(l)
IF ( apw(l) ) THEN
fj(k,l,ispin,intspin) = 1.0*con1 * ff / usdus%us(l,n,ispin)
gj(k,l,ispin,intspin) = 0.0
fjgj%fj(k,l,ispin,intspin) = 1.0*con1 * ff / usdus%us(l,n,ispin)
fjgj%gj(k,l,ispin,intspin) = 0.0
ELSE
IF (noco%l_constr.or.l_socfirst.OR.noco%l_mtNocoPot) THEN
DO jspin = 1, input%jspins
fj(k,l,jspin,intspin) = ws(jspin) * ( usdus%uds(l,n,jspin)*gg - usdus%duds(l,n,jspin)*ff )
gj(k,l,jspin,intspin) = ws(jspin) * ( usdus%dus(l,n,jspin)*ff - usdus%us(l,n,jspin)*gg )
fjgj%fj(k,l,jspin,intspin) = ws(jspin) * ( usdus%uds(l,n,jspin)*gg - usdus%duds(l,n,jspin)*ff )
fjgj%gj(k,l,jspin,intspin) = ws(jspin) * ( usdus%dus(l,n,jspin)*ff - usdus%us(l,n,jspin)*gg )
END DO
ELSE
fj(k,l,ispin,intspin) = ws(ispin) * ( usdus%uds(l,n,ispin)*gg - usdus%duds(l,n,ispin)*ff )
gj(k,l,ispin,intspin) = ws(ispin) * ( usdus%dus(l,n,ispin)*ff - usdus%us(l,n,ispin)*gg )
fjgj%fj(k,l,ispin,intspin) = ws(ispin) * ( usdus%uds(l,n,ispin)*gg - usdus%duds(l,n,ispin)*ff )
fjgj%gj(k,l,ispin,intspin) = ws(ispin) * ( usdus%dus(l,n,ispin)*ff - usdus%us(l,n,ispin)*gg )
ENDIF
ENDIF
ENDDO
......
......@@ -8,11 +8,12 @@ MODULE m_hsmt_lo
USE m_juDFT
IMPLICIT NONE
CONTAINS
SUBROUTINE Hsmt_lo(Input,Atoms,Sym,Cell,Mpi,Noco,nococonv,Lapw,Ud,Tlmplm,Fj,Gj,N,Chi,Isp,Iintsp,Jintsp,Hmat,Smat)
SUBROUTINE Hsmt_lo(Input,Atoms,Sym,Cell,Mpi,Noco,nococonv,Lapw,Ud,Tlmplm,FjGj,N,Chi,Isp,jsp,Iintsp,Jintsp,Hmat,Smat)
USE m_hlomat
USE m_slomat
USE m_setabc1lo
USE m_types
USE m_hsmt_fjgj
IMPLICIT NONE
TYPE(t_mpi),INTENT(IN) :: mpi
TYPE(t_input),INTENT(IN) :: input
......@@ -24,6 +25,7 @@ CONTAINS
TYPE(t_lapw),INTENT(IN) :: lapw
TYPE(t_usdus),INTENT(IN) :: ud
TYPE(t_tlmplm),INTENT(IN) :: tlmplm
TYPE(t_fjgj),INTENT(IN) :: fjgj
CLASS(t_mat),INTENT(INOUT)::hmat
CLASS(t_mat),INTENT(INOUT),OPTIONAL::smat
......@@ -31,11 +33,9 @@ CONTAINS
! ..
! .. Scalar Arguments ..
INTEGER,INTENT(IN) :: n
INTEGER, INTENT (IN) :: isp,iintsp,jintsp !spins
INTEGER, INTENT (IN) :: isp,jsp,iintsp,jintsp !spins
COMPLEX, INTENT(IN) :: chi
!Arrays
REAL,INTENT(IN) :: fj(:,:,:),gj(:,:,:)
! ..
! .. Local Scalars ..
INTEGER na,nn,usp
......@@ -61,15 +61,15 @@ CONTAINS
!---> add the local orbital contribution to the overlap and
!---> hamiltonian matrix, if they are used for this atom.
IF (isp<3) THEN
IF (isp==jsp) THEN
IF (.NOT.PRESENT(smat)) CALL judft_error("Bug in hsmt_lo, called without smat")
CALL slomat(&
input,atoms,sym,mpi,lapw,cell,nococonv,n,na,&
isp,ud, alo1(:,isp),blo1(:,isp),clo1(:,isp),fj,gj,&
isp,ud, alo1(:,isp),blo1(:,isp),clo1(:,isp),fjgj,&
iintsp,jintsp,chi,smat)
ENDIF
CALL hlomat(input,atoms,mpi,lapw,ud,tlmplm,sym,cell,noco,nococonv,isp,&
n,na,fj,gj,alo1,blo1,clo1,iintsp,jintsp,chi,hmat)
CALL hlomat(input,atoms,mpi,lapw,ud,tlmplm,sym,cell,noco,nococonv,isp,jsp,&
n,na,fjgj,alo1,blo1,clo1,iintsp,jintsp,chi,hmat)
ENDIF
END IF
!---> end loop over equivalent atoms
......
......@@ -7,7 +7,7 @@ MODULE m_hsmt_mtNocoPot_offdiag
USE m_juDFT
IMPLICIT NONE
CONTAINS
SUBROUTINE hsmt_mtNocoPot_offdiag(n,input,mpi,sym,atoms,noco,nococonv,cell,lapw,ud,td,fj,gj,hmat_tmp,hmat)
SUBROUTINE hsmt_mtNocoPot_offdiag(n,input,mpi,sym,atoms,noco,nococonv,cell,lapw,ud,td,fjgj,iintsp,jintsp,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
......@@ -20,6 +20,7 @@ CONTAINS
USE m_hsmt_distspins
USE m_hsmt_spinor
USE m_hsmt_lo
USE m_hsmt_fjgj
IMPLICIT NONE
TYPE(t_input),INTENT(IN) :: input
TYPE(t_mpi),INTENT(IN) :: mpi
......@@ -31,12 +32,9 @@ CONTAINS
TYPE(t_lapw),INTENT(IN) :: lapw
TYPE(t_usdus),INTENT(IN) :: ud
TYPE(t_tlmplm),INTENT(IN) :: td
TYPE(t_fjgj),INTENT(IN) :: fjgj
INTEGER,INTENT(IN) :: iintsp,jintsp
#if defined CPP_GPU
REAL,MANAGED,INTENT(IN) :: fj(:,:,:,:),gj(:,:,:,:)
#else
REAL,INTENT(IN) :: fj(:,0:,:,:),gj(:,0:,:,:)
#endif
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: n
COMPLEX :: chi_one,chi(2,2)
......@@ -45,8 +43,8 @@ CONTAINS
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,nococonv,cell,lapw,td,fj(:,0:,1,:),gj(:,0:,1,:),hmat_tmp)
CALL hsmt_lo(input,atoms,sym,cell,mpi,noco,nococonv,lapw,ud,td,fj(:,0:,1,:),gj(:,0:,1,:),n,chi_one,3,1,1,hmat_tmp)
CALL hsmt_nonsph(n,mpi,sym,atoms,2,1,iintsp,iintsp,chi_one,noco,nococonv,cell,lapw,td,fjgj,hmat_tmp)
CALL hsmt_lo(input,atoms,sym,cell,mpi,noco,nococonv,lapw,ud,td,fjgj,n,chi_one,2,1,iintsp,jintsp,hmat_tmp)
!call hmat_tmp%generate_full_matrix()
CALL hsmt_spinor(3,n,nococonv,chi) !spinor for off-diagonal part
CALL hsmt_distspins(chi,hmat_tmp,hmat)
......@@ -60,9 +58,8 @@ CONTAINS
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,nococonv,cell,lapw,td,&
fj(:,0:,1,:),gj(:,0:,1,:),hmat_tmp)
CALL hsmt_lo(input,atoms,sym,cell,mpi,noco,nococonv,lapw,ud,td,fj(:,0:,1,:),gj(:,0:,1,:),n,chi_one,4,1,1,hmat_tmp)
CALL hsmt_nonsph(n,mpi,sym,atoms,1,2,iintsp,jintsp,chi_one,noco,nococonv,cell,lapw,td,fjgj,hmat_tmp)
CALL hsmt_lo(input,atoms,sym,cell,mpi,noco,nococonv,lapw,ud,td,fjgj,n,chi_one,1,2,iintsp,jintsp,hmat_tmp)
!call hmat_tmp%generate_full_matrix()
CALL hsmt_spinor(3,n,nococonv,chi)
......
......@@ -15,7 +15,8 @@ MODULE m_hsmt_nonsph
#endif
END INTERFACE
CONTAINS
SUBROUTINE hsmt_nonsph(n,mpi,sym,atoms,isp,iintsp,jintsp,chi,noco,nococonv,cell,lapw,td,fj,gj,hmat)
SUBROUTINE hsmt_nonsph(n,mpi,sym,atoms,isp,jsp,iintsp,jintsp,chi,noco,nococonv,cell,lapw,td,fjgj,hmat)
USE m_hsmt_fjgj
USE m_types
IMPLICIT NONE
TYPE(t_mpi),INTENT(IN) :: mpi
......@@ -26,16 +27,13 @@ CONTAINS
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_lapw),INTENT(IN) :: lapw
TYPE(t_tlmplm),INTENT(IN) :: td
TYPE(t_fjgj),INTENT(IN) :: fjgj
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: n,isp,iintsp,jintsp
INTEGER, INTENT (IN) :: n,isp,jsp,iintsp,jintsp
COMPLEX,INTENT(IN) :: chi
! .. Array Arguments ..
#if defined CPP_GPU
REAL,MANAGED,INTENT(IN) :: fj(:,:,:),gj(:,:,:)
#else
REAL,INTENT(IN) :: fj(:,0:,:),gj(:,0:,:)
#endif
CLASS(t_mat),INTENT(INOUT) ::hmat
#if defined CPP_GPU
COMPLEX,ALLOCATABLE,DEVICE :: h_loc_dev(:,:)
#endif
......@@ -43,14 +41,14 @@ CONTAINS
IF (mpi%n_size==1) THEN
#if defined CPP_GPU
ALLOCATE(h_loc_dev(size(td%h_loc,1),size(td%h_loc,2)))
h_loc_dev(1:,1:) = CONJG(td%h_loc(0:,0:,n,isp))
h_loc_dev(1:,1:) = CONJG(td%h_loc(0:,0:,n,isp,jsp))
CALL priv_noMPI(n,mpi,sym,atoms,isp,iintsp,jintsp,chi,noco,nococonv,cell,lapw,h_loc_dev,fj,gj,hmat)
CALL priv_noMPI(n,mpi,sym,atoms,isp,jsp,iintsp,jintsp,chi,noco,nococonv,cell,lapw,h_loc_dev,fj,gj,hmat)
#else
CALL priv_noMPI(n,mpi,sym,atoms,isp,iintsp,jintsp,chi,noco,nococonv,cell,lapw,td,fj,gj,hmat)
CALL priv_noMPI(n,mpi,sym,atoms,isp,jsp,iintsp,jintsp,chi,noco,nococonv,cell,lapw,td,fjgj,hmat)
#endif
ELSE
CALL priv_MPI(n,mpi,sym,atoms,isp,iintsp,jintsp,chi,noco,nococonv,cell,lapw,td,fj,gj,hmat)
CALL priv_MPI(n,mpi,sym,atoms,isp,jsp,iintsp,jintsp,chi,noco,nococonv,cell,lapw,td,fjgj,hmat)
ENDIF
CALL timestop("non-spherical setup")
END SUBROUTINE hsmt_nonsph
......@@ -146,13 +144,13 @@ CONTAINS
END SUBROUTINE priv_noMPI_gpu
#endif
SUBROUTINE priv_noMPI_cpu(n,mpi,sym,atoms,isp,iintsp,jintsp,chi,noco,nococonv,cell,lapw,td,fj,gj,hmat)
SUBROUTINE priv_noMPI_cpu(n,mpi,sym,atoms,isp,jsp,iintsp,jintsp,chi,noco,nococonv,cell,lapw,td,fjgj,hmat)
!Calculate overlap matrix
USE m_hsmt_ab
USE m_constants, ONLY : fpi_const,tpi_const
USE m_types
USE m_ylm
USE m_hsmt_fjgj
IMPLICIT NONE
TYPE(t_mpi),INTENT(IN) :: mpi
TYPE(t_sym),INTENT(IN) :: sym
......@@ -162,13 +160,13 @@ CONTAINS
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_lapw),INTENT(IN) :: lapw
TYPE(t_tlmplm),INTENT(IN) :: td
TYPE(t_fjgj),INTENT(IN) :: fjgj
! ..
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: n,isp,iintsp,jintsp
INTEGER, INTENT (IN) :: n,isp,jsp,iintsp,jintsp
COMPLEX,INTENT(in) :: chi
! ..
! .. Array Arguments ..
REAL,INTENT(IN) :: fj(:,0:,:),gj(:,0:,:)
CLASS(t_mat),INTENT(INOUT)::hmat
......@@ -193,31 +191,36 @@ CONTAINS
IF ((sym%invsat(na)==0) .OR. (sym%invsat(na)==1)) THEN
rchi=MERGE(REAL(chi),REAL(chi)*2,(sym%invsat(na)==0))
CALL hsmt_ab(sym,atoms,noco,nococonv,isp,jintsp,n,na,cell,lapw,fj,gj,ab,ab_size,.TRUE.)
CALL hsmt_ab(sym,atoms,noco,nococonv,jsp,jintsp,n,na,cell,lapw,fjgj,ab,ab_size,.TRUE.)
!Calculate Hamiltonian
CALL zgemm("N","N",lapw%nv(jintsp),ab_size,ab_size,CMPLX(1.0,0.0),ab,SIZE(ab,1),&
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,jsp),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))
IF (iintsp==jintsp) THEN
IF (isp<3) THEN
IF (isp==jsp) 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 hsmt_ab(sym,atoms,noco,nococonv,isp,2,n,na,cell,lapw,fj,gj,ab,ab_size,.TRUE.)
CALL hsmt_ab(sym,atoms,noco,nococonv,isp,iintsp,n,na,cell,lapw,fjgj,ab,ab_size,.TRUE.)