Commit ff5e7d6a authored by Daniel Wortmann's avatar Daniel Wortmann
Browse files

Changes due to update of t_stars

parent 813e333b
......@@ -123,7 +123,7 @@ CONTAINS
COMPLEX,INTENT(IN),OPTIONAL :: vpw(:,:)
REAL,INTENT(IN),OPTIONAL :: vr(:,0:,:,:)
COMPLEX,INTENT (INOUT) :: qpw(stars%ng3,input%jspins)
COMPLEX,INTENT (INOUT) :: rhtxy(vacuum%nmzxyd,oneD%odi%n2d-1,2,input%jspins)
COMPLEX,INTENT (INOUT) :: rhtxy(vacuum%nmzxyd,stars%ng2-1,2,input%jspins)
REAL, INTENT (INOUT) :: rho(atoms%jmtd,0:sphhar%nlhd,atoms%ntype,input%jspins)
REAL, INTENT (INOUT) :: rht(vacuum%nmzd,2,input%jspins)
REAL, INTENT (INOUT) :: rh(atoms%msh,atoms%ntype)
......
......@@ -167,8 +167,9 @@
x(ng) = cmplx(cell%volint,0.0)
cycle starloop
ELSE
IF (oneD%odi%d1) THEN
IF (allocated(stars%ig2)) THEN
!Film calculation
IF (oneD%odi%d1) THEN
IF (stars%kv3(3,ng).EQ.0) THEN
g = (stars%kv3(1,ng)*cell%bmat(1,1) + stars%kv3(2,ng)*cell%bmat(2,1))**2 + &
(stars%kv3(1,ng)*cell%bmat(1,2) + stars%kv3(2,ng)*cell%bmat(2,2))**2
......@@ -179,7 +180,7 @@
ELSE
x(ng) = (0.0,0.0)
END IF
ELSE
ELSE
ig2d = stars%ig2(ig3d)
IF (ig2d.EQ.1) THEN
g = stars%kv3(3,ng)*cell%bmat(3,3)*cell%z1
......@@ -187,8 +188,10 @@
ELSE
x(ng) = (0.0,0.0)
END IF
END IF
END IF
ELSE
x(ng)=0.0
ENDIF
END IF
! -----> sphere contributions
s = stars%sk3(ig3d)
......
......@@ -4,8 +4,8 @@ CONTAINS
& stars,&
& afft2,bfft2,&
& fg,fgi,fgxy,&
& stride,isn,&
& firstderiv,secondderiv )
& isn,&
& firstderiv,secondderiv,cell )
!*************************************************************
!* *
......@@ -24,11 +24,12 @@ CONTAINS
USE m_types
IMPLICIT NONE
TYPE(t_stars),INTENT(IN) :: stars
INTEGER, INTENT (IN) :: isn,stride
TYPE(t_cell),INTENT(IN),OPTIONAL:: cell
INTEGER, INTENT (IN) :: isn
REAL :: fg,fgi
REAL :: afft2(0:9*stars%mx1*stars%mx2-1),bfft2(0:9*stars%mx1*stars%mx2-1)
COMPLEX :: fgxy(stride,stars%ng2-1)
COMPLEX :: fgxy(:)
REAL,OPTIONAL,INTENT(IN):: firstderiv(3),secondderiv(3)
!... local variables
......@@ -38,14 +39,14 @@ CONTAINS
COMPLEX fg2(stars%ng2)
call grid%init([3*stars%mx2,3*stars%mx2,1])
call grid%init([3*stars%mx1,3*stars%mx2,1])
IF (isn>0) THEN
! ---> put stars onto the fft-grid
fg2(1) = CMPLX(fg,fgi)
fg2(2:)=fgxy(stride,:)
fg2(2:)=fgxy(:)
call grid%putFieldOnGrid(stars,fg2,firstderiv=firstderiv,secondderiv=secondderiv,l_2d=.true.)
call grid%putFieldOnGrid(stars,fg2,cell,firstderiv=firstderiv,secondderiv=secondderiv,l_2d=.true.)
else
grid%grid=cmplx(afft2,bfft2)
endif
......@@ -70,7 +71,7 @@ CONTAINS
fg=REAL(fg2(1))
fgi=AIMAG(fg2(1))
DO i=2,stars%ng2
fgxy(1,i-1)=fg2(i)
fgxy(i-1)=fg2(i)
ENDDO
ENDIF
......
......@@ -30,10 +30,10 @@ CONTAINS
! ..
!
n=SIZE(ind)
IF (n>SIZE(lv)) CALL judft_error("BUG: incosistent dimensions")
IF (n>SIZE(lv)) CALL judft_error("BUG in sort: inconsistent dimensions")
ALLOCATE(llv(n))
IF (PRESENT(lv1)) THEN
IF (n>SIZE(lv1)) CALL judft_error("BUG: incosistent dimensions")
IF (n>SIZE(lv1)) CALL judft_error("BUG in sort: inconsistent dimensions")
llv=lv1
ELSE
llv=(/(1.*i,i=1,n)/)
......
......@@ -785,7 +785,7 @@
& stars,&
& rhoRS, rhoRSimag,&
& fg, fgi,&
& efield%rhoEF(:,ivac), 1, -1)
& efield%rhoEF(:,ivac), -1)
! FFT gives the the average charge per grid point
! while sig_b stores the (total) charge per sheet
IF (efield%dirichlet .and. ABS (fg) > 1.0e-15) THEN
......
......@@ -322,8 +322,8 @@ CONTAINS
DO imz = 1,vacuum%nmzxyd
rziw = 0.0
CALL fft2d(stars, rvacxy(0,imz,ivac,iden), fftwork, &
rht(imz,ivac,iden), rziw, rhtxy(imz,1,ivac,iden), &
vacuum%nmzxyd, 1)
rht(imz,ivac,iden), rziw, rhtxy(imz,:,ivac,iden), &
1)
END DO
END DO
END DO
......@@ -334,7 +334,7 @@ CONTAINS
vz_r = REAL(cdomvz(imz,ivac))
vz_i = AIMAG(cdomvz(imz,ivac))
CALL fft2d(stars, rvacxy(0,imz,ivac,3), rvacxy(0,imz,ivac,4), &
vz_r, vz_i, cdomvxy(imz,1,ivac), vacuum%nmzxyd, 1)
vz_r, vz_i, cdomvxy(imz,:,ivac), 1)
END DO
END DO
......@@ -387,8 +387,8 @@ CONTAINS
DO imz = 1,vacuum%nmzxyd
fftwork=zero
CALL fft2d(stars, rvacxy(0,imz,ivac,iden), fftwork, &
rht(imz,ivac,iden), rziw, rhtxy(imz,1,ivac,iden), &
vacuum%nmzxyd, -1)
rht(imz,ivac,iden), rziw, rhtxy(imz,:,ivac,iden), &
-1)
END DO
END DO
END DO
......
......@@ -858,6 +858,9 @@ def execute_fleur(fleur_binary, work_dir, mpi_command, pytestconfig, test_logger
with open(f"{workdir}/{stderr}", "bw") as f_stderr:
# we parse the whole string and execute in shell,
# otherwise popen thinks 'mpirun -np 2 /path/fleur' is the path to the executable...
print('FLEUR execution:')
print('arg_list:',arg_list)
print('env:',run_env)
p1 = subprocess.run(arg_list, env=run_env, stdout=f_stdout, stderr=f_stderr, check=False)
# Check per hand if successful:
......
......@@ -142,7 +142,7 @@ function map_g_to_fft_grid(grid, g_in) result(g_idx)
twod=.false.
if (present(l_2d)) twoD=l_2d
if (twoD.and.this%dimensions(3)>0) call juDFT_error("Bug in putFieldOnGrid: no two-D grid")
if (twoD.and.this%dimensions(3)>1) call juDFT_error("Bug in putFieldOnGrid: no two-D grid")
DO z = merge(0,-stars%mx3,twoD), merge(0,stars%mx3,twoD)
zGrid = MODULO(z, merge(1,this%dimensions(3),twoD)) !always 0 in 2d-case
......@@ -162,7 +162,9 @@ function map_g_to_fft_grid(grid, g_in) result(g_idx)
endif
IF (iStar .EQ. 0) CYCLE
IF (stars%sk3(iStar) .GT. gCutoffInternal) CYCLE
IF (twod.and.stars%sk2(istar)>gCutoffInternal) CYCLE
IF (twod) THEN
if(stars%sk2(istar)>gCutoffInternal) CYCLE
ENDIF
xGrid = MODULO(x, this%dimensions(1))
this%grid(xGrid + this%dimensions(1)*yGrid + layerDim*zGrid) = field(iStar)*fct
END DO
......@@ -192,7 +194,7 @@ function map_g_to_fft_grid(grid, g_in) result(g_idx)
twod=.false.
if (present(l_2d)) twoD=l_2d
if (twoD.and.this%dimensions(3)>0) call juDFT_error("Bug in takeFieldFromGrid: no two-D grid")
if (twoD.and.this%dimensions(3)>1) call juDFT_error("Bug in takeFieldFromGrid: no two-D grid")
field(:) = CMPLX(0.0, 0.0)
layerDim = this%dimensions(1)*this%dimensions(2)
......
......@@ -637,6 +637,8 @@ CONTAINS
!END IF
call timestop("mpimat_init")
#else
CALL juDFT_ERROR("No parallel matrix setup without SCALAPACK")
#endif
END SUBROUTINE mpimat_init
......
......@@ -127,9 +127,17 @@ CONTAINS
INTEGER,ALLOCATABLE :: index(:)
REAL,ALLOCATABLE :: gsk3(:)
allocate(gsk3(stars%ng3),index(stars%ng3))
gmax2=stars%gmax**2
allocate(gsk3(stars%ng3),index(stars%ng3))
ALLOCATE(stars%rgphs(-stars%mx1:stars%mx1,-stars%mx2:stars%mx2,-stars%mx3:stars%mx3))
ALLOCATE(stars%kv3(3,stars%ng3),stars%sk3(stars%ng3),stars%nstr(stars%ng3))
ALLOCATE(stars%ig(-stars%mx1:stars%mx1,-stars%mx2:stars%mx2,-stars%mx3:stars%mx3))
stars%rgphs=0.0
stars%ig=0
stars%nstr=0
k=0
!Generate 3D stars
x_dim: DO k1 = stars%mx1,-stars%mx1,-1
......@@ -159,6 +167,8 @@ CONTAINS
ENDDO z_dim
ENDDO y_dim
ENDDO x_dim
if (k.ne.stars%ng3) call judft_error("BUG inconsistency in star setup")
!sort for increasing length sk3
CALL sort(index,stars%sk3,gsk3)
stars%kv3=stars%kv3(:,index)
......@@ -176,8 +186,20 @@ CONTAINS
stars%nstr(k)=stars%nstr(k)+1
ENDDO symloop
ENDDO
!count number of stars in 2*rkmax (stars are ordered)
!Adjust phases
if (sym%symor) THEN
stars%rgphs=1.0
ELSE
DO k1 = stars%mx1,-stars%mx1,-1
DO k2 = stars%mx2,-stars%mx2,-1
DO k3 = stars%mx3,-stars%mx3,-1
IF ( stars%ig(k1,k2,k3)==0 ) CYCLE
stars%rgphs(k1,k2,k3)=stars%rgphs(k1,k2,k3)*stars%nstr(stars%ig(k1,k2,k3))/sym%nop
enddo
ENDDO
ENDDO
ENDIF
!count number of stars in 2*rkmax (stars are ordered)
associate(i=>stars%ng3_fft)
DO i=stars%ng3,1,-1
IF ( stars%sk3(i).LE.2.0*rkmax ) EXIT
......@@ -188,8 +210,14 @@ CONTAINS
!
! Now the same for the 2D stars
!
stars%ig2=0
ALLOCATE(stars%r2gphs(-stars%mx1:stars%mx1,-stars%mx2:stars%mx2))
ALLOCATE(stars%kv2(2,stars%ng2),stars%sk2(stars%ng2),stars%nstr2(stars%ng2))
ALLOCATE(stars%i2g(-stars%mx1:stars%mx1,-stars%mx2:stars%mx2))
ALLOCATE(stars%ig2(stars%ng3))
ALLOCATE(stars%igvac(stars%ng2,-stars%mx3:stars%mx3))
stars%r2gphs=0.0
stars%i2g=0
stars%nstr2=0
kv(3)=0
k=0
!Generate 2D stars
......@@ -205,29 +233,26 @@ CONTAINS
stars%kv2(:,k)=kv(:2)
stars%sk2(k)=sqrt(s)
! secondary key for equal length stars
gsk3(k) = (stars%mx1+stars%kv3(1,k)) +&
& (stars%mx2+stars%kv3(2,k))*(2*stars%mx1+1)
gsk3(k) = (stars%mx1+stars%kv3(1,k)) +(stars%mx2+stars%kv3(2,k))*(2*stars%mx1+1)
!Now generate all equivalent g-vectors
CALL spgrot(sym%nop2,sym%symor,sym%mrot(:2,:2,:),sym%tau(:2,:),sym%invtab,stars%kv3(:2,k),&
kr(:2,:))
CALL spgrot(sym%nop2,sym%symor,sym%mrot(:2,:2,:),sym%tau(:2,:),sym%invtab,stars%kv2(:2,k),kr(:2,:))
DO n = 1,sym%nop2
stars%i2g(kr(1,n),kr(2,n))=k
ENDDO
ENDDO y_dim2
ENDDO x_dim2
if (k.ne.stars%ng2) call judft_error("BUG in init_stars: inconsistency in ng2")
!sort for increasing length sk2
CALL sort(index,stars%sk2,gsk3)
stars%kv2=stars%kv2(:,index)
stars%sk2=stars%sk2(index)
CALL sort(index(:stars%ng2),stars%sk2,gsk3(:stars%ng2))
stars%kv2(:,:)=stars%kv2(:,index(:stars%ng2))
stars%sk2=stars%sk2(index(:stars%ng2))
! set up the pointers and phases for 2d stars
DO k = 1,stars%ng2
CALL spgrot(sym%nop2,sym%symor,sym%mrot(:2,:2,:),sym%tau(:2,:),sym%invtab,stars%kv2(:2,k),&
kr(:2,:),phas)
DO k3= stars%mx3,-stars%mx3,-1
stars%igvac(k,k3) = stars%ig(stars%kv2(1,k),stars%kv2(2,k),k3)
stars%igvac(k,k3) = stars%ig(stars%kv2(1,k),stars%kv2(2,k),k3)
ENDDO
CALL spgrot(sym%nop2,sym%symor,sym%mrot(:2,:2,:),sym%tau(:2,:),sym%invtab,stars%kv2(:2,k),kr(:2,:),phas)
symloop2: DO n = 1,sym%nop2
stars%i2g(kr(1,n),kr(2,n))=k
stars%r2gphs(kr(1,n),kr(2,n))=stars%r2gphs(kr(1,n),kr(2,n))+phas(n)
......@@ -239,7 +264,18 @@ CONTAINS
ENDDO
DO k=1,stars%ng3
stars%ig2(k)=stars%i2g(stars%kv3(1,k),stars%kv3(2,k))
ENDDO
ENDDO
!Adjust phases
IF (sym%symor) THEN
stars%r2gphs=1.0
ELSE
DO k1 = stars%mx1,-stars%mx1,-1
DO k2 = stars%mx2,-stars%mx2,-1
IF ( stars%i2g(k1,k2)==0 ) CYCLE
stars%r2gphs(k1,k2)=stars%r2gphs(k1,k2)*stars%nstr2(stars%i2g(k1,k2))/sym%nop2
ENDDO
ENDDO
ENDIF
END SUBROUTINE init_stars
subroutine dim_stars(stars,sym,cell)
......@@ -262,11 +298,11 @@ CONTAINS
stars%mx2 = int(stars%gmax/arltv2) + 1
stars%mx3 = int(stars%gmax/arltv3) + 1
ALLOCATE(stars%ig(-stars%mx1:stars%mx1,-stars%mx2:stars%mx2,-stars%mx3:stars%mx3))
ALLOCATE(stars%i2g(-stars%mx1:stars%mx1,-stars%mx2:stars%mx2))
ALLOCATE(stars%rgphs(-stars%mx1:stars%mx1,-stars%mx2:stars%mx2,-stars%mx3:stars%mx3))
ALLOCATE(stars%r2gphs(-stars%mx1:stars%mx1,-stars%mx2:stars%mx2))
stars%i2g=0
stars%ig=0
stars%ng2=0
......@@ -276,7 +312,7 @@ CONTAINS
y_dim: DO k2 = stars%mx2,-stars%mx2,-1
kv(2) = k2
!Check 2d-star
IF (stars%i2g(k1,k2).ne.0) THEN
IF (stars%i2g(k1,k2)==0) THEN
g(:2)=matmul(kv(:2),cell%bmat(:2,:2))
s=dot_product(g(:2),g(:2))
IF (.not.s>gmax2) THEN !in sphere
......@@ -302,8 +338,9 @@ CONTAINS
ENDDO y_dim
ENDDO x_dim
ALLOCATE(stars%kv3(3,stars%ng3),stars%sk3(stars%ng3),stars%nstr(stars%ng3))
ALLOCATE(stars%kv2(3,stars%ng2),stars%sk2(stars%ng2),stars%nstr2(stars%ng2))
stars%rgphs=0.0;stars%r2gphs=0.0
DEALLOCATE(stars%ig)
DEALLOCATE(stars%i2g)
END SUBROUTINE dim_stars
END MODULE m_types_stars
......@@ -4,8 +4,8 @@ vgen/grdrsvac.f
vgen/mkgz.f
vgen/modcyli.f
vgen/modcylk.f
vgen/od_mkgxyz3.f
vgen/od_mkgz.f
#vgen/od_mkgxyz3.f
#vgen/od_mkgz.f
vgen/vacp5_0.f
vgen/vacp5_z.f
vgen/visp5_0.f
......@@ -25,8 +25,8 @@ vgen/int_nv.F90
vgen/lhglptg.f90
vgen/lhglpts.f90
vgen/mpmom.F90
vgen/od_vvac.f90
vgen/od_vvacis.f90
#vgen/od_vvac.f90
#vgen/od_vvacis.f90
vgen/vgen_coulomb.F90
vgen/vgen_xcpot.F90
vgen/vgen_finalize.F90
......
......@@ -85,13 +85,13 @@ CONTAINS
CALL timestart("Vac divergence")
div%vacxy=CMPLX(0.0,0.0)
div%vacz=0.0
CALL vac_grad(vacuum,stars,bxc(1),grad,9*stars%mx1*stars%mx2)
CALL vac_grad(vacuum,stars,cell,bxc(1),grad,9*stars%mx1*stars%mx2)
div%vacxy=div%vacxy+grad(1)%vacxy
div%vacz=div%vacz+grad(1)%vacz
CALL vac_grad(vacuum,stars,bxc(2),grad,9*stars%mx1*stars%mx2)
CALL vac_grad(vacuum,stars,cell,bxc(2),grad,9*stars%mx1*stars%mx2)
div%vacxy=div%vacxy+grad(2)%vacxy
div%vacz=div%vacz+grad(2)%vacz
CALL vac_grad(vacuum,stars,bxc(3),grad,9*stars%mx1*stars%mx2)
CALL vac_grad(vacuum,stars,cell,bxc(3),grad,9*stars%mx1*stars%mx2)
div%vacxy=div%vacxy+grad(3)%vacxy
div%vacz=div%vacz+grad(3)%vacz
CALL timestop("Vac divergence")
......@@ -100,7 +100,7 @@ CONTAINS
END SUBROUTINE divergence
SUBROUTINE vac_grad(vacuum,stars,den,grad,ifftd2)
SUBROUTINE vac_grad(vacuum,stars,cell,den,grad,ifftd2)
USE m_constants
USE m_grdchlh
......@@ -110,6 +110,7 @@ CONTAINS
IMPLICIT NONE
TYPE(t_vacuum),INTENT(IN) :: vacuum
TYPE(t_stars),INTENT(IN) :: stars
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_potden),INTENT(IN) :: den
TYPE(t_potden),INTENT(INOUT),DIMENSION(3) :: grad
! ..
......@@ -192,7 +193,7 @@ CONTAINS
! Transform charge and magnetization to real-space.
CALL fft2d(stars, af2(0),bf2, den%vacz(ip,ivac,1),0.,&
den%vacxy(ip,1,ivac,1), vacuum%nmzxyd,+1)
den%vacxy(ip,:,ivac,1),+1)
! calculate derivatives with respect to x,y in g-space
! and transform them to real-space.
......@@ -207,15 +208,15 @@ CONTAINS
! dn/atoms = FFT(0,i*gx*den%vacxy)
CALL fft2d(stars, rhdx(0),bf2, zro,rhti,cqpw, 1,+1,firstderiv=[1.,0.0,0.])
CALL fft2d(stars, rhdx(0),bf2, zro,rhti,cqpw,+1,firstderiv=[1.,0.0,0.],cell=cell)
rhti = 0.0
CALL fft2d( & ! dn/dy = FFT(0,i*gy*den%vacxy)&
stars, rhdy(0),bf2, zro,rhti,cqpw, 1,+1,firstderiv=[0.,1.0,0.])
stars, rhdy(0),bf2, zro,rhti,cqpw, +1,firstderiv=[0.,1.0,0.],cell=cell)
rhti = 0.0
CALL fft2d( & ! dn/dz = FFT(rhtdz,rxydz)&
stars, rhdz(0),bf2, rhtdz(ip),rhti,rxydz(ip,1), vacuum%nmzxyd,+1)
stars, rhdz(0),bf2, rhtdz(ip),rhti,rxydz(ip,:), +1)
!
! set minimal value of af2 to 1.0e-15
......@@ -229,9 +230,9 @@ CONTAINS
! ----> 2-d back fft to g space
!
bf2=0.0
CALL fft2d(stars, rhdx,bf2, fgz(1),rhti,fgxy(:,1), 1,-1)
CALL fft2d(stars, rhdy,bf2, fgz(2),rhti,fgxy(:,2), 1,-1)
CALL fft2d(stars, rhdz,bf2, fgz(3),rhti,fgxy(:,3), 1,-1)
CALL fft2d(stars, rhdx,bf2, fgz(1),rhti,fgxy(:,1), -1)
CALL fft2d(stars, rhdy,bf2, fgz(2),rhti,fgxy(:,2), -1)
CALL fft2d(stars, rhdz,bf2, fgz(3),rhti,fgxy(:,3), -1)
! the g||.eq.zero component is added to grad%vacz
!
......@@ -347,7 +348,7 @@ CONTAINS
IF (input%film) THEN
CALL timestart("Vac potential gradient")
CALL vac_grad(vacuum,stars,pot,grad,9*stars%mx1*stars%mx2)
CALL vac_grad(vacuum,stars,cell,pot,grad,9*stars%mx1*stars%mx2)
CALL timestart("Vac potential gradient")
END IF
......
......@@ -147,8 +147,8 @@ CONTAINS
! & %igf,odl%pgf,odi%nst2)
ELSE
CALL fft2d(stars,rvacxy(:,imz,ivac,iden),fftwork,&
den%vacz(imz,ivac,iden),rziw,den%vacxy(imz,1,ivac,iden),&
vacuum%nmzxyd,1)
den%vacz(imz,ivac,iden),rziw,den%vacxy(imz,:,ivac,iden),&
1)
END IF
END DO
END DO
......@@ -169,7 +169,7 @@ CONTAINS
! & %igf,odl%pgf,odi%nst2)
ELSE
CALL fft2d(stars,rvacxy(:,imz,ivac,3),rvacxy(:,imz,ivac,4),&
vz_r,vz_i,den%vacxy(imz,1,ivac,3),vacuum%nmzxyd,1)
vz_r,vz_i,den%vacxy(imz,:,ivac,3),1)
END IF
END DO
END DO
......@@ -235,8 +235,8 @@ CONTAINS
! & %igf,odl%pgf,odi%nst2)
ELSE
CALL fft2d(stars,rvacxy(:,imz,ivac,jspin),fftwork,&
den%vacz(imz,ivac,jspin),rziw,den%vacxy(imz,1,ivac,jspin),&
vacuum%nmzxyd,-1)
den%vacz(imz,ivac,jspin),rziw,den%vacxy(imz,:,ivac,jspin),&
-1)
END IF
END DO
END DO
......@@ -359,7 +359,7 @@ CONTAINS
! & %igf,odl%pgf,odi%nst2)
ELSE
CALL fft2d(stars, vvacxy(:,imz,ivac,jspin),fftwork,&
vTot%vacz(imz,ivac,jspin),vziw,vTot%vacxy(imz,1,ivac,jspin), vacuum%nmzxyd,1)
vTot%vacz(imz,ivac,jspin),vziw,vTot%vacxy(imz,:,ivac,jspin), 1)
END IF
END DO
END DO
......@@ -413,7 +413,7 @@ CONTAINS
! & %igf,odl%pgf,odi%nst2)
ELSE
CALL fft2d(stars, vvacxy(:,imz,ivac,ipot),fftwork,&
vTot%vacz(imz,ivac,ipot),vziw,vTot%vacxy(imz,1,ivac,ipot), vacuum%nmzxyd,-1)
vTot%vacz(imz,ivac,ipot),vziw,vTot%vacxy(imz,:,ivac,ipot),-1)
END IF
END DO
END DO
......@@ -433,7 +433,7 @@ CONTAINS
! & %igf,odl%pgf,odi%nst2)
ELSE
CALL fft2d(stars, vvacxy(:,imz,ivac,3),vvacxy(:,imz,ivac,4),&
vTot%vacz(imz,ivac,3),vTot%vacz(imz,ivac,4),vTot%vacxy(imz,1,ivac,3), vacuum%nmzxyd,-1)
vTot%vacz(imz,ivac,3),vTot%vacz(imz,ivac,4),vTot%vacxy(imz,:,ivac,3),-1)
END IF
END DO
END DO
......
......@@ -117,12 +117,12 @@ CONTAINS
!idx1=(ivac-1)* ( vacuum%nmzxy * ifftd2 + nmzdiff ) + 1
DO ip=1,vacuum%nmzxy
DO js=1,jspins
CALL fft2d(stars, rho(idx1:,js),bf2, vacz(ip,ivac,js),0.,&
vacxy(ip,:,ivac,js), 1,+1)
CALL fft2d(stars, rho(idx1:idx1+9*stars%mx1*stars%mx2-1,js),bf2, vacz(ip,ivac,js),0.,&
vacxy(ip,:,ivac,js),+1)
END DO
IF (l_noco) THEN
CALL fft2d(stars, mx,my, vacz(ip,ivac,3),vacz(ip,ivac,4), &
vacxy(ip,:,ivac,3), 1,+1)
vacxy(ip,:,ivac,3),+1)
DO i=0,9*stars%mx1*stars%mx2-1
magmom(i,ip)= mx(i)**2 + my(i)**2 + ((rho(i+idx1,1)-rho(i+idx1,2))/2.)**2
......@@ -229,16 +229,16 @@ CONTAINS
CALL fft2d(stars, rhdx(0,js),bf2, zro,rhti,cqpw, 1,+1,firstderiv=[1.,0.,0.])
CALL fft2d(stars, rhdx(0,js),bf2, zro,rhti,cqpw,+1,firstderiv=[1.,0.,0.],cell=cell)
!TODO & pgft2x)
rhti = 0.0
CALL fft2d( & ! dn/dy = FFT(0,i*gy*vacxy)&
stars, rhdy(0,js),bf2, zro,rhti,cqpw, 1,+1,firstderiv=[0.,1.,0.])
stars, rhdy(0,js),bf2, zro,rhti,cqpw, +1,firstderiv=[0.,1.,0.],cell=cell)
rhti = 0.0
CALL fft2d( & ! dn/dz = FFT(rhtdz,rxydz)&
stars, rhdz(0,js),bf2, rhtdz(ip,js),rhti,rxydz(ip,1,js), vacuum%nmzxyd,+1)
stars, rhdz(0,js),bf2, rhtdz(ip,js),rhti,rxydz(ip,:,js), +1)
DO iq=1,stars%ng2-1
cqpw(iq)=-vacxy(ip,iq,ivac,js)
......@@ -246,15 +246,15 @@ CONTAINS
rhti = 0.0
CALL fft2d( & ! d2n/dx2 = FFT(0,-gx^2*vacxy)&
stars, rhdxx(0,js),bf2, zro,rhti,cqpw, 1,+1,firstderiv=[1.0,0.,0.],secondderiv=[1.0,0.,0.])
stars, rhdxx(0,js),bf2, zro,rhti,cqpw, +1,firstderiv=[1.0,0.,0.],secondderiv=[1.0,0.,0.],cell=cell)
rhti = 0.0
CALL fft2d( & ! d2n/dy2 = FFT(0,-gy^2*vacxy)&
stars, rhdyy(0,js),bf2, zro,rhti,cqpw, 1,+1,firstderiv=[0.,1.0,0.],secondderiv=[0.,1.0,0.])
stars, rhdyy(0,js),bf2, zro,rhti,cqpw, +1,firstderiv=[0.,1.0,0.],secondderiv=[0.,1.0,0.],cell=cell)