Commit 9b98c8c0 authored by Daniel Wortmann's avatar Daniel Wortmann

Added Hamiltonian contribution for fully fully noco

parent 5d8d29d0
!--------------------------------------------------------------------------------
! 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
USE m_juDFT
IMPLICIT NONE
......@@ -25,6 +30,7 @@ CONTAINS
USE m_hsmt_fjgj
USE m_hsmt_spinor
USE m_hsmt_soc_offdiag
USE m_hsmt_mtNocoPot_offdiag
USE m_hsmt_offdiag
IMPLICIT NONE
TYPE(t_mpi),INTENT(IN) :: mpi
......@@ -84,15 +90,18 @@ CONTAINS
!global spin-matrices.
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),&
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,&
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,:),&
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_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()
ENDIF
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)
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,isp,iintsp,jintsp,chi,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
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: n
COMPLEX :: chi_one
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()
CALL hsmt_spinor(4,n,noco,chi) !spinor for off-diagonal part
CALL hsmt_distspins(chi,CONJG(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()
CALL hsmt_spinor(4,n,noco,chi)
CALL hsmt_distspins(chi,CONJG(hmat_tmp),hmat)
END SUBROUTINE hsmt_mtNocoPot_offdiag
END MODULE m_hsmt_mtNocoPot_offdiag
......@@ -197,7 +197,13 @@ CONTAINS
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))
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
!Second set of ab is needed
CALL hsmt_ab(sym,atoms,noco,isp,iintsp,n,na,cell,lapw,fj,gj,ab,ab_size,.TRUE.)
......
......@@ -30,10 +30,21 @@ CONTAINS
chi(2,2) = exp(ImagUnit*noco%alph(n)/2)*cos(noco%beta(n)/2)
!---> and determine the prefactors for the Hamitonian- and
!---> overlapp-matrix elements
chi_mat(1,1) = chi(1,isp)*CONJG(chi(1,isp))
chi_mat(2,1) = chi(2,isp)*CONJG(chi(1,isp))
chi_mat(2,2) = chi(2,isp)*CONJG(chi(2,isp))
chi_mat(1,2) = chi(1,isp)*CONJG(chi(2,isp))
IF (isp<3) THEN
isp1=isp
isp2=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
CALL timestart("tlmplm")
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
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,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)
......
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