Commit 0725c6e9 authored by Daniel Wortmann's avatar Daniel Wortmann

Starting to refactor potential generator, nothing compiles yet...

parent 294af201
...@@ -113,7 +113,7 @@ CONTAINS ...@@ -113,7 +113,7 @@ CONTAINS
ALLOCATE ( kpts%bk(3,kpts%nkpt),kpts%wtkpt(kpts%nkpt) ) ALLOCATE ( kpts%bk(3,kpts%nkpt),kpts%wtkpt(kpts%nkpt) )
ALLOCATE ( stars%pgfft(0:DIMENSION%nn3d-1),stars%pgfft2(0:DIMENSION%nn2d-1) ) ALLOCATE ( stars%pgfft(0:DIMENSION%nn3d-1),stars%pgfft2(0:DIMENSION%nn2d-1) )
ALLOCATE ( stars%ufft(0:27*stars%mx1*stars%mx2*stars%mx3-1) ) ALLOCATE ( stars%ufft(0:27*stars%mx1*stars%mx2*stars%mx3-1) )
ALLOCATE ( atoms%bmu(atoms%ntype),atoms%vr0(atoms%ntype) ) ALLOCATE ( atoms%bmu(atoms%ntype) )
ALLOCATE ( atoms%l_geo(atoms%ntype) ) ALLOCATE ( atoms%l_geo(atoms%ntype) )
ALLOCATE ( atoms%nlo(atoms%ntype),atoms%llo(atoms%nlod,atoms%ntype) ) ALLOCATE ( atoms%nlo(atoms%ntype),atoms%llo(atoms%nlod,atoms%ntype) )
ALLOCATE ( atoms%lo1l(0:atoms%llod,atoms%ntype),atoms%nlol(0:atoms%llod,atoms%ntype),atoms%lapw_l(atoms%ntype) ) ALLOCATE ( atoms%lo1l(0:atoms%llod,atoms%ntype),atoms%nlol(0:atoms%llod,atoms%ntype),atoms%lapw_l(atoms%ntype) )
...@@ -140,7 +140,6 @@ CONTAINS ...@@ -140,7 +140,6 @@ CONTAINS
input%l_coreSpec = .FALSE. input%l_coreSpec = .FALSE.
atoms%vr0(:) = 0.0
results%force(:,:,:) = 0.0 results%force(:,:,:) = 0.0
IF(.NOT.juDFT_was_argument("-toXML")) THEN IF(.NOT.juDFT_was_argument("-toXML")) THEN
......
...@@ -275,8 +275,6 @@ SUBROUTINE postprocessInput(mpi,input,sym,stars,atoms,vacuum,obsolete,kpts,& ...@@ -275,8 +275,6 @@ SUBROUTINE postprocessInput(mpi,input,sym,stars,atoms,vacuum,obsolete,kpts,&
dimension%msh = 0 dimension%msh = 0
ALLOCATE(atoms%rmsh(atoms%jmtd,atoms%ntype)) ALLOCATE(atoms%rmsh(atoms%jmtd,atoms%ntype))
ALLOCATE(atoms%volmts(atoms%ntype)) ALLOCATE(atoms%volmts(atoms%ntype))
ALLOCATE(atoms%vr0(atoms%ntype)) ! This should actually not be in the atoms type!
atoms%vr0(:) = 0.0
na = 0 na = 0
DO iType = 1, atoms%ntype DO iType = 1, atoms%ntype
l_vca = .FALSE. l_vca = .FALSE.
......
...@@ -177,7 +177,7 @@ CONTAINS ...@@ -177,7 +177,7 @@ CONTAINS
WRITE (6,FMT=8045) zintn_r(n) WRITE (6,FMT=8045) zintn_r(n)
WRITE (16,FMT=8045) zintn_r(n) WRITE (16,FMT=8045) zintn_r(n)
CALL intgr3(mt(1,n),atoms%rmsh(1,n),atoms%dx(n),atoms%jri(n),totz) CALL intgr3(mt(1,n),atoms%rmsh(1,n),atoms%dx(n),atoms%jri(n),totz)
vmd(n) = atoms%rmt(n)*atoms%vr0(n)/sfp_const + atoms%zatom(n) - totz*sfp_const vmd(n) = atoms%rmt(n)*vCoul%mt(atoms%jri(n),0,n,1)/sfp_const + atoms%zatom(n) - totz*sfp_const
vmd(n) = -atoms%neq(n)*atoms%zatom(n)*vmd(n)/ (2.*atoms%rmt(n)) vmd(n) = -atoms%neq(n)*atoms%zatom(n)*vmd(n)/ (2.*atoms%rmt(n))
WRITE (6,FMT=8050) n,vmd(n) WRITE (6,FMT=8050) n,vmd(n)
WRITE (16,FMT=8050) n,vmd(n) WRITE (16,FMT=8050) n,vmd(n)
......
This diff is collapsed.
...@@ -9,7 +9,7 @@ MODULE m_types_potden ...@@ -9,7 +9,7 @@ MODULE m_types_potden
TYPE t_potden TYPE t_potden
INTEGER :: iter INTEGER :: iter
INTEGER :: potdenType INTEGER :: potdenType
COMPLEX,ALLOCATABLE :: pw(:,:) COMPLEX,ALLOCATABLE :: pw(:,:),pw_w(:,:)
REAL,ALLOCATABLE :: mt(:,:,:,:) REAL,ALLOCATABLE :: mt(:,:,:,:)
REAL,ALLOCATABLE :: vacz(:,:,:) REAL,ALLOCATABLE :: vacz(:,:,:)
COMPLEX,ALLOCATABLE :: vacxy(:,:,:,:) COMPLEX,ALLOCATABLE :: vacxy(:,:,:,:)
...@@ -33,9 +33,24 @@ MODULE m_types_potden ...@@ -33,9 +33,24 @@ MODULE m_types_potden
PROCEDURE :: init_potden_simple PROCEDURE :: init_potden_simple
PROCEDURE :: resetpotden PROCEDURE :: resetpotden
GENERIC :: init=>init_potden_types,init_potden_simple GENERIC :: init=>init_potden_types,init_potden_simple
PROCEDURE :: copy_both_spin
END TYPE t_potden END TYPE t_potden
CONTAINS CONTAINS
SUBROUTINE copy_both_spin(this,that)
IMPLICIT NONE
CLASS(t_potden),INTENT(IN) :: this
TYPE(t_potden),INTENT(INOUT) :: that
IF (SIZE(that%mt,4)==2) THEN
that%mt(:,0:,:,2)=this%mt(:,0:,:,1)
that%pw(:,2)=this%pw(:,1)
that%vacz(:,:,2)=this%vacz(:,:,1)
that%vacxy(:,:,:,2)=this%vacxy(:,:,:,1)
IF (ALLOCATED(that%pw_w).AND.ALLOCATED(this%pw_w)) that%pw_w(:,2)=this%pw_w(:,1)
END IF
END SUBROUTINE copy_both_spin
SUBROUTINE init_potden_types(pd,stars,atoms,sphhar,vacuum,noco,oneD,jspins,nocoExtraDim,potden_type) SUBROUTINE init_potden_types(pd,stars,atoms,sphhar,vacuum,noco,oneD,jspins,nocoExtraDim,potden_type)
USE m_judft USE m_judft
USE m_types_setup USE m_types_setup
......
...@@ -180,7 +180,6 @@ MODULE m_types_setup ...@@ -180,7 +180,6 @@ MODULE m_types_setup
TYPE(t_utype),ALLOCATABLE::lda_u(:) TYPE(t_utype),ALLOCATABLE::lda_u(:)
INTEGER,ALLOCATABLE :: relax(:,:) !<(3,ntype) INTEGER,ALLOCATABLE :: relax(:,:) !<(3,ntype)
INTEGER, ALLOCATABLE :: nflip(:) !<flip magnetisation of this atom INTEGER, ALLOCATABLE :: nflip(:) !<flip magnetisation of this atom
REAL,ALLOCATABLE:: vr0(:) !< Average Coulomb potential for atoms
END TYPE t_atoms END TYPE t_atoms
TYPE t_cell TYPE t_cell
......
...@@ -25,6 +25,7 @@ vgen/mpmom.F90 ...@@ -25,6 +25,7 @@ vgen/mpmom.F90
vgen/od_vvac.f90 vgen/od_vvac.f90
vgen/od_vvacis.f90 vgen/od_vvacis.f90
vgen/pot_mod.f90 vgen/pot_mod.f90
vgen/vgen_coulomb.F90
vgen/prp_xcfft_map.f90 vgen/prp_xcfft_map.f90
vgen/psqpw.F90 vgen/psqpw.F90
vgen/rhodirgen.f90 vgen/rhodirgen.f90
......
...@@ -4,21 +4,16 @@ MODULE m_intnv ...@@ -4,21 +4,16 @@ MODULE m_intnv
! and potential in the unit cell ! and potential in the unit cell
! ************************************************ ! ************************************************
CONTAINS CONTAINS
SUBROUTINE int_nv(& SUBROUTINE int_nv(ispin,stars,vacuum,atoms,sphhar,&
& stars,vacuum,atoms,sphhar,& cell,sym,input,oneD,vpot,den,RESULT)
& cell,sym,input,oneD,&
& qpw,vpw_w,&
& rhtxy,vxy,&
& rht,vz,&
& rho,vr,&
& RESULT)
USE m_intgr, ONLY : intgr3,intgz0 USE m_intgr, ONLY : intgr3,intgz0
USE m_types USE m_types
IMPLICIT NONE IMPLICIT NONE
! .. ! ..
! .. Scalar Arguments .. ! .. Scalar Arguments ..
REAL RESULT REAL RESULT
INTEGER,INTENT(IN) :: ispin
TYPE(t_stars),INTENT(IN) :: stars TYPE(t_stars),INTENT(IN) :: stars
TYPE(t_vacuum),INTENT(IN) :: vacuum TYPE(t_vacuum),INTENT(IN) :: vacuum
TYPE(t_atoms),INTENT(IN) :: atoms TYPE(t_atoms),INTENT(IN) :: atoms
...@@ -27,14 +22,9 @@ CONTAINS ...@@ -27,14 +22,9 @@ CONTAINS
TYPE(t_sym),INTENT(IN) :: sym TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_input),INTENT(IN) :: input TYPE(t_input),INTENT(IN) :: input
TYPE(t_oneD),INTENT(IN) :: oneD TYPE(t_oneD),INTENT(IN) :: oneD
TYPE(t_potden),INTENT(IN) :: vpot,den
! ..
! .. Array Arguments ..
COMPLEX qpw(stars%ng3),rhtxy(vacuum%nmzxyd,oneD%odi%n2d-1,2),&
& vpw_w(stars%ng3),vxy(vacuum%nmzxyd,oneD%odi%n2d-1,2)
REAL rho(atoms%jmtd,0:sphhar%nlhd,atoms%ntype),rht(vacuum%nmzd,2),&
& vr(atoms%jmtd,0:sphhar%nlhd,atoms%ntype),vz(vacuum%nmzd,2)
! .. ! ..
! .. Local Scalars .. ! .. Local Scalars ..
REAL dpdot,facv,tis,tmt,tvac,tvact REAL dpdot,facv,tis,tmt,tvac,tvact
...@@ -51,7 +41,7 @@ CONTAINS ...@@ -51,7 +41,7 @@ CONTAINS
! !
! -> warping has been moved to vgen and visxc resp. ...gustav ! -> warping has been moved to vgen and visxc resp. ...gustav
! !
tis = cell%omtil * REAL( DOT_PRODUCT(vpw_w,qpw)) tis = cell%omtil * REAL( DOT_PRODUCT(vpot%pw_w(:,ispin),den%pw(:,ispin)))
WRITE (6,FMT=8020) tis WRITE (6,FMT=8020) tis
WRITE (16,FMT=8020) tis WRITE (16,FMT=8020) tis
...@@ -66,7 +56,7 @@ CONTAINS ...@@ -66,7 +56,7 @@ CONTAINS
DO n = 1,atoms%ntype DO n = 1,atoms%ntype
DO lh = 0,sphhar%nlh(atoms%ntypsy(nat)) DO lh = 0,sphhar%nlh(atoms%ntypsy(nat))
DO j = 1,atoms%jri(n) DO j = 1,atoms%jri(n)
dpj(j) = rho(j,lh,n)*vr(j,lh,n) dpj(j) = den%mt(j,lh,n,ispin)*vpot%mt(j,lh,n,ispin)
ENDDO ENDDO
CALL intgr3(dpj,atoms%rmsh(1,n),atoms%dx(n),atoms%jri(n),dpdot) CALL intgr3(dpj,atoms%rmsh(1,n),atoms%dx(n),atoms%jri(n),dpdot)
tmt = tmt + dpdot*atoms%neq(n) tmt = tmt + dpdot*atoms%neq(n)
...@@ -94,14 +84,14 @@ CONTAINS ...@@ -94,14 +84,14 @@ CONTAINS
dpz=0.0 dpz=0.0
DO ivac = 1,vacuum%nvac DO ivac = 1,vacuum%nvac
DO ip = 1,vacuum%nmz DO ip = 1,vacuum%nmz
dpz(npz-ip) = rht(ip,ivac)*vz(ip,ivac) dpz(npz-ip) = den%vacz(ip,ivac,ispin)*vpot%vacz(ip,ivac,ispin)
! ---> WARPING REGION ! ---> WARPING REGION
ENDDO ENDDO
DO k2 = 2,stars%ng2 DO k2 = 2,stars%ng2
DO ip = 1,vacuum%nmzxy DO ip = 1,vacuum%nmzxy
dpz(npz-ip) = dpz(npz-ip) +& dpz(npz-ip) = dpz(npz-ip) +&
& stars%nstr2(k2)*rhtxy(ip,k2-1,ivac)*& & stars%nstr2(k2)*den%vacxy(ip,k2-1,ivac,ispin)*&
& CONJG(vxy(ip,k2-1,ivac)) & CONJG(vpot%vacxy(ip,k2-1,ivac,ispin))
ENDDO ENDDO
ENDDO ENDDO
CALL intgz0(dpz,vacuum%delz,vacuum%nmz,tvac,tail) CALL intgz0(dpz,vacuum%delz,vacuum%nmz,tvac,tail)
...@@ -121,15 +111,15 @@ CONTAINS ...@@ -121,15 +111,15 @@ CONTAINS
dpz=0.0 dpz=0.0
DO ip = 1,vacuum%nmz DO ip = 1,vacuum%nmz
dpz(npz-ip) = (cell%z1+vacuum%delz*(ip-1))*& dpz(npz-ip) = (cell%z1+vacuum%delz*(ip-1))*&
& rht(ip,vacuum%nvac)*vz(ip,vacuum%nvac) & den%vacz(ip,vacuum%nvac,ispin)*vpot%vacz(ip,vacuum%nvac,ispin)
! ---> WARPING REGION ! ---> WARPING REGION
ENDDO ENDDO
DO k2 = 2,oneD%odi%nq2 DO k2 = 2,oneD%odi%nq2
DO ip = 1,vacuum%nmzxy DO ip = 1,vacuum%nmzxy
dpz(npz-ip) = dpz(npz-ip)+& dpz(npz-ip) = dpz(npz-ip)+&
& (cell%z1+vacuum%delz*(ip-1))*& & (cell%z1+vacuum%delz*(ip-1))*&
& rhtxy(ip,k2-1,vacuum%nvac)*& & den%vacxy(ip,k2-1,vacuum%nvac,ispin)*&
& CONJG(vxy(ip,k2-1,vacuum%nvac)) & CONJG(vpot%vacxy(ip,k2-1,vacuum%nvac,ispin))
ENDDO ENDDO
ENDDO ENDDO
......
...@@ -28,8 +28,8 @@ CONTAINS ...@@ -28,8 +28,8 @@ CONTAINS
! !
! !
! .. Array Arguments .. ! .. Array Arguments ..
REAL, INTENT (IN) :: rho(:,0:,:,:) !(atoms%jmtd,0:sphhar%nlhd,atoms%ntype,dimension%jspd) REAL, INTENT (IN) :: rho(:,0:,:) !(atoms%jmtd,0:sphhar%nlhd,atoms%ntype)
COMPLEX, INTENT (IN) :: qpw(:,:) !(stars%ng3,dimension%jspd) COMPLEX, INTENT (IN) :: qpw(:) !(stars%ng3)
COMPLEX, INTENT (OUT):: qlm(-atoms%lmaxd:atoms%lmaxd,0:atoms%lmaxd,atoms%ntype) COMPLEX, INTENT (OUT):: qlm(-atoms%lmaxd:atoms%lmaxd,0:atoms%lmaxd,atoms%ntype)
!-odim !-odim
!+odim !+odim
...@@ -50,12 +50,12 @@ CONTAINS ...@@ -50,12 +50,12 @@ CONTAINS
! !
IF (mpi%irank == 0) THEN IF (mpi%irank == 0) THEN
CALL mt_moments(atoms,sphhar,& CALL mt_moments(atoms,sphhar,&
& rho(:,:,:,1),qlmo) & rho(:,:,:),qlmo)
ENDIF ! mpi%irank == 0 ENDIF ! mpi%irank == 0
CALL pw_moments(mpi,stars,atoms,cell,& CALL pw_moments(mpi,stars,atoms,cell,&
& sym,oneD,& & sym,oneD,&
& qpw(:,1),qlmp) & qpw(:),qlmp)
! !
! eq.(15): \tilde q_(lm}^i = q_{lm}^i - q_{lm}^{Ii} ! eq.(15): \tilde q_(lm}^i = q_{lm}^i - q_{lm}^{Ii}
! !
......
...@@ -29,8 +29,8 @@ CONTAINS ...@@ -29,8 +29,8 @@ CONTAINS
COMPLEX, INTENT (IN) :: psq(stars%ng3) COMPLEX, INTENT (IN) :: psq(stars%ng3)
REAL, INTENT (IN) :: rht(:,:,:) !(vacuum%nmzd,2,dimension%jspd) REAL, INTENT (IN) :: rht(:,:) !(vacuum%nmzd,2)
REAL, INTENT (OUT) :: vz(:,:,:) !(vacuum%nmzd,2,dimension%jspd) REAL, INTENT (OUT) :: vz(:,:) !(vacuum%nmzd,2)
COMPLEX rhobar COMPLEX rhobar
INTEGER k1,k2,irec3,irec2,i,j,ivac,imz,imz1 INTEGER k1,k2,irec3,irec2,i,j,ivac,imz,imz1
...@@ -46,7 +46,7 @@ CONTAINS ...@@ -46,7 +46,7 @@ CONTAINS
f2(i) = 0. f2(i) = 0.
f22(i) = 0. f22(i) = 0.
DO ivac = 1,vacuum%nvac DO ivac = 1,vacuum%nvac
vz(i,ivac,1) = 0. vz(i,ivac) = 0.
END DO END DO
END DO END DO
...@@ -71,7 +71,7 @@ CONTAINS ...@@ -71,7 +71,7 @@ CONTAINS
!----> 1st equivalent way !----> 1st equivalent way
DO i=1,vacuum%nmz DO i=1,vacuum%nmz
rht1(i) = fpi_const*(cell%z1+(i-1)*vacuum%delz)*rht(i,1,1) rht1(i) = fpi_const*(cell%z1+(i-1)*vacuum%delz)*rht(i,1)
ENDDO ENDDO
CALL qsf(vacuum%delz,rht1(1),f2(1),vacuum%nmz,1) CALL qsf(vacuum%delz,rht1(1),f2(1),vacuum%nmz,1)
...@@ -89,7 +89,7 @@ CONTAINS ...@@ -89,7 +89,7 @@ CONTAINS
ENDDO ENDDO
CALL qsf(vacuum%delz,f22(1),a,vacuum%nmz,0) CALL qsf(vacuum%delz,f22(1),a,vacuum%nmz,0)
DO ivac =1,vacuum%nvac DO ivac =1,vacuum%nvac
vz(i,ivac,1) = -a(1) vz(i,ivac) = -a(1)
ENDDO ENDDO
ENDDO ENDDO
!----> 2nd equivalent way (via the Green function) !----> 2nd equivalent way (via the Green function)
...@@ -99,14 +99,14 @@ CONTAINS ...@@ -99,14 +99,14 @@ CONTAINS
DO imz1 = 1,vacuum%nmz DO imz1 = 1,vacuum%nmz
zp = cell%z1 + (imz1-1)*vacuum%delz zp = cell%z1 + (imz1-1)*vacuum%delz
IF (imz1.LE.imz) THEN IF (imz1.LE.imz) THEN
rht1(imz1) = fpi_const*LOG(z)*zp*rht(imz1,1,1) rht1(imz1) = fpi_const*LOG(z)*zp*rht(imz1,1)
ELSE ELSE
rht1(imz1) = fpi_const*LOG(zp)*zp*rht(imz1,1,1) rht1(imz1) = fpi_const*LOG(zp)*zp*rht(imz1,1)
END IF END IF
END DO END DO
CALL qsf(vacuum%delz,rht1,a,vacuum%nmz,0) CALL qsf(vacuum%delz,rht1,a,vacuum%nmz,0)
vz(imz,1,1) = tpi_const*LOG(z)*(cell%z1*cell%z1)*rhobar - a(1) vz(imz,1) = tpi_const*LOG(z)*(cell%z1*cell%z1)*rhobar - a(1)
END DO END DO
RETURN RETURN
......
...@@ -63,11 +63,11 @@ CONTAINS ...@@ -63,11 +63,11 @@ CONTAINS
INTEGER, INTENT (IN) :: nstr2_1(n2d_1) INTEGER, INTENT (IN) :: nstr2_1(n2d_1)
INTEGER, INTENT (IN) :: kv2_1(2,n2d_1) INTEGER, INTENT (IN) :: kv2_1(2,n2d_1)
COMPLEX, INTENT (INOUT) :: psq(stars%ng3) COMPLEX, INTENT (INOUT) :: psq(stars%ng3)
REAL, INTENT (IN) :: vz(vacuum%nmzd,2,DIMENSION%jspd) REAL, INTENT (IN) :: vz(vacuum%nmzd,2)
REAL, INTENT (IN) :: rht(vacuum%nmzd,2,DIMENSION%jspd) REAL, INTENT (IN) :: rht(vacuum%nmzd,2)
COMPLEX, INTENT (IN) :: rhtxy(vacuum%nmzxyd,n2d_1-1,2,DIMENSION%jspd) COMPLEX, INTENT (IN) :: rhtxy(vacuum%nmzxyd,n2d_1-1,2)
COMPLEX, INTENT (OUT):: vxy(vacuum%nmzxyd,n2d_1-1,2,DIMENSION%jspd) COMPLEX, INTENT (OUT):: vxy(vacuum%nmzxyd,n2d_1-1,2)
COMPLEX, INTENT (OUT):: vpw(stars%ng3,DIMENSION%jspd) COMPLEX, INTENT (OUT):: vpw(stars%ng3)
! local ! local
INTEGER :: m INTEGER :: m
...@@ -174,19 +174,19 @@ CONTAINS ...@@ -174,19 +174,19 @@ CONTAINS
!----> vpw in the '1st aproximation' (V - tilde) !----> vpw in the '1st aproximation' (V - tilde)
vpw(1,1) = CMPLX(0.,0.) vpw(1) = CMPLX(0.,0.)
DO irec3 = 2,stars%ng3 DO irec3 = 2,stars%ng3
g = stars%sk3(irec3) g = stars%sk3(irec3)
vpw(irec3,1) = fpi_const*psq(irec3)/(g*g) vpw(irec3) = fpi_const*psq(irec3)/(g*g)
ENDDO ENDDO
DO irc1 = 2,nq2_1 DO irc1 = 2,nq2_1
DO i = 1,vacuum%nmzxy DO i = 1,vacuum%nmzxy
vxy(i,irc1-1,1,1) = CMPLX(0.,0.) vxy(i,irc1-1,1) = CMPLX(0.,0.)
END DO END DO
END DO END DO
...@@ -219,7 +219,7 @@ CONTAINS ...@@ -219,7 +219,7 @@ CONTAINS
irec3 = stars%ig(stars%kv2(1,irec2),stars%kv2(2,irec2),k3) irec3 = stars%ig(stars%kv2(1,irec2),stars%kv2(2,irec2),k3)
IF (irec3.NE.0) THEN IF (irec3.NE.0) THEN
val(irc1) = val(irc1) +& val(irc1) = val(irc1) +&
& (ic**m)*vpw(irec3,1)*EXP(-ic*& & (ic**m)*vpw(irec3)*EXP(-ic*&
& m*phi)*fJJ(iabs(m),irec2)*& & m*phi)*fJJ(iabs(m),irec2)*&
& stars%nstr2(irec2)*mult & stars%nstr2(irec2)*mult
END IF END IF
...@@ -268,7 +268,7 @@ CONTAINS ...@@ -268,7 +268,7 @@ CONTAINS
irec3 = stars%ig(stars%kv2(1,irec2),stars%kv2(2,irec2),gzi) irec3 = stars%ig(stars%kv2(1,irec2),stars%kv2(2,irec2),gzi)
IF (irec3.NE.0) THEN IF (irec3.NE.0) THEN
val_m(gzi,m) = val_m(gzi,m) +& val_m(gzi,m) = val_m(gzi,m) +&
& (ic**m)*vpw(irec3,1)*EXP(-ic*& & (ic**m)*vpw(irec3)*EXP(-ic*&
& m*phi)*fJJ(iabs(m),irec2)*& & m*phi)*fJJ(iabs(m),irec2)*&
& stars%nstr2(irec2)*mult & stars%nstr2(irec2)*mult
END IF END IF
...@@ -290,12 +290,12 @@ CONTAINS ...@@ -290,12 +290,12 @@ CONTAINS
im = zf im = zf
q = zf - im q = zf - im
vis(ix,iy,1) = 0.5*(q-1.)*& vis(ix,iy,1) = 0.5*(q-1.)*&
& (q-2.)*vz(im,1,1) -& & (q-2.)*vz(im,1) -&
& q*(q-2.)*vz(im+1,1,1) +& & q*(q-2.)*vz(im+1,1) +&
& 0.5*q*(q-1.)*vz(im+2,1,1) & 0.5*q*(q-1.)*vz(im+2,1)
ELSE ELSE
vis(ix,iy,1) = & vis(ix,iy,1) = &
& vz(1,1,1) - val(1) + tpi_const*& & vz(1,1) - val(1) + tpi_const*&
& psq(1)*(cell%z1*cell%z1 - r*r)/2. & psq(1)*(cell%z1*cell%z1 - r*r)/2.
END IF END IF
DO irc1 = 2,nq2_1 DO irc1 = 2,nq2_1
...@@ -398,7 +398,7 @@ CONTAINS ...@@ -398,7 +398,7 @@ CONTAINS
!----- this form of the density is just more easy to use !----- this form of the density is just more easy to use
DO imz = 1,vacuum%nmzxy DO imz = 1,vacuum%nmzxy
rxy(imz) = rhtxy(imz,irec1(l)-1,1,1) rxy(imz) = rhtxy(imz,irec1(l)-1,1)
END DO END DO
!----- vacuum potential caused by the vacuum density !----- vacuum potential caused by the vacuum density
...@@ -435,7 +435,7 @@ CONTAINS ...@@ -435,7 +435,7 @@ CONTAINS
pint(:vacuum%nmzxy) = fact(:vacuum%nmzxy)*aa pint(:vacuum%nmzxy) = fact(:vacuum%nmzxy)*aa
vxy(:vacuum%nmzxy,irec1(l)-1,1,1) = pvac(:vacuum%nmzxy) + pint(:vacuum%nmzxy) vxy(:vacuum%nmzxy,irec1(l)-1,1) = pvac(:vacuum%nmzxy) + pint(:vacuum%nmzxy)
!----- array val further is a boundary values of the !----- array val further is a boundary values of the
!----- potential V- \tilde \tilde which is created to compensate !----- potential V- \tilde \tilde which is created to compensate
...@@ -444,7 +444,7 @@ CONTAINS ...@@ -444,7 +444,7 @@ CONTAINS
!----- density, V - \tilde and V - \tilde\tilde are then added in !----- density, V - \tilde and V - \tilde\tilde are then added in
!----- order to obtain the real interstitial potential !----- order to obtain the real interstitial potential
val_help = vxy(1,irec1(l)-1,1,1) - val(irec1(l)) val_help = vxy(1,irec1(l)-1,1) - val(irec1(l))
!----- potential \tilde\tilde{V} is a solution of the Laplase equation !----- potential \tilde\tilde{V} is a solution of the Laplase equation
!----- in the interstitial with the boundary conditions val_0 and val_z !----- in the interstitial with the boundary conditions val_0 and val_z
...@@ -471,7 +471,7 @@ CONTAINS ...@@ -471,7 +471,7 @@ CONTAINS
!-------------------------------------------------------------> !------------------------------------------------------------->
DO imz = 1,vacuum%nmzxy DO imz = 1,vacuum%nmzxy
rxy(imz) = rhtxy(imz,irec1(l)-1,1,1) rxy(imz) = rhtxy(imz,irec1(l)-1,1)
END DO END DO
!----- vacuum potential caused by the vacuum density !----- vacuum potential caused by the vacuum density
...@@ -510,10 +510,10 @@ CONTAINS ...@@ -510,10 +510,10 @@ CONTAINS
DO imz = 1,vacuum%nmzxy DO imz = 1,vacuum%nmzxy
pint(imz) = fpi_const*a*KK(imz) pint(imz) = fpi_const*a*KK(imz)
vxy(imz,irec1(l)-1,1,1) = pint(imz) + pvac(imz) vxy(imz,irec1(l)-1,1) = pint(imz) + pvac(imz)
END DO END DO
val_help = vxy(1,irec1(l)-1,1,1) - val(irec1(l)) val_help = vxy(1,irec1(l)-1,1) - val(irec1(l))
CALL visp5_z(& CALL visp5_z(&
& vacuum%nmzxyd,vacuum%nmzxyd,vacuum%delz,m,ivfft1,ivfft2,IIIR,& & vacuum%nmzxyd,vacuum%nmzxyd,vacuum%delz,m,ivfft1,ivfft2,IIIR,&
...@@ -571,10 +571,10 @@ CONTAINS ...@@ -571,10 +571,10 @@ CONTAINS
irec3 = stars%ig(stars%kv2(1,irec2),stars%kv2(2,irec2),k3) irec3 = stars%ig(stars%kv2(1,irec2),stars%kv2(2,irec2),k3)
IF (irec3.NE.0) THEN IF (irec3.NE.0) THEN
IF (irec2.EQ.1) THEN IF (irec2.EQ.1) THEN
fxy0 = REAL(vpw(irec3,1)) fxy0 = REAL(vpw(irec3))
rhti = AIMAG(vpw(irec3,1)) rhti = AIMAG(vpw(irec3))
ELSE ELSE
fxy(irec2-1) = vpw(irec3,1) fxy(irec2-1) = vpw(irec3)
END IF END IF
END IF END IF
END DO END DO
...@@ -668,15 +668,15 @@ CONTAINS ...@@ -668,15 +668,15 @@ CONTAINS
END DO ! gz -> Vpw(.,.,gz) END DO ! gz -> Vpw(.,.,gz)
DO irec3 = 1,stars%ng3 DO irec3 = 1,stars%ng3
vpw(irec3,1) = vpw_help(irec3) vpw(irec3) = vpw_help(irec3)
!$$$ vpw(irec3,1) = vpw(irec3,1) + vpw_help(irec3) !$$$ vpw(irec3,1) = vpw(irec3,1) + vpw_help(irec3)
END DO END DO
DO irc1 = 2,nq2_1 DO irc1 = 2,nq2_1
DO imz = 1,vacuum%nmzxy DO imz = 1,vacuum%nmzxy
IF (ABS(vxy(imz,irc1-1,1,1)).LE.tol_21)& IF (ABS(vxy(imz,irc1-1,1)).LE.tol_21)&
& vxy(imz,irc1-1,1,1) = CMPLX(0.,0.) & vxy(imz,irc1-1,1) = CMPLX(0.,0.)
END DO END DO
END DO END DO
......
...@@ -43,9 +43,9 @@ CONTAINS ...@@ -43,9 +43,9 @@ CONTAINS
LOGICAL, INTENT (IN) :: l_xyav LOGICAL, INTENT (IN) :: l_xyav
! .. ! ..
! .. Array Arguments .. ! .. Array Arguments ..
COMPLEX, INTENT (IN) :: qpw(stars%ng3,DIMENSION%jspd) COMPLEX, INTENT (IN) :: qpw(stars%ng3)
REAL, INTENT (IN) :: rho(atoms%jmtd,0:sphhar%nlhd,atoms%ntype,DIMENSION%jspd) REAL, INTENT (IN) :: rho(atoms%jmtd,0:sphhar%nlhd,atoms%ntype)
REAL, INTENT (IN) :: rht(vacuum%nmzd,2,DIMENSION%jspd) REAL, INTENT (IN) :: rht(vacuum%nmzd,2)
COMPLEX, INTENT (OUT):: psq(stars%ng3) COMPLEX, INTENT (OUT):: psq(stars%ng3)
!-odim !-odim