scnc
/
quantum-espresso
mirror of https://gitlab.com/QEF/q-e.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

More CP-PW merge of variables: ei[123] (CP) replaced by eigts[123] PW. 

The latter are in module reciprocal_vectors. Old unused vdw code removed.


git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@7347 c92efa57-630b-4861-b058-cf58834340f0
This commit is contained in:
giannozz 2010-12-23 17:35:05 +00:00
parent bce1b0901b
commit e03f9c39e5
13 changed files with 47 additions and 505 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
CPV/Makefile
View File

@ -72,7 +72,6 @@ runcp.o \
spline.o \
stop_run.o \
stress.o \
vanderwaals.o \
vol_clu.o \
wannier_base.o \
wannier.o \

17
CPV/cpr.f90
View File

@ -43,7 +43,7 @@ SUBROUTINE cprmain( tau_out, fion_out, etot_out )
USE gvecs, ONLY : ngms
USE gvecb, ONLY : ngb
USE gvecw, ONLY : ngw
USE reciprocal_vectors, ONLY : gstart, mill
USE reciprocal_vectors, ONLY : gstart, mill, eigts1, eigts2, eigts3
USE ions_base, ONLY : na, nat, pmass, nax, nsp, rcmax
USE ions_base, ONLY : ind_srt, ions_cofmass, ions_kinene, &
ions_temp, ions_thermal_stress, if_pos, extfor
@ -104,9 +104,9 @@ SUBROUTINE cprmain( tau_out, fion_out, etot_out )
USE time_step, ONLY : delt, tps, dt2, twodelt
USE cp_interfaces, ONLY : cp_print_rho, nlfh, print_lambda
USE cp_main_variables, ONLY : acc, bec, lambda, lambdam, lambdap, &
ema0bg, sfac, eigr, ei1, ei2, ei3, &
ema0bg, sfac, eigr, iprint_stdout, &
irb, becdr, taub, eigrb, rhog, rhos, &
rhor, bephi, becp_dist, nfi, descla, iprint_stdout, &
rhor, bephi, becp_dist, nfi, descla, &
drhor, drhog, nlax
USE autopilot, ONLY : event_step, event_index, &
max_event_step, restart_p
@ -267,11 +267,11 @@ SUBROUTINE cprmain( tau_out, fion_out, etot_out )
!
IF ( tfor .OR. thdyn ) THEN
!
CALL phfacs( ei1, ei2, ei3, eigr, mill, taus, nr1, nr2, nr3, nat )
CALL phfacs( eigts1,eigts2,eigts3, eigr, mill, taus, nr1,nr2,nr3, nat )
!
! ... strucf calculates the structure factor sfac
!
CALL strucf( sfac, ei1, ei2, ei3, mill, ngms )
CALL strucf( sfac, eigts1, eigts2, eigts3, mill, ngms )
!
END IF
!
@ -493,8 +493,7 @@ SUBROUTINE cprmain( tau_out, fion_out, etot_out )
!
! ... phfac calculates eigr
!
CALL phfacs( ei1, ei2, ei3, eigr, mill, tausp, nr1, nr2, nr3, nat )
!
CALL phfacs( eigts1,eigts2,eigts3, eigr, mill, tausp, nr1,nr2,nr3, nat )
! ... prefor calculates vkb
!
CALL prefor( eigr, vkb )
@ -756,8 +755,8 @@ SUBROUTINE cprmain( tau_out, fion_out, etot_out )
CALL phbox( taub, eigrb, ainvb )
END IF
CALL r_to_s( tau0, taus, na, nsp, ainv )
CALL phfacs( ei1, ei2, ei3, eigr, mill, taus, nr1, nr2, nr3, nat )
CALL strucf( sfac, ei1, ei2, ei3, mill, ngms )
CALL phfacs( eigts1,eigts2,eigts3, eigr, mill, taus, nr1,nr2,nr3, nat )
CALL strucf( sfac, eigts1, eigts2, eigts3, mill, ngms )
!
IF ( thdyn ) CALL formf( tfirst, eself )
IF ( tefield ) CALL efield_update( eigr )

11
CPV/fromscra.f90
View File

@ -35,7 +35,7 @@ SUBROUTINE from_scratch( )
USE gvecw, ONLY : ngw
USE gvecs, ONLY : ngms
USE gvecp, ONLY : ngm
USE reciprocal_vectors, ONLY : gstart, mill
USE reciprocal_vectors, ONLY : gstart, mill, eigts1, eigts2, eigts3
USE cvan, ONLY : nvb
USE cp_electronic_mass, ONLY : emass
USE efield_module, ONLY : tefield, efield_berry_setup, berry_energy, &
@ -55,7 +55,7 @@ SUBROUTINE from_scratch( )
USE grid_dimensions, ONLY : nr1, nr2, nr3
USE time_step, ONLY : delt
USE cp_main_variables, ONLY : setval_lambda, descla, bephi, becp_dist, becdr, nfi, &
sfac, eigr, ei1, ei2, ei3, bec, taub, irb, eigrb, &
sfac, eigr, bec, taub, irb, eigrb, &
lambda, lambdam, lambdap, ema0bg, rhog, rhor, rhos, &
vpot, ht0, edft, nlax
USE mp_global, ONLY : np_ortho, me_ortho, ortho_comm
@ -109,9 +109,10 @@ SUBROUTINE from_scratch( )
!
END IF
!
CALL phfacs( ei1, ei2, ei3, eigr, mill, atoms0%taus, nr1, nr2, nr3, atoms0%nat )
CALL phfacs( eigts1, eigts2, eigts3, eigr, mill, atoms0%taus, &
nr1, nr2, nr3, atoms0%nat )
!
CALL strucf( sfac, ei1, ei2, ei3, mill, ngms )
CALL strucf( sfac, eigts1, eigts2, eigts3, mill, ngms )
!
IF ( okvan .OR. nlcc_any ) THEN
CALL initbox ( tau0, taub, irb, ainv, a1, a2, a3 )
@ -194,7 +195,7 @@ SUBROUTINE from_scratch( )
vpot = rhor
!
CALL vofrho( nfi, vpot, rhog, rhos, rhoc, tfirst, tlast, &
& ei1, ei2, ei3, irb, eigrb, sfac, tau0, fion )
& eigts1, eigts2, eigts3, irb, eigrb, sfac, tau0, fion )
IF( tefield ) THEN
CALL berry_energy( enb, enbi, bec, cm(:,:), fion )

13
CPV/init.f90
View File

@ -30,8 +30,9 @@
use smallbox_grid_dimensions, only: nr1b, nr2b, nr3b, nr1bx, nr2bx, nr3bx
use smooth_grid_dimensions, only: nr1s, nr2s, nr3s, nr1sx, nr2sx, nr3sx, nrxxs
USE grid_subroutines, ONLY: realspace_grids_init, realspace_grids_para
USE reciprocal_vectors, ONLY: mill_g, g2_g
USE reciprocal_vectors, ONLY: mill_g, g2_g, eigts1,eigts2,eigts3
USE recvecs_subroutines, ONLY: recvecs_init
use ions_base, only: nat
use gvecw, only: gcutw, gkcut
use gvecp, only: ecutrho, gcutm
use gvecs, only: gcutms
@ -140,30 +141,32 @@ end if
!
CALL recvecs_init( ngm_ , ngw_ , ngs_ )
!
!
! ... Initialize (local) real space dimensions
!
CALL realspace_grids_para( dfftp, dffts )
!
!
! ... generate g-space
!
call ggencp( b1, b2, b3, nr1, nr2, nr3, nr1s, nr2s, nr3s, gcutm, &
gcutms, gkcut, gamma_only )
!
! Allocate index required to compute polarizability
!
IF( tdipole ) THEN
CALL berry_setup( ngw_ , mill_g )
END IF
!
! global arrays are no more needed
!
if( allocated( g2_g ) ) deallocate( g2_g )
if( allocated( mill_g ) ) deallocate( mill_g )
!
! allocate spaces for phases e^{-iG*tau_s}
!
allocate( eigts1(-nr1:nr1,nat) )
allocate( eigts2(-nr2:nr2,nat) )
allocate( eigts3(-nr3:nr3,nat) )
!
! generation of little box g-vectors
!
IF ( nr1b > 0 .AND. nr2b > 0 .AND. nr3b > 0 ) THEN

2
CPV/init_run.f90
View File

@ -44,7 +44,7 @@ SUBROUTINE init_run()
USE cell_base, ONLY : h, hold, hnew, velh, tpiba2, ibrav, &
alat, celldm, a1, a2, a3, b1, b2, b3
USE cp_main_variables, ONLY : lambda, lambdam, lambdap, ema0bg, bec, &
sfac, eigr, ei1, ei2, ei3, taub, &
sfac, eigr, taub, &
irb, eigrb, rhog, rhos, rhor, &
acc, acc_this_run, wfill, &
edft, nfi, vpot, ht0, htm, iprint_stdout

9
CPV/mainvar.f90
View File

@ -28,9 +28,6 @@ MODULE cp_main_variables
! ... R_I = ionic positions
!
COMPLEX(DP), ALLOCATABLE :: eigr(:,:) ! exp (i G dot R_I)
COMPLEX(DP), ALLOCATABLE :: ei1(:,:) ! exp (i G_x dot x_I)
COMPLEX(DP), ALLOCATABLE :: ei2(:,:) ! exp (i G_y dot y_I)
COMPLEX(DP), ALLOCATABLE :: ei3(:,:) ! exp (i G_z dot z_I)
!
! ... structure factors (summed over atoms of the same kind)
!
@ -137,9 +134,6 @@ MODULE cp_main_variables
!
ALLOCATE( eigr( ngw, nat ) )
ALLOCATE( sfac( ngs, nsp ) )
ALLOCATE( ei1( -nr1:nr1, nat ) )
ALLOCATE( ei2( -nr2:nr2, nat ) )
ALLOCATE( ei3( -nr3:nr3, nat ) )
ALLOCATE( eigrb( ngb, nat ) )
ALLOCATE( irb( 3, nat ) )
!
@ -231,9 +225,6 @@ MODULE cp_main_variables
SUBROUTINE deallocate_mainvar()
!------------------------------------------------------------------------
!
IF( ALLOCATED( ei1 ) ) DEALLOCATE( ei1 )
IF( ALLOCATED( ei2 ) ) DEALLOCATE( ei2 )
IF( ALLOCATED( ei3 ) ) DEALLOCATE( ei3 )
IF( ALLOCATED( eigr ) ) DEALLOCATE( eigr )
IF( ALLOCATED( sfac ) ) DEALLOCATE( sfac )
IF( ALLOCATED( eigrb ) ) DEALLOCATE( eigrb )

4
CPV/make.depend
View File

@ -863,10 +863,6 @@ stress.o : ../Modules/mp_global.o
stress.o : ../Modules/recvec.o
stress.o : cp_interfaces.o
stress.o : modules.o
vanderwaals.o : ../Modules/cell_base.o
vanderwaals.o : ../Modules/constants.o
vanderwaals.o : ../Modules/kind.o
vanderwaals.o : ../Modules/mp_global.o
vol_clu.o : ../Modules/cell_base.o
vol_clu.o : ../Modules/constants.o
vol_clu.o : ../Modules/control_flags.o

11
CPV/move_electrons.f90
View File

@ -17,7 +17,7 @@ SUBROUTINE move_electrons_x( nfi, tfirst, tlast, b1, b2, b3, fion, &
USE control_flags, ONLY : lwf, tfor, tprnfor, thdyn
USE cg_module, ONLY : tcg
USE cp_main_variables, ONLY : eigr, bec, irb, eigrb, rhog, rhos, rhor, &
ei1, ei2, ei3, sfac, ema0bg, becdr, &
sfac, ema0bg, becdr, &
taub, lambda, lambdam, lambdap, vpot
USE wavefunctions_module, ONLY : c0, cm, phi => cp
USE cell_base, ONLY : omega, ibrav, h, press
@ -44,7 +44,7 @@ SUBROUTINE move_electrons_x( nfi, tfirst, tlast, b1, b2, b3, fion, &
USE cp_interfaces, ONLY : rhoofr, compute_stress
USE electrons_base, ONLY : nupdwn
USE mp_global, ONLY : me_image
!
USE reciprocal_vectors, ONLY : eigts1, eigts2, eigts3
IMPLICIT NONE
!
INTEGER, INTENT(IN) :: nfi
@ -64,7 +64,7 @@ SUBROUTINE move_electrons_x( nfi, tfirst, tlast, b1, b2, b3, fion, &
electron_dynamic: IF ( tcg ) THEN
!
CALL runcg_uspp( nfi, tfirst, tlast, eigr, bec, irb, eigrb, &
rhor, rhog, rhos, rhoc, ei1, ei2, ei3, sfac, &
rhor, rhog, rhos, rhoc, eigts1, eigts2, eigts3, sfac, &
fion, ema0bg, becdr, lambdap, lambda, vpot )
!
CALL compute_stress( stress, detot, h, omega )
@ -91,8 +91,9 @@ SUBROUTINE move_electrons_x( nfi, tfirst, tlast, b1, b2, b3, fion, &
!
vpot = rhor
!
CALL vofrho( nfi, vpot(1,1), rhog(1,1), rhos(1,1), rhoc(1), tfirst, tlast, &
ei1, ei2, ei3, irb(1,1), eigrb(1,1), sfac(1,1), tau0(1,1), fion(1,1) )
CALL vofrho( nfi, vpot(1,1), rhog(1,1), rhos(1,1), rhoc(1), tfirst, tlast,&
eigts1, eigts2, eigts3, irb(1,1), eigrb(1,1), sfac(1,1), &
tau0(1,1), fion(1,1) )
!
IF ( lwf ) CALL wf_options( tfirst, nfi, cm, becsum, bec, &
eigr, eigrb, taub, irb, ibrav, b1, &

8
CPV/restart_sub.f90
View File

@ -23,7 +23,7 @@ SUBROUTINE from_restart( )
USE ions_positions, ONLY : taus, tau0, tausm, taum, vels, fion, fionm, set_velocities
USE ions_nose, ONLY : xnhp0, xnhpm
USE grid_dimensions, ONLY : nr1, nr2, nr3
USE reciprocal_vectors, ONLY : mill
USE reciprocal_vectors, ONLY : mill, eigts1, eigts2, eigts3
USE printout_base, ONLY : printout_pos
USE gvecs, ONLY : ngms
USE gvecw, ONLY : ngw
@ -36,7 +36,7 @@ SUBROUTINE from_restart( )
USE small_box, ONLY : ainvb
USE uspp, ONLY : okvan, vkb, nkb
USE core, ONLY : nlcc_any
USE cp_main_variables, ONLY : ht0, htm, lambdap, lambda, lambdam, ei1, ei2, ei3, eigr, &
USE cp_main_variables, ONLY : ht0, htm, lambdap, lambda, lambdam, eigr, &
sfac, bec, taub, irb, eigrb, edft
USE cdvan, ONLY : dbec
USE time_step, ONLY : delt
@ -121,9 +121,9 @@ SUBROUTINE from_restart( )
CALL phbox( taub, eigrb, ainvb )
END IF
!
CALL phfacs( ei1, ei2, ei3, eigr, mill, taus, nr1, nr2, nr3, nat )
CALL phfacs( eigts1, eigts2, eigts3, eigr, mill, taus, nr1, nr2, nr3, nat )
!
CALL strucf( sfac, ei1, ei2, ei3, mill, ngms )
CALL strucf( sfac, eigts1, eigts2, eigts3, mill, ngms )
!
CALL prefor( eigr, vkb )
!

454
CPV/vanderwaals.f90
View File

@ -1,454 +0,0 @@
!
! Copyright (C) 2002-2005 FPMD-CPV groups
! This file is distributed under the terms of the
! GNU General Public License. See the file `License'
! in the root directory of the present distribution,
! or http://www.gnu.org/copyleft/gpl.txt .
!
module vanderwaals
USE kinds
IMPLICIT NONE
SAVE
PRIVATE
logical :: tvdw = .false.
PUBLIC :: vdw, tvdw
contains
!---------------------------------
subroutine VdW(evdw, taus, nat, na, nsp, fion, box)
USE constants, ONLY: bohr_radius_angs
USE cell_base, ONLY: s_to_r, boxdimensions
USE mp_global, ONLY: me_image, root_image
!
! taus == atomic positions in scaled coordinates
! nat == numero atomi
! na(s) == numero atomi per la specie s
! nsp(1) == numero atomi specie 1
! x,y,z == coordinate cartesiane
! force == forze
! evdw == energia di VdW
! csp() == coeffic. di VdW
!
implicit none
REAL(DP), intent(in) :: taus(:,:)
INTEGER, intent(in) :: nat, na(:), nsp
type(boxdimensions), intent(in) :: box
REAL(DP), intent(out) :: evdw
REAL(DP), intent(out) :: fion(:,:)
REAL(DP) alp,rcc,rcut,cutoff
parameter (alp=2.d0,rcc=6.5d0,rcut=3.0d0,cutoff=14.0d0)
REAL(DP) csp11, csp12, csp22
parameter (csp11=1.0191452D0, csp12=0.2239317D0, csp22=0.04364401D0)
REAL(DP) sij(3),rij(3),sij_image(3)
REAL(DP) csp1, dist, ff,dist6,fun,fact,cont
REAL(DP) force( 3, nat )
integer i,j,is,js,ia,ja,ix,iy,iz,iesr
logical:: tzero,tshift
force=0.d0
evdw =0.d0
iesr=1
if(nsp.ne.2 .or. .not.tvdw) then
return
endif
do i=1,nat
if(i.le.na(1)) then
ia = i
is = 1
else
ia = i - na(1)
is = 2
end if
do j=1,nat
if(j.le.na(1)) then
ja = j
js = 1
else
ja = j - na(1)
js = 2
end if
if (i.eq.j) then
sij=0.d0
tzero=.true.
else
tzero=.false.
sij = taus(:,i) - taus(:,j)
CALL PBCS(sij(1),sij(2),sij(3),sij(1),sij(2),sij(3),1)
end if
do ix=-iesr,iesr
sij_image(1)= sij(1)+DBLE(ix)
do iy=-iesr,iesr
sij_image(2)= sij(2)+DBLE(iy)
do iz=-iesr,iesr
sij_image(3)= sij(3)+DBLE(iz)
tshift=ix.eq.0 .and. iy.eq.0 .and. iz.eq.0
if(.not.(tzero.and.tshift)) then
call s_to_r(sij_image,rij,box)
dist = ( rij(1)**2 + rij(2)**2 + rij(3)**2 )**0.5d0
!
! ... c-c vdw coefficient
!
CSP1 = csp11
!
! ... c-h vdw coefficient
!
if ( (i.le.na(1).and.j.gt.na(1)) .or. &
(i.gt.na(1).and.j.le.na(1)) ) then
CSP1 = csp12
end if
!
! ... h-h vdw coefficient
!
if (i.gt.na(1).and.j.gt.na(1)) then
CSP1 = csp22
end if
!
! ... apply lower boundary cut-off
!
if(dist.lt.rcut) then
dist = rcut
end if
ff = alp * (rcc - dist)
dist6 = dist**6
fun = - CSP1 / dist6 * cutofun_vdw(ff) / bohr_radius_angs**6
if(dist.lt.rcut) then
fact = 0.d0
else
fact = (6.d0 * CSP1/dist**7 * cutofun_vdw(ff) + &
alp * dcutofun_vdw(ff) * CSP1/dist6) / bohr_radius_angs**6
endif
evdw = evdw + fun
force(1,i) = force(1,i) - fact * rij(1) / dist
force(2,i) = force(2,i) - fact * rij(2) / dist
force(3,i) = force(3,i) - fact * rij(3) / dist
endif
enddo !iz
enddo !iy
enddo !ix
enddo !j
enddo !i
evdw=evdw/2.d0
IF( me_image == root_image ) THEN
fion( :, 1:nat ) = fion( :, 1:nat ) + force( :, 1:nat )
END IF
return
end subroutine vdw
!==================================================================
function cutofun_vdw(xin)
implicit none
REAL(DP) cutofun_vdw
REAL(DP), intent(in) :: xin
REAL(DP) x
if( xin .gt. 30.d0 ) then
x = 30.d0
else
x = xin
endif
cutofun_vdw = 1.d0 / (exp(x) + 1.d0)
return
end function cutofun_vdw
!================================================================== c
!==================================================================
function dcutofun_vdw(xin)
implicit none
REAL(DP) dcutofun_vdw
REAL(DP), intent(in) :: xin
REAL(DP) x
if( xin .gt. 30.d0 ) then
x = 30.d0
else
x = xin
endif
dcutofun_vdw = - exp(x) / (exp(x) + 1.d0)**2
return
end function dcutofun_vdw
!==================================================================
subroutine baricentro(bar,vectors,nvec)
implicit none
integer, intent(in) :: nvec
REAL(DP), intent(out) :: bar(3)
REAL(DP), intent(in) :: vectors(3,nvec)
integer i,j
do i = 1,3
bar(i) = 0.0d0
do j = 1,nvec
bar(i) = bar(i) + vectors(i,j)
end do
bar(i) = bar(i) / DBLE(nvec)
end do
return
end subroutine baricentro
REAL(DP) function distanza(u,v)
implicit none
REAL(DP) u(3),v(3)
distanza = (u(1)-v(1))**2 + (u(2)-v(2))**2 + (u(3)-v(3))**2
distanza = sqrt(distanza)
return
end function distanza
! REAL(DP) FUNCTION VDW_FORCES(C6,IESR,FION,STAU0,NA,NAX,NSP)
!
! USE cell_base, only: R_TO_S, S_TO_R
!
! implicit none
!
! REAL(DP) c6
! integer iesr
! REAL(DP) fion(3,nax,nsp)
! REAL(DP) stau0(3,nax,nsp)
! integer na(nsp)
! integer nax,nsp
!
! REAL(DP) EVDW
! REAL(DP) distanza
! integer i,j,k,ix,iy,iz,infm,m,l,ishft,im
! REAL(DP) XLM, YLM, ZLM, ZERO
! REAL(DP) sxlm(3),rxlm(3),ERRE2,RLM,ADDEVDW,ADDPRE
! REAL(DP) FXX, REPAND
! REAL(DP) molbar(3,NAX)
! REAL(DP) molecola(3,NAX),tau(3),rdis
! REAL(DP) fmol(3,NAX)
! REAL(DP) bond_len_au
! integer iatmol(NAX,NSP),imol,nmol,natmol
! logical TZERO
!
!
! bond_len_au = 2.0d0
! imol = 1
! do i=1,na(1)
! im = 1
! call S_TO_R(stau0(1,i,1),molecola(1,im))
! iatmol(i,1) = im
! im = im + 1
! do j = 1,na(2)
! call S_TO_R(stau0(1,j,2),tau)
! rdis = distanza(molecola(1,1),tau)
! if(rdis.lt.bond_len_au) then
! call S_TO_R(stau0(1,j,2),molecola(1,im))
! iatmol(j,2) = im
! im = im + 1
! end if
! end do
! natmol = im - 1
! call baricentro(tau,molecola,natmol)
! call r_to_s(tau,molbar(1,imol))
! imol = imol + 1
! end do
! nmol = imol - 1
!
!
!
! EVDW = 0.D0
!
! call azzera(fmol,3*nax)
! DO L=1,nmol
! DO M= L,nmol
! IF(L.EQ.M) THEN
! XLM=0.D0
! YLM=0.D0
! ZLM=0.D0
! TZERO=.TRUE.
! ELSE
! TZERO=.FALSE.
! XLM = molbar(1,l) - molbar(1,m)
! YLM = molbar(2,l) - molbar(2,m)
! ZLM = molbar(3,l) - molbar(3,m)
! CALL PBCS(XLM,YLM,ZLM,XLM,YLM,ZLM,1)
! END IF
! DO IX=-IESR,IESR
! DO IY=-IESR,IESR
! DO IZ=-IESR,IESR
! ISHFT=IX*IX+IY*IY+IZ*IZ
! IF(.NOT.(TZERO.AND.ISHFT.EQ.0)) THEN
! sxlm(1) = XLM + DBLE(IX)
! sxlm(2) = YLM + DBLE(IY)
! sxlm(3) = ZLM + DBLE(IZ)
! CALL S_TO_R(sxlm,rxlm)
! ERRE2 = rxlm(1)**2 + rxlm(2)**2 + rxlm(3)**2
! RLM = SQRT(ERRE2)
! IF (TZERO) THEN
! ZERO=0.5D0
! ELSE
! ZERO=1.D0
! END IF
! ADDEVDW = - C6 / RLM**6
! EVDW = EVDW + ZERO*ADDEVDW
! ADDPRE = - 6.0D0 * C6 /RLM**8
! REPAND = ZERO*(ADDEVDW + ADDPRE)
! DO I=1,3
! FXX = REPAND*rxlm(I)
! FMOL(I,L) = FMOL(I,L) + FXX
! FMOL(I,M) = FMOL(I,M) - FXX
! END DO
! END IF
! END DO ! IZ
! END DO ! IY
! END DO ! IX
! END DO ! M
! END DO ! L
!
! do i=1,nsp
! do j=1,na(i)
! do k=1,3
! fion(k,j,i)=fion(k,j,i)+fmol(k,iatmol(j,i))/REAL(natmol)
! end do
! end do
! end do
!
! VDW_FORCES = EVDW
! return
! end FUNCTION VDW_FORCES
!
!
! subroutine VDW_STRESS(C6,IESR,STAU0,DVDW,NA,NAX,NSP)
!
! USE cell_base, only: R_TO_S, S_TO_R
!
! implicit none
!
! REAL(DP) c6
! integer iesr
! REAL(DP) stau0(3,nax,nsp)
! REAL(DP) dvdw(6)
! integer na(nsp)
! integer nax,nsp
!
! REAL(DP) distanza
! integer i,j,k,ix,iy,iz,infm,m,l,ishft,im
! REAL(DP) XLM, YLM, ZLM, ZERO
! REAL(DP) sxlm(3),rxlm(3),ERRE2,RLM,ADDEVDW,ADDPRE
! REAL(DP) FXX, REPAND
! REAL(DP) molbar(3,NAX)
! REAL(DP) molecola(3,NAX),tau(3),rdis
! REAL(DP) bond_len_au
! integer iatmol(NAX,NSP),imol,nmol,natmol
! integer alpha(6),beta(6)
! logical TZERO
!
! ALPHA(1) = 1
! ALPHA(2) = 2
! ALPHA(3) = 3
! ALPHA(4) = 2
! ALPHA(5) = 3
! ALPHA(6) = 3
! BETA(1) = 1
! BETA(2) = 1
! BETA(3) = 1
! BETA(4) = 2
! BETA(5) = 2
! BETA(6) = 3
!
! do i=1,6
! dvdw(i) = 0.0d0
! end do
!
! bond_len_au = 2.0d0
! imol = 1
! do i=1,na(1)
! im = 1
! call S_TO_R(stau0(1,i,1),molecola(1,im))
! iatmol(i,1) = im
! im = im + 1
! do j = 1,na(2)
! call S_TO_R(stau0(1,j,2),tau)
! rdis = distanza(molecola(1,1),tau)
! if(rdis.lt.bond_len_au) then
! call S_TO_R(stau0(1,j,2),molecola(1,im))
! iatmol(j,2) = im
! im = im + 1
! end if
! end do
! natmol = im - 1
! call baricentro(tau,molecola,natmol)
! call r_to_s(tau,molbar(1,imol))
! imol = imol + 1
! end do
! nmol = imol - 1
!
!
! DO L=1,nmol
! DO M= L,nmol
! IF(L.EQ.M) THEN
! XLM=0.D0
! YLM=0.D0
! ZLM=0.D0
! TZERO=.TRUE.
! ELSE
! TZERO=.FALSE.
! XLM = molbar(1,l) - molbar(1,m)
! YLM = molbar(2,l) - molbar(2,m)
! ZLM = molbar(3,l) - molbar(3,m)
! CALL PBCS(XLM,YLM,ZLM,XLM,YLM,ZLM,1)
! END IF
! DO IX=-IESR,IESR
! DO IY=-IESR,IESR
! DO IZ=-IESR,IESR
! ISHFT=IX*IX+IY*IY+IZ*IZ
! IF(.NOT.(TZERO.AND.ISHFT.EQ.0)) THEN
! sxlm(1) = XLM + DBLE(IX)
! sxlm(2) = YLM + DBLE(IY)
! sxlm(3) = ZLM + DBLE(IZ)
! CALL S_TO_R(sxlm,rxlm)
! ERRE2 = rxlm(1)**2 + rxlm(2)**2 + rxlm(3)**2
! RLM = SQRT(ERRE2)
! IF (TZERO) THEN
! ZERO=0.5D0
! ELSE
! ZERO=1.D0
! END IF
! ADDPRE = - 6.0D0 * C6 /RLM**8
! REPAND = ZERO * ADDPRE
! DO I=1,6
! FXX = REPAND*rxlm(ALPHA(I))*rxlm(BETA(I))
! DVDW(I) = DVDW(I) - FXX
! END DO
! END IF
! END DO ! IZ
! END DO ! IY
! END DO ! IX
! END DO ! M
! END DO ! L
!
! return
! end SUBROUTINE VDW_STRESS
end module vanderwaals

10
Modules/recvec.f90
View File

@ -168,9 +168,12 @@
! sortedig_l2g = array obtained by sorting ig_l2g
!
!
INTEGER, ALLOCATABLE, TARGET :: sortedig_l2g(:)
!
! the phases e^{-iG*tau_s}
!
COMPLEX(DP), ALLOCATABLE :: eigts1(:,:), eigts2(:,:), eigts3(:,:)
!
CONTAINS
SUBROUTINE deallocate_recvecs
@ -182,6 +185,9 @@
IF( ALLOCATED( mill ) ) DEALLOCATE( mill )
IF( ALLOCATED( ig_l2g ) ) DEALLOCATE( ig_l2g )
IF( ALLOCATED( sortedig_l2g ) ) DEALLOCATE( sortedig_l2g )
IF( ALLOCATED( eigts1 ) ) DEALLOCATE( eigts1 )
IF( ALLOCATED( eigts2 ) ) DEALLOCATE( eigts2 )
IF( ALLOCATED( eigts3 ) ) DEALLOCATE( eigts3 )
END SUBROUTINE deallocate_recvecs
!=----------------------------------------------------------------------------=!

1
PW/make.depend
View File

@ -206,7 +206,6 @@ cegterg.o : ../Modules/mp_global.o
cegterg.o : ../Modules/ptoolkit.o
clean_pw.o : ../Modules/atom.o
clean_pw.o : ../Modules/constraints_module.o
clean_pw.o : ../Modules/control_flags.o
clean_pw.o : ../Modules/fft_base.o
clean_pw.o : ../Modules/fft_types.o
clean_pw.o : ../Modules/ions_base.o

11
PW/pwcom.f90
View File

@ -29,7 +29,8 @@ MODULE gvect
!
USE kinds, ONLY : DP
USE gvecp, ONLY : ngm, ngm_g, ngl, nl, nlm, gcutm, ecutrho
USE reciprocal_vectors, ONLY : ig_l2g, gstart, g, gl, gg, mill
USE reciprocal_vectors, ONLY : ig_l2g, gstart, g, gl, gg, mill, eigts1, &
eigts2, eigts3
!
SAVE
!
@ -57,10 +58,10 @@ MODULE gvect
!REAL (DP) :: &
! dual, &! link between G of wavefunctions and charge
! gcutm ! cut-off for G vectors
COMPLEX(DP), ALLOCATABLE :: &
eigts1(:,:), &!
eigts2(:,:), &! the phases e^{-iG*tau_s}
eigts3(:,:) !
!COMPLEX(DP), ALLOCATABLE :: &
! eigts1(:,:), &!
! eigts2(:,:), &! the phases e^{-iG*tau_s}
! eigts3(:,:) !
!
END MODULE gvect
!