Commit 6ccbdf05 authored by Alexander Neukirchen's avatar Alexander Neukirchen

Fixes for sourcefree. Antiferromagnets now stay antiferromagnetic.

parent d75e869a
......@@ -205,8 +205,12 @@ CONTAINS
CALL timestop("MT divergence")
CALL timestart("PW divergence")
CALL pw_div(stars,sym,cell,noco,bxc,div)
div%pw(:,1)=CMPLX(0.0,0.0)
DO i=1,3
div%pw(:,1)=div%pw(:,1)+ImagUnit*(cell%bmat(i,1)*stars%kv3(1,:)+cell%bmat(i,2)*stars%kv3(2,:)+cell%bmat(i,3)*stars%kv3(3,:))*bxc(i)%pw(:,1)
END DO
CALL timestop("PW divergence")
......@@ -628,7 +632,10 @@ CONTAINS
CALL timestart("PW potential gradient")
CALL pw_grad(stars,cell,noco,sym,pot,grad)
DO i=1,3
grad(i)%pw(:,1)=ImagUnit*(cell%bmat(i,1)*stars%kv3(1,:)+cell%bmat(i,2)*stars%kv3(2,:)+cell%bmat(i,3)*stars%kv3(3,:))*pot%pw(:,1)
END DO
CALL timestop("PW potential gradient")
......
......@@ -61,14 +61,12 @@ contains
nat = 1
do n = 1, atoms%ntype
write( 6, fmt=8000 ) n
nd = sym%ntypsy(nat)
do lh = 0, sphhar%nlh(nd)
l = sphhar%llh(lh,nd)
mems = sphhar%nmem(lh,nd)
do mem = 1, mems
m = sphhar%mlh(mem,lh,nd)
write( 6, fmt=8010 ) l, m, qlmo(m,l,n), qlmp(m,l,n)
end do
do l = 0, atoms%lmax(n)
do m = -l, l
if ( qlmo(m,l,n)/=CMPLX(0.0) .or. qlmp(m,l,n)/=CMPLX(0.0) ) then
write( 6, fmt=8010 ) l, m, qlmo(m,l,n), qlmp(m,l,n)
end if
end do
end do
nat = nat + atoms%neq(n)
end do
......
......@@ -232,7 +232,7 @@ CONTAINS
ENDIF
kt = kt + nsp
END DO
IF (PRESENT(ch)) THEN
!Rotation to local if needed (Indicated by rotch)
IF (rotch.AND.noco%l_mtNocoPot) THEN
DO jr = 1,nsp*atoms%jri(n)
......@@ -253,7 +253,8 @@ CONTAINS
ELSE
ch(:nsp*atoms%jri(n),1:jspins)=ch_calc(:nsp*atoms%jri(n),1:jspins)
EnD IF
END IF
END IF
END SUBROUTINE mt_to_grid
SUBROUTINE mt_from_grid(atoms, sym, sphhar, n, jspins, v_in, vr)
......
......@@ -299,9 +299,11 @@ CONTAINS
!
!----> add to warped coulomb potential
!
DO k = 1,stars%ng3
v_out_pw_w(k,js) = v_out_pw_w(k,js) + fg3(k)
ENDDO
IF (PRESENT(v_out_pw_w)) THEN
DO k = 1,stars%ng3
v_out_pw_w(k,js) = v_out_pw_w(k,js) + fg3(k)
ENDDO
END IF
ENDIF
END DO
END SUBROUTINE pw_from_grid
......
......@@ -39,6 +39,7 @@ CONTAINS
USE m_fft2d
USE m_fft3d
USE m_types
USE m_polangle
IMPLICIT NONE
......@@ -118,31 +119,7 @@ CONTAINS
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
CALL pol_angle(mx,my,mz,theta,phi)
! write(36,'(i4,2f12.6)') mod(imesh,33),rho_11,rho_22
ris(imesh,1) = rho_up
......
......@@ -21,6 +21,7 @@ CONTAINS
USE m_rotate_mt_den_tofrom_local
USE m_sfTests
USE m_magnMomFromDen
USE m_pw_tofrom_grid
IMPLICIT NONE
TYPE(t_mpi), INTENT(IN) :: mpi
TYPE(t_oneD), INTENT(IN) :: oneD
......@@ -43,6 +44,8 @@ CONTAINS
TYPE(t_potden) :: div, phi, checkdiv
TYPE(t_potden), DIMENSION(3) :: cvec, corrB, bxc
REAL :: b(3,atoms%ntype),dummy1(atoms%ntype),dummy2(atoms%ntype),sfscale
REAL,ALLOCATABLE :: intden(:,:)
TYPE(t_gradients) :: tmp_grad
......@@ -101,6 +104,12 @@ CONTAINS
CALL bxc(i)%resetPotDen()
CALL corrB(i)%resetPotDen()
END DO
CALL init_pw_grid(.FALSE.,stars,sym,cell)
CALL pw_to_grid(.FALSE.,1,.FALSE.,stars,cell,cvec(i)%pw,tmp_grad,rho=intden)
CALL pw_from_grid(.FALSE.,stars,.TRUE.,intden,cvec(i)%pw,cvec(i)%pw_w)
CALL finish_pw_grid()
CALL timestart("Correcting vTot")
CALL correctPot(vTot,cvec)
CALL timestop("Correcting vTot")
......
......@@ -62,13 +62,13 @@ CONTAINS
REAL vup,vdown,veff,beff,vziw,theta,phi
! ..
! .. Local Arrays ..
REAL, ALLOCATABLE :: vvacxy(:,:,:,:),vis(:,:),fftwork(:)
REAL, ALLOCATABLE :: vvacxy(:,:,:,:),vis(:,:),fftwork(:),vis2(:,:)
ifft3 = 27*stars%mx1*stars%mx2*stars%mx3
IF (ifft3.NE.SIZE(den%theta_pw)) CALL judft_error("Wrong size of angles")
ifft2 = SIZE(den%phi_vacxy,1)
ALLOCATE ( vis(ifft3,4),fftwork(ifft3))
ALLOCATE ( vis(ifft3,4),fftwork(ifft3),vis2(ifft3,4))
!---> fouriertransform the spin up and down potential
!---> in the interstitial, vpw, to real space (vis)
......@@ -98,7 +98,7 @@ CONTAINS
vis(imeshpt,4) = beff*SIN(theta)*SIN(phi)
DO ipot = 1,4
vis(imeshpt,ipot) = vis(imeshpt,ipot) * stars%ufft(imeshpt-1)
vis2(imeshpt,ipot) = vis(imeshpt,ipot) * stars%ufft(imeshpt-1)
ENDDO
ENDDO
......@@ -106,10 +106,13 @@ CONTAINS
!---> Fouriertransform the matrix potential back to reciprocal space
DO ipot = 1,2
fftwork=0.0
CALL fft3d(vis(:,ipot),fftwork, vTot%pw_w(1,ipot), stars,-1)
CALL fft3d(vis(:,ipot),fftwork, vTot%pw(1,ipot), stars,-1)
fftwork=0.0
CALL fft3d(vis2(:,ipot),fftwork, vTot%pw_w(1,ipot), stars,-1)
ENDDO
CALL fft3d(vis(:,3),vis(:,4), vTot%pw_w(1,3), stars,-1)
CALL fft3d(vis(:,3),vis(:,4), vTot%pw(1,3), stars,-1)
CALL fft3d(vis2(:,3),vis2(:,4), vTot%pw_w(1,3), stars,-1)
IF (.NOT. input%film) RETURN
......
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