Commit b6baaec9 authored by Daniel Wortmann's avatar Daniel Wortmann

Added fully-fully noco code to potential generator and charge density part....

Added fully-fully noco code to potential generator and charge density part. Proper handling of spin dimension for density and potential still missing
parent d50db5cf
......@@ -49,24 +49,24 @@ CONTAINS
! ..
! .. Allocatable Arrays ..
REAL, ALLOCATABLE :: f(:,:,:,:),g(:,:,:,:)
COMPLEX, ALLOCATABLE :: rho21(:,:,:)
COMPLEX :: rho21
!
CALL timestart("cdnmt")
IF (noco%l_mperp) THEN
IF (denCoeffsOffdiag%l_fmpl) THEN
ALLOCATE ( rho21(atoms%jmtd,0:sphhar%nlhd,atoms%ntype) )
rho21(:,:,:) = cmplx(0.0,0.0)
!ALLOCATE ( rho21(atoms%jmtd,0:sphhar%nlhd,atoms%ntype) )
rho(:,:,:,3:4) = CMPLX(0.0,0.0)
ENDIF
ENDIF
!$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(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
ALLOCATE ( f(atoms%jmtd,2,0:atoms%lmaxd,jspd),g(atoms%jmtd,2,0:atoms%lmaxd,jspd) )
ELSE
......@@ -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%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) )
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
......@@ -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)&
+ 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) )
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
......@@ -241,15 +247,6 @@ CONTAINS
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 MODULE m_cdnmt
set(fleur_F77 ${fleur_F77}
)
set(fleur_F90 ${fleur_F90}
eigen/hsmt_mtNocoPot_offdiag.F90
eigen/eigen.F90
eigen/hlomat.F90
eigen/hs_int.F90
......
......@@ -100,7 +100,7 @@ CONTAINS
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()
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) &
CALL hsmt_soc_offdiag(n,atoms,mpi,noco,lapw,usdus,td,fj(:,0:,:,iintsp),gj(:,0:,:,iintsp),hmat)
......
......@@ -7,7 +7,7 @@ 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)
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
......@@ -27,9 +27,10 @@ CONTAINS
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
COMPLEX :: chi_one,chi(2,2)
CLASS(t_mat),INTENT(INOUT) :: hmat(:,:),hmat_tmp
chi_one=1.0
......@@ -42,8 +43,9 @@ CONTAINS
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,CONJG(hmat_tmp),hmat)
CALL hsmt_distspins(chi,hmat_tmp,hmat)
CALL hmat_tmp%clear()
......@@ -56,7 +58,8 @@ CONTAINS
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,CONJG(hmat_tmp),hmat)
CALL hsmt_distspins(chi,hmat_tmp,hmat)
END SUBROUTINE hsmt_mtNocoPot_offdiag
END MODULE m_hsmt_mtNocoPot_offdiag
......@@ -28,6 +28,7 @@ CONTAINS
USE m_vgen_coulomb
USE m_vgen_xcpot
USE m_vgen_finalize
USE m_rotate_mt_den_tofrom_local
#ifdef CPP_MPI
USE m_mpi_bc_potden
#endif
......@@ -82,14 +83,15 @@ CONTAINS
IF (noco%l_noco) THEN
CALL denRot%init(stars,atoms,sphhar,vacuum,input%jspins,noco%l_noco,0)
denRot=den
CALL rotate_int_den_to_local(dimension,sym,stars,atoms,sphhar,vacuum,cell,input,noco,oneD,denRot)
CALL rotate_int_den_to_local(DIMENSION,sym,stars,atoms,sphhar,vacuum,cell,input,noco,oneD,denRot)
IF (noco%l_mtnocoPot) CALL rotate_mt_den_to_local(atoms,sphhar,sym,denrot)
ENDIF
CALL vgen_xcpot(hybrid,input,xcpot,dimension,atoms,sphhar,stars,vacuum,sym,&
obsolete,cell,oneD,sliceplot,mpi,noco,den,denRot,vTot,vx,results)
!ToDo, check if this is needed for more potentials as well...
CALL vgen_finalize(atoms,stars,vacuum,sym,noco,input,vTot,vCoul,denRot)
CALL vgen_finalize(atoms,stars,vacuum,sym,noco,input,sphhar,vTot,vCoul,denRot)
!DEALLOCATE(vcoul%pw_w)
CALL bfield(input,noco,atoms,field,vTot)
......
......@@ -20,6 +20,8 @@ MODULE m_types_potden
REAL,ALLOCATABLE :: phi_vacz(:,:)
REAL,ALLOCATABLE :: theta_vacxy(:,:,:)
REAL,ALLOCATABLE :: phi_vacxy(:,:,:)
REAL,ALLOCATABLE :: theta_mt(:,:)
REAL,ALLOCATABLE :: phi_mt(:,:)
! For density matrix and associated potential matrix
......
......@@ -14,6 +14,7 @@ vgen/visp5_0.f
vgen/visp5_z.f
)
set(fleur_F90 ${fleur_F90}
vgen/rotate_mt_den_tofrom_local.f90
vgen/b_field.F90
vgen/mkgylm.f90
vgen/mkgxyz3.f90
......
!--------------------------------------------------------------------------------
! 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_rotate_mt_den_tofrom_local
USE m_juDFT
USE m_types
USE m_constants
use m_mt_tofrom_grid
IMPLICIT NONE
CONTAINS
SUBROUTINE rotate_mt_den_to_local(atoms,sphhar,sym,den)
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_sphhar),INTENT(IN) :: sphhar
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_potden),INTENT(INOUT) :: den
TYPE(t_xcpot_inbuild) :: xcpot !local xcpot that is LDA to indicate we do not need gradients
TYPE(t_gradients) :: grad
INTEGER :: n,nsp,imesh
REAL :: rho_11,rho_22,rho_21r,rho_21i,mx,my,mz,magmom
REAL :: rhotot,rho_up,rho_down,theta,phi
REAL,ALLOCATABLE :: ch(:,:)
REAL :: eps=1E-10
nsp=(atoms%lmaxd+1+MOD(atoms%lmaxd+1,2))*(2*atoms%lmaxd+1)
ALLOCATE(ch(nsp,4),den%theta_mt(nsp,atoms%ntype),den%phi_mt(nsp,atoms%ntype))
CALL init_mt_grid(nsp,4,atoms,sphhar,xcpot,sym)
DO n=1,atoms%ntype
CALL mt_to_grid(xcpot,4,atoms,sphhar,den%mt(:,0:,n,:),nsp,n,grad,ch)
DO imesh = 1,nsp
rho_11 = ch(imesh,1)
rho_22 = ch(imesh,2)
rho_21r = ch(imesh,3)
rho_21i = ch(imesh,4)
mx = 2*rho_21r
my = -2*rho_21i
mz = (rho_11-rho_22)
magmom = SQRT(mx**2 + my**2 + mz**2)
rhotot = rho_11 + rho_22
rho_up = (rhotot + magmom)/2
rho_down= (rhotot - magmom)/2
IF (ABS(mz) .LE. eps) THEN
theta = pi_const/2
ELSEIF (mz .GE. 0.0) THEN
theta = ATAN(SQRT(mx**2 + my**2)/mz)
ELSE
theta = ATAN(SQRT(mx**2 + my**2)/mz) + pi_const
ENDIF
IF (ABS(mx) .LE. eps) THEN
IF (ABS(my) .LE. eps) THEN
phi = 0.0
ELSEIF (my .GE. 0.0) THEN
phi = pi_const/2
ELSE
phi = -pi_const/2
ENDIF
ELSEIF (mx .GE. 0.0) THEN
phi = ATAN(my/mx)
ELSE
IF (my .GE. 0.0) THEN
phi = ATAN(my/mx) + pi_const
ELSE
phi = ATAN(my/mx) - pi_const
ENDIF
ENDIF
ch(imesh,1) = rho_up
ch(imesh,2) = rho_down
den%theta_mt(imesh,n) = theta
den%theta_mt(imesh,n) = phi
ENDDO
CALL mt_from_grid(atoms,sphhar,nsp,n,2,ch,den%mt(:,0:,n,:))
END DO
CALL finish_mt_grid()
END SUBROUTINE rotate_mt_den_to_local
SUBROUTINE rotate_mt_den_from_local(atoms,sphhar,sym,den,vtot)
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_sphhar),INTENT(IN) :: sphhar
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_potden),INTENT(IN) :: den
TYPE(t_potden),INTENT(INOUT) :: vtot
TYPE(t_xcpot_inbuild) :: xcpot !local xcpot that is LDA to indicate we do not need gradients
TYPE(t_gradients) :: grad
INTEGER :: n,nsp,imesh
REAL :: vup,vdown,veff,beff
REAL :: theta,phi
REAL,ALLOCATABLE :: ch(:,:)
nsp=(atoms%lmaxd+1+MOD(atoms%lmaxd+1,2))*(2*atoms%lmaxd+1)
ALLOCATE(ch(nsp,4),den%theta_mt(nsp,atoms%ntype),den%phi_mt(nsp,atoms%ntype))
CALL init_mt_grid(nsp,4,atoms,sphhar,xcpot,sym)
DO n=1,atoms%ntype
CALL mt_to_grid(xcpot,2,atoms,sphhar,vtot%mt(:,0:,n,:),nsp,n,grad,ch)
DO imesh = 1,nsp
vup = ch(imesh,1)
vdown = ch(imesh,2)
theta = den%theta_mt(imesh,n)
phi = den%phi_mt(imesh,n)
veff = (vup + vdown)/2.0
beff = (vup - vdown)/2.0
ch(imesh,1) = veff + beff*COS(theta)
ch(imesh,2) = veff - beff*COS(theta)
ch(imesh,3) = beff*SIN(theta)*COS(phi)
ch(imesh,4) = beff*SIN(theta)*SIN(phi)
ENDDO
CALL mt_from_grid(atoms,sphhar,nsp,n,4,ch,vtot%mt(:,0:,n,:))
END DO
CALL finish_mt_grid()
END SUBROUTINE rotate_mt_den_from_local
END MODULE m_rotate_mt_den_tofrom_local
......@@ -6,7 +6,7 @@
MODULE m_vgen_finalize
USE m_juDFT
CONTAINS
SUBROUTINE vgen_finalize(atoms,stars,vacuum,sym,noco,input,vTot,vCoul,denRot)
SUBROUTINE vgen_finalize(atoms,stars,vacuum,sym,noco,input,sphhar,vTot,vCoul,denRot)
! ***********************************************************
! FLAPW potential generator *
! ***********************************************************
......@@ -17,6 +17,7 @@ CONTAINS
USE m_constants
USE m_vmatgen
USE m_types
USE m_rotate_mt_den_tofrom_local
IMPLICIT NONE
TYPE(t_vacuum),INTENT(IN) :: vacuum
TYPE(t_noco),INTENT(IN) :: noco
......@@ -24,6 +25,7 @@ CONTAINS
TYPE(t_stars),INTENT(IN) :: stars
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_input),INTENT(IN) :: input
TYPE(t_sphhar),INTENT(IN) :: sphhar
TYPE(t_potden),INTENT(INOUT) :: vTot,vCoul,denRot
! ..
! .. Local Scalars ..
......@@ -46,6 +48,7 @@ CONTAINS
END DO
ELSEIF(noco%l_noco) THEN
CALL vmatgen(stars,atoms,vacuum,sym,input,denRot,vTot)
IF (noco%l_mtnocoPot) CALL rotate_mt_den_from_local(atoms,sphhar,sym,denRot,vtot)
ENDIF
! Rescale vCoul%pw_w with number of stars
......
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