...
 
Commits (20)
......@@ -71,17 +71,19 @@ CONTAINS
ENDDO
CALL timestart("Interstitial part")
! CALL timestart("Interstitial part")
!Generate interstitial part of Hamiltonian
CALL hs_int(input,noco,stars,lapw,mpi,cell,isp,v%pw_w,smat,hmat)
CALL timestop("Interstitial part")
! 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,cell,lapw,ud,td,smat,hmat)
ENDDO
CALL timestop("MT part")
STOP "hsmt_spherical only"
!Vacuum contributions
IF (input%film) THEN
CALL timestart("Vacuum part")
......
......@@ -73,10 +73,10 @@ CONTAINS
!that is needed and allocated
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(1,1),hmat(1,1))
CALL hsmt_nonsph(n,mpi,sym,atoms,ispin,1,1,chi_one,noco,cell,lapw,td,&
fj(:,0:,ispin,:),gj(:,0:,ispin,:),hmat(1,1))
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(1,1),smat(1,1))
! CALL hsmt_nonsph(n,mpi,sym,atoms,ispin,1,1,chi_one,noco,cell,lapw,td,&
! fj(:,0:,ispin,:),gj(:,0:,ispin,:),hmat(1,1))
! 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(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
......
This diff is collapsed.
......@@ -233,11 +233,20 @@ CONTAINS
!!$ END IF
!---< gwf
INQUIRE(file="vtotal",exist=l_cont)
IF (l_cont) THEN
CALL readDensity(stars,vacuum,atoms,cell,sphhar,input,sym,oneD,archiveType,CDN_INPUT_DEN_const,&
0,results%ef,l_qfix,vtot,"vtotal")
ELSE
CALL timestart("generation of potential")
CALL vgen(hybrid,field,input,xcpot,DIMENSION,atoms,sphhar,stars,vacuum,sym,&
obsolete,cell,oneD,sliceplot,mpi,results,noco,inDen,vTot,vx,vCoul)
CALL timestop("generation of potential")
CALL writeDensity(stars,vacuum,atoms,cell,sphhar,input,sym,oneD,archiveType,CDN_INPUT_DEN_const,&
0,-1.0,results%ef,.FALSE.,vtot,"vtotal")
stop "Potential written"
END IF
#ifdef CPP_MPI
CALL MPI_BARRIER(mpi%mpi_comm,ierr)
#endif
......
......@@ -32,6 +32,7 @@ math/DoubleFactorial.f90
math/ExpSave.f90
math/intgr.F90
math/ylm4.F90
math/LegendrePoly.f90
)
if (FLEUR_USE_FFTMKL)
set(fleur_F90 ${fleur_F90} math/mkl_dfti.f90)
......
module m_LegendrePoly
implicit none
contains
pure recursive function LegendrePoly(l,x) result(p)
implicit none
integer, intent(in) :: l
real, intent(in) :: x(:)
real :: p(size(x))
real, parameter :: one_128 = 1.0/128.0, one_256 = 1.0/256.0
select case(l)
case(0)
p = 1.0
case(1)
p = x
case(2)
p = 0.5 * ( 3 * x**2 - 1)
case(3)
p = 0.5 * ( 5 * x**3 - 3 * x)
case(4)
p = 0.125 * (35 * x**4 - 30 * x**2 + 3)
case(5)
p = 0.125 * (63 * x**5 - 70 * x**3 + 15 * x)
case(6)
p = 0.0625 * (231 * x**6 -315 * x**4 + 105 * x**2 - 5)
case(7)
p = 0.0625 * (429 * x**7 -693 * x**5 + 315 * x**3 - 35 * x)
case(8)
p = one_128 * (6435 * x**8 -12012 *x**6 + 6930* x**4 - 1260 * x**2 + 35)
case(9)
p = one_128 * (12155* x**9 -25740 *x**7 +18018* x**5 - 4620 * x**3 + 315 * x)
case(10)
p = one_256 * (46189* x**10 -109395*x**8 +90090* x**6 -30030 * x**4 +3465 * x**2 - 63)
case default
p = ( (2*l-1)*x*LegendrePoly(l-1,x) - (l-1)*LegendrePoly(l-2,x) ) / l
end select
end function LegendrePoly
pure recursive function LegendrePoly_scalar(l,x) result(p)
implicit none
integer, intent(in) :: l
real, intent(in) :: x
real :: p
real, parameter :: one_128 = 1.0/128.0, one_256 = 1.0/256.0
select case(l)
case(0)
p = 1.0
case(1)
p = x
case(2)
p = 0.5 * ( 3 * x**2 - 1)
case(3)
p = 0.5 * ( 5 * x**3 - 3 * x)
case(4)
p = 0.125 * (35 * x**4 - 30 * x**2 + 3)
case(5)
p = 0.125 * (63 * x**5 - 70 * x**3 + 15 * x)
case(6)
p = 0.0625 * (231 * x**6 -315 * x**4 + 105 * x**2 - 5)
case(7)
p = 0.0625 * (429 * x**7 -693 * x**5 + 315 * x**3 - 35 * x)
case(8)
p = one_128 * (6435 * x**8 -12012 *x**6 + 6930* x**4 - 1260 * x**2 + 35)
case(9)
p = one_128 * (12155* x**9 -25740 *x**7 +18018* x**5 - 4620 * x**3 + 315 * x)
case(10)
p = one_256 * (46189* x**10 -109395*x**8 +90090* x**6 -30030 * x**4 +3465 * x**2 - 63)
case default
p = ( (2*l-1)*x*LegendrePoly_scalar(l-1,x) - (l-1)*LegendrePoly_scalar(l-2,x) ) / l
end select
end function LegendrePoly_scalar
end module m_LegendrePoly
......@@ -371,10 +371,12 @@ CONTAINS
INTEGER:: k
REAL:: th
!$OMP PARALLEL DO PRIVATE(k,th) SHARED(tau,cph,lapw,iintsp,qss) DEFAULT(none)
DO k = 1,lapw%nv(iintsp)
th= DOT_PRODUCT(lapw%gvec(:,k,iintsp)+(iintsp-1.5)*qss,tau)
cph(k) = CMPLX(COS(tpi_const*th),-SIN(tpi_const*th))
END DO
!$OMP END PARALLEL DO
END SUBROUTINE lapw_phase_factors
......@@ -426,6 +428,7 @@ CONTAINS
ENDIF
!---> set up phase factors
!$OMP PARALLEL DO PRIVATE(k,th) SHARED(rph,cph)
DO k = 1,lapw%nv(iintsp)
th= tpi_const*DOT_PRODUCT((/lapw%k1(k,iintsp),lapw%k2(k,iintsp),lapw%k3(k,iintsp)/)+qssbti,atoms%taual(:,na))
rph(k,iintsp) = COS(th)
......