...
 
Commits (20)
...@@ -71,17 +71,19 @@ CONTAINS ...@@ -71,17 +71,19 @@ CONTAINS
ENDDO ENDDO
CALL timestart("Interstitial part") ! CALL timestart("Interstitial part")
!Generate interstitial part of Hamiltonian !Generate interstitial part of Hamiltonian
CALL hs_int(input,noco,stars,lapw,mpi,cell,isp,v%pw_w,smat,hmat) ! CALL hs_int(input,noco,stars,lapw,mpi,cell,isp,v%pw_w,smat,hmat)
CALL timestop("Interstitial part") ! CALL timestop("Interstitial part")
CALL timestart("MT part") CALL timestart("MT part")
!MT-part of Hamiltonian. In case of noco, we need an loop over the local spin of the atoms !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) 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) CALL hsmt(atoms,sym,enpara,ispin,input,mpi,noco,cell,lapw,ud,td,smat,hmat)
ENDDO ENDDO
CALL timestop("MT part") CALL timestop("MT part")
STOP "hsmt_spherical only"
!Vacuum contributions !Vacuum contributions
IF (input%film) THEN IF (input%film) THEN
CALL timestart("Vacuum part") CALL timestart("Vacuum part")
......
...@@ -73,10 +73,10 @@ CONTAINS ...@@ -73,10 +73,10 @@ CONTAINS
!that is needed and allocated !that is needed and allocated
CALL hsmt_sph(n,atoms,mpi,ispin,input,noco,1,1,chi_one,lapw,enpara%el0,& 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)) 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,& ! 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)) ! 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,:),& ! 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)) ! n,chi_one,ispin,iintsp,jintsp,hmat(1,1),smat(1,1))
ELSEIF(noco%l_noco.AND..NOT.noco%l_ss) THEN ELSEIF(noco%l_noco.AND..NOT.noco%l_ss) THEN
!The NOCO but non-spinspiral setup follows: !The NOCO but non-spinspiral setup follows:
!The Matrix-elements are first calculated in the local frame of the atom and !The Matrix-elements are first calculated in the local frame of the atom and
......
This diff is collapsed.
...@@ -233,11 +233,20 @@ CONTAINS ...@@ -233,11 +233,20 @@ CONTAINS
!!$ END IF !!$ END IF
!---< gwf !---< 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 timestart("generation of potential")
CALL vgen(hybrid,field,input,xcpot,DIMENSION,atoms,sphhar,stars,vacuum,sym,& CALL vgen(hybrid,field,input,xcpot,DIMENSION,atoms,sphhar,stars,vacuum,sym,&
obsolete,cell,oneD,sliceplot,mpi,results,noco,inDen,vTot,vx,vCoul) obsolete,cell,oneD,sliceplot,mpi,results,noco,inDen,vTot,vx,vCoul)
CALL timestop("generation of potential") 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 #ifdef CPP_MPI
CALL MPI_BARRIER(mpi%mpi_comm,ierr) CALL MPI_BARRIER(mpi%mpi_comm,ierr)
#endif #endif
......
...@@ -32,6 +32,7 @@ math/DoubleFactorial.f90 ...@@ -32,6 +32,7 @@ math/DoubleFactorial.f90
math/ExpSave.f90 math/ExpSave.f90
math/intgr.F90 math/intgr.F90
math/ylm4.F90 math/ylm4.F90
math/LegendrePoly.f90
) )
if (FLEUR_USE_FFTMKL) if (FLEUR_USE_FFTMKL)
set(fleur_F90 ${fleur_F90} math/mkl_dfti.f90) 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 ...@@ -371,10 +371,12 @@ CONTAINS
INTEGER:: k INTEGER:: k
REAL:: th REAL:: th
!$OMP PARALLEL DO PRIVATE(k,th) SHARED(tau,cph,lapw,iintsp,qss) DEFAULT(none)
DO k = 1,lapw%nv(iintsp) DO k = 1,lapw%nv(iintsp)
th= DOT_PRODUCT(lapw%gvec(:,k,iintsp)+(iintsp-1.5)*qss,tau) th= DOT_PRODUCT(lapw%gvec(:,k,iintsp)+(iintsp-1.5)*qss,tau)
cph(k) = CMPLX(COS(tpi_const*th),-SIN(tpi_const*th)) cph(k) = CMPLX(COS(tpi_const*th),-SIN(tpi_const*th))
END DO END DO
!$OMP END PARALLEL DO
END SUBROUTINE lapw_phase_factors END SUBROUTINE lapw_phase_factors
...@@ -426,6 +428,7 @@ CONTAINS ...@@ -426,6 +428,7 @@ CONTAINS
ENDIF ENDIF
!---> set up phase factors !---> set up phase factors
!$OMP PARALLEL DO PRIVATE(k,th) SHARED(rph,cph)
DO k = 1,lapw%nv(iintsp) 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)) 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) rph(k,iintsp) = COS(th)
......