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

- grid data structure merged with the fft data structure. 

Now all variables regarding real space grid, fft and 
  their parallelization are contained into the objects:
  dfftp (dense grid) 
  dffts (smooth grid)



git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@7973 c92efa57-630b-4861-b058-cf58834340f0
This commit is contained in:
ccavazzoni 2011-07-14 22:14:15 +00:00
parent e9627abe97
commit 8040dea31d
159 changed files with 1538 additions and 1770 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
CPV/cg_sub.f90
View File

@ -34,9 +34,7 @@
use gvecw, only: ngw
use gvect, only: gstart
use ions_base, only: na, nat, pmass, nax, nsp, rcmax
use grid_dimensions, only: grid_dim, dense
use cell_base, only: omega, alat, tpiba2
use smooth_grid_dimensions, only: grid_dim, smooth
use local_pseudo, only: vps, rhops
use io_global, ONLY : stdout, ionode, ionode_id
use mp_global, ONLY : intra_bgrp_comm, np_ortho, me_ortho, ortho_comm
@ -59,6 +57,7 @@
USE cp_main_variables, ONLY : nlax, collect_lambda, distribute_lambda, descla, nrlx, nlam, drhor, drhog
USE descriptors, ONLY : la_npc_ , la_npr_ , la_comm_ , la_me_ , la_nrl_ , ldim_cyclic
USE mp_global, ONLY: me_image, my_image_id, nbgrp
USE fft_base, ONLY: dffts, dfftp
!
@ -73,14 +72,14 @@
real(dp) :: becdr(nhsa,nbspx,3)
integer irb(3,nat)
complex(dp) :: eigrb(ngb,nat)
real(dp) :: rhor(dense%nrxx,nspin)
real(dp) :: vpot(dense%nrxx,nspin)
real(dp) :: rhor(dfftp%nnr,nspin)
real(dp) :: vpot(dfftp%nnr,nspin)
complex(dp) :: rhog(ngm,nspin)
real(dp) :: rhos(smooth%nrxx,nspin)
real(dp) :: rhoc(dense%nrxx)
complex(dp) :: ei1(-dense%nr1:dense%nr1,nat)
complex(dp) :: ei2(-dense%nr2:dense%nr2,nat)
complex(dp) :: ei3(-dense%nr3:dense%nr3,nat)
real(dp) :: rhos(dffts%nnr,nspin)
real(dp) :: rhoc(dfftp%nnr)
complex(dp) :: ei1(-dfftp%nr1:dfftp%nr1,nat)
complex(dp) :: ei2(-dfftp%nr2:dfftp%nr2,nat)
complex(dp) :: ei3(-dfftp%nr3:dfftp%nr3,nat)
complex(dp) :: sfac( ngms, nsp )
real(dp) :: fion(3,nat)
real(dp) :: ema0bg(ngw)
@ -298,7 +297,7 @@
call prefor(eigr,betae)!ATTENZIONE
do i=1,nbsp,2
call dforce( i, bec, betae, c0,c2,c3,rhos, smooth%nrxx, ispin,f,nbsp,nspin)
call dforce( i, bec, betae, c0,c2,c3,rhos, dffts%nnr, ispin,f,nbsp,nspin)
if(tefield .and. (evalue.ne.0.d0)) then
call dforceb(c0, i, betae, ipolp, bec ,ctabin(1,1,ipolp), gqq, gqqm, qmat, deeq, df)
c2(1:ngw)=c2(1:ngw)+evalue*df(1:ngw)
@ -838,7 +837,7 @@
call prefor(eigr,betae)
do i=1,nbsp,2
call dforce(i,bec,betae,c0,c2,c3,rhos,smooth%nrxx,ispin,f,nbsp,nspin)
call dforce(i,bec,betae,c0,c2,c3,rhos,dffts%nnr,ispin,f,nbsp,nspin)
if(tefield.and.(evalue .ne. 0.d0)) then
call dforceb &
(c0, i, betae, ipolp, bec ,ctabin(1,1,ipolp), gqq, gqqm, qmat, deeq, df)

102
CPV/chargedensity.f90
View File

@ -107,10 +107,7 @@
USE gvect, ONLY: gstart
USE uspp, ONLY: nkb
USE uspp_param, ONLY: nh, nhm
USE grid_dimensions, ONLY: grid_dim, dense
USE cell_base, ONLY: omega
USE smooth_grid_dimensions, &
ONLY: grid_dim, smooth
USE electrons_base, ONLY: nspin, nbsp_bgrp, ispin_bgrp, f_bgrp
USE constants, ONLY: pi, fpi
USE mp, ONLY: mp_sum
@ -228,11 +225,11 @@
!
CALL read_rho( nspin, rhor )
ALLOCATE( psi( dense%nrxx ) )
ALLOCATE( psi( dfftp%nnr ) )
!
IF(nspin.EQ.1)THEN
iss=1
DO ir=1,dense%nrxx
DO ir=1,dfftp%nnr
psi(ir)=CMPLX(rhor(ir,iss),0.d0,kind=DP)
END DO
CALL fwfft('Dense', psi, dfftp )
@ -242,7 +239,7 @@
ELSE
isup=1
isdw=2
DO ir=1,dense%nrxx
DO ir=1,dfftp%nnr
psi(ir)=CMPLX(rhor(ir,isup),rhor(ir,isdw),kind=DP)
END DO
CALL fwfft('Dense', psi, dfftp )
@ -289,7 +286,7 @@
!
iss1=1
sa1=f_bgrp(i)/omega
DO ir=1,smooth%nrxx
DO ir=1,dffts%nnr
rhos(ir,iss1)=rhos(ir,iss1) + sa1*( DBLE(psis(ir)))**2
END DO
!
@ -299,11 +296,11 @@
!
ELSE
!
ALLOCATE( psis( smooth%nrxx ) )
ALLOCATE( psis( dffts%nnr ) )
!
DO i = 1, nbsp_bgrp, 2
!
CALL c2psi( psis, smooth%nrxx, c_bgrp( 1, i ), c_bgrp( 1, i+1 ), ngw, 2 )
CALL c2psi( psis, dffts%nnr, c_bgrp( 1, i ), c_bgrp( 1, i+1 ), ngw, 2 )
CALL invfft('Wave',psis, dffts )
!
@ -317,7 +314,7 @@
sa2 = 0.0d0
END IF
!
DO ir = 1, smooth%nrxx
DO ir = 1, dffts%nnr
rhos(ir,iss1) = rhos(ir,iss1) + sa1 * ( DBLE(psis(ir)))**2
rhos(ir,iss2) = rhos(ir,iss2) + sa2 * (AIMAG(psis(ir)))**2
END DO
@ -334,11 +331,11 @@
!
! smooth charge in g-space is put into rhog(ig)
!
ALLOCATE( psis( smooth%nrxx ) )
ALLOCATE( psis( dffts%nnr ) )
!
IF(nspin.EQ.1)THEN
iss=1
DO ir=1,smooth%nrxx
DO ir=1,dffts%nnr
psis(ir)=CMPLX(rhos(ir,iss),0.d0,kind=DP)
END DO
CALL fwfft('Smooth', psis, dffts )
@ -348,7 +345,7 @@
ELSE
isup=1
isdw=2
DO ir=1,smooth%nrxx
DO ir=1,dffts%nnr
psis(ir)=CMPLX(rhos(ir,isup),rhos(ir,isdw),kind=DP)
END DO
CALL fwfft('Smooth',psis, dffts )
@ -360,7 +357,7 @@
END DO
ENDIF
!
ALLOCATE( psi( dense%nrxx ) )
ALLOCATE( psi( dfftp%nnr ) )
!
IF( nspin .EQ. 1 ) THEN
!
@ -373,7 +370,7 @@
psi(nl (ig))= rhog(ig,iss)
END DO
CALL invfft('Dense',psi, dfftp )
DO ir=1,dense%nrxx
DO ir=1,dfftp%nnr
rhor(ir,iss)=DBLE(psi(ir))
END DO
!
@ -389,7 +386,7 @@
psi(nl(ig))=rhog(ig,isup)+ci*rhog(ig,isdw)
END DO
CALL invfft('Dense',psi, dfftp )
DO ir=1,dense%nrxx
DO ir=1,dfftp%nnr
rhor(ir,isup)= DBLE(psi(ir))
rhor(ir,isdw)=AIMAG(psi(ir))
END DO
@ -424,9 +421,9 @@
( MOD(nfi, iprint_stdout) == 0 ) .AND. ( .NOT. tcg ) ) THEN
IF( iprsta > 2 ) THEN
CALL checkrho( dense%nrxx, nspin, rhor, rmin, rmax, rsum, rnegsum )
rnegsum = rnegsum * omega / DBLE(dense%nr1*dense%nr2*dense%nr3)
rsum = rsum * omega / DBLE(dense%nr1*dense%nr2*dense%nr3)
CALL checkrho( dfftp%nnr, nspin, rhor, rmin, rmax, rsum, rnegsum )
rnegsum = rnegsum * omega / DBLE(dfftp%nr1*dfftp%nr2*dfftp%nr3)
rsum = rsum * omega / DBLE(dfftp%nr1*dfftp%nr2*dfftp%nr3)
WRITE( stdout,'(a,4(1x,f12.6))') &
& ' rhoofr: rmin rmax rnegsum rsum ',rmin,rmax,rnegsum,rsum
END IF
@ -466,7 +463,7 @@
!
DO iss=1,nspin
rsumg(iss)=omega*DBLE(rhog(1,iss))
rsumr(iss)=SUM(rhor(:,iss),1)*omega/DBLE(dense%nr1*dense%nr2*dense%nr3)
rsumr(iss)=SUM(rhor(:,iss),1)*omega/DBLE(dfftp%nr1*dfftp%nr2*dfftp%nr3)
END DO
IF (gstart.NE.2) THEN
@ -607,7 +604,7 @@
!
!This loop goes through all components of charge density that is local
!to each processor. In the original code this is nrxxs. In the task-groups
!to each processor. In the original code this is nnr. In the task-groups
!code this should be equal to the total number of planes
!
@ -668,7 +665,6 @@
!
USE kinds, ONLY: DP
use gvect, ONLY: g, ngm, nl, nlm
use grid_dimensions, ONLY: grid_dim, dense
use cell_base, ONLY: tpiba
USE fft_interfaces, ONLY: invfft
USE fft_base, ONLY: dfftp
@ -678,20 +674,20 @@
integer, intent(in) :: nspin
complex(DP) :: rhog( ngm, nspin )
! output
real(DP) :: gradr( dense%nrxx, 3, nspin )
real(DP) :: gradr( dfftp%nnr, 3, nspin )
! local
complex(DP), allocatable :: v(:)
complex(DP) :: ci
integer :: iss, ig, ir
!
!
allocate( v( dense%nrxx ) )
allocate( v( dfftp%nnr ) )
!
ci = ( 0.0d0, 1.0d0 )
do iss = 1, nspin
!$omp parallel default(shared), private(ig)
!$omp do
do ig = 1, dense%nrxx
do ig = 1, dfftp%nnr
v( ig ) = ( 0.0d0, 0.0d0 )
end do
!$omp do
@ -705,11 +701,11 @@
!
!$omp parallel default(shared), private(ig,ir)
!$omp do
do ir=1,dense%nrxx
do ir=1,dfftp%nnr
gradr(ir,1,iss)=DBLE(v(ir))
end do
!$omp do
do ig=1,dense%nrxx
do ig=1,dfftp%nnr
v(ig)=(0.0d0,0.0d0)
end do
!$omp do
@ -724,7 +720,7 @@
call invfft( 'Dense', v, dfftp )
!
!$omp parallel do default(shared)
do ir=1,dense%nrxx
do ir=1,dfftp%nnr
gradr(ir,2,iss)= DBLE(v(ir))
gradr(ir,3,iss)=AIMAG(v(ir))
end do
@ -789,7 +785,6 @@ SUBROUTINE drhov(irb,eigrb,rhovan,drhovan,rhog,rhor,drhog,drhor)
USE control_flags, ONLY: iprint
USE ions_base, ONLY: na, nsp, nat
USE uspp_param, ONLY: nhm, nh, nvb
USE grid_dimensions, ONLY: grid_dim, dense
USE electrons_base, ONLY: nspin
USE smallbox_gvec, ONLY: ngb, npb, nmb
USE gvect, ONLY: ngm, nlm, nl
@ -804,12 +799,12 @@ SUBROUTINE drhov(irb,eigrb,rhovan,drhovan,rhog,rhor,drhog,drhor)
IMPLICIT NONE
! input
INTEGER, INTENT(IN) :: irb(3,nat)
REAL(DP), INTENT(IN) :: rhor(dense%nrxx,nspin)
REAL(DP), INTENT(IN) :: rhor(dfftp%nnr,nspin)
REAL(DP), INTENT(IN) :: rhovan(nhm*(nhm+1)/2,nat,nspin)
REAL(DP), INTENT(IN) :: drhovan(nhm*(nhm+1)/2,nat,nspin,3,3)
COMPLEX(DP), INTENT(IN) :: eigrb(ngb,nat), rhog(ngm,nspin)
! output
REAL(DP), INTENT(OUT) :: drhor(dense%nrxx,nspin,3,3)
REAL(DP), INTENT(OUT) :: drhor(dfftp%nnr,nspin,3,3)
COMPLEX(DP), INTENT(OUT) :: drhog(ngm,nspin,3,3)
! local
INTEGER i, j, isup, isdw, nfft, ifft, iv, jv, ig, ijv, is, iss, &
@ -829,7 +824,7 @@ SUBROUTINE drhov(irb,eigrb,rhovan,drhovan,rhog,rhor,drhog,drhor)
DO j=1,3
DO i=1,3
DO iss=1,nspin
DO ir=1,dense%nrxx
DO ir=1,dfftp%nnr
drhor(ir,iss,i,j)=-rhor(ir,iss)*ainv(j,i)
END DO
DO ig=1,ngm
@ -841,7 +836,7 @@ SUBROUTINE drhov(irb,eigrb,rhovan,drhovan,rhog,rhor,drhog,drhor)
IF ( nvb < 0 ) RETURN
ALLOCATE( v( dense%nrxx ) )
ALLOCATE( v( dfftp%nnr ) )
ci =( 0.0d0, 1.0d0 )
@ -960,7 +955,7 @@ SUBROUTINE drhov(irb,eigrb,rhovan,drhovan,rhog,rhor,drhog,drhor)
iss = 1
DO ir=1,dense%nrxx
DO ir=1,dfftp%nnr
drhor(ir,iss,i,j) = drhor(ir,iss,i,j) + DBLE(v(ir))
END DO
!
@ -1037,7 +1032,7 @@ SUBROUTINE drhov(irb,eigrb,rhovan,drhovan,rhog,rhor,drhog,drhor)
DEALLOCATE( dqgbt )
DEALLOCATE( qv )
!
DO ir=1,dense%nrxx
DO ir=1,dfftp%nnr
drhor(ir,isup,i,j) = drhor(ir,isup,i,j) + DBLE(v(ir))
drhor(ir,isdw,i,j) = drhor(ir,isdw,i,j) +AIMAG(v(ir))
ENDDO
@ -1081,7 +1076,6 @@ SUBROUTINE rhov(irb,eigrb,rhovan,rhog,rhor)
USE mp, ONLY: mp_sum
USE uspp_param, ONLY: nh, nhm, nvb
USE uspp, ONLY: deeq
USE grid_dimensions, ONLY: grid_dim, dense
USE electrons_base, ONLY: nspin
USE smallbox_gvec, ONLY: npb, nmb, ngb
USE gvect, ONLY: ngm, nl, nlm
@ -1099,7 +1093,7 @@ SUBROUTINE rhov(irb,eigrb,rhovan,rhog,rhor)
INTEGER, INTENT(in) :: irb(3,nat)
COMPLEX(DP), INTENT(in):: eigrb(ngb,nat)
!
REAL(DP), INTENT(inout):: rhor(dense%nrxx,nspin)
REAL(DP), INTENT(inout):: rhor(dfftp%nnr,nspin)
COMPLEX(DP), INTENT(inout):: rhog(ngm,nspin)
!
INTEGER :: isup, isdw, nfft, ifft, iv, jv, ig, ijv, is, iss, isa, ia, ir, i, j
@ -1123,7 +1117,7 @@ SUBROUTINE rhov(irb,eigrb,rhovan,rhog,rhor)
ci=(0.d0,1.d0)
!
!
ALLOCATE( v( dense%nrxx ) )
ALLOCATE( v( dfftp%nnr ) )
! private variable need to be initialized, otherwise
! outside the parallel region they have an undetermined value
@ -1143,7 +1137,7 @@ SUBROUTINE rhov(irb,eigrb,rhovan,rhog,rhor)
!$omp parallel default(none) &
!$omp shared(nvb, na, nnrbx, ngb, nh, rhovan, qgb, eigrb, dfftb, iprsta, omegab, irb, v, nr1b, &
!$omp nr2b, nr3b, nmb, stdout, ci, npb, rhor, dense ) &
!$omp nr2b, nr3b, nmb, stdout, ci, npb, rhor, dfftp ) &
!$omp private(mytid, ntids, is, ia, nfft, ifft, iv, jv, ijv, sumrho, qgbt, ig, iss, isa, ca, &
!$omp qv, itid, ir )
@ -1264,7 +1258,7 @@ SUBROUTINE rhov(irb,eigrb,rhovan,rhog,rhor)
iss = 1
DO ir=1,dense%nrxx
DO ir=1,dfftp%nnr
rhor(ir,iss)=rhor(ir,iss)+DBLE(v(ir))
END DO
@ -1275,7 +1269,7 @@ SUBROUTINE rhov(irb,eigrb,rhovan,rhog,rhor)
CALL mp_sum( ca, intra_bgrp_comm )
WRITE( stdout,'(a,2f12.8)') &
& ' rhov: int n_v(r) dr = ',omega*ca/(dense%nr1*dense%nr2*dense%nr3)
& ' rhov: int n_v(r) dr = ',omega*ca/(dfftp%nr1*dfftp%nr2*dfftp%nr3)
ENDIF
!
CALL fwfft('Dense',v, dfftp )
@ -1363,7 +1357,7 @@ SUBROUTINE rhov(irb,eigrb,rhovan,rhog,rhor)
END DO
END DO
!
DO ir=1,dense%nrxx
DO ir=1,dfftp%nnr
rhor(ir,isup)=rhor(ir,isup)+DBLE(v(ir))
rhor(ir,isdw)=rhor(ir,isdw)+AIMAG(v(ir))
END DO
@ -1371,7 +1365,7 @@ SUBROUTINE rhov(irb,eigrb,rhovan,rhog,rhor)
IF(iprsta.GT.2) THEN
ca = SUM(v)
CALL mp_sum( ca, intra_bgrp_comm )
WRITE( stdout,'(a,2f12.8)') 'rhov:in n_v ',omega*ca/(dense%nr1*dense%nr2*dense%nr3)
WRITE( stdout,'(a,2f12.8)') 'rhov:in n_v ',omega*ca/(dfftp%nr1*dfftp%nr2*dfftp%nr3)
ENDIF
!
CALL fwfft('Dense',v, dfftp )
@ -1422,7 +1416,6 @@ END SUBROUTINE rhov
!
use kinds, ONLY: DP
USE fft_base, ONLY: dfftp
use grid_dimensions, ONLY: grid_dim, dense
use xml_io_base, ONLY: read_rho_xml, restart_dir
use control_flags, ONLY: ndr
USE io_files, ONLY: tmp_dir
@ -1432,7 +1425,7 @@ END SUBROUTINE rhov
implicit none
!
integer :: nspin
real(DP) :: rhor( dense%nrxx, nspin )
real(DP) :: rhor( dfftp%nnr, nspin )
!
integer :: is
CHARACTER(LEN=256) :: filename, dirname
@ -1467,11 +1460,10 @@ END SUBROUTINE rhov
subroutine old_write_rho( rhounit, nspin, rhor )
!----------------------------------------------------------------------
!
! collect rhor(nrxx,nspin) on first node and write to file
! collect rhor(nnr,nspin) on first node and write to file
!
use kinds, ONLY: DP
use parallel_include
use grid_dimensions, only : grid_dim, dense
use gvecw , only : ngw
USE mp_global, ONLY : nproc_bgrp, intra_bgrp_comm
USE io_global, ONLY : ionode, ionode_id
@ -1483,7 +1475,7 @@ END SUBROUTINE rhov
implicit none
!
integer, INTENT(IN) :: rhounit, nspin
real(kind=DP), INTENT(IN) :: rhor( dense%nrxx, nspin )
real(kind=DP), INTENT(IN) :: rhor( dfftp%nnr, nspin )
!
integer :: ir, is
@ -1497,12 +1489,12 @@ END SUBROUTINE rhov
!
WRITE( rhounit, '("3 2")' )
!
WRITE( rhounit, '(3(2X,I3))' ) dense%nr1x, dense%nr2x, dense%nr3x
WRITE( rhounit, '(3(2X,I3))' ) dfftp%nr1x, dfftp%nr2x, dfftp%nr3x
!
WRITE( rhounit, '(3(2X,"0",2X,F16.10))' ) &
( DBLE(dense%nr1x-1) / DBLE(dense%nr1x) ) * at(1,1)*alat * bohr_radius_angs, &
( DBLE(dense%nr2x-1) / DBLE(dense%nr2x) ) * at(2,2)*alat * bohr_radius_angs, &
( DBLE(dense%nr3x-1) / DBLE(dense%nr3x) ) * at(3,3)*alat * bohr_radius_angs
( DBLE(dfftp%nr1x-1) / DBLE(dfftp%nr1x) ) * at(1,1)*alat * bohr_radius_angs, &
( DBLE(dfftp%nr2x-1) / DBLE(dfftp%nr2x) ) * at(2,2)*alat * bohr_radius_angs, &
( DBLE(dfftp%nr3x-1) / DBLE(dfftp%nr3x) ) * at(3,3)*alat * bohr_radius_angs
!
END IF
!
@ -1510,7 +1502,7 @@ END SUBROUTINE rhov
!
ALLOCATE( displs( nproc_bgrp ), recvcount( nproc_bgrp ) )
!
if (ionode) allocate(rhodist(dense%nr1x*dense%nr2x*dense%nr3x))
if (ionode) allocate(rhodist(dfftp%nr1x*dfftp%nr2x*dfftp%nr3x))
!
do proc=1,nproc_bgrp
recvcount(proc) = dfftp%nnp * ( dfftp%npp(proc) )
@ -1531,7 +1523,7 @@ END SUBROUTINE rhov
! write the charge density to unit "rhounit" from first node only
!
if ( ionode ) &
write( rhounit, '(F12.7)' ) (rhodist(ir),ir=1,dense%nr1x*dense%nr2x*dense%nr3x)
write( rhounit, '(F12.7)' ) (rhodist(ir),ir=1,dfftp%nr1x*dfftp%nr2x*dfftp%nr3x)
!
end do
@ -1541,7 +1533,7 @@ END SUBROUTINE rhov
ELSE
IF ( ionode ) THEN
WRITE( rhounit, '(F12.7)' ) ( ( rhor(ir,is), ir = 1, dense%nrxx ), is = 1, nspin )
WRITE( rhounit, '(F12.7)' ) ( ( rhor(ir,is), ir = 1, dfftp%nnr ), is = 1, nspin )
END IF
END IF COLLECT_CHARGE

21
CPV/cp_interfaces.f90
View File

@ -259,11 +259,11 @@
SUBROUTINE fillgrad_x( nspin, rhog, gradr )
USE kinds, ONLY: DP
USE gvect, ONLY: ngm
USE grid_dimensions, ONLY: grid_dim, dense
USE fft_base, ONLY: dfftp
IMPLICIT NONE
INTEGER, INTENT(IN) :: nspin
complex(DP) :: rhog( ngm, nspin )
real(DP) :: gradr( dense%nrxx, 3, nspin )
real(DP) :: gradr( dfftp%nnr, 3, nspin )
END SUBROUTINE fillgrad_x
END INTERFACE
@ -271,7 +271,6 @@
INTERFACE checkrho
SUBROUTINE checkrho_x(nnr,nspin,rhor,rmin,rmax,rsum,rnegsum)
USE kinds, ONLY: DP
USE grid_dimensions, ONLY: nrxx
IMPLICIT NONE
INTEGER, INTENT(IN) :: nnr, nspin
REAL(DP) :: rhor(nnr,nspin), rmin, rmax, rsum, rnegsum
@ -597,11 +596,11 @@
SUBROUTINE strucf_x( sfac, ei1, ei2, ei3, mill, ngm )
USE kinds, ONLY: DP
USE ions_base, ONLY: nat
USE grid_dimensions, ONLY: grid_dim, dense
USE fft_base, ONLY: dfftp
IMPLICIT NONE
COMPLEX(DP) :: ei1( -dense%nr1 : dense%nr1, nat )
COMPLEX(DP) :: ei2( -dense%nr2 : dense%nr2, nat )
COMPLEX(DP) :: ei3( -dense%nr3 : dense%nr3, nat )
COMPLEX(DP) :: ei1( -dfftp%nr1 : dfftp%nr1, nat )
COMPLEX(DP) :: ei2( -dfftp%nr2 : dfftp%nr2, nat )
COMPLEX(DP) :: ei3( -dfftp%nr3 : dfftp%nr3, nat )
INTEGER :: mill( :, : )
INTEGER :: ngm
COMPLEX(DP), INTENT(OUT) :: sfac(:,:)
@ -706,7 +705,7 @@
SUBROUTINE force_loc_x( tscreen, rhoeg, fion, rhops, vps, ei1, ei2, ei3, &
sfac, omega, screen_coul )
USE kinds, ONLY: DP
USE grid_dimensions, ONLY: grid_dim, dense
USE fft_base, ONLY: dfftp
USE ions_base, ONLY: nat
IMPLICIT NONE
LOGICAL :: tscreen
@ -714,9 +713,9 @@
REAL(DP) :: rhops(:,:), vps(:,:)
COMPLEX(DP) :: rhoeg(:)
COMPLEX(DP), INTENT(IN) :: sfac(:,:)
COMPLEX(DP) :: ei1(-dense%nr1:dense%nr1,nat)
COMPLEX(DP) :: ei2(-dense%nr2:dense%nr2,nat)
COMPLEX(DP) :: ei3(-dense%nr3:dense%nr3,nat)
COMPLEX(DP) :: ei1(-dfftp%nr1:dfftp%nr1,nat)
COMPLEX(DP) :: ei2(-dfftp%nr2:dfftp%nr2,nat)
COMPLEX(DP) :: ei3(-dfftp%nr3:dfftp%nr3,nat)
REAL(DP) :: omega
COMPLEX(DP) :: screen_coul(:)
END SUBROUTINE

12
CPV/cp_restart.f90
View File

@ -58,8 +58,6 @@ MODULE cp_restart
intra_bgrp_comm, intra_image_comm, inter_bgrp_comm, &
root_bgrp, intra_pool_comm
USE printout_base, ONLY : title
USE grid_dimensions, ONLY : grid_dim, dense
USE smooth_grid_dimensions, ONLY : smooth
USE smallbox_grid_dim, ONLY : nr1b, nr2b, nr3b
USE gvect, ONLY : ngm, ngm_g
USE gvecs, ONLY : ngms_g, ecuts, dual
@ -74,7 +72,7 @@ MODULE cp_restart
USE energies, ONLY : enthal, ekin, eht, esr, eself, &
epseu, enl, exc, vave
USE mp, ONLY : mp_sum
USE fft_base, ONLY : dfftp
USE fft_base, ONLY : dfftp, dffts
USE constants, ONLY : pi
USE uspp_param, ONLY : n_atom_wfc
USE global_version, ONLY : version_number
@ -363,8 +361,8 @@ MODULE cp_restart
! ... PLANE_WAVES
!-------------------------------------------------------------------------------
!
CALL write_planewaves( ecutwfc, dual, ngw_g, gamma_only, dense%nr1, dense%nr2, &
dense%nr3, ngm_g, smooth%nr1, smooth%nr2, smooth%nr3, ngms_g, nr1b, &
CALL write_planewaves( ecutwfc, dual, ngw_g, gamma_only, dfftp%nr1, dfftp%nr2, &
dfftp%nr3, ngm_g, dffts%nr1, dffts%nr2, dffts%nr3, ngms_g, nr1b, &
nr2b, nr3b, mill_g, .FALSE. )
!
!-------------------------------------------------------------------------------
@ -932,9 +930,7 @@ MODULE cp_restart
USE io_files, ONLY : iunpun, xmlpun, iunwfc, nwordwfc, &
tmp_dir, diropn
USE printout_base, ONLY : title
USE grid_dimensions, ONLY : grid_dim, dense
USE smooth_grid_dimensions, ONLY : smooth
USE smallbox_grid_dim, ONLY : nr1b, nr2b, nr3b
USE smallbox_grid_dim, ONLY : nr1b, nr2b, nr3b
USE gvect, ONLY : ngm
USE gvecw, ONLY : ngw, ngw_g
USE electrons_base, ONLY : nspin, nbnd, nelt, nel, &

4
CPV/cplib.f90
View File

@ -1136,7 +1136,7 @@ subroutine nlinit
use gvect, ONLY : ngm
use cp_interfaces, ONLY : pseudopotential_indexes, compute_dvan, &
compute_betagx, compute_qradx
USE grid_dimensions, ONLY : grid_dim, dense
USE fft_base, ONLY : dfftp
!
implicit none
@ -1167,7 +1167,7 @@ subroutine nlinit
!
call aainit( lmaxkb + 1 )
!
CALL allocate_core( dense%nrxx, ngm, ngb, nsp )
CALL allocate_core( dfftp%nnr, ngm, ngb, nsp )
!
!
allocate( beta( ngw, nhm, nsp ) )

45
CPV/cplib_meta.f90
View File

@ -16,15 +16,14 @@
use gvect, only : g
use gvecs, only : ngms, nlsm, nls
use gvecw, only : ngw
use smooth_grid_dimensions, only : smooth
use cell_base, only : tpiba2
USE metagga, ONLY : kedtaus
USE fft_interfaces, ONLY : fwfft, invfft
USE fft_base, ONLY: dffts
USE fft_base, ONLY : dffts
!
implicit none
!
complex(dp) c(ngw), ca(ngw), df(ngw), da(ngw),psi(smooth%nrxx)
complex(dp) c(ngw), ca(ngw), df(ngw), da(ngw),psi(dffts%nnr)
integer iss1, iss2
real(dp) fi, fip
! local variables
@ -42,7 +41,7 @@
end do
call invfft('Wave',psi,dffts )
! on smooth grids--> grids for charge density
do ir=1, smooth%nrxx
do ir=1, dffts%nnr
psi(ir) = CMPLX (kedtaus(ir,iss1)*DBLE(psi(ir)), &
kedtaus(ir,iss2)*AIMAG(psi(ir)),kind=DP)
end do
@ -72,9 +71,7 @@
use gvecw, only: ngw
use gvect, only: g
use gvect, only: nl, nlm
use grid_dimensions, only: dense
use cell_base
use smooth_grid_dimensions, only: smooth
use electrons_base, only: nx => nbspx, n => nbsp, f, ispin, nspin
use constants, only: pi, fpi
!
@ -134,12 +131,12 @@
! gradient of wfc in real space
call invfft('Wave',psis, dffts )
! on smooth grids--> grids for charge density
do ir=1, smooth%nrxx
do ir=1, dffts%nnr
kedtaus(ir,iss1)=kedtaus(ir,iss1)+0.5d0*sa1*DBLE(psis(ir))**2
kedtaus(ir,iss2)=kedtaus(ir,iss2)+0.5d0*sa2*AIMAG(psis(ir))**2
end do
if(tpre) then
do ir=1, smooth%nrxx
do ir=1, dffts%nnr
gradwfc(ir,ipol)=psis(ir)
end do
end if
@ -150,7 +147,7 @@
do iy=1,ix
ipol2xy(ix,iy)=ipol
ipol2xy(iy,ix)=ipol
do ir=1,smooth%nrxx
do ir=1,dffts%nnr
crosstaus(ir,ipol,iss1) = crosstaus(ir,ipol,iss1) +&
sa1*DBLE(gradwfc(ir,ix))*DBLE(gradwfc(ir,iy))
crosstaus(ir,ipol,iss2) = crosstaus(ir,ipol,iss2) +&
@ -166,7 +163,7 @@
do iss=1,nspin
do ix=1,3
do iy=1,3
do ir=1,smooth%nrxx
do ir=1,dffts%nnr
dkedtaus(ir,ix,iy,iss)=-kedtaus(ir,iss)*ainv(iy,ix)&
-crosstaus(ir,ipol2xy(1,ix),iss)*ainv(iy,1)&
-crosstaus(ir,ipol2xy(2,ix),iss)*ainv(iy,2)&
@ -182,7 +179,7 @@
if(nspin.eq.1)then
iss=1
psis(1:smooth%nrxx)=CMPLX(kedtaus(1:smooth%nrxx,iss),0.d0,kind=DP)
psis(1:dffts%nnr)=CMPLX(kedtaus(1:dffts%nnr,iss),0.d0,kind=DP)
call fwfft('Smooth',psis, dffts )
kedtaug(1:ngms,iss)=psis(nls(1:ngms))
@ -190,7 +187,7 @@
isup=1
isdw=2
psis(1:smooth%nrxx)=CMPLX(kedtaus(1:smooth%nrxx,isup),kedtaus(1:smooth%nrxx,isdw),kind=DP)
psis(1:dffts%nnr)=CMPLX(kedtaus(1:dffts%nnr,isup),kedtaus(1:dffts%nnr,isdw),kind=DP)
call fwfft('Smooth',psis, dffts )
do ig=1,ngms
fp= psis(nls(ig)) + psis(nlsm(ig))
@ -211,7 +208,7 @@
psi(nlm(1:ngms))=CONJG(kedtaug(1:ngms,iss))
psi(nl(1:ngms)) = kedtaug(1:ngms,iss)
call invfft('Dense',psi, dfftp )
kedtaur(1:dense%nrxx,iss)=DBLE(psi(1:dense%nrxx))
kedtaur(1:dfftp%nnr,iss)=DBLE(psi(1:dfftp%nnr))
else
! ==================================================================
@ -227,8 +224,8 @@
psi(nl(ig)) =kedtaug(ig,isup)+ci*kedtaug(ig,isdw)
end do
call invfft('Dense',psi, dfftp )
kedtaur(1:dense%nrxx,isup)= DBLE(psi(1:dense%nrxx))
kedtaur(1:dense%nrxx,isdw)=AIMAG(psi(1:dense%nrxx))
kedtaur(1:dfftp%nnr,isup)= DBLE(psi(1:dfftp%nnr))
kedtaur(1:dfftp%nnr,isdw)=AIMAG(psi(1:dfftp%nnr))
endif
@ -258,8 +255,6 @@
use gvecs
use gvect, only: ngm, nl, nlm
use cell_base, only: omega
use grid_dimensions, only: dense
use smooth_grid_dimensions, only: smooth
use electrons_base, only: nspin
use constants, only: pi, fpi
use energies, only: etot, eself, enl, ekin, epseu, esr, eht, exc
@ -279,7 +274,7 @@
integer iss, isup, isdw, ig, ir,i,j,k,is, ia
real(dp) dkedxc(3,3) !metagga
complex(dp) fp, fm, ci
complex(dp) v(dense%nrxx), vs(smooth%nrxx)
complex(dp) v(dfftp%nnr), vs(dffts%nnr)
!
ci=(0.d0,1.d0)
@ -304,7 +299,7 @@
!
if(nspin.eq.1) then
iss=1
do ir=1,dense%nrxx
do ir=1,dfftp%nnr
v(ir)=CMPLX(kedtaur(ir,iss),0.0d0,kind=DP)
end do
call fwfft('Dense',v, dfftp )
@ -316,7 +311,7 @@
isup=1
isdw=2
v(1:dense%nrxx)=CMPLX(kedtaur(1:dense%nrxx,isup),kedtaur(1:dense%nrxx,isdw),kind=DP)
v(1:dfftp%nnr)=CMPLX(kedtaur(1:dfftp%nnr,isup),kedtaur(1:dfftp%nnr,isdw),kind=DP)
call fwfft('Dense',v, dfftp )
do ig=1,ngm
fp=v(nl(ig))+v(nlm(ig))
@ -337,7 +332,7 @@
!
call invfft('Smooth',vs, dffts )
!
kedtaus(1:smooth%nrxx,iss)=DBLE(vs(1:smooth%nrxx))
kedtaus(1:dffts%nnr,iss)=DBLE(vs(1:dffts%nnr))
else
isup=1
isdw=2
@ -346,8 +341,8 @@
vs(nlsm(ig))=CONJG(kedtaug(ig,isup)) +ci*conjg(kedtaug(ig,isdw))
end do
call invfft('Smooth',vs, dffts )
kedtaus(1:smooth%nrxx,isup)= DBLE(vs(1:smooth%nrxx))
kedtaus(1:smooth%nrxx,isdw)=AIMAG(vs(1:smooth%nrxx))
kedtaus(1:dffts%nnr,isup)= DBLE(vs(1:dffts%nnr))
kedtaus(1:dffts%nnr,isdw)=AIMAG(vs(1:dffts%nnr))
endif
!calculate dkedxc in real space on smooth grids !metagga
if(tpre) then
@ -355,7 +350,7 @@
do j=1,3
do i=1,3
dkedxc(i,j)=0.d0
do ir=1,smooth%nrxx
do ir=1,dffts%nnr
!2.d0 : because kedtau = 0.5d0 d_Exc/d_kedtau
dkedxc(i,j)= dkedxc(i,j)+kedtaus(ir,iss)*2.d0*&
dkedtaus(ir,i,j,iss)
@ -368,7 +363,7 @@
#endif
do j=1,3
do i=1,3
dxc(i,j) = dxc(i,j) + omega/(smooth%nr1*smooth%nr2*smooth%nr3)*dkedxc(i,j)
dxc(i,j) = dxc(i,j) + omega/(dffts%nr1*dffts%nr2*dffts%nr3)*dkedxc(i,j)
end do
end do
end if

9
CPV/cpr.f90
View File

@ -53,8 +53,6 @@ SUBROUTINE cprmain( tau_out, fion_out, etot_out )
greash, tpiba2, omega, alat, ibrav, &
celldm, h, hold, hnew, velh, &
wmass, press, iforceh, cell_force
USE grid_dimensions, ONLY : dense
!USE smooth_grid_dimensions, ONLY : smooth
USE local_pseudo, ONLY : allocate_local_pseudo
USE io_global, ONLY : stdout, ionode, ionode_id
USE dener, ONLY : detot
@ -118,6 +116,7 @@ SUBROUTINE cprmain( tau_out, fion_out, etot_out )
USE mp_global, ONLY : root_bgrp, intra_bgrp_comm, np_ortho, me_ortho, ortho_comm, &
me_bgrp, inter_bgrp_comm, nbgrp
USE ldaU_cp, ONLY : lda_plus_u, vupsi
USE fft_base, ONLY : dfftp
!
IMPLICIT NONE
!
@ -257,7 +256,7 @@ SUBROUTINE cprmain( tau_out, fion_out, etot_out )
!
IF ( tfor .OR. thdyn ) THEN
!
CALL phfacs( eigts1,eigts2,eigts3, eigr, mill, taus, dense%nr1,dense%nr2,dense%nr3, nat )
CALL phfacs( eigts1,eigts2,eigts3, eigr, mill, taus, dfftp%nr1,dfftp%nr2,dfftp%nr3, nat )
!
! ... strucf calculates the structure factor sfac
!
@ -480,7 +479,7 @@ SUBROUTINE cprmain( tau_out, fion_out, etot_out )
!
! ... phfac calculates eigr
!
CALL phfacs( eigts1,eigts2,eigts3, eigr, mill, tausp, dense%nr1,dense%nr2,dense%nr3, nat )
CALL phfacs( eigts1,eigts2,eigts3, eigr, mill, tausp, dfftp%nr1,dfftp%nr2,dfftp%nr3, nat )
! ... prefor calculates vkb
!
CALL prefor( eigr, vkb )
@ -735,7 +734,7 @@ SUBROUTINE cprmain( tau_out, fion_out, etot_out )
CALL phbox( taub, iprsta, eigrb )
END IF
CALL r_to_s( tau0, taus, na, nsp, ainv )
CALL phfacs( eigts1,eigts2,eigts3, eigr, mill, taus, dense%nr1,dense%nr2,dense%nr3, nat )
CALL phfacs( eigts1,eigts2,eigts3, eigr, mill, taus, dfftp%nr1,dfftp%nr2,dfftp%nr3, nat )
CALL strucf( sfac, eigts1, eigts2, eigts3, mill, ngms )
!
IF ( thdyn ) CALL formf( tfirst, eself )

83
CPV/exch_corr.f90
View File

@ -17,7 +17,7 @@
use funct, only : dft_is_gradient, dft_is_meta
use gvect, only : ngm
use gvecs, only : ngms
use grid_dimensions, only : dense
use fft_base, only : dfftp
use cell_base, only : ainv, omega, h
use ions_base, only : nsp
use control_flags, only : tpre, iprsta
@ -47,7 +47,7 @@
! output
! rhor contains the exchange-correlation potential
!
real(DP) :: rhor( dense%nrxx, nspin ), rhoc( dense%nrxx )
real(DP) :: rhor( dfftp%nnr, nspin ), rhoc( dfftp%nnr )
real(DP) :: dxc( 3, 3 ), exc
real(DP) :: dcc( 3, 3 ), drc( 3, 3 )
!
@ -68,7 +68,7 @@
!
if ( dft_is_gradient() ) then
!
allocate( gradr( dense%nrxx, 3, nspin ) )
allocate( gradr( dfftp%nnr, 3, nspin ) )
call fillgrad( nspin, rhog, gradr )
!
else
@ -88,9 +88,9 @@
! allocate the sic_arrays
!
ALLOCATE( self_rho( dense%nrxx, nspin ) )
ALLOCATE( self_rho( dfftp%nnr, nspin ) )
ALLOCATE( self_rhog(ngm, nspin ) )
IF( dft_is_gradient() ) ALLOCATE( self_gradr( dense%nrxx, 3, nspin ) )
IF( dft_is_gradient() ) ALLOCATE( self_gradr( dfftp%nnr, 3, nspin ) )
self_rho(:, 1) = rhor( :, 2)
self_rho(:, 2) = rhor( :, 2)
@ -109,14 +109,14 @@
!
if( dft_is_meta() ) then
!
call tpssmeta( dense%nrxx, nspin, gradr, rhor, kedtaur, exc )
call tpssmeta( dfftp%nnr, nspin, gradr, rhor, kedtaur, exc )
!
else
!
CALL exch_corr_cp(dense%nrxx, nspin, gradr, rhor, exc)
CALL exch_corr_cp(dfftp%nnr, nspin, gradr, rhor, exc)
!
IF ( ttsic ) THEN
CALL exch_corr_cp(dense%nrxx, nspin, self_gradr, self_rho, self_exc)
CALL exch_corr_cp(dfftp%nnr, nspin, self_gradr, self_rho, self_exc)
self_exc = sic_alpha * (exc - self_exc)
exc = exc - self_exc
END IF
@ -126,8 +126,8 @@
call mp_sum( exc, intra_bgrp_comm )
IF ( ttsic ) call mp_sum( self_exc, intra_bgrp_comm )
exc = exc * omega / DBLE( dense%nr1 * dense%nr2 * dense%nr3 )
IF ( ttsic ) self_exc = self_exc * omega/DBLE(dense%nr1 * dense%nr2 *dense%nr3 )
exc = exc * omega / DBLE( dfftp%nr1 * dfftp%nr2 * dfftp%nr3 )
IF ( ttsic ) self_exc = self_exc * omega/DBLE(dfftp%nr1 * dfftp%nr2 *dfftp%nr3 )
! WRITE(*,*) 'Debug: calcolo exc', exc, 'eself', self_exc
!
@ -142,14 +142,14 @@
do iss = 1, nspin
do j=1,3
do i=1,3
do ir=1,dense%nrxx
do ir=1,dfftp%nnr
dxc(i,j) = dxc(i,j) + rhor( ir, iss ) * drhor( ir, iss, i, j )
end do
end do
end do
end do
!
dxc = dxc * omega / DBLE( dense%nr1*dense%nr2*dense%nr3 )
dxc = dxc * omega / DBLE( dfftp%nr1*dfftp%nr2*dfftp%nr3 )
!
call mp_sum ( dxc, intra_bgrp_comm )
!
@ -220,7 +220,7 @@
!
dcc = 0.0d0
!
IF( nlcc_any ) CALL denlcc( dense%nrxx, nspin, rhor, sfac, drhocg, dcc )
IF( nlcc_any ) CALL denlcc( dfftp%nnr, nspin, rhor, sfac, drhocg, dcc )
!
! DEBUG
!
@ -234,14 +234,14 @@
IF( nlcc_any ) THEN
do j=1,3
do i=1,3
do ir=1,dense%nrxx
do ir=1,dfftp%nnr
drc(i,j) = drc(i,j) + rhor( ir, iss ) * rhoc( ir ) * ainv(j,i)
end do
end do
end do
call mp_sum ( drc, intra_bgrp_comm )
END IF
dxc = dxc - drc * ( 1.0d0 / nspin ) * omega / ( dense%nr1*dense%nr2*dense%nr3 )
dxc = dxc - drc * ( 1.0d0 / nspin ) * omega / ( dfftp%nr1*dfftp%nr2*dfftp%nr3 )
end do
!
END IF
@ -269,7 +269,6 @@
use control_flags, only: iprint, tpre
use gvect, only: g
use gvect, only: ngm, nl, nlm
use grid_dimensions, only: dense
use cell_base, only: ainv, tpiba, omega
use cp_main_variables, only: drhog
USE fft_interfaces, ONLY: fwfft, invfft
@ -278,7 +277,7 @@
implicit none
! input
integer nspin
real(DP) :: gradr( dense%nrxx, 3, nspin ), rhor( dense%nrxx, nspin ), dexc( 3, 3 )
real(DP) :: gradr( dfftp%nnr, 3, nspin ), rhor( dfftp%nnr, nspin ), dexc( 3, 3 )
complex(DP) :: rhog( ngm, nspin )
!
complex(DP), allocatable:: v(:)
@ -286,7 +285,7 @@
complex(DP) :: ci, fp, fm
integer :: iss, ig, ir, i,j
!
allocate(v(dense%nrxx))
allocate(v(dfftp%nnr))
allocate(x(ngm))
allocate(vtemp(ngm))
!
@ -298,7 +297,7 @@
! _________________________________________________________________
! second part xc-potential: 3 forward ffts
!
do ir=1,dense%nrxx
do ir=1,dfftp%nnr
v(ir)=CMPLX(gradr(ir,1,iss),0.d0,kind=DP)
end do
call fwfft('Dense',v, dfftp )
@ -319,7 +318,7 @@
end do
endif
!
do ir=1,dense%nrxx
do ir=1,dfftp%nnr
v(ir)=CMPLX(gradr(ir,2,iss),gradr(ir,3,iss),kind=DP)
end do
call fwfft('Dense',v, dfftp )
@ -354,7 +353,7 @@
! _________________________________________________________________
! second part xc-potential: 1 inverse fft
!
do ig=1,dense%nrxx
do ig=1,dfftp%nnr
v(ig)=(0.0d0,0.0d0)
end do
do ig=1,ngm
@ -362,7 +361,7 @@
v(nlm(ig))=CONJG(x(ig))
end do
call invfft('Dense',v, dfftp )
do ir=1,dense%nrxx
do ir=1,dfftp%nnr
rhor(ir,iss)=rhor(ir,iss)-DBLE(v(ir))
end do
end do
@ -382,17 +381,17 @@
!
!=----------------------------------------------------------------------------=!
subroutine exch_corr_wrapper(nrxx, nspin, grhor, rhor, etxc, v, h)
subroutine exch_corr_wrapper(nnr, nspin, grhor, rhor, etxc, v, h)
use kinds, only: DP
use funct, only: dft_is_gradient, get_igcc, &
xc, xc_spin, gcxc, gcx_spin, gcc_spin, gcc_spin_more
implicit none
integer, intent(in) :: nrxx
integer, intent(in) :: nnr
integer, intent(in) :: nspin
real(DP), intent(in) :: grhor( nrxx, 3, nspin )
real(DP) :: h( nrxx, nspin, nspin )
real(DP), intent(in) :: rhor( nrxx, nspin )
real(DP) :: v( nrxx, nspin )
real(DP), intent(in) :: grhor( nnr, 3, nspin )
real(DP) :: h( nnr, nspin, nspin )
real(DP), intent(in) :: rhor( nnr, nspin )
real(DP) :: v( nnr, nspin )
real(DP) :: etxc
integer :: ir, is, k
real(DP) :: rup, rdw, ex, ec, vx(2), vc(2)
@ -418,7 +417,7 @@ subroutine exch_corr_wrapper(nrxx, nspin, grhor, rhor, etxc, v, h)
! spin-unpolarized case
!
!$omp parallel do private( rhox, arhox, ex, ec, vx, vc ), reduction(+:etxc)
do ir = 1, nrxx
do ir = 1, nnr
rhox = rhor (ir, nspin)
arhox = abs (rhox)
if (arhox.gt.1.d-30) then
@ -438,7 +437,7 @@ subroutine exch_corr_wrapper(nrxx, nspin, grhor, rhor, etxc, v, h)
neg (1) = 0
neg (2) = 0
neg (3) = 0
do ir = 1, nrxx
do ir = 1, nnr
rhox = rhor(ir,1) + rhor(ir,2)
arhox = abs(rhox)
if (arhox.gt.1.d-30) then
@ -465,7 +464,7 @@ subroutine exch_corr_wrapper(nrxx, nspin, grhor, rhor, etxc, v, h)
if( debug_xc ) then
open(unit=17,form='unformatted')
write(17) nrxx, nspin
write(17) nnr, nspin
write(17) rhor
write(17) grhor
close(17)
@ -482,7 +481,7 @@ subroutine exch_corr_wrapper(nrxx, nspin, grhor, rhor, etxc, v, h)
!
!$omp parallel do &
!$omp private( is, grho2, arho, segno, sx, sc, v1x, v2x, v1c, v2c ), reduction(+:etxc)
do k = 1, nrxx
do k = 1, nnr
!
grho2 (1) = grhor(k, 1, 1)**2 + grhor(k, 2, 1)**2 + grhor(k, 3, 1)**2
arho = abs (rhor (k, 1) )
@ -511,7 +510,7 @@ subroutine exch_corr_wrapper(nrxx, nspin, grhor, rhor, etxc, v, h)
!
! spin-polarised case
!
do k = 1, nrxx
do k = 1, nnr
do is = 1, nspin
grho2 (is) = grhor(k, 1, is)**2 + grhor(k, 2, is)**2 + grhor(k, 3, is)**2
enddo
@ -582,28 +581,28 @@ end subroutine exch_corr_wrapper
!
!=----------------------------------------------------------------------------=!
subroutine exch_corr_cp(nrxx,nspin,grhor,rhor,etxc)
subroutine exch_corr_cp(nnr,nspin,grhor,rhor,etxc)
use kinds, only: DP
use funct, only: dft_is_gradient
implicit none
integer, intent(in) :: nrxx
integer, intent(in) :: nnr
integer, intent(in) :: nspin
real(DP) :: grhor( nrxx, 3, nspin )
real(DP) :: rhor( nrxx, nspin )
real(DP) :: grhor( nnr, 3, nspin )
real(DP) :: rhor( nnr, nspin )
real(DP) :: etxc
integer :: k, ipol
real(DP) :: grup, grdw
real(DP), allocatable :: v(:,:)
real(DP), allocatable :: h(:,:,:)
!
allocate( v( nrxx, nspin ) )
allocate( v( nnr, nspin ) )
if( dft_is_gradient() ) then
allocate( h( nrxx, nspin, nspin ) )
allocate( h( nnr, nspin, nspin ) )
else
allocate( h( 1, 1, 1 ) )
endif
!
call exch_corr_wrapper(nrxx,nspin,grhor,rhor,etxc,v,h)
call exch_corr_wrapper(nnr,nspin,grhor,rhor,etxc,v,h)
if( dft_is_gradient() ) then
!
@ -614,7 +613,7 @@ subroutine exch_corr_cp(nrxx,nspin,grhor,rhor,etxc)
!
do ipol = 1, 3
!$omp do
do k = 1, nrxx
do k = 1, nnr
grhor (k, ipol, 1) = h (k, 1, 1) * grhor (k, ipol, 1)
enddo
!$omp end do
@ -625,7 +624,7 @@ subroutine exch_corr_cp(nrxx,nspin,grhor,rhor,etxc)
!
do ipol = 1, 3
!$omp do
do k = 1, nrxx
do k = 1, nnr
grup = grhor (k, ipol, 1)
grdw = grhor (k, ipol, 2)
grhor (k, ipol, 1) = h (k, 1, 1) * grup + h (k, 1, 2) * grdw

45
CPV/fft.f90
View File

@ -254,7 +254,6 @@
! nfft=2 add imaginary part of qv(r) to real part of array vr(r)
!
USE kinds, ONLY: dp
USE grid_dimensions, ONLY: dense
USE smallbox_grid_dim, ONLY: nr1b, nr2b, nr3b, nr1bx, nr2bx, nnrbx
USE fft_base, ONLY: dfftp
USE mp_global, ONLY: me_bgrp
@ -262,7 +261,7 @@
IMPLICIT NONE
INTEGER, INTENT(in):: nfft, irb(3)
REAL(dp), INTENT(in):: qv(2,nnrbx)
COMPLEX(dp), INTENT(inout):: vr(dense%nrxx)
COMPLEX(dp), INTENT(inout):: vr(dfftp%nnr)
!
INTEGER ir1, ir2, ir3, ir, ibig1, ibig2, ibig3, ibig
INTEGER me
@ -273,22 +272,22 @@
DO ir3=1,nr3b
ibig3=irb(3)+ir3-1
ibig3=1+MOD(ibig3-1,dense%nr3)
IF(ibig3.LT.1.OR.ibig3.GT.dense%nr3) &
ibig3=1+MOD(ibig3-1,dfftp%nr3)
IF(ibig3.LT.1.OR.ibig3.GT.dfftp%nr3) &
& CALL errore('box2grid','ibig3 wrong',ibig3)
ibig3=ibig3-dfftp%ipp(me)
IF ( ibig3 .GT. 0 .AND. ibig3 .LE. ( dfftp%npp(me) ) ) THEN
DO ir2=1,nr2b
ibig2=irb(2)+ir2-1
ibig2=1+MOD(ibig2-1,dense%nr2)
IF(ibig2.LT.1.OR.ibig2.GT.dense%nr2) &
ibig2=1+MOD(ibig2-1,dfftp%nr2)
IF(ibig2.LT.1.OR.ibig2.GT.dfftp%nr2) &
& CALL errore('box2grid','ibig2 wrong',ibig2)
DO ir1=1,nr1b
ibig1=irb(1)+ir1-1
ibig1=1+MOD(ibig1-1,dense%nr1)
IF(ibig1.LT.1.OR.ibig1.GT.dense%nr1) &
ibig1=1+MOD(ibig1-1,dfftp%nr1)
IF(ibig1.LT.1.OR.ibig1.GT.dfftp%nr1) &
& CALL errore('box2grid','ibig1 wrong',ibig1)
ibig=ibig1+(ibig2-1)*dense%nr1x+(ibig3-1)*dense%nr1x*dense%nr2x
ibig=ibig1+(ibig2-1)*dfftp%nr1x+(ibig3-1)*dfftp%nr1x*dfftp%nr2x
ir=ir1+(ir2-1)*nr1bx+(ir3-1)*nr1bx*nr2bx
!$omp critical
vr(ibig) = vr(ibig)+qv(nfft,ir)
@ -310,7 +309,6 @@
! irb : position of the box in the dense grid
!
USE kinds, ONLY: dp
USE grid_dimensions, ONLY: dense
USE smallbox_grid_dim, ONLY: nr1b, nr2b, nr3b, nr1bx, nr2bx, nnrbx
USE fft_base, ONLY: dfftp
USE mp_global, ONLY: me_bgrp
@ -319,7 +317,7 @@
!
INTEGER, INTENT(in):: irb(3)
COMPLEX(dp), INTENT(in):: qv(nnrbx)
COMPLEX(dp), INTENT(inout):: v(dense%nrxx)
COMPLEX(dp), INTENT(inout):: v(dfftp%nnr)
!
INTEGER ir1, ir2, ir3, ir, ibig1, ibig2, ibig3, ibig
INTEGER me
@ -328,22 +326,22 @@
DO ir3=1,nr3b
ibig3=irb(3)+ir3-1
ibig3=1+MOD(ibig3-1,dense%nr3)
IF(ibig3.LT.1.OR.ibig3.GT.dense%nr3) &
ibig3=1+MOD(ibig3-1,dfftp%nr3)
IF(ibig3.LT.1.OR.ibig3.GT.dfftp%nr3) &
& CALL errore('box2grid2','ibig3 wrong',ibig3)
ibig3=ibig3-dfftp%ipp(me)
IF (ibig3.GT.0.AND.ibig3.LE. dfftp%npp(me) ) THEN
DO ir2=1,nr2b
ibig2=irb(2)+ir2-1
ibig2=1+MOD(ibig2-1,dense%nr2)
IF(ibig2.LT.1.OR.ibig2.GT.dense%nr2) &
ibig2=1+MOD(ibig2-1,dfftp%nr2)
IF(ibig2.LT.1.OR.ibig2.GT.dfftp%nr2) &
& CALL errore('box2grid2','ibig2 wrong',ibig2)
DO ir1=1,nr1b
ibig1=irb(1)+ir1-1
ibig1=1+MOD(ibig1-1,dense%nr1)
IF(ibig1.LT.1.OR.ibig1.GT.dense%nr1) &
ibig1=1+MOD(ibig1-1,dfftp%nr1)
IF(ibig1.LT.1.OR.ibig1.GT.dfftp%nr1) &
& CALL errore('box2grid2','ibig1 wrong',ibig1)
ibig=ibig1+(ibig2-1)*dense%nr1x+(ibig3-1)*dense%nr1x*dense%nr2x
ibig=ibig1+(ibig2-1)*dfftp%nr1x+(ibig3-1)*dfftp%nr1x*dfftp%nr2x
ir=ir1+(ir2-1)*nr1bx+(ir3-1)*nr1bx*nr2bx
v(ibig) = v(ibig)+qv(ir)
END DO
@ -366,13 +364,12 @@
! Parallel execution: remember to sum the contributions from other nodes
!
USE kinds, ONLY: dp
USE grid_dimensions, ONLY: dense
USE smallbox_grid_dim, ONLY: nr1b, nr2b, nr3b, nr1bx, nr2bx, nnrbx
USE fft_base, ONLY: dfftp
USE mp_global, ONLY: me_bgrp
IMPLICIT NONE
INTEGER, INTENT(in):: nfft, irb(3)
REAL(dp), INTENT(in):: qv(2,nnrbx), vr(dense%nrxx)
REAL(dp), INTENT(in):: qv(2,nnrbx), vr(dfftp%nnr)
!
INTEGER ir1, ir2, ir3, ir, ibig1, ibig2, ibig3, ibig
INTEGER me
@ -386,16 +383,16 @@
DO ir3=1,nr3b
ibig3=irb(3)+ir3-1
ibig3=1+MOD(ibig3-1,dense%nr3)
ibig3=1+MOD(ibig3-1,dfftp%nr3)
ibig3=ibig3-dfftp%ipp(me)
IF (ibig3.GT.0.AND.ibig3.LE. dfftp%npp(me) ) THEN
DO ir2=1,nr2b
ibig2=irb(2)+ir2-1
ibig2=1+MOD(ibig2-1,dense%nr2)
ibig2=1+MOD(ibig2-1,dfftp%nr2)
DO ir1=1,nr1b
ibig1=irb(1)+ir1-1
ibig1=1+MOD(ibig1-1,dense%nr1)
ibig=ibig1 + (ibig2-1)*dense%nr1x + (ibig3-1)*dense%nr1x*dense%nr2x
ibig1=1+MOD(ibig1-1,dfftp%nr1)
ibig=ibig1 + (ibig2-1)*dfftp%nr1x + (ibig3-1)*dfftp%nr1x*dfftp%nr2x
ir =ir1 + (ir2-1)*nr1bx + (ir3-1)*nr1bx*nr2bx
boxdotgrid = boxdotgrid + qv(nfft,ir)*vr(ibig)
END DO

7
CPV/forces.f90
View File

@ -30,7 +30,6 @@
USE gvecs, ONLY: nlsm, nls
USE uspp, ONLY: nhsa=>nkb, dvan, deeq
USE uspp_param, ONLY: nhm, nh, ish
USE smooth_grid_dimensions, ONLY: smooth
USE constants, ONLY: pi, fpi
USE ions_base, ONLY: nsp, na, nat
USE gvecw, ONLY: ngw, ggp
@ -73,7 +72,7 @@
ALLOCATE( psi( dffts%tg_nnr * dffts%nogrp ) )
ELSE
nogrp_ = 1
ALLOCATE( psi( smooth%nrxx ) )
ALLOCATE( psi( dffts%nnr ) )
END IF
!
ci = ( 0.0d0, 1.0d0 )
@ -132,14 +131,14 @@
!
IF( PRESENT( v1 ) ) THEN
!$omp parallel do
DO ir=1,smooth%nrxx
DO ir=1,dffts%nnr
psi(ir)=CMPLX ( v(ir,iss1)* DBLE(psi(ir)), &
v1(ir,iss2)*AIMAG(psi(ir)) ,kind=DP)
END DO
!$omp end parallel do
ELSE
!$omp parallel do
DO ir=1,smooth%nrxx
DO ir=1,dffts%nnr
psi(ir)=CMPLX( v(ir,iss1)* DBLE(psi(ir)), &
v(ir,iss2)*AIMAG(psi(ir)) ,kind=DP)
END DO

4
CPV/fromscra.f90
View File

@ -51,7 +51,7 @@ SUBROUTINE from_scratch( )
USE atoms_type_module, ONLY : atoms_type
USE wave_base, ONLY : wave_steepest
USE wavefunctions_module, ONLY : c0_bgrp, cm_bgrp, phi_bgrp
USE grid_dimensions, ONLY : dense
USE fft_base, ONLY : dfftp
USE time_step, ONLY : delt
USE cp_main_variables, ONLY : setval_lambda, descla, bephi, becp_bgrp, nfi, &
sfac, eigr, taub, irb, eigrb, bec_bgrp, &
@ -106,7 +106,7 @@ SUBROUTINE from_scratch( )
!
END IF
!
CALL phfacs( eigts1, eigts2, eigts3, eigr, mill, atoms0%taus, dense%nr1, dense%nr2, dense%nr3, atoms0%nat )
CALL phfacs( eigts1, eigts2, eigts3, eigr, mill, atoms0%taus, dfftp%nr1, dfftp%nr2, dfftp%nr3, atoms0%nat )
!
CALL strucf( sfac, eigts1, eigts2, eigts3, mill, ngms )
!

29
CPV/gradrho.f90
View File

@ -19,26 +19,25 @@ SUBROUTINE gradrho(nspin,rhog,drho,d2rho,dxdyrho,dxdzrho,dydzrho)
use gvect, only: ngm, nl, nlm, g
USE fft_interfaces, ONLY: invfft
USE fft_base, ONLY: dfftp
use grid_dimensions, only : dense
!
implicit none
! input
integer nspin
complex(kind=8) rhog(ngm,nspin)
! output
real(kind=8) drho(3,dense%nrxx), d2rho(3,dense%nrxx), &
& dxdyrho(dense%nrxx), dxdzrho(dense%nrxx), &
& dydzrho(dense%nrxx)
real(kind=8) drho(3,dfftp%nnr), d2rho(3,dfftp%nnr), &
& dxdyrho(dfftp%nnr), dxdzrho(dfftp%nnr), &
& dydzrho(dfftp%nnr)
! local
complex(kind=8), allocatable:: v(:), w(:)
complex(kind=8) ci
integer iss, ig, ir, j
!
!
allocate(v(dense%nrxx))
allocate(w(dense%nrxx))
allocate(v(dfftp%nnr))
allocate(w(dfftp%nnr))
ci=(0.0d0,1.0d0)
do ir = 1,dense%nrxx
do ir = 1,dfftp%nnr
do j = 1,3
drho(j,ir) = 0.d0
d2rho(j,ir) = 0.d0
@ -49,7 +48,7 @@ SUBROUTINE gradrho(nspin,rhog,drho,d2rho,dxdyrho,dxdzrho,dydzrho)
end do
do iss=1,nspin
do ig=1,dense%nrxx
do ig=1,dfftp%nnr
v(ig)=(0.0d0,0.0d0)
w(ig)=(0.0d0,0.0d0)
end do
@ -61,12 +60,12 @@ SUBROUTINE gradrho(nspin,rhog,drho,d2rho,dxdyrho,dxdzrho,dydzrho)
end do
call invfft('Dense',v, dfftp )
call invfft('Dense',w, dfftp )
do ir=1,dense%nrxx
do ir=1,dfftp%nnr
drho(1,ir)=drho(1,ir)+real(v(ir))
d2rho(1,ir)=d2rho(1,ir)+real(w(ir))
end do
!
do ig=1,dense%nrxx
do ig=1,dfftp%nnr
v(ig)=(0.0d0,0.0d0)
w(ig)=(0.0d0,0.0d0)
end do
@ -82,14 +81,14 @@ SUBROUTINE gradrho(nspin,rhog,drho,d2rho,dxdyrho,dxdzrho,dydzrho)
end do
call invfft('Dense',v, dfftp )
call invfft('Dense',w, dfftp )
do ir=1,dense%nrxx
do ir=1,dfftp%nnr
drho(2,ir)=drho(2,ir)+real(v(ir))
drho(3,ir)=drho(3,ir)+aimag(v(ir))
d2rho(2,ir)=d2rho(2,ir)+real(w(ir))
d2rho(3,ir)=d2rho(3,ir)+aimag(w(ir))
end do
do ig=1,dense%nrxx
do ig=1,dfftp%nnr
v(ig)=(0.0d0,0.0d0)
end do
do ig=1,ngm
@ -97,11 +96,11 @@ SUBROUTINE gradrho(nspin,rhog,drho,d2rho,dxdyrho,dxdzrho,dydzrho)
v(nlm(ig))=conjg(v(nl(ig)))
end do
call invfft('Dense',v, dfftp )
do ir=1,dense%nrxx
do ir=1,dfftp%nnr
dxdyrho(ir)=dxdyrho(ir)+real(v(ir))
end do
!
do ig=1,dense%nrxx
do ig=1,dfftp%nnr
v(ig)=(0.0d0,0.0d0)
end do
do ig=1,ngm
@ -112,7 +111,7 @@ SUBROUTINE gradrho(nspin,rhog,drho,d2rho,dxdyrho,dxdzrho,dydzrho)
& ci*conjg(g(2,ig)*g(3,ig)*rhog(ig,iss)))
end do
call invfft('Dense',v, dfftp )
do ir=1,dense%nrxx
do ir=1,dfftp%nnr
dxdzrho(ir)=dxdzrho(ir)+real(v(ir))
dydzrho(ir)=dydzrho(ir)+aimag(v(ir))
end do

30
CPV/init.f90
View File

@ -23,8 +23,6 @@
USE constants, ONLY: tpi
use io_global, only: stdout, ionode
use control_flags, only: gamma_only, iprsta
use grid_dimensions, only: dense
use smooth_grid_dimensions, only: smooth
use cell_base, only: ainv, at, omega, alat
use small_box, only: small_box_set
use smallbox_grid_dim, only: nr1b, nr2b, nr3b, &
@ -81,8 +79,8 @@
! ... Initialize FFT real-space grids and small box grid
!
CALL realspace_grids_init( dense, smooth, at, bg, gcutm, gcutms)
CALL smallbox_grid_init( dense )
CALL realspace_grids_init( dfftp, dffts, at, bg, gcutm, gcutms)
CALL smallbox_grid_init( dfftp )
IF( ionode ) THEN
@ -115,7 +113,7 @@
nogrp_ = get_ntask_groups()
CALL pstickset( gamma_only, bg, gcutm, gkcut, gcutms, &
dfftp, dffts, ngw_ , ngm_ , ngs_ , dense, smooth, me_bgrp, root_bgrp, nproc_bgrp, intra_bgrp_comm, nogrp_ )
dfftp, dffts, ngw_ , ngm_ , ngs_ , me_bgrp, root_bgrp, nproc_bgrp, intra_bgrp_comm, nogrp_ )
!
!
! ... Initialize reciprocal space local and global dimensions
@ -127,7 +125,7 @@
!
! ... Print real-space grid dimensions
!
CALL realspace_grids_info ( dense, smooth, dfftp, dffts, nproc_bgrp )
CALL realspace_grids_info ( dfftp, dffts, nproc_bgrp )
CALL smallbox_grid_info ( )
!
! ... generate g-space vectors (dense and smooth grid)
@ -151,9 +149,9 @@
!
! allocate spaces for phases e^{-iG*tau_s}
!
allocate( eigts1(-dense%nr1:dense%nr1,nat) )
allocate( eigts2(-dense%nr2:dense%nr2,nat) )
allocate( eigts3(-dense%nr3:dense%nr3,nat) )
allocate( eigts1(-dfftp%nr1:dfftp%nr1,nat) )
allocate( eigts2(-dfftp%nr2:dfftp%nr2,nat) )
allocate( eigts3(-dfftp%nr3:dfftp%nr3,nat) )
!
! small boxes
!
@ -161,9 +159,9 @@
! set the small box parameters
rat1 = DBLE( nr1b ) / DBLE( dense%nr1 )
rat2 = DBLE( nr2b ) / DBLE( dense%nr2 )
rat3 = DBLE( nr3b ) / DBLE( dense%nr3 )
rat1 = DBLE( nr1b ) / DBLE( dfftp%nr1 )
rat2 = DBLE( nr2b ) / DBLE( dfftp%nr2 )
rat3 = DBLE( nr3b ) / DBLE( dfftp%nr3 )
!
CALL small_box_set( alat, omega, at, rat1, rat2, rat3 )
!
@ -334,7 +332,7 @@
cell_base_reinit
USE gvecw, ONLY : g2kin_init
USE gvect, ONLY : g, gg, ngm, mill
USE grid_dimensions, ONLY : dense
USE fft_base, ONLY : dfftp
USE small_box, ONLY : small_box_set
USE smallbox_subs, ONLY : gcalb
USE io_global, ONLY : stdout, ionode
@ -372,9 +370,9 @@
!
! generation of little box g-vectors
!
rat1 = DBLE( nr1b ) / DBLE( dense%nr1 )
rat2 = DBLE( nr2b ) / DBLE( dense%nr2 )
rat3 = DBLE( nr3b ) / DBLE( dense%nr3 )
rat1 = DBLE( nr1b ) / DBLE( dfftp%nr1 )
rat2 = DBLE( nr2b ) / DBLE( dfftp%nr2 )
rat3 = DBLE( nr3b ) / DBLE( dfftp%nr3 )
CALL small_box_set( alat, omega, at, rat1, rat2, rat3 )
!
call gcalb ( )

18
CPV/init_run.f90
View File

@ -27,12 +27,10 @@ SUBROUTINE init_run()
USE gvecs, ONLY : ngms
USE gvect, ONLY : ngm
USE gvect, ONLY : gstart
USE grid_dimensions, ONLY : dense
USE fft_base, ONLY : dfftp
USE fft_base, ONLY : dfftp, dffts
USE electrons_base, ONLY : nspin, nbsp, nbspx, nupdwn, f
USE uspp, ONLY : nkb, vkb, deeq, becsum,nkbus
USE core, ONLY : rhoc
USE smooth_grid_dimensions, ONLY : smooth
USE wavefunctions_module, ONLY : c0_bgrp, cm_bgrp, phi_bgrp
USE ensemble_dft, ONLY : tens, z0t
USE cg_module, ONLY : tcg
@ -149,8 +147,8 @@ SUBROUTINE init_run()
! allocation of all arrays not already allocated in init and nlinit
!=======================================================================
!
CALL allocate_mainvar( ngw, ngw_g, ngb, ngms, ngm, dense%nr1,dense%nr2,dense%nr3, dfftp%nr1x, &
dfftp%nr2x, dfftp%npl, dense%nrxx, smooth%nrxx, nat, nax, nsp, &
CALL allocate_mainvar( ngw, ngw_g, ngb, ngms, ngm, dfftp%nr1,dfftp%nr2,dfftp%nr3, dfftp%nr1x, &
dfftp%nr2x, dfftp%npl, dfftp%nnr, dffts%nnr, nat, nax, nsp, &
nspin, nbsp, nbspx, nupdwn, nkb, gstart, nudx, &
tpre, nbspx_bgrp )
!
@ -201,22 +199,22 @@ SUBROUTINE init_run()
!
IF ( dft_is_meta() .AND. tpre ) THEN
!
ALLOCATE( crosstaus( smooth%nrxx, 6, nspin ) )
ALLOCATE( dkedtaus( smooth%nrxx, 3, 3, nspin ) )
ALLOCATE( gradwfc( smooth%nrxx, 3 ) )
ALLOCATE( crosstaus( dffts%nnr, 6, nspin ) )
ALLOCATE( dkedtaus( dffts%nnr, 3, 3, nspin ) )
ALLOCATE( gradwfc( dffts%nnr, 3 ) )
!
END IF
!
IF ( lwf ) THEN
IF( nbgrp > 1 ) &
CALL errore( ' init_run ', ' wannier with band paralleliztion not implemented ', 1 )
CALL allocate_wannier( nbsp, smooth%nrxx, nspin, ngm )
CALL allocate_wannier( nbsp, dffts%nnr, nspin, ngm )
END IF
!
IF ( tens .OR. tcg ) THEN
IF( nbgrp > 1 ) &
CALL errore( ' init_run ', ' ensemble_dft with band paralleliztion not implemented ', 1 )
CALL allocate_ensemble_dft( nkb, nbsp, ngw, nudx, nspin, nbspx, smooth%nrxx, nat, nlax, nrlx )
CALL allocate_ensemble_dft( nkb, nbsp, ngw, nudx, nspin, nbspx, dffts%nnr, nat, nlax, nrlx )
END IF
!
IF ( tcg ) THEN

44
CPV/inner_loop_cold.f90
View File

@ -38,11 +38,8 @@
ONLY: gstart
USE uspp_param, ONLY: nvb, ish
USE ions_base, ONLY: na, nat, pmass, nax, nsp, rcmax
USE grid_dimensions, &
ONLY: dense
USE cell_base, ONLY: omega, alat
USE smooth_grid_dimensions, &
ONLY: smooth
USE fft_base, ONLY: dfftp, dffts
USE local_pseudo, ONLY: vps, rhops
USE io_global, ONLY: stdout, ionode, ionode_id
USE mp_global, ONLY: intra_bgrp_comm, leg_ortho
@ -79,14 +76,14 @@
INTEGER :: irb( 3, nat )
COMPLEX (kind=DP) :: eigrb( ngb, nat )
REAL(kind=DP) :: rhor( dense%nrxx, nspin )
REAL(kind=DP) :: vpot( dense%nrxx, nspin )
REAL(kind=DP) :: rhor( dfftp%nnr, nspin )
REAL(kind=DP) :: vpot( dfftp%nnr, nspin )
COMPLEX(kind=DP) :: rhog( ngm, nspin )
REAL(kind=DP) :: rhos( smooth%nrxx, nspin )
REAL(kind=DP) :: rhoc( dense%nrxx )
COMPLEX(kind=DP) :: ei1( dense%nr1:dense%nr1, nat )
COMPLEX(kind=DP) :: ei2( dense%nr2:dense%nr2, nat )
COMPLEX(kind=DP) :: ei3( dense%nr3:dense%nr3, nat )
REAL(kind=DP) :: rhos( dffts%nnr, nspin )
REAL(kind=DP) :: rhoc( dfftp%nnr )
COMPLEX(kind=DP) :: ei1( dfftp%nr1:dfftp%nr1, nat )
COMPLEX(kind=DP) :: ei2( dfftp%nr2:dfftp%nr2, nat )
COMPLEX(kind=DP) :: ei3( dfftp%nr3:dfftp%nr3, nat )
COMPLEX(kind=DP) :: sfac( ngms, nsp )
@ -157,7 +154,7 @@
! operates the Hamiltonian on the wavefunction c0
h0c0( :, : )= 0.D0
DO i= 1, n, 2
CALL dforce( i, bec, betae, c0, h0c0(:,i), h0c0(:,i+1), rhos, smooth%nrxx, ispin, f, n, nspin )
CALL dforce( i, bec, betae, c0, h0c0(:,i), h0c0(:,i+1), rhos, dffts%nnr, ispin, f, n, nspin )
END DO
@ -340,11 +337,7 @@
ONLY: gstart
USE uspp_param, ONLY: nvb, ish
USE ions_base, ONLY: na, nat, pmass, nax, nsp, rcmax
USE grid_dimensions, &
ONLY: dense
USE cell_base, ONLY: omega, alat
USE smooth_grid_dimensions, &
ONLY: smooth
USE local_pseudo, ONLY: vps, rhops
USE io_global, ONLY: stdout, ionode, ionode_id
USE dener
@ -356,6 +349,7 @@
USE mp, ONLY: mp_sum,mp_bcast
use cp_interfaces, only: rhoofr, dforce, vofrho
USE cp_main_variables, ONLY: descla, nlax, nrlx, drhor, drhog
USE fft_base, ONLY: dfftp, dffts
!
IMPLICIT NONE
@ -373,14 +367,14 @@
INTEGER :: irb( 3, nat )
COMPLEX (kind=DP) :: eigrb( ngb, nat )
REAL(kind=DP) :: rhor( dense%nrxx, nspin )
REAL(kind=DP) :: vpot( dense%nrxx, nspin )
REAL(kind=DP) :: rhor( dfftp%nnr, nspin )
REAL(kind=DP) :: vpot( dfftp%nnr, nspin )
COMPLEX(kind=DP) :: rhog( ngm, nspin )
REAL(kind=DP) :: rhos( smooth%nrxx, nspin )
REAL(kind=DP) :: rhoc( dense%nrxx )
COMPLEX(kind=DP) :: ei1( dense%nr1:dense%nr1, nat )
COMPLEX(kind=DP) :: ei2( dense%nr2:dense%nr2, nat )
COMPLEX(kind=DP) :: ei3( dense%nr3:dense%nr3, nat )
REAL(kind=DP) :: rhos( dffts%nnr, nspin )
REAL(kind=DP) :: rhoc( dfftp%nnr )
COMPLEX(kind=DP) :: ei1( dfftp%nr1:dfftp%nr1, nat )
COMPLEX(kind=DP) :: ei2( dfftp%nr2:dfftp%nr2, nat )
COMPLEX(kind=DP) :: ei3( dfftp%nr3:dfftp%nr3, nat )
COMPLEX(kind=DP) :: sfac( ngms, nsp )
REAL(kind=DP), INTENT(in) :: c0hc0(nlax,nlax,nspin)
@ -525,11 +519,7 @@
ONLY: gstart
USE uspp_param, ONLY: nvb, ish
USE ions_base, ONLY: na, nat, pmass, nax, nsp, rcmax
USE grid_dimensions, &
ONLY: dense
USE cell_base, ONLY: omega, alat
USE smooth_grid_dimensions, &
ONLY: smooth
USE local_pseudo, ONLY: vps, rhops
USE io_global, ONLY: stdout, ionode, ionode_id
USE mp_global, ONLY: intra_bgrp_comm

15
CPV/input.f90
View File

@ -865,8 +865,7 @@ MODULE input
nr1b_ => nr1b, &
nr2b_ => nr2b, &
nr3b_ => nr3b
USE grid_dimensions, ONLY: dense
USE smooth_grid_dimensions, ONLY: smooth
USE fft_base, ONLY: dfftp, dffts
USE kohn_sham_states, ONLY : ks_states_init
USE electrons_module, ONLY : electrons_setup
USE electrons_base, ONLY : electrons_base_initval
@ -931,16 +930,16 @@ MODULE input
! set size for potentials and charge density
! (re-calculated automatically)
dense%nr1 = nr1
dense%nr2 = nr2
dense%nr3 = nr3
dfftp%nr1 = nr1
dfftp%nr2 = nr2
dfftp%nr3 = nr3
! set size for wavefunctions
! (re-calculated automatically)
smooth%nr1 = nr1s
smooth%nr2 = nr2s
smooth%nr3 = nr3s
dffts%nr1 = nr1s
dffts%nr2 = nr2s
dffts%nr3 = nr3s
CALL efield_init( epol, efield )

11
CPV/ksstates.f90
View File

@ -140,8 +140,7 @@ CONTAINS
USE io_global, ONLY: ionode, ionode_id
USE io_global, ONLY: stdout
USE gvecw, ONLY: ngw
USE grid_dimensions, ONLY: dense
USE fft_base, ONLY: dfftp, dffts
USE fft_base, ONLY: dfftp, dffts, dfftp
USE fft_interfaces, ONLY: invfft
USE xml_io_base, ONLY: write_rho_xml
USE mp_global, ONLY: intra_bgrp_comm, inter_bgrp_comm
@ -155,13 +154,13 @@ CONTAINS
INTEGER :: i
REAL(DP) :: charge
ALLOCATE( psi( dense%nrxx ) )
ALLOCATE( rpsi2( dense%nrxx ) )
ALLOCATE( psi( dfftp%nnr ) )
ALLOCATE( rpsi2( dfftp%nnr ) )
CALL c2psi( psi, dffts%nnr, c, c, ngw, 1 )
CALL invfft( 'Wave', psi, dffts )
DO i = 1, dense%nrxx
DO i = 1, dfftp%nnr
rpsi2( i ) = DBLE( psi( i ) )**2
END DO
charge = SUM( rpsi2 )
@ -174,7 +173,7 @@ CONTAINS
IF ( ionode ) THEN
WRITE( stdout,'(3X,A15," integrated charge : ",F14.5)') &
& TRIM(file_name), charge / DBLE(dense%nr1*dense%nr2*dense%nr3)
& TRIM(file_name), charge / DBLE(dfftp%nr1*dfftp%nr2*dfftp%nr3)
END IF
DEALLOCATE( rpsi2, psi )

38
CPV/make.depend
View File

@ -31,7 +31,7 @@ cg_sub.o : ../Modules/control_flags.o
cg_sub.o : ../Modules/descriptors.o
cg_sub.o : ../Modules/electrons_base.o
cg_sub.o : ../Modules/energies.o
cg_sub.o : ../Modules/griddim.o
cg_sub.o : ../Modules/fft_base.o
cg_sub.o : ../Modules/io_files.o
cg_sub.o : ../Modules/io_global.o
cg_sub.o : ../Modules/ions_base.o
@ -74,7 +74,6 @@ chargedensity.o : ../Modules/electrons_base.o
chargedensity.o : ../Modules/fft_base.o
chargedensity.o : ../Modules/fft_interfaces.o
chargedensity.o : ../Modules/funct.o
chargedensity.o : ../Modules/griddim.o
chargedensity.o : ../Modules/io_files.o
chargedensity.o : ../Modules/io_global.o
chargedensity.o : ../Modules/ions_base.o
@ -110,7 +109,7 @@ cp_emass.o : ../Modules/control_flags.o
cp_emass.o : ../Modules/kind.o
cp_interfaces.o : ../Modules/cell_base.o
cp_interfaces.o : ../Modules/descriptors.o
cp_interfaces.o : ../Modules/griddim.o
cp_interfaces.o : ../Modules/fft_base.o
cp_interfaces.o : ../Modules/ions_base.o
cp_interfaces.o : ../Modules/kind.o
cp_interfaces.o : ../Modules/recvec.o
@ -122,7 +121,6 @@ cp_restart.o : ../Modules/electrons_base.o
cp_restart.o : ../Modules/energies.o
cp_restart.o : ../Modules/fft_base.o
cp_restart.o : ../Modules/funct.o
cp_restart.o : ../Modules/griddim.o
cp_restart.o : ../Modules/io_files.o
cp_restart.o : ../Modules/io_global.o
cp_restart.o : ../Modules/ions_base.o
@ -150,7 +148,6 @@ cplib.o : ../Modules/electrons_base.o
cplib.o : ../Modules/fft_base.o
cplib.o : ../Modules/fft_interfaces.o
cplib.o : ../Modules/funct.o
cplib.o : ../Modules/griddim.o
cplib.o : ../Modules/io_global.o
cplib.o : ../Modules/ions_base.o
cplib.o : ../Modules/kind.o
@ -175,7 +172,6 @@ cplib_meta.o : ../Modules/electrons_base.o
cplib_meta.o : ../Modules/energies.o
cplib_meta.o : ../Modules/fft_base.o
cplib_meta.o : ../Modules/fft_interfaces.o
cplib_meta.o : ../Modules/griddim.o
cplib_meta.o : ../Modules/io_global.o
cplib_meta.o : ../Modules/ions_base.o
cplib_meta.o : ../Modules/kind.o
@ -193,7 +189,7 @@ cpr.o : ../Modules/constraints_module.o
cpr.o : ../Modules/control_flags.o
cpr.o : ../Modules/electrons_base.o
cpr.o : ../Modules/energies.o
cpr.o : ../Modules/griddim.o
cpr.o : ../Modules/fft_base.o
cpr.o : ../Modules/io_files.o
cpr.o : ../Modules/io_global.o
cpr.o : ../Modules/ions_base.o
@ -313,7 +309,6 @@ exch_corr.o : ../Modules/control_flags.o
exch_corr.o : ../Modules/fft_base.o
exch_corr.o : ../Modules/fft_interfaces.o
exch_corr.o : ../Modules/funct.o
exch_corr.o : ../Modules/griddim.o
exch_corr.o : ../Modules/io_global.o
exch_corr.o : ../Modules/ions_base.o
exch_corr.o : ../Modules/kind.o
@ -325,7 +320,6 @@ exch_corr.o : cp_interfaces.o
exch_corr.o : mainvar.o
exch_corr.o : modules.o
fft.o : ../Modules/fft_base.o
fft.o : ../Modules/griddim.o
fft.o : ../Modules/kind.o
fft.o : ../Modules/mp_global.o
fft.o : ../Modules/recvec.o
@ -336,7 +330,6 @@ forces.o : ../Modules/control_flags.o
forces.o : ../Modules/fft_base.o
forces.o : ../Modules/fft_interfaces.o
forces.o : ../Modules/funct.o
forces.o : ../Modules/griddim.o
forces.o : ../Modules/ions_base.o
forces.o : ../Modules/kind.o
forces.o : ../Modules/mp_global.o
@ -357,7 +350,7 @@ fromscra.o : ../Modules/cell_base.o
fromscra.o : ../Modules/control_flags.o
fromscra.o : ../Modules/electrons_base.o
fromscra.o : ../Modules/energies.o
fromscra.o : ../Modules/griddim.o
fromscra.o : ../Modules/fft_base.o
fromscra.o : ../Modules/io_global.o
fromscra.o : ../Modules/ions_base.o
fromscra.o : ../Modules/kind.o
@ -387,7 +380,6 @@ fromscra.o : ortho_base.o
gradrho.o : ../Modules/cell_base.o
gradrho.o : ../Modules/fft_base.o
gradrho.o : ../Modules/fft_interfaces.o
gradrho.o : ../Modules/griddim.o
gradrho.o : ../Modules/recvec.o
gram.o : ../Modules/electrons_base.o
gram.o : ../Modules/ions_base.o
@ -442,7 +434,6 @@ init_run.o : ../Modules/electrons_base.o
init_run.o : ../Modules/energies.o
init_run.o : ../Modules/fft_base.o
init_run.o : ../Modules/funct.o
init_run.o : ../Modules/griddim.o
init_run.o : ../Modules/io_files.o
init_run.o : ../Modules/io_global.o
init_run.o : ../Modules/ions_base.o
@ -478,7 +469,7 @@ inner_loop_cold.o : ../Modules/descriptors.o
inner_loop_cold.o : ../Modules/dspev_drv.o
inner_loop_cold.o : ../Modules/electrons_base.o
inner_loop_cold.o : ../Modules/energies.o
inner_loop_cold.o : ../Modules/griddim.o
inner_loop_cold.o : ../Modules/fft_base.o
inner_loop_cold.o : ../Modules/io_global.o
inner_loop_cold.o : ../Modules/ions_base.o
inner_loop_cold.o : ../Modules/kind.o
@ -500,7 +491,7 @@ input.o : ../Modules/constants.o
input.o : ../Modules/constraints_module.o
input.o : ../Modules/control_flags.o
input.o : ../Modules/electrons_base.o
input.o : ../Modules/griddim.o
input.o : ../Modules/fft_base.o
input.o : ../Modules/input_parameters.o
input.o : ../Modules/io_files.o
input.o : ../Modules/io_global.o
@ -547,7 +538,6 @@ ions_positions.o : atoms_type.o
ksstates.o : ../Modules/electrons_base.o
ksstates.o : ../Modules/fft_base.o
ksstates.o : ../Modules/fft_interfaces.o
ksstates.o : ../Modules/griddim.o
ksstates.o : ../Modules/io_global.o
ksstates.o : ../Modules/kind.o
ksstates.o : ../Modules/mp.o
@ -586,7 +576,6 @@ makov_payne.o : ../Modules/cell_base.o
makov_payne.o : ../Modules/constants.o
makov_payne.o : ../Modules/electrons_base.o
makov_payne.o : ../Modules/fft_base.o
makov_payne.o : ../Modules/griddim.o
makov_payne.o : ../Modules/io_global.o
makov_payne.o : ../Modules/ions_base.o
makov_payne.o : ../Modules/kind.o
@ -622,7 +611,6 @@ newd.o : ../Modules/control_flags.o
newd.o : ../Modules/electrons_base.o
newd.o : ../Modules/fft_base.o
newd.o : ../Modules/fft_interfaces.o
newd.o : ../Modules/griddim.o
newd.o : ../Modules/ions_base.o
newd.o : ../Modules/kind.o
newd.o : ../Modules/mp.o
@ -652,7 +640,6 @@ nlcc.o : ../Modules/control_flags.o
nlcc.o : ../Modules/electrons_base.o
nlcc.o : ../Modules/fft_base.o
nlcc.o : ../Modules/fft_interfaces.o
nlcc.o : ../Modules/griddim.o
nlcc.o : ../Modules/io_global.o
nlcc.o : ../Modules/ions_base.o
nlcc.o : ../Modules/kind.o
@ -698,7 +685,7 @@ ortho_base.o : gvecw.o
phasefactor.o : ../Modules/cell_base.o
phasefactor.o : ../Modules/constants.o
phasefactor.o : ../Modules/control_flags.o
phasefactor.o : ../Modules/griddim.o
phasefactor.o : ../Modules/fft_base.o
phasefactor.o : ../Modules/io_global.o
phasefactor.o : ../Modules/ions_base.o
phasefactor.o : ../Modules/kind.o
@ -729,7 +716,6 @@ potentials.o : ../Modules/constants.o
potentials.o : ../Modules/control_flags.o
potentials.o : ../Modules/fft_base.o
potentials.o : ../Modules/fft_interfaces.o
potentials.o : ../Modules/griddim.o
potentials.o : ../Modules/io_files.o
potentials.o : ../Modules/io_global.o
potentials.o : ../Modules/ions_base.o
@ -856,7 +842,7 @@ restart_sub.o : ../Modules/cell_base.o
restart_sub.o : ../Modules/control_flags.o
restart_sub.o : ../Modules/electrons_base.o
restart_sub.o : ../Modules/energies.o
restart_sub.o : ../Modules/griddim.o
restart_sub.o : ../Modules/fft_base.o
restart_sub.o : ../Modules/io_global.o
restart_sub.o : ../Modules/ions_base.o
restart_sub.o : ../Modules/kind.o
@ -894,14 +880,13 @@ smallbox.o : ../Modules/constants.o
smallbox.o : ../Modules/io_global.o
smallbox.o : ../Modules/kind.o
smallbox_grid.o : ../Modules/fft_scalar.o
smallbox_grid.o : ../Modules/griddim.o
smallbox_grid.o : ../Modules/fft_types.o
smallbox_grid.o : ../Modules/io_global.o
smallbox_gvec.o : ../Modules/kind.o
smallbox_lib.o : ../Modules/cell_base.o
smallbox_lib.o : ../Modules/control_flags.o
smallbox_lib.o : ../Modules/fft_base.o
smallbox_lib.o : ../Modules/fft_types.o
smallbox_lib.o : ../Modules/griddim.o
smallbox_lib.o : ../Modules/io_global.o
smallbox_lib.o : ../Modules/ions_base.o
smallbox_lib.o : ../Modules/kind.o
@ -943,7 +928,6 @@ vofrho.o : ../Modules/energies.o
vofrho.o : ../Modules/fft_base.o
vofrho.o : ../Modules/fft_interfaces.o
vofrho.o : ../Modules/funct.o
vofrho.o : ../Modules/griddim.o
vofrho.o : ../Modules/io_global.o
vofrho.o : ../Modules/ions_base.o
vofrho.o : ../Modules/kind.o
@ -963,7 +947,6 @@ vol_clu.o : ../Modules/control_flags.o
vol_clu.o : ../Modules/electrons_base.o
vol_clu.o : ../Modules/fft_base.o
vol_clu.o : ../Modules/fft_interfaces.o
vol_clu.o : ../Modules/griddim.o
vol_clu.o : ../Modules/io_global.o
vol_clu.o : ../Modules/ions_base.o
vol_clu.o : ../Modules/kind.o
@ -977,7 +960,7 @@ vol_clu.o : pres_ai_mod.o
wannier.o : ../Modules/cell_base.o
wannier.o : ../Modules/control_flags.o
wannier.o : ../Modules/electrons_base.o
wannier.o : ../Modules/griddim.o
wannier.o : ../Modules/fft_base.o
wannier.o : ../Modules/io_global.o
wannier.o : ../Modules/ions_base.o
wannier.o : ../Modules/kind.o
@ -1009,7 +992,6 @@ wf.o : ../Modules/control_flags.o
wf.o : ../Modules/electrons_base.o
wf.o : ../Modules/fft_base.o
wf.o : ../Modules/fft_interfaces.o
wf.o : ../Modules/griddim.o
wf.o : ../Modules/io_global.o
wf.o : ../Modules/ions_base.o
wf.o : ../Modules/kind.o

45
CPV/makov_payne.f90
View File

@ -22,7 +22,6 @@ SUBROUTINE makov_payne(etot)
USE electrons_base, ONLY : nspin
USE cell_base, ONLY : at, bg, omega, alat, ibrav
USE parallel_include
USE grid_dimensions, ONLY : dense
USE gvecw , ONLY : ngw
USE fft_base, ONLY : dfftp
#if defined __PARA
@ -57,11 +56,11 @@ REAL(KIND=DP), ALLOCATABLE:: rhodist2(:)
RETURN
ENDIF
!
usunx=1.0D0/DBLE(dense%nr1x)
usuny=1.0D0/DBLE(dense%nr2x)
usunz=1.0D0/DBLE(dense%nr3x)
ALLOCATE ( r(nat,3),rhof(dense%nr1x,dense%nr2x,dense%nr3x),&
& rgx(dense%nr1x),rgy(dense%nr2x),rgz(dense%nr3x),zvv(nat) )
usunx=1.0D0/DBLE(dfftp%nr1x)
usuny=1.0D0/DBLE(dfftp%nr2x)
usunz=1.0D0/DBLE(dfftp%nr3x)
ALLOCATE ( r(nat,3),rhof(dfftp%nr1x,dfftp%nr2x,dfftp%nr3x),&
& rgx(dfftp%nr1x),rgy(dfftp%nr2x),rgz(dfftp%nr3x),zvv(nat) )
!
DO i=1,nat
zvv(i)=zv(ityp(i))
@ -74,8 +73,8 @@ REAL(KIND=DP), ALLOCATABLE:: rhodist2(:)
rhof=0.0D0
!
!--------------------------------------------------------------------
ALLOCATE(rhodist1(dense%nr1x*dense%nr2x*dense%nr3x))
IF (nspin.EQ.2) ALLOCATE(rhodist2(dense%nr1x*dense%nr2x*dense%nr3x))
ALLOCATE(rhodist1(dfftp%nr1x*dfftp%nr2x*dfftp%nr3x))
IF (nspin.EQ.2) ALLOCATE(rhodist2(dfftp%nr1x*dfftp%nr2x*dfftp%nr3x))
#if defined __PARA
ALLOCATE( displs( nproc_bgrp ), recvcount( nproc_bgrp ) )
!
@ -111,9 +110,9 @@ ENDIF
#if defined __PARA
IF ( ionode ) THEN
#endif
DO k = 1, dense%nr3x
DO j = 1, dense%nr2x
DO i = 1, dense%nr1x
DO k = 1, dfftp%nr3x
DO j = 1, dfftp%nr2x
DO i = 1, dfftp%nr1x
ip=ip+1
IF (nspin == 1 )rhof(i,j,k)=rhodist1(ip)
IF (nspin == 2 )rhof(i,j,k)=rhodist1(ip)+rhodist2(ip)
@ -121,13 +120,13 @@ IF ( ionode ) THEN
ENDDO
ENDDO
ip=0
DO i=1,dense%nr1x
DO i=1,dfftp%nr1x
rgx(i)=DBLE(i-1)*usunx*alat
ENDDO
DO i=1,dense%nr2x
DO i=1,dfftp%nr2x
rgy(i)=DBLE(i-1)*usuny*alat
ENDDO
DO i=1,dense%nr3x
DO i=1,dfftp%nr3x
rgz(i)=DBLE(i-1)*usunz*alat
ENDDO
!
@ -153,13 +152,13 @@ IF ( ionode ) THEN
!
! shift of the electon density
!
DO i=1,dense%nr1x
DO i=1,dfftp%nr1x
rgx(i)=(rgx(i)-R0(1))-alat*anint( (rgx(i)-R0(1))/alat )
ENDDO
DO i=1,dense%nr2x
DO i=1,dfftp%nr2x
rgy(i)=(rgy(i)-R0(2))-alat*anint( (rgy(i)-R0(2))/alat )
ENDDO
DO i=1,dense%nr3x
DO i=1,dfftp%nr3x
rgz(i)=(rgz(i)-R0(3))-alat*anint( (rgz(i)-R0(3))/alat )
ENDDO
@ -184,9 +183,9 @@ IF ( ionode ) THEN
dipole_el = 0.0D0
quadrupole_el = 0.0D0
DO i = 1, dense%nr1x
DO j = 1, dense%nr2x
DO k = 1, dense%nr3x
DO i = 1, dfftp%nr1x
DO j = 1, dfftp%nr2x
DO k = 1, dfftp%nr3x
charge_el = charge_el + rhof(i,j,k)
dipole_el(1) = dipole_el(1) + rgx(i)*rhof(i,j,k)
@ -199,9 +198,9 @@ IF ( ionode ) THEN
ENDDO
ENDDO
ENDDO
charge_el=charge_el*alat**3/DBLE(dense%nr1x*dense%nr2x*dense%nr3x)
dipole_el=dipole_el*alat**3/DBLE(dense%nr1x*dense%nr2x*dense%nr3x)
quadrupole_el=quadrupole_el*alat**3/DBLE(dense%nr1x*dense%nr2x*dense%nr3x)
charge_el=charge_el*alat**3/DBLE(dfftp%nr1x*dfftp%nr2x*dfftp%nr3x)
dipole_el=dipole_el*alat**3/DBLE(dfftp%nr1x*dfftp%nr2x*dfftp%nr3x)
quadrupole_el=quadrupole_el*alat**3/DBLE(dfftp%nr1x*dfftp%nr2x*dfftp%nr3x)
! ... compute ionic+electronic total charge, dipole and quadrupole moments
!

5
CPV/newd.f90
View File

@ -21,7 +21,6 @@
USE uspp, ONLY: deeq
USE ions_base, ONLY: nat, nsp, na
USE constants, ONLY: pi, fpi
USE grid_dimensions, ONLY: dense
USE smallbox_gvec, ONLY: ngb, npb, nmb, gxb
USE small_box, ONLY: omegab, tpibab
USE smallbox_grid_dim, ONLY: nr1b, nr2b, nr3b, nr1bx, nr2bx, nr3bx, nnrbx
@ -32,14 +31,14 @@
USE mp_global, ONLY: intra_bgrp_comm, inter_bgrp_comm, &
distribute_over_bgrp, my_bgrp_id, nbgrp
USE fft_interfaces, ONLY: invfft
USE fft_base, ONLY: dfftb
USE fft_base, ONLY: dfftb, dfftp
!
IMPLICIT NONE
! input
INTEGER irb(3,nat)
REAL(DP) rhovan(nhm*(nhm+1)/2,nat,nspin)
COMPLEX(DP) eigrb(ngb,nat)
REAL(DP) vr(dense%nrxx,nspin)
REAL(DP) vr(dfftp%nnr,nspin)
! output
REAL(DP) fion(3,nat)
! local

31
CPV/nlcc.f90
View File

@ -111,14 +111,13 @@
! gives an "internal compiler error"
use gvect, only: gstart
use gvect, only: ngm, nl
use grid_dimensions, only: dense
USE fft_interfaces, ONLY: fwfft
USE fft_base, ONLY: dfftp
!
implicit none
!
REAL(DP), INTENT(IN) :: rhoc( dense%nrxx )
REAL(DP), INTENT(INOUT):: rhor( dense%nrxx, nspin )
REAL(DP), INTENT(IN) :: rhoc( dfftp%nnr )
REAL(DP), INTENT(INOUT):: rhor( dfftp%nnr, nspin )
COMPLEX(DP), INTENT(INOUT):: rhog( ngm, nspin )
!
COMPLEX(DP), ALLOCATABLE :: wrk1( : )
@ -127,7 +126,7 @@
REAL(DP) :: rsum
!
IF( iprsta > 2 ) THEN
rsum = SUM( rhoc ) * omega / DBLE(dense%nr1*dense%nr2*dense%nr3)
rsum = SUM( rhoc ) * omega / DBLE(dfftp%nr1*dfftp%nr2*dfftp%nr3)
CALL mp_sum( rsum, intra_bgrp_comm )
WRITE( stdout, 10 ) rsum
10 FORMAT( 3X, 'Core Charge = ', D14.6 )
@ -137,17 +136,17 @@
!
if ( nspin .eq. 1 ) then
iss=1
call daxpy(dense%nrxx,1.d0,rhoc,1,rhor(1,iss),1)
call daxpy(dfftp%nnr,1.d0,rhoc,1,rhor(1,iss),1)
else
isup=1
isdw=2
call daxpy(dense%nrxx,0.5d0,rhoc,1,rhor(1,isup),1)
call daxpy(dense%nrxx,0.5d0,rhoc,1,rhor(1,isdw),1)
call daxpy(dfftp%nnr,0.5d0,rhoc,1,rhor(1,isup),1)
call daxpy(dfftp%nnr,0.5d0,rhoc,1,rhor(1,isdw),1)
end if
!
! rhoc(r) -> rhoc(g) (wrk1 is used as work space)
!
allocate( wrk1( dense%nrxx ) )
allocate( wrk1( dfftp%nnr ) )
wrk1(:) = rhoc(:)
@ -184,14 +183,13 @@
USE kinds, ONLY: DP
use electrons_base, only: nspin
use smallbox_gvec, only: gxb, ngb, npb, nmb
use grid_dimensions, only: dense
use cell_base, only: omega
use ions_base, only: nsp, na, nat
use small_box, only: tpibab
use uspp_param, only: upf
use core, only: rhocb
use fft_interfaces, only: invfft
use fft_base, only: dfftb
use fft_base, only: dfftb, dfftp
use gvect, only: gstart
use smallbox_grid_dim, only: nr1b, nr2b, nr3b, nr1bx, nr2bx, nr3bx, nnrbx
@ -200,7 +198,7 @@
! input
integer, intent(in) :: irb(3,nat)
complex(dp), intent(in):: eigrb(ngb,nat)
real(dp), intent(in) :: vxc(dense%nrxx,nspin)
real(dp), intent(in) :: vxc(dfftp%nnr,nspin)
! output
real(dp), intent(inout):: fion1(3,nat)
! local
@ -219,7 +217,7 @@
call start_clock( 'forcecc' )
ci = (0.d0,1.d0)
fac = omega/DBLE(dense%nr1*dense%nr2*dense%nr3*nspin)
fac = omega/DBLE(dfftp%nr1*dfftp%nr2*dfftp%nr3*nspin)
!$omp parallel default(none) &
!$omp shared(nsp, na, nnrbx,ngb, eigrb, dfftb, irb, nmb, npb, ci, rhocb, &
@ -336,12 +334,11 @@
use kinds, only: dp
use ions_base, only: nsp, na, nat
use uspp_param, only: upf
use grid_dimensions, only: dense
use smallbox_gvec, only: ngb, npb, nmb
use control_flags, only: iprint
use core, only: rhocb
use fft_interfaces, only: invfft
use fft_base, only: dfftb
use fft_base, only: dfftb, dfftp
use smallbox_grid_dim, only: nr1b, nr2b, nr3b, nr1bx, nr2bx, nr3bx, nnrbx
implicit none
@ -349,7 +346,7 @@
integer, intent(in) :: irb(3,nat)
complex(dp), intent(in):: eigrb(ngb,nat)
! output
real(dp), intent(out) :: rhoc(dense%nrxx)
real(dp), intent(out) :: rhoc(dfftp%nnr)
! local
integer nfft, ig, is, ia, isa
complex(dp) ci
@ -364,7 +361,7 @@
call start_clock( 'set_cc' )
ci=(0.d0,1.d0)
allocate( wrk1 ( dense%nrxx ) )
allocate( wrk1 ( dfftp%nnr ) )
wrk1 (:) = (0.d0, 0.d0)
!
!$omp parallel default(none) &
@ -439,7 +436,7 @@
!$omp end parallel
call dcopy( dense%nrxx, wrk1, 2, rhoc, 1 )
call dcopy( dfftp%nnr, wrk1, 2, rhoc, 1 )
deallocate( wrk1 )
!

16
CPV/phasefactor.f90
View File

@ -24,7 +24,7 @@
use io_global, only: stdout
use ions_base, only: nsp, na, nat
use cell_base, only: ainv, r_to_s
use grid_dimensions, only: dense
use fft_base, only: dfftp
use gvect, only: mill
use gvecw, only: ngw
use cp_interfaces, only: phfacs
@ -32,8 +32,8 @@
implicit none
real(DP) tau0(3,nat)
!
complex(DP) ei1(-dense%nr1:dense%nr1,nat), ei2(-dense%nr2:dense%nr2,nat), &
& ei3(-dense%nr3:dense%nr3,nat), eigr(ngw,nat)
complex(DP) ei1(-dfftp%nr1:dfftp%nr1,nat), ei2(-dfftp%nr2:dfftp%nr2,nat), &
& ei3(-dfftp%nr3:dfftp%nr3,nat), eigr(ngw,nat)
!
integer :: i, isa
real(DP), allocatable :: taus(:,:)
@ -45,7 +45,7 @@
WRITE( stdout,*) ( ( tau0(i,isa), i=1, 3 ), isa=1, nat )
endif
CALL r_to_s( tau0, taus, na, nsp, ainv )
CALL phfacs( ei1, ei2, ei3, eigr, mill, taus, dense%nr1, dense%nr2, dense%nr3, nat )
CALL phfacs( ei1, ei2, ei3, eigr, mill, taus, dfftp%nr1, dfftp%nr2, dfftp%nr3, nat )
deallocate( taus )
!
@ -193,15 +193,15 @@
USE kinds, ONLY: DP
USE ions_base, ONLY: nat, na, nsp
use grid_dimensions, only: dense
use fft_base, only: dfftp
IMPLICIT NONE
! ... declare subroutine arguments
!
COMPLEX(DP) :: ei1( -dense%nr1 : dense%nr1, nat )
COMPLEX(DP) :: ei2( -dense%nr2 : dense%nr2, nat )
COMPLEX(DP) :: ei3( -dense%nr3 : dense%nr3, nat )
COMPLEX(DP) :: ei1( -dfftp%nr1 : dfftp%nr1, nat )
COMPLEX(DP) :: ei2( -dfftp%nr2 : dfftp%nr2, nat )
COMPLEX(DP) :: ei3( -dfftp%nr3 : dfftp%nr3, nat )
INTEGER :: mill( :, : )
INTEGER :: ngm
COMPLEX(DP), INTENT(OUT) :: sfac(:,:)

38
CPV/potentials.f90
View File

@ -134,7 +134,6 @@
USE gvect, ONLY: ngm
USE constants, ONLY: gsmall, pi
USE cell_base, ONLY: tpiba2, s_to_r, alat
use grid_dimensions, only: dense
IMPLICIT NONE
@ -160,7 +159,7 @@
END DO
nr3l = dfftp%npl
ALLOCATE( grr( dense%nrxx ) )
ALLOCATE( grr( dfftp%nnr ) )
ALLOCATE( grg( SIZE( screen_coul ) ) )
grr = 0.0d0
@ -169,15 +168,15 @@
!
rc = 7.0d0 / alat
rc2 = rc**2
fact = omega / ( dense%nr1 * dense%nr2 * dense%nr3 )
IF( MOD(dense%nr1 * dense%nr2 * dense%nr3, 2) /= 0 ) fact = -fact
fact = omega / ( dfftp%nr1 * dfftp%nr2 * dfftp%nr3 )
IF( MOD(dfftp%nr1 * dfftp%nr2 * dfftp%nr3, 2) /= 0 ) fact = -fact
DO k = 1, nr3l
s(3) = DBLE ( (k-1) + (ir3 - 1) ) / dense%nr3 - 0.5d0
DO j = 1, dense%nr2
s(2) = DBLE ( (j-1) + (ir2 - 1) ) / dense%nr2 - 0.5d0
DO i = 1, dense%nr1
s(1) = DBLE ( (i-1) + (ir1 - 1) ) / dense%nr1 - 0.5d0
s(3) = DBLE ( (k-1) + (ir3 - 1) ) / dfftp%nr3 - 0.5d0
DO j = 1, dfftp%nr2
s(2) = DBLE ( (j-1) + (ir2 - 1) ) / dfftp%nr2 - 0.5d0
DO i = 1, dfftp%nr1
s(1) = DBLE ( (i-1) + (ir1 - 1) ) / dfftp%nr1 - 0.5d0
CALL S_TO_R( S, R, hmat )
rmod = SQRT( r(1)**2 + r(2)**2 + r(3)**2 )
ir = i + (j-1)*dfftp%nr1x + (k-1)*dfftp%nr1x*dfftp%nr2x
@ -417,11 +416,11 @@
USE constants, ONLY: fpi
USE cell_base, ONLY: tpiba2, tpiba
USE io_global, ONLY: stdout
USE grid_dimensions, ONLY: dense
USE gvect, ONLY: mill, gstart, g, gg
USE ions_base, ONLY: nat, nsp, na
USE gvect, ONLY: ngm
USE gvecs, ONLY: ngms
USE fft_base, ONLY: dfftp
IMPLICIT NONE
@ -432,9 +431,9 @@
REAL(DP) :: rhops(:,:), vps(:,:)
COMPLEX(DP) :: rhoeg(:)
COMPLEX(DP), INTENT(IN) :: sfac(:,:)
COMPLEX(DP) :: ei1(-dense%nr1:dense%nr1,nat)
COMPLEX(DP) :: ei2(-dense%nr2:dense%nr2,nat)
COMPLEX(DP) :: ei3(-dense%nr3:dense%nr3,nat)
COMPLEX(DP) :: ei1(-dfftp%nr1:dfftp%nr1,nat)
COMPLEX(DP) :: ei2(-dfftp%nr2:dfftp%nr2,nat)
COMPLEX(DP) :: ei3(-dfftp%nr3:dfftp%nr3,nat)
REAL(DP) :: omega
COMPLEX(DP) :: screen_coul(:)
@ -838,7 +837,6 @@
USE gvect, ONLY: gstart, gg
USE gvect, ONLY: ngm
USE gvecw, ONLY: ngw
use grid_dimensions, only: dense
USE fft_interfaces, ONLY: fwfft, invfft
IMPLICIT NONE
@ -875,8 +873,8 @@
nr3l = dfftp%npl
omega = ht%deth
ALLOCATE( density( dense%nrxx ) )
ALLOCATE( psi( dense%nrxx ) )
ALLOCATE( density( dfftp%nnr ) )
ALLOCATE( psi( dfftp%nnr ) )
ALLOCATE( k_density( ngm ) )
CALL c2psi( psi, dffts%nnr, wfc, wfc, ngw, 1 )
@ -908,22 +906,22 @@
!WRITE(6,*) 'ATOM ', ind_localisation( isa_input )
!WRITE(6,*) 'POS ', atoms_m%taus( :, isa_sorted )
work = dense%nr1
work = dfftp%nr1
work2 = sic_rloc * work
work = work * R(1) - work2
Xmin = FLOOR(work)
work = work + 2*work2
Xmax = FLOOR(work)
IF ( Xmax > dense%nr1 ) Xmax = dense%nr1
IF ( Xmax > dfftp%nr1 ) Xmax = dfftp%nr1
IF ( Xmin < 1 ) Xmin = 1
work = dense%nr2
work = dfftp%nr2
work2 = sic_rloc * work
work = work * R(2) - work2
Ymin = FLOOR(work)
work = work + 2*work2
Ymax = FLOOR(work)
IF ( Ymax > dense%nr2 ) Ymax = dense%nr2
IF ( Ymax > dfftp%nr2 ) Ymax = dfftp%nr2
IF ( Ymin < 1 ) Ymin = 1
work = nr3l

4
CPV/restart_sub.f90
View File

@ -22,7 +22,6 @@ SUBROUTINE from_restart( )
USE time_step, ONLY : tps, delt
USE ions_positions, ONLY : taus, tau0, tausm, taum, vels, fion, fionm, set_velocities
USE ions_nose, ONLY : xnhp0, xnhpm
USE grid_dimensions, ONLY : dense
USE gvect, ONLY : mill, eigts1, eigts2, eigts3
USE printout_base, ONLY : printout_pos
USE gvecs, ONLY : ngms
@ -38,6 +37,7 @@ SUBROUTINE from_restart( )
sfac, taub, irb, eigrb, edft, bec_bgrp, dbec
USE time_step, ONLY : delt
USE atoms_type_module, ONLY : atoms_type
USE fft_base, ONLY : dfftp
!
IMPLICIT NONE
@ -120,7 +120,7 @@ SUBROUTINE from_restart( )
CALL phbox( taub, iprsta, eigrb )
END IF
!
CALL phfacs( eigts1, eigts2, eigts3, eigr, mill, taus, dense%nr1, dense%nr2, dense%nr3, nat )
CALL phfacs( eigts1, eigts2, eigts3, eigr, mill, taus, dfftp%nr1, dfftp%nr2, dfftp%nr3, nat )
!
CALL strucf( sfac, eigts1, eigts2, eigts3, mill, ngms )
!

8
CPV/smallbox_grid.f90
View File

@ -40,14 +40,14 @@
CONTAINS
SUBROUTINE smallbox_grid_init( dense )
SUBROUTINE smallbox_grid_init( dfftp )
!
USE fft_scalar, only: good_fft_dimension, good_fft_order
USE grid_types, only: grid_dim
USE fft_types, only: fft_dlay_descriptor
!
IMPLICIT NONE
!
TYPE(grid_dim), INTENT(IN) :: dense
TYPE(fft_dlay_descriptor), INTENT(IN) :: dfftp
!
! no default values for grid box: if nr*b=0, ignore
@ -74,7 +74,7 @@
nr2bl = nr2b
nr3bl = nr3b
IF ( nr1b > dense%nr1 .or. nr2b > dense%nr2 .or. nr3b > dense%nr3 ) &
IF ( nr1b > dfftp%nr1 .or. nr2b > dfftp%nr2 .or. nr3b > dfftp%nr3 ) &
CALL errore(' smallbox_grid_init ', ' box grid larger than dense grid?',1)
RETURN

7
CPV/smallbox_lib.f90
View File

@ -14,7 +14,6 @@
!
USE kinds, ONLY: DP
USE ions_base, ONLY: nsp, na, nat
USE grid_dimensions, ONLY: dense
USE smallbox_grid_dim, ONLY: nr1b, nr2b, nr3b, nr1bx, nr2bx, nr3bx
USE control_flags, ONLY: iprsta
USE io_global, ONLY: stdout
@ -39,9 +38,9 @@
IF ( nr3b < 1) CALL errore &
('initbox', 'incorrect value for box grid dimensions', 3)
nr (1)=dense%nr1
nr (2)=dense%nr2
nr (3)=dense%nr3
nr (1)=dfftp%nr1
nr (2)=dfftp%nr2
nr (3)=dfftp%nr3
nrb(1)=nr1b
nrb(2)=nr2b
nrb(3)=nr3b

26
CPV/vofrho.f90
View File

@ -30,8 +30,6 @@ SUBROUTINE vofrho_x( nfi, rhor, drhor, rhog, drhog, rhos, rhoc, tfirst, tlast,
USE cell_base, ONLY: omega, r_to_s
USE cell_base, ONLY: alat, at, tpiba2, h, ainv
USE gvect, ONLY: gstart, gg, g
USE grid_dimensions, ONLY: dense
USE smooth_grid_dimensions, ONLY: smooth
USE electrons_base, ONLY: nspin
USE constants, ONLY: pi, fpi, au_gpa
USE energies, ONLY: etot, eself, enl, ekin, epseu, esr, eht, exc, eextfor
@ -112,8 +110,8 @@ SUBROUTINE vofrho_x( nfi, rhor, drhor, rhog, drhog, rhos, rhoc, tfirst, tlast,
!
ht = TRANSPOSE( h )
!
ALLOCATE( v( dense%nrxx ) )
ALLOCATE( vs( smooth%nrxx ) )
ALLOCATE( v( dfftp%nnr ) )
ALLOCATE( vs( dffts%nnr ) )
ALLOCATE( vtemp( ngm ) )
ALLOCATE( rhotmp( ngm ) )
!
@ -331,12 +329,12 @@ SUBROUTINE vofrho_x( nfi, rhor, drhor, rhog, drhog, rhos, rhoc, tfirst, tlast,
iss = 1
if (abivol.or.abisur) then
!$omp parallel do
do ir=1,dense%nrxx
do ir=1, dfftp%nnr
v(ir)=CMPLX( rhor( ir, iss ) + v_vol( ir ), 0.d0 ,kind=DP)
end do
else
!$omp parallel do
do ir=1,dense%nrxx
do ir=1, dfftp%nnr
v(ir)=CMPLX( rhor( ir, iss ), 0.d0 ,kind=DP)
end do
end if
@ -358,13 +356,13 @@ SUBROUTINE vofrho_x( nfi, rhor, drhor, rhog, drhog, rhos, rhoc, tfirst, tlast,
isdw=2
if (abivol.or.abisur) then
!$omp parallel do
do ir=1,dense%nrxx
do ir=1, dfftp%nnr
v(ir)=CMPLX ( rhor(ir,isup)+v_vol(ir), &
rhor(ir,isdw)+v_vol(ir),kind=DP)
end do
else
!$omp parallel do
do ir=1,dense%nrxx
do ir=1, dfftp%nnr
v(ir)=CMPLX (rhor(ir,isup),rhor(ir,isdw),kind=DP)
end do
end if
@ -421,13 +419,13 @@ SUBROUTINE vofrho_x( nfi, rhor, drhor, rhog, drhog, rhos, rhoc, tfirst, tlast,
CALL invfft('Dense',v, dfftp )
!
!$omp parallel do
DO ir=1,dense%nrxx
DO ir=1, dfftp%nnr
rhor(ir,iss)=DBLE(v(ir))
END DO
!
! calculation of average potential
!
vave=SUM(rhor(:,iss))/DBLE(dense%nr1*dense%nr2*dense%nr3)
vave=SUM(rhor(:,iss))/DBLE( dfftp%nr1* dfftp%nr2* dfftp%nr3)
ELSE
isup=1
isdw=2
@ -439,14 +437,14 @@ SUBROUTINE vofrho_x( nfi, rhor, drhor, rhog, drhog, rhos, rhoc, tfirst, tlast,
!
CALL invfft('Dense',v, dfftp )
!$omp parallel do
DO ir=1,dense%nrxx
DO ir=1, dfftp%nnr
rhor(ir,isup)= DBLE(v(ir))
rhor(ir,isdw)=AIMAG(v(ir))
END DO
!
! calculation of average potential
!
vave=(SUM(rhor(:,isup))+SUM(rhor(:,isdw))) / 2.0d0 / DBLE( dense%nr1 * dense%nr2 * dense%nr3 )
vave=(SUM(rhor(:,isup))+SUM(rhor(:,isdw))) / 2.0d0 / DBLE( dfftp%nr1 * dfftp%nr2 * dfftp%nr3 )
ENDIF
CALL mp_sum( vave, intra_bgrp_comm )
@ -468,7 +466,7 @@ SUBROUTINE vofrho_x( nfi, rhor, drhor, rhog, drhog, rhos, rhoc, tfirst, tlast,
CALL invfft('Smooth',vs, dffts )
!
!$omp parallel do
DO ir=1,smooth%nrxx
DO ir=1,dffts%nnr
rhos(ir,iss)=DBLE(vs(ir))
END DO
!
@ -485,7 +483,7 @@ SUBROUTINE vofrho_x( nfi, rhor, drhor, rhog, drhog, rhos, rhoc, tfirst, tlast,
CALL invfft('Smooth',vs, dffts )
!
!$omp parallel do
DO ir=1,smooth%nrxx
DO ir=1,dffts%nnr
rhos(ir,isup)= DBLE(vs(ir))
rhos(ir,isdw)=AIMAG(vs(ir))
END DO

47
CPV/vol_clu.f90
View File

@ -28,7 +28,6 @@ SUBROUTINE vol_clu(rho_real,rho_g,s_fac,flag)
use control_flags, only: tpre
use fft_base, ONLY : dfftp
USE fft_interfaces, ONLY: invfft
use grid_dimensions,only: dense
use pres_ai_mod, only: rho_thr, n_cntr, cntr, step_rad, fill_vac, &
& delta_eps, delta_sigma, axis, &
& abisur, dthr, Surf_t, rho_gaus, v_vol, &
@ -51,7 +50,7 @@ SUBROUTINE vol_clu(rho_real,rho_g,s_fac,flag)
real(kind=8) dx, dxx, xcc(4500)
real(kind=8) weight0, wpiu, wmeno, maxr, minr
real(kind=8) tau00(3), dist
real(kind=8) rho_real(dense%nrxx,nspin), rhoc
real(kind=8) rho_real(dfftp%nnr,nspin), rhoc
real(kind=8) alfa(nsx), alfa0, sigma, hgt
real(kind=8) pos_cry(3), pos_car(3), pos_aux(3)
real(kind=8) pos_cry0(3), dpvdh(3,3)
@ -78,12 +77,12 @@ SUBROUTINE vol_clu(rho_real,rho_g,s_fac,flag)
integer shift(nproc), incr(nproc), ppp(nproc)
integer displs(nproc), ip, me
#endif
if (abisur) allocate(drho(3,dense%nrxx))
if (abisur) allocate(d2rho(3,dense%nrxx))
if (abisur) allocate(dxdyrho(dense%nrxx))
if (abisur) allocate(dxdzrho(dense%nrxx))
if (abisur) allocate(dydzrho(dense%nrxx))
allocate(psi(dense%nrxx))
if (abisur) allocate(drho(3,dfftp%nnr))
if (abisur) allocate(d2rho(3,dfftp%nnr))
if (abisur) allocate(dxdyrho(dfftp%nnr))
if (abisur) allocate(dxdzrho(dfftp%nnr))
if (abisur) allocate(dydzrho(dfftp%nnr))
allocate(psi(dfftp%nnr))
call start_clock( 'vol_clu' )
@ -128,15 +127,15 @@ SUBROUTINE vol_clu(rho_real,rho_g,s_fac,flag)
end do
! This doesn't work yet.....
if (jellium) then
do ir3 = 1,dense%nr3
do ir2 = 1,dense%nr2
do ir1 = 1,dense%nr1
ir = ir1 + (ir2-1)*dense%nr1 + (ir3-1)*dense%nr2*dense%nr1
do ir3 = 1,dfftp%nr3
do ir2 = 1,dfftp%nr2
do ir1 = 1,dfftp%nr1
ir = ir1 + (ir2-1)*dfftp%nr1 + (ir3-1)*dfftp%nr2*dfftp%nr1
dist = 0.d0
do i = 1,3
posv(i,ir) = (DBLE(ir1)-1.0d0)*at(i,1)/DBLE(dense%nr1) +&
& (DBLE(ir2)-1.0d0)*at(i,2)/DBLE(dense%nr2) +&
& (DBLE(ir3)-1.0d0)*at(i,3)/DBLE(dense%nr3)
posv(i,ir) = (DBLE(ir1)-1.0d0)*at(i,1)/DBLE(dfftp%nr1) +&
& (DBLE(ir2)-1.0d0)*at(i,2)/DBLE(dfftp%nr2) +&
& (DBLE(ir3)-1.0d0)*at(i,3)/DBLE(dfftp%nr3)
end do
end do
end do
@ -259,7 +258,7 @@ SUBROUTINE vol_clu(rho_real,rho_g,s_fac,flag)
psi(nlm(ig))= conjg(rhotmp(ig,1))
end do
call invfft('Dense',psi, dfftp )
do ir = 1,dense%nrxx
do ir = 1,dfftp%nnr
rho_gaus(ir) = real(psi(ir))
end do
else
@ -268,7 +267,7 @@ SUBROUTINE vol_clu(rho_real,rho_g,s_fac,flag)
psi(nlm(ig))= conjg(rhotmp(ig,1)) + ci*conjg(rhotmp(ig,2))
end do
call invfft('Dense',psi, dfftp )
do ir = 1,dense%nrxx
do ir = 1,dfftp%nnr
rho_gaus(ir) = real(psi(ir))+aimag(psi(ir))
end do
end if
@ -277,7 +276,7 @@ SUBROUTINE vol_clu(rho_real,rho_g,s_fac,flag)
e_j = 0.d0
do ir = 1,dense%nrxx
do ir = 1,dfftp%nnr
v_vol(ir) = 0.d0
@ -307,11 +306,11 @@ SUBROUTINE vol_clu(rho_real,rho_g,s_fac,flag)
end if
if (nspin.eq.1) then
e_j = e_j + v_vol(ir) * rho_real(ir,1) * omega / &
& DBLE(dense%nr1*dense%nr2*dense%nr3)
& DBLE(dfftp%nr1*dfftp%nr2*dfftp%nr3)
else
e_j = e_j + v_vol(ir) * &
( rho_real(ir,1) + rho_real(ir,2) ) * omega / &
& DBLE(dense%nr1*dense%nr2*dense%nr3)
& DBLE(dfftp%nr1*dfftp%nr2*dfftp%nr3)
end if
end if
@ -366,7 +365,7 @@ SUBROUTINE vol_clu(rho_real,rho_g,s_fac,flag)
do is = 1,nspin
dpvdh(k,j) = dpvdh(k,j) + &
& v_vol(ir)*drhor(ir,is,k,j)*omega/ &
& DBLE(dense%nr1*dense%nr2*dense%nr3)
& DBLE(dfftp%nr1*dfftp%nr2*dfftp%nr3)
end do
end do
end do
@ -399,9 +398,9 @@ SUBROUTINE vol_clu(rho_real,rho_g,s_fac,flag)
call mp_sum(surfclu,intra_bgrp_comm)
call mp_sum(dpvdh,intra_bgrp_comm)
#endif
volclu = volclu * omega / DBLE(dense%nr1*dense%nr2*dense%nr3)
n_ele = n_ele * omega / DBLE(dense%nr1*dense%nr2*dense%nr3)
surfclu = surfclu * omega / DBLE(dense%nr1*dense%nr2*dense%nr3) / dthr
volclu = volclu * omega / DBLE(dfftp%nr1*dfftp%nr2*dfftp%nr3)
n_ele = n_ele * omega / DBLE(dfftp%nr1*dfftp%nr2*dfftp%nr3)
surfclu = surfclu * omega / DBLE(dfftp%nr1*dfftp%nr2*dfftp%nr3) / dthr
do i = 1,3
do j = 1,3
stress_vol(i,j) = dpvdh(i,1)*h(j,1) + dpvdh(i,2)*h(j,2) + &

8
CPV/wannier.f90
View File

@ -476,13 +476,13 @@ MODULE wannier_subroutines
ydist, zdist
USE electric_field_module, ONLY : field_tune, e_tuned, par, rel1, rel2
USE wannier_module, ONLY : rhos1, rhos2, wfc
USE smooth_grid_dimensions, ONLY : grid_dim, smooth
USE electrons_base, ONLY : nbsp, nspin, nupdwn, f, ispin
USE cell_base, ONLY : ainv, alat, at
USE gvect, ONLY : gstart
USE control_flags, ONLY : tsde
USE wave_base, ONLY : wave_steepest, wave_verlet
USE cp_interfaces, ONLY : dforce
USE fft_base, ONLY : dffts
!
IMPLICIT NONE
!
@ -547,7 +547,7 @@ MODULE wannier_subroutines
IF(wf_efield) THEN
rhos1=0.d0
rhos2=0.d0
DO ir=1,smooth%nrxx
DO ir=1,dffts%nnr
rel1(1)=xdist(ir)*a1(1)+ydist(ir)*a2(1)+zdist(ir)*a3(1)-wfc(1,i)
rel1(2)=xdist(ir)*a1(2)+ydist(ir)*a2(2)+zdist(ir)*a3(2)-wfc(2,i)
rel1(3)=xdist(ir)*a1(3)+ydist(ir)*a2(3)+zdist(ir)*a3(3)-wfc(3,i)
@ -581,9 +581,9 @@ MODULE wannier_subroutines
rhos2(ir,:)=rhos1(ir,:)
END IF
END DO
CALL dforce(i,bec,betae,c0,c2,c3,rhos1,smooth%nrxx,ispin,f,nbsp,nspin,rhos2)
CALL dforce(i,bec,betae,c0,c2,c3,rhos1,dffts%nnr,ispin,f,nbsp,nspin,rhos2)
ELSE
CALL dforce(i,bec,betae,c0,c2,c3,rhos,smooth%nrxx,ispin,f,nbsp,nspin)
CALL dforce(i,bec,betae,c0,c2,c3,rhos,dffts%nnr,ispin,f,nbsp,nspin)
END IF
IF(tsde) THEN
CALL wave_steepest( cm(:, i ), c0(:, i ), emadt2, c2 )

39
CPV/wf.f90
View File

@ -30,13 +30,11 @@ SUBROUTINE wf( clwf, c, bec, eigr, eigrb, taub, irb, &
USE smallbox_gvec, ONLY : npb, nmb, ngb
USE gvecw, ONLY : ngw
USE gvect, ONLY : gstart
USE smooth_grid_dimensions, ONLY : smooth
USE control_flags, ONLY : iprsta
USE qgb_mod, ONLY : qgb
USE wannier_base, ONLY : wfg, nw, weight, indexplus, indexplusz, &
indexminus, indexminusz, tag, tagp, &
expo, wfsd
USE grid_dimensions, ONLY : dense
USE smallbox_grid_dim, ONLY : nnrbx
USE uspp_param, ONLY : nh, nhm
USE uspp, ONLY : nkb
@ -413,7 +411,7 @@ SUBROUTINE wf( clwf, c, bec, eigr, eigrb, taub, irb, &
isa = isa + 1
END DO
END DO
t1=omega/DBLE(dense%nr1*dense%nr2*dense%nr3)
t1=omega/DBLE(dfftp%nr1*dfftp%nr2*dfftp%nr3)
X=X*t1
DO i=1, nbsp
DO j=i+1, nbsp
@ -1377,7 +1375,6 @@ SUBROUTINE grid_map()
!
USE kinds, ONLY : DP
USE efcalc, ONLY : xdist, ydist, zdist
USE smooth_grid_dimensions, ONLY : smooth
USE fft_base, ONLY : dffts
USE mp_global, ONLY : me_bgrp
USE parallel_include
@ -1388,9 +1385,9 @@ SUBROUTINE grid_map()
!
me = me_bgrp + 1
!
ALLOCATE(xdist(smooth%nrxx))
ALLOCATE(ydist(smooth%nrxx))
ALLOCATE(zdist(smooth%nrxx))
ALLOCATE(xdist(dffts%nnr))
ALLOCATE(ydist(dffts%nnr))
ALLOCATE(zdist(dffts%nnr))
!
nr1s = dffts%nr1
nr2s = dffts%nr2
@ -1973,7 +1970,6 @@ SUBROUTINE small_box_wf( i_1, j_1, k_1, nw1 )
USE io_global, ONLY : stdout
USE constants, ONLY : fpi
USE wannier_base, ONLY : expo
USE grid_dimensions, ONLY : dense
USE fft_base, ONLY : dfftp
USE mp_global, ONLY : me_bgrp
USE parallel_include
@ -1987,25 +1983,25 @@ SUBROUTINE small_box_wf( i_1, j_1, k_1, nw1 )
me = me_bgrp + 1
ALLOCATE(expo(dense%nrxx,nw1))
ALLOCATE(expo(dfftp%nnr,nw1))
DO inw=1,nw1
WRITE( stdout, * ) inw ,":", i_1(inw), j_1(inw), k_1(inw)
DO ir3=1,dense%nr3
DO ir3=1,dfftp%nr3
#ifdef __PARA
ibig3 = ir3 - dfftp%ipp( me )
IF(ibig3.GT.0.AND.ibig3.LE.dfftp%npp(me)) THEN
#else
ibig3=ir3
#endif
DO ir2=1,dense%nr2
DO ir1=1,dense%nr1
x = (((ir1-1)/DBLE(dense%nr1x))*i_1(inw) + &
& ((ir2-1)/DBLE(dense%nr2x))*j_1(inw) + &
& ((ir3-1)/DBLE(dense%nr3x))*k_1(inw))*0.5d0*fpi
expo(ir1+(ir2-1)*dense%nr1x+(ibig3-1)*dense%nr1x*dense%nr2x,inw) = CMPLX(COS(x), -SIN(x),kind=DP)
DO ir2=1,dfftp%nr2
DO ir1=1,dfftp%nr1
x = (((ir1-1)/DBLE(dfftp%nr1x))*i_1(inw) + &
& ((ir2-1)/DBLE(dfftp%nr2x))*j_1(inw) + &
& ((ir3-1)/DBLE(dfftp%nr3x))*k_1(inw))*0.5d0*fpi
expo(ir1+(ir2-1)*dfftp%nr1x+(ibig3-1)*dfftp%nr1x*dfftp%nr2x,inw) = CMPLX(COS(x), -SIN(x),kind=DP)
END DO
END DO
#ifdef __PARA
@ -2028,7 +2024,6 @@ FUNCTION boxdotgridcplx(irb,qv,vr)
! use ion_parameters
!
USE kinds, ONLY : DP
USE grid_dimensions, ONLY : dense
USE smallbox_grid_dim, ONLY : nnrbx, nr1b, nr2b, nr3b, nr1bx, nr2bx, nr3bx
USE fft_base, ONLY : dfftp
USE mp_global, ONLY : me_bgrp
@ -2036,7 +2031,7 @@ FUNCTION boxdotgridcplx(irb,qv,vr)
IMPLICIT NONE
!
INTEGER, INTENT(IN):: irb(3)
COMPLEX(DP), INTENT(IN):: qv(nnrbx), vr(dense%nrxx)
COMPLEX(DP), INTENT(IN):: qv(nnrbx), vr(dfftp%nnr)
COMPLEX(DP) :: boxdotgridcplx
!
INTEGER :: ir1, ir2, ir3, ir, ibig1, ibig2, ibig3, ibig, me
@ -2047,18 +2042,18 @@ FUNCTION boxdotgridcplx(irb,qv,vr)
DO ir3=1,nr3b
ibig3=irb(3)+ir3-1
ibig3=1+MOD(ibig3-1,dense%nr3)
ibig3=1+MOD(ibig3-1,dfftp%nr3)
#ifdef __PARA
ibig3 = ibig3 - dfftp%ipp( me )
IF (ibig3.GT.0.AND.ibig3.LE.dfftp%npp(me)) THEN
#endif
DO ir2=1,nr2b
ibig2=irb(2)+ir2-1
ibig2=1+MOD(ibig2-1,dense%nr2)
ibig2=1+MOD(ibig2-1,dfftp%nr2)
DO ir1=1,nr1b
ibig1=irb(1)+ir1-1
ibig1=1+MOD(ibig1-1,dense%nr1)
ibig=ibig1 + (ibig2-1)*dense%nr1x + (ibig3-1)*dense%nr1x*dense%nr2x
ibig1=1+MOD(ibig1-1,dfftp%nr1)
ibig=ibig1 + (ibig2-1)*dfftp%nr1x + (ibig3-1)*dfftp%nr1x*dfftp%nr2x
ir =ir1 + (ir2-1)*nr1bx + (ir3-1)*nr1bx*nr2bx
boxdotgridcplx = boxdotgridcplx + qv(ir)*vr(ibig)
END DO

16
D3/d3_exc.f90
View File

@ -18,7 +18,7 @@ SUBROUTINE d3_exc
USE kinds, ONLY : DP
USE pwcom
USE scf, only : rho, rho_core
USE grid_dimensions, only : dense
USE fft_base, only : dfftp
USE phcom
USE d3com
USE io_global, ONLY : ionode_id
@ -35,10 +35,10 @@ SUBROUTINE d3_exc
COMPLEX (DP), ALLOCATABLE :: work1 (:), work2 (:), &
work3 (:), d3dyn1 (:,:,:)
ALLOCATE (d2muxc( dense%nrxx))
ALLOCATE (work1 ( dense%nrxx))
ALLOCATE (work2 ( dense%nrxx))
ALLOCATE (work3 ( dense%nrxx))
ALLOCATE (d2muxc( dfftp%nnr))
ALLOCATE (work1 ( dfftp%nnr))
ALLOCATE (work2 ( dfftp%nnr))
ALLOCATE (work3 ( dfftp%nnr))
ALLOCATE (d3dyn1( 3*nat, 3*nat, 3*nat))
! IF ( my_pool_id == 0 ) THEN
@ -46,7 +46,7 @@ SUBROUTINE d3_exc
! Calculates third derivative of Exc
!
d2muxc(:) = 0.d0
DO ir = 1, dense%nrxx
DO ir = 1, dfftp%nnr
rhotot = rho%of_r (ir, 1) + rho_core (ir)
IF (rhotot > 1.d-30) d2muxc (ir) = d2mxc (rhotot)
IF (rhotot < - 1.d-30) d2muxc (ir) = - d2mxc ( - rhotot)
@ -63,7 +63,7 @@ SUBROUTINE d3_exc
DO kpert = 1, 3 * nat
CALL davcio_drho (work3, lrdrho, iudrho, kpert, - 1)
aux = CMPLX(0.d0, 0.d0,kind=DP)
DO ir = 1, dense%nrxx
DO ir = 1, dfftp%nnr
aux = aux + &
d2muxc (ir) * work1 (ir) * &
CONJG (work2 (ir) ) * work3 (ir)
@ -71,7 +71,7 @@ SUBROUTINE d3_exc
!
CALL mp_sum ( aux, intra_pool_comm )
!
d3dyn1 (ipert, jpert, kpert) = omega * aux / (dense%nr1 * dense%nr2 * dense%nr3)
d3dyn1 (ipert, jpert, kpert) = omega * aux / (dfftp%nr1 * dfftp%nr2 * dfftp%nr3)
!
ENDDO
ENDDO

10
D3/d3_init.f90
View File

@ -13,7 +13,7 @@ SUBROUTINE d3_init
USE pwcom
USE uspp_param, ONLY : upf
USE atom, ONLY : msh, rgrid
USE grid_dimensions, ONLY : dense
USE fft_base, ONLY : dfftp
USE phcom
USE d3com
USE mp, ONLY : mp_barrier
@ -27,7 +27,7 @@ SUBROUTINE d3_init
COMPLEX (DP), ALLOCATABLE :: drhoscf (:,:)
COMPLEX (DP), ALLOCATABLE :: drhoscf2 (:,:,:)
ALLOCATE (drhoscf( dense%nrxx, 3))
ALLOCATE (drhoscf( dfftp%nnr, 3))
!
! the fourier trasform of the core charge both for q=0 and q.ne.0
@ -83,8 +83,8 @@ SUBROUTINE d3_init
CALL psymd0rho (npertg0(irr), irr, drhoscf)
#else
CALL symd0rho (npertx, npertg0(irr), irr, drhoscf, s, ftau, nsymg0, &
irgq, tg0, nat, dense%nr1, dense%nr2, dense%nr3, dense%nr1x, &
dense%nr2x, dense%nr3x)
irgq, tg0, nat, dfftp%nr1, dfftp%nr2, dfftp%nr3, dfftp%nr1x, &
dfftp%nr2x, dfftp%nr3x)
#endif
DO ipert = 1, npertg0 (irr)
CALL davcio_drho2 (drhoscf(1,ipert), lrdrho, iud0rho, &
@ -102,7 +102,7 @@ SUBROUTINE d3_init
imode0 = imode0 + npert (irr1)
ENDDO
ALLOCATE (drhoscf2( dense%nrxx, nspin,npert(irr) ))
ALLOCATE (drhoscf2( dfftp%nnr, nspin,npert(irr) ))
DO ipert = 1, npert (irr)
CALL davcio_drho (drhoscf2(1,1,ipert), lrdrho, iudrho, &

10
D3/d3_setup.f90
View File

@ -47,7 +47,7 @@ SUBROUTINE d3_setup()
USE io_files, ONLY : tmp_dir
USE kinds, ONLY : DP
USE pwcom
USE grid_dimensions,ONLY: dense
USE fft_base, ONLY : dfftp
USE scf, only : rho, rho_core, v, vltot, vrs, kedtau
USE symm_base, ONLY : nrot, nsym, s, ftau, irt, invs, inverse_s, &
s_axis_to_cart, find_sym, copy_sym, s_axis_to_cart
@ -89,20 +89,20 @@ SUBROUTINE d3_setup()
!
! 1) Computes the total local potential (external+scf) on the smoot grid
!
CALL set_vrs (vrs, vltot, v%of_r, kedtau, v%kin_r, dense%nrxx, nspin, doublegrid)
CALL set_vrs (vrs, vltot, v%of_r, kedtau, v%kin_r, dfftp%nnr, nspin, doublegrid)
!
! 2) Computes the derivative of the xc potential
!
dmuxc (:,:,:) = 0.d0
IF (lsda) THEN
DO ir = 1, dense%nrxx
DO ir = 1, dfftp%nnr
rhoup = rho%of_r (ir, 1) + 0.5d0 * rho_core (ir)
rhodw = rho%of_r (ir, 2) + 0.5d0 * rho_core (ir)
CALL dmxc_spin (rhoup, rhodw, dmuxc (ir, 1, 1), &
dmuxc (ir, 2, 1), dmuxc (ir, 1, 2), dmuxc (ir, 2, 2) )
ENDDO
ELSE
DO ir = 1, dense%nrxx
DO ir = 1, dfftp%nnr
rhotot = rho%of_r (ir, nspin) + rho_core (ir)
IF (rhotot > 1.d-30) dmuxc (ir, 1, 1) = dmxc (rhotot)
IF (rhotot < - 1.d-30) dmuxc (ir, 1, 1) = - dmxc ( - rhotot)
@ -180,7 +180,7 @@ SUBROUTINE d3_setup()
!
modenum = 0
magnetic_sym = .false.
CALL find_sym ( nat, tau, ityp, dense%nr1, dense%nr2, dense%nr3, .FALSE., &
CALL find_sym ( nat, tau, ityp, dfftp%nr1, dfftp%nr2, dfftp%nr3, .FALSE., &
magnetic_sym, mdum, .FALSE.)
sym(:) =.false.
sym(1:nsym)=.true.

25
D3/d3_summary.f90
View File

@ -22,8 +22,7 @@ subroutine d3_summary
USE io_global, ONLY : stdout
USE symm_base, ONLY : s, sr, sname, ftau
USE control_flags, ONLY : iverbosity
USE smooth_grid_dimensions, ONLY : smooth
USE grid_dimensions, ONLY : dense
USE fft_base, ONLY : dffts, dfftp
use pwcom
use phcom
use d3com
@ -145,22 +144,22 @@ subroutine d3_summary
WRITE( stdout, '(/6x,"isym = ",i2,5x,a45/)') isymq, sname (isym)
if (ftau (1, isym) .ne.0.or.ftau (2, isym) .ne.0.or.ftau (3, &
isym) .ne.0) then
ft1 = at (1, 1) * ftau (1, isym) / dense%nr1 + at (1, 2) * ftau ( &
2, isym) / dense%nr2 + at (1, 3) * ftau (3, isym) / dense%nr3
ft2 = at (2, 1) * ftau (1, isym) / dense%nr1 + at (2, 2) * ftau ( &
2, isym) / dense%nr2 + at (2, 3) * ftau (3, isym) / dense%nr3
ft3 = at (3, 1) * ftau (1, isym) / dense%nr1 + at (3, 2) * ftau ( &
2, isym) / dense%nr2 + at (3, 3) * ftau (3, isym) / dense%nr3
ft1 = at (1, 1) * ftau (1, isym) / dfftp%nr1 + at (1, 2) * ftau ( &
2, isym) / dfftp%nr2 + at (1, 3) * ftau (3, isym) / dfftp%nr3
ft2 = at (2, 1) * ftau (1, isym) / dfftp%nr1 + at (2, 2) * ftau ( &
2, isym) / dfftp%nr2 + at (2, 3) * ftau (3, isym) / dfftp%nr3
ft3 = at (3, 1) * ftau (1, isym) / dfftp%nr1 + at (3, 2) * ftau ( &
2, isym) / dfftp%nr2 + at (3, 3) * ftau (3, isym) / dfftp%nr3
WRITE( stdout, '(1x,"cryst.",3x,"s(",i2,") = (",3(i6,5x), &
&" ) f =( ",f10.7," )")') isymq, (s (1, ipol, isym),&
ipol = 1, 3) , DBLE (ftau (1, isym) ) / DBLE (dense%nr1)
ipol = 1, 3) , DBLE (ftau (1, isym) ) / DBLE (dfftp%nr1)
WRITE( stdout, '(17x," (",3(i6,5x), &
& " ) ( ",f10.7," )")') &
(s (2, ipol, &
&isym) , ipol = 1, 3) , DBLE (ftau (2, isym) ) / DBLE (dense%nr2)
&isym) , ipol = 1, 3) , DBLE (ftau (2, isym) ) / DBLE (dfftp%nr2)
WRITE( stdout, '(17x," (",3(i6,5x), &
& " ) ( ",f10.7," )"/)') (s (3, ipol, &
& isym) , ipol = 1, 3) , DBLE (ftau (3, isym) ) / DBLE (dense%nr3)
& isym) , ipol = 1, 3) , DBLE (ftau (3, isym) ) / DBLE (dfftp%nr3)
WRITE( stdout,'(1x,"cart.",3x,"s(",i2,") = (",3f11.7, &
& " ) f =( ", f10.7," )")') &
isymq, (sr (1,ipol,isym), ipol=1,3), ft1
@ -189,12 +188,12 @@ subroutine d3_summary
!
WRITE( stdout, '(/5x,"G cutoff =",f10.4," (", &
& i7," G-vectors)"," FFT grid: (",i3, &
& ",",i3,",",i3,")")') gcutm, ngm, dense%nr1, dense%nr2, dense%nr3
& ",",i3,",",i3,")")') gcutm, ngm, dfftp%nr1, dfftp%nr2, dfftp%nr3
if (doublegrid) WRITE( stdout, '(5x,"G cutoff =",f10.4," (", &
& i7," G-vectors)"," smooth grid: (",i3, &
& ",",i3,",",i3,")")') gcutms, ngms, &
&smooth%nr1, smooth%nr2, smooth%nr3
&dffts%nr1, dffts%nr2, dffts%nr3
if (degauss.eq.0.d0) then
WRITE( stdout, '(5x,"number of k points=",i5)') nkstot
else

4
D3/dpsidvdpsi.f90
View File

@ -15,7 +15,7 @@ subroutine dpsidvdpsi (nu_q0)
USE mp_global, ONLY : inter_pool_comm, intra_pool_comm
USE mp, ONLY : mp_sum
use pwcom
USE grid_dimensions, ONLY : dense
USE fft_base, ONLY : dfftp
USE uspp, ONLY : nkb, vkb
use phcom
use d3com
@ -32,7 +32,7 @@ subroutine dpsidvdpsi (nu_q0)
allocate (dqpsi( npwx, nbnd))
allocate (dvloc( dense%nrxx))
allocate (dvloc( dfftp%nnr))
allocate (d3dyn1( 3 * nat, 3 * nat, 3 * nat))
if (.not.allmodes) then
allocate (d3dyn2( 3 * nat, 3 * nat, 3 * nat))

4
D3/drhod2v.f90
View File

@ -21,7 +21,7 @@ subroutine drhod2v
!
USE ions_base, ONLY : nat
USE kinds, only : DP
USE grid_dimensions, ONLY : dense
USE fft_base, ONLY : dfftp
use pwcom
use phcom
use d3com
@ -32,7 +32,7 @@ subroutine drhod2v
complex (DP), allocatable :: drhoscf (:)
! the change of density due to perturbations
allocate (drhoscf( dense%nrxx))
allocate (drhoscf( dfftp%nnr))
call read_ef
if (.not.allmodes) then

7
D3/dvdpsi.f90
View File

@ -15,10 +15,9 @@ subroutine dvdpsi (nu_i, xq_, dvloc, vkb_, vkbq_, psi_, dvpsi_)
!
USE ions_base, ONLY : nat, ityp, ntyp => nsp
USE cell_base, ONLY : tpiba
USE fft_base, ONLY : dffts
USE fft_base, ONLY : dffts, dfftp
USE fft_interfaces, ONLY : fwfft, invfft
USE gvect, ONLY : g
USE grid_dimensions, ONLY : dense
USE gvecs, ONLY : nls
USE wvfct, ONLY : nbnd, npwx, npw, igk
use phcom
@ -34,7 +33,7 @@ subroutine dvdpsi (nu_i, xq_, dvloc, vkb_, vkbq_, psi_, dvpsi_)
! input: the mode under consideration
real (DP) :: xq_ (3)
! input: coordinates of the q point describing the perturbation
complex (DP) :: dvloc (dense%nrxx), psi_ (npwx, nbnd), dvpsi_ (npwx, nbnd)
complex (DP) :: dvloc (dfftp%nnr), psi_ (npwx, nbnd), dvpsi_ (npwx, nbnd)
! input: local part of the KS potential
! input: wavefunction
! output: variation of the KS potential applied to psi_
@ -51,7 +50,7 @@ subroutine dvdpsi (nu_i, xq_, dvloc, vkb_, vkbq_, psi_, dvpsi_)
complex (DP) , external:: zdotc
logical :: q_eq_zero
!
allocate (aux( dense%nrxx))
allocate (aux( dfftp%nnr))
allocate (ps( 2, nbnd))
allocate (wrk2( npwx))
q_eq_zero = xq_ (1) == 0.d0 .and. xq_ (2) == 0.d0 .and. xq_ (3) == 0.d0

4
D3/gen_dpdvp.f90
View File

@ -20,7 +20,7 @@ subroutine gen_dpdvp
USE ions_base, ONLY : nat
USE kinds, only : DP
use pwcom
USE grid_dimensions, ONLY : dense
USE fft_base, ONLY : dfftp
USE uspp, ONLY: vkb
USE wavefunctions_module, ONLY: evc
USE io_files, ONLY : iunigk
@ -40,7 +40,7 @@ subroutine gen_dpdvp
if (degauss.eq.0.d0) return
allocate (dvloc( dense%nrxx))
allocate (dvloc( dfftp%nnr))
allocate (dpsidvpsi( nbnd, nbnd))
rewind (unit = iunigk)

19
D3/make.depend
View File

@ -42,7 +42,7 @@ d0rhod2v.o : ../PW/pwcom.o
d0rhod2v.o : d3com.o
d2mxc.o : ../Modules/constants.o
d2mxc.o : ../Modules/kind.o
d3_exc.o : ../Modules/griddim.o
d3_exc.o : ../Modules/fft_base.o
d3_exc.o : ../Modules/io_global.o
d3_exc.o : ../Modules/ions_base.o
d3_exc.o : ../Modules/kind.o
@ -53,7 +53,7 @@ d3_exc.o : ../PW/pwcom.o
d3_exc.o : ../PW/scf_mod.o
d3_exc.o : d3com.o
d3_init.o : ../Modules/atom.o
d3_init.o : ../Modules/griddim.o
d3_init.o : ../Modules/fft_base.o
d3_init.o : ../Modules/ions_base.o
d3_init.o : ../Modules/mp.o
d3_init.o : ../Modules/uspp.o
@ -79,8 +79,8 @@ d3_recover.o : ../PW/pwcom.o
d3_recover.o : d3com.o
d3_setup.o : ../Modules/constants.o
d3_setup.o : ../Modules/control_flags.o
d3_setup.o : ../Modules/fft_base.o
d3_setup.o : ../Modules/funct.o
d3_setup.o : ../Modules/griddim.o
d3_setup.o : ../Modules/io_files.o
d3_setup.o : ../Modules/io_global.o
d3_setup.o : ../Modules/ions_base.o
@ -94,7 +94,7 @@ d3_setup.o : ../PW/scf_mod.o
d3_setup.o : ../PW/symm_base.o
d3_setup.o : d3com.o
d3_summary.o : ../Modules/control_flags.o
d3_summary.o : ../Modules/griddim.o
d3_summary.o : ../Modules/fft_base.o
d3_summary.o : ../Modules/io_global.o
d3_summary.o : ../Modules/ions_base.o
d3_summary.o : ../Modules/kind.o
@ -183,7 +183,7 @@ dpsidpsidv.o : ../Modules/mp_global.o
dpsidpsidv.o : ../PH/phcom.o
dpsidpsidv.o : ../PW/pwcom.o
dpsidpsidv.o : d3com.o
dpsidvdpsi.o : ../Modules/griddim.o
dpsidvdpsi.o : ../Modules/fft_base.o
dpsidvdpsi.o : ../Modules/io_files.o
dpsidvdpsi.o : ../Modules/ions_base.o
dpsidvdpsi.o : ../Modules/kind.o
@ -218,7 +218,7 @@ drho_drc.o : ../Modules/uspp.o
drho_drc.o : ../PH/phcom.o
drho_drc.o : ../PW/pwcom.o
drho_drc.o : d3com.o
drhod2v.o : ../Modules/griddim.o
drhod2v.o : ../Modules/fft_base.o
drhod2v.o : ../Modules/ions_base.o
drhod2v.o : ../Modules/kind.o
drhod2v.o : ../PH/phcom.o
@ -227,7 +227,6 @@ drhod2v.o : d3com.o
dvdpsi.o : ../Modules/cell_base.o
dvdpsi.o : ../Modules/fft_base.o
dvdpsi.o : ../Modules/fft_interfaces.o
dvdpsi.o : ../Modules/griddim.o
dvdpsi.o : ../Modules/ions_base.o
dvdpsi.o : ../Modules/mp.o
dvdpsi.o : ../Modules/mp_global.o
@ -244,7 +243,7 @@ dvscf.o : ../Modules/uspp.o
dvscf.o : ../PH/phcom.o
dvscf.o : ../PW/pwcom.o
dvscf.o : d3com.o
gen_dpdvp.o : ../Modules/griddim.o
gen_dpdvp.o : ../Modules/fft_base.o
gen_dpdvp.o : ../Modules/io_files.o
gen_dpdvp.o : ../Modules/ions_base.o
gen_dpdvp.o : ../Modules/kind.o
@ -268,7 +267,7 @@ incdrhoscf2.o : ../Modules/wavefunctions.o
incdrhoscf2.o : ../PH/phcom.o
incdrhoscf2.o : ../PW/pwcom.o
openfild3.o : ../Modules/control_flags.o
openfild3.o : ../Modules/griddim.o
openfild3.o : ../Modules/fft_base.o
openfild3.o : ../Modules/io_files.o
openfild3.o : ../Modules/io_global.o
openfild3.o : ../Modules/mp_global.o
@ -313,7 +312,7 @@ set_sym_irr.o : ../Modules/kind.o
set_sym_irr.o : ../Modules/mp.o
set_sym_irr.o : ../Modules/mp_global.o
solve_linter_d3.o : ../Modules/cell_base.o
solve_linter_d3.o : ../Modules/griddim.o
solve_linter_d3.o : ../Modules/fft_base.o
solve_linter_d3.o : ../Modules/io_files.o
solve_linter_d3.o : ../Modules/io_global.o
solve_linter_d3.o : ../Modules/ions_base.o

4
D3/openfild3.f90
View File

@ -16,7 +16,7 @@ SUBROUTINE openfild3
USE pwcom
USE phcom
USE d3com
USE grid_dimensions, ONLY : dense
USE fft_base, ONLY : dfftp
USE control_flags, ONLY : twfcollect
USE io_files, ONLY : iunigk, prefix, tmp_dir, diropn
USE io_global, ONLY : ionode
@ -95,7 +95,7 @@ SUBROUTINE openfild3
iudrho = 25
iud0rho = 33
IF (lgamma) iud0rho = iudrho
lrdrho = 2 * dense%nr1x * dense%nr2x * dense%nr3x * nspin
lrdrho = 2 * dfftp%nr1x * dfftp%nr2x * dfftp%nr3x * nspin
!
! is opened only by the first task of each pool
!

6
D3/solve_linter_d3.f90
View File

@ -32,7 +32,7 @@ subroutine solve_linter_d3 (irr, imode0, npe, isw_sl)
USE io_global, ONLY : stdout
USE io_files, ONLY : iunigk
USE gvect, ONLY : g
USE grid_dimensions, ONLY : dense
USE fft_base, ONLY : dfftp
USE ener, ONLY : ef
USE klist, ONLY : xk, wk, degauss, ngauss
USE wvfct, ONLY : nbnd, npwx, npw, igk, g2kin, et
@ -94,8 +94,8 @@ subroutine solve_linter_d3 (irr, imode0, npe, isw_sl)
external ch_psi_all2, cg_psi
!
call start_clock ('solve_linter')
allocate (drhoscf( dense%nrxx, npe))
allocate (dvloc( dense%nrxx, npe))
allocate (drhoscf( dfftp%nnr, npe))
allocate (dvloc( dfftp%nnr, npe))
allocate (spsi( npwx))
allocate (auxg( npwx))
if (degauss /= 0.d0) allocate (dpsiaux( npwx, nbnd))

6
GWW/head/openfilq.f90
View File

@ -28,7 +28,7 @@ SUBROUTINE openfilq()
USE qpoint, ONLY : nksq
USE output, ONLY : fildyn, fildvscf
USE wvfct, ONLY : nbnd, npwx
USE grid_dimensions,ONLY : dense
USE fft_base, ONLY : dfftp
USE lsda_mod, ONLY : nspin
USE uspp, ONLY : nkb, okvan
USE io_files, ONLY : prefix, iunigk
@ -95,7 +95,7 @@ SUBROUTINE openfilq()
!
IF (okvan) THEN
iudrhous = 25
lrdrhous = 2 * dense%nrxx * nspin
lrdrhous = 2 * dfftp%nnr * nspin
CALL diropn (iudrhous, 'prd', lrdrhous, exst)
IF (recover.AND..NOT.exst) &
CALL errore ('openfilq','file '//trim(prefix)//'.prd not found', 1)
@ -105,7 +105,7 @@ SUBROUTINE openfilq()
! and solve_linter). Used for third-order calculations.
!
iudrho = 23
lrdrho = 2 * dense%nr1x * dense%nr2x * dense%nr3x * nspin
lrdrho = 2 * dfftp%nr1x * dfftp%nr2x * dfftp%nr3x * nspin
!
!
! Here the sequential files

8
GWW/pw4gww/distance_gw.f90
View File

@ -12,7 +12,7 @@ subroutine distance_wannier
USE io_files, ONLY : find_free_unit, prefix
USE wannier_gw
USE io_global, ONLY : ionode, stdout
USE grid_dimensions, ONLY : dense
USE fft_base, ONLY : dfftp
USE cell_base, ONLY: at, alat
implicit none
@ -25,9 +25,9 @@ subroutine distance_wannier
if(ionode) then
rspacel(1)=dense%nr1
rspacel(2)=dense%nr2
rspacel(3)=dense%nr3
rspacel(1)=dfftp%nr1
rspacel(2)=dfftp%nr2
rspacel(3)=dfftp%nr3
iun = find_free_unit()

27
GWW/pw4gww/energies_xc.f90
View File

@ -28,11 +28,10 @@ SUBROUTINE energies_xc( lda, n, m, e_xc, e_h )
USE control_flags, ONLY : gamma_only
USE uspp, ONLY : vkb, nkb
USE wvfct, ONLY : igk, g2kin, ecutwfc
USE fft_base, ONLY : dffts
USE fft_base, ONLY : dffts, dfftp
USE fft_interfaces, ONLY : fwfft, invfft
USE gvecs, ONLY : nls, doublegrid
USE gvect, ONLY : ngm, gstart, nl, nlm, g, gg, gcutm
USE grid_dimensions, ONLY : dense
USE cell_base, ONLY : alat, omega
USE lsda_mod, ONLY : nspin
USE ldaU, ONLY : lda_plus_u
@ -241,7 +240,7 @@ SUBROUTINE energies_xc( lda, n, m, e_xc, e_h )
deallocate(hpsi,psi,becp%r)
endif
!
allocate(psi_r(dense%nrxx),psi_rs(dffts%nnr))
allocate(psi_r(dfftp%nnr),psi_rs(dffts%nnr))
!
iunwfcreal=find_free_unit()
CALL diropn( iunwfcreal, 'real_whole', dffts%nnr, exst )
@ -250,7 +249,7 @@ SUBROUTINE energies_xc( lda, n, m, e_xc, e_h )
!
!if(.not.allocated(rho%of_r)) write(stdout,*) 'rho not allocated'
!if(.not.allocated(v%of_r)) write(stdout,*) 'v not allocated'
allocate(rho_fake_core(dense%nrxx))
allocate(rho_fake_core(dfftp%nnr))
rho_fake_core(:)=0.d0
CALL v_xc( rho, rho_core, rhog_core, etxc, vtxc, v%of_r )
!!CALL v_xc(rho,rho_core,nr1,nr2,nr3,nr1x,nr2x,nr3x,&
@ -278,7 +277,7 @@ SUBROUTINE energies_xc( lda, n, m, e_xc, e_h )
endif
!
!
do ir=1,dense%nrxx
do ir=1,dfftp%nnr
psi_r(ir)=psi_r(ir)**2.d0
enddo
!
@ -289,10 +288,10 @@ SUBROUTINE energies_xc( lda, n, m, e_xc, e_h )
! CHECK if the norm if equal to 1.0
!
norm=0.0
do ir=1,dense%nrxx
do ir=1,dfftp%nnr
norm=norm+psi_r(ir)
enddo
norm=norm/dble(dense%nr1*dense%nr2*dense%nr3)
norm=norm/dble(dfftp%nr1*dfftp%nr2*dfftp%nr3)
call mp_sum(norm)
!
diff=abs( norm - 1.0d0 )
@ -305,11 +304,11 @@ SUBROUTINE energies_xc( lda, n, m, e_xc, e_h )
endif
!
e_xc(ibnd)=0.d0
do ir=1,dense%nrxx
do ir=1,dfftp%nnr
e_xc(ibnd)=e_xc(ibnd)+psi_r(ir)*v%of_r(ir,1)!the 1 is for the spin NOT IMPLEMENTED YET
enddo
!
e_xc(ibnd)=e_xc(ibnd)/dble(dense%nr1*dense%nr2*dense%nr3)
e_xc(ibnd)=e_xc(ibnd)/dble(dfftp%nr1*dfftp%nr2*dfftp%nr3)
!
call mp_sum(e_xc(ibnd))
!
@ -333,7 +332,7 @@ SUBROUTINE energies_xc( lda, n, m, e_xc, e_h )
psi_r(:)=psi_rs(:)
endif
!
do ir=1,dense%nrxx
do ir=1,dfftp%nnr
psi_r(ir)=psi_r(ir)**2.d0
enddo
!
@ -341,10 +340,10 @@ SUBROUTINE energies_xc( lda, n, m, e_xc, e_h )
!
! CHECK the norm
norm=0.0
do ir=1,dense%nrxx
do ir=1,dfftp%nnr
norm=norm+psi_r(ir)
enddo
norm=norm/dble(dense%nr1*dense%nr2*dense%nr3)
norm=norm/dble(dfftp%nr1*dfftp%nr2*dfftp%nr3)
call mp_sum(norm)
!
diff=abs( norm - 1.0d0 )
@ -357,10 +356,10 @@ SUBROUTINE energies_xc( lda, n, m, e_xc, e_h )
endif
!
e_h(ibnd)=0.d0
do ir=1,dense%nrxx
do ir=1,dfftp%nnr
e_h(ibnd)=e_h(ibnd)+psi_r(ir)*v%of_r(ir,1)!the 1 is for the spin NOT IMPLEMENTED YET
enddo
e_h(ibnd)=e_h(ibnd)/dble(dense%nr1*dense%nr2*dense%nr3)
e_h(ibnd)=e_h(ibnd)/dble(dfftp%nr1*dfftp%nr2*dfftp%nr3)
!
call mp_sum(e_h(ibnd))
write(stdout,*) 'Routine energies_h :', ibnd, e_h(ibnd)*rytoev

60
GWW/pw4gww/matrix_wannier_gamma.f90
View File

@ -17,9 +17,7 @@ subroutine matrix_wannier_gamma_big( matsincos, ispin, n_set, itask )
USE uspp, ONLY : okvan, nkb
USE io_files, ONLY : find_free_unit, diropn
USE io_global, ONLY : stdout
USE smooth_grid_dimensions,ONLY: smooth
USE realus, ONLY : qsave, box,maxbox
USE grid_dimensions, ONLY : dense
USE wannier_gw, ONLY : becp_gw, expgsave, becp_gw_c, maxiter2,num_nbnd_first,num_nbndv,nbnd_normal
USE ions_base, ONLY : nat, ntyp => nsp, ityp
USE uspp_param, ONLY : upf, lmaxq, nh, nhm
@ -56,11 +54,11 @@ subroutine matrix_wannier_gamma_big( matsincos, ispin, n_set, itask )
call flush_unit(stdout)
iunwfcreal2=find_free_unit()
CALL diropn( iunwfcreal2, 'real_whole', smooth%nrxx, exst )
CALL diropn( iunwfcreal2, 'real_whole', dffts%nnr, exst )
allocate(tmprealis(smooth%nrxx,n_set),tmprealjs(smooth%nrxx,n_set), tmpreal(smooth%nrxx))
allocate(tmpexp2(smooth%nrxx,6))
allocate(tmprealis(dffts%nnr,n_set),tmprealjs(dffts%nnr,n_set), tmpreal(dffts%nnr))
allocate(tmpexp2(dffts%nnr,6))
!set up exponential grid
@ -128,7 +126,7 @@ subroutine matrix_wannier_gamma_big( matsincos, ispin, n_set, itask )
do iw=(iiw-1)*n_set+1,min(iiw*n_set,nbnd_eff)
!read from disk wfc on coarse grid
CALL davcio( tmprealis(:,iw-(iiw-1)*n_set),smooth%nrxx,iunwfcreal2,iw,-1)
CALL davcio( tmprealis(:,iw-(iiw-1)*n_set),dffts%nnr,iunwfcreal2,iw,-1)
enddo
!read in iw wfcs
do jjw=iiw,nbnd_eff/n_set+1
@ -136,7 +134,7 @@ subroutine matrix_wannier_gamma_big( matsincos, ispin, n_set, itask )
call flush_unit(stdout)
do jw=(jjw-1)*n_set+1,min(jjw*n_set,nbnd_eff)
CALL davcio( tmprealjs(:,jw-(jjw-1)*n_set),smooth%nrxx,iunwfcreal2,jw,-1)
CALL davcio( tmprealjs(:,jw-(jjw-1)*n_set),dffts%nnr,iunwfcreal2,jw,-1)
enddo
!do product
@ -158,7 +156,7 @@ subroutine matrix_wannier_gamma_big( matsincos, ispin, n_set, itask )
!calculate matrix element
do mdir=1,3
sca=0.d0
do ir=1,smooth%nrxx
do ir=1,dffts%nnr
sca=sca+tmpreal(ir)*tmpexp2(ir,mdir)
enddo
sca=sca/dble(dffts%nr1*dffts%nr2*dffts%nr3)
@ -185,38 +183,38 @@ subroutine matrix_wannier_gamma_big( matsincos, ispin, n_set, itask )
write(stdout,*) 'Calculate US'
call flush_unit(stdout)
if(okvan) then
allocate(tmpexp(dense%nrxx))
allocate(tmpexp(dfftp%nnr))
allocate(expgsave(maxval(nh),maxval(nh),nat,3))
expgsave(:,:,:,:)=0.d0
do mdir=1,3
#ifndef __PARA
if(mdir==1) then
do ix=1,dense%nr1
ee=exp(cmplx(0.d0,1.d0)*tpi*real(ix)/real(dense%nr1))
do iy=1,dense%nr2
do iz=1,dense%nr3
nn=(iz-1)*dense%nr1x*dense%nr2x+(iy-1)*dense%nr1x+ix
do ix=1,dfftp%nr1
ee=exp(cmplx(0.d0,1.d0)*tpi*real(ix)/real(dfftp%nr1))
do iy=1,dfftp%nr2
do iz=1,dfftp%nr3
nn=(iz-1)*dfftp%nr1x*dfftp%nr2x+(iy-1)*dfftp%nr1x+ix
tmpexp(nn)=ee
enddo
enddo
enddo
else if(mdir==2) then
do iy=1,dense%nr2
ee=exp(cmplx(0.d0,1.d0)*tpi*real(iy)/real(dense%nr2))
do ix=1,dense%nr1
do iz=1,dense%nr3
nn=(iz-1)*dense%nr1x*dense%nr2x+(iy-1)*dense%nr1x+ix
do iy=1,dfftp%nr2
ee=exp(cmplx(0.d0,1.d0)*tpi*real(iy)/real(dfftp%nr2))
do ix=1,dfftp%nr1
do iz=1,dfftp%nr3
nn=(iz-1)*dfftp%nr1x*dfftp%nr2x+(iy-1)*dfftp%nr1x+ix
tmpexp(nn)=ee
enddo
enddo
enddo
else if(mdir==3) then
do iz=1,dense%nr3
ee=exp(cmplx(0.d0,1.d0)*tpi*real(iz)/real(dense%nr3))
do ix=1,dense%nr1
do iy=1,dense%nr2
nn=(iz-1)*dense%nr1x*dense%nr2x+(iy-1)*dense%nr1x+ix
do iz=1,dfftp%nr3
ee=exp(cmplx(0.d0,1.d0)*tpi*real(iz)/real(dfftp%nr3))
do ix=1,dfftp%nr1
do iy=1,dfftp%nr2
nn=(iz-1)*dfftp%nr1x*dfftp%nr2x+(iy-1)*dfftp%nr1x+ix
tmpexp(nn)=ee
enddo
enddo
@ -232,16 +230,16 @@ subroutine matrix_wannier_gamma_big( matsincos, ispin, n_set, itask )
end do
do iz=1,dfftp%npp(me_pool+1)
do iy=1,dense%nr2
do ix=1,dense%nr1
do iy=1,dfftp%nr2
do ix=1,dfftp%nr1
nn=(iz-1)*dense%nr1x*dense%nr2x+(iy-1)*dense%nr1x+ix
nn=(iz-1)*dfftp%nr1x*dfftp%nr2x+(iy-1)*dfftp%nr1x+ix
if(mdir==1) then
tmpexp(nn)= exp(cmplx(0.d0,1.d0)*tpi*real(ix-1)/real(dense%nr1))
tmpexp(nn)= exp(cmplx(0.d0,1.d0)*tpi*real(ix-1)/real(dfftp%nr1))
elseif(mdir==2) then
tmpexp(nn)= exp(cmplx(0.d0,1.d0)*tpi*real(iy-1)/real(dense%nr2))
tmpexp(nn)= exp(cmplx(0.d0,1.d0)*tpi*real(iy-1)/real(dfftp%nr2))
else
tmpexp(nn)= exp(cmplx(0.d0,1.d0)*tpi*real(iz+nr3_start-1-1)/real(dense%nr3))
tmpexp(nn)= exp(cmplx(0.d0,1.d0)*tpi*real(iz+nr3_start-1-1)/real(dfftp%nr3))
endif
enddo
enddo
@ -301,7 +299,7 @@ subroutine matrix_wannier_gamma_big( matsincos, ispin, n_set, itask )
END IF
ENDDO
expgsave(:,:,:,mdir)=expgsave(:,:,:,mdir)*omega/dble(dense%nr1*dense%nr2*dense%nr3)
expgsave(:,:,:,mdir)=expgsave(:,:,:,mdir)*omega/dble(dfftp%nr1*dfftp%nr2*dfftp%nr3)
#ifdef __PARA
!!!call reduce (2 *maxval(nh) *maxval(nh)* nat, expgsave(:,:,:,mdir))

4
GWW/pw4gww/pw4gww.f90
View File

@ -50,7 +50,7 @@ program pp_punch
USE kinds, ONLY : i4b
use pwcom
use grid_dimensions, ONLY : dense
use fft_base, ONLY : dfftp
USE constants, ONLY : rytoev
use io_global, ONLY : stdout, ionode, ionode_id
use io_files, ONLY : psfile, pseudo_dir
@ -412,7 +412,7 @@ program pp_punch
CALL init_ns()
endif
CALL set_vrs(vrs, vltot, v%of_r, kedtau, v%kin_r, dense%nrxx, nspin, doublegrid )
CALL set_vrs(vrs, vltot, v%of_r, kedtau, v%kin_r, dfftp%nnr, nspin, doublegrid )
!-------------------------------------------------
! allocating wannier stuff (from init_run.f90)

216
GWW/pw4gww/ultralocalization.f90
View File

@ -15,9 +15,9 @@ SUBROUTINE ultralocalization(nbndv,ultra_thr,isubspace,max_array)
USE io_files, ONLY : find_free_unit, diropn
USE io_global, ONLY : stdout
USE smooth_grid_dimensions,ONLY: smooth
USE fft_base, ONLY : dffts
USE gvecs, ONLY : nls, nlsm, doublegrid
USE grid_dimensions, ONLY : dense
USE fft_base, ONLY : dfftp
use mp_global, ONLY : nproc_pool, me_pool
USE wvfct, ONLY : igk, g2kin, npwx, npw, nbnd, nbndx
USE basis
@ -83,13 +83,13 @@ SUBROUTINE ultralocalization(nbndv,ultra_thr,isubspace,max_array)
allocate(eigvector_set(nbnd,nmaxeig),eigvector_tmp(nbnd))
allocate(tmpreal(dense%nrxx))
allocate(tmpreal(dfftp%nnr))
allocate(eigenvector2(nbnd),eigenvector_old(nbnd,max_array))
allocate(iwork(5*nbnd),ifail(nbnd))
allocate(eigx(nbnd,nbnd),eigy(nbnd,nbnd),eigz(nbnd,nbnd))
allocate(exp_x(dense%nrxx),exp_y(dense%nrxx),exp_z(dense%nrxx))
allocate(sums(dense%nr1,dense%nr2,dense%nr3))
allocate(tmp_s(smooth%nrxx),tmp_r(dense%nrxx))
allocate(exp_x(dfftp%nnr),exp_y(dfftp%nnr),exp_z(dfftp%nnr))
allocate(sums(dfftp%nr1,dfftp%nr2,dfftp%nr3))
allocate(tmp_s(dffts%nnr),tmp_r(dfftp%nnr))
if(okvan) allocate(becp_gw2(nkb,nbnd))
if(isubspace==0) then
@ -109,16 +109,16 @@ SUBROUTINE ultralocalization(nbndv,ultra_thr,isubspace,max_array)
alfa=0.01d0
allocate(tmpreali(smooth%nrxx,n_bands))
allocate(tmprealj(smooth%nrxx))
allocate(min_1(dense%nr2,dense%nr3,n_bands),min_2(dense%nr2,dense%nr3,n_bands))
allocate(max_1(dense%nr2,dense%nr3,n_bands),max_2(dense%nr2,dense%nr3,n_bands))
allocate(tmpreali(dffts%nnr,n_bands))
allocate(tmprealj(dffts%nnr))
allocate(min_1(dfftp%nr2,dfftp%nr3,n_bands),min_2(dfftp%nr2,dfftp%nr3,n_bands))
allocate(max_1(dfftp%nr2,dfftp%nr3,n_bands),max_2(dfftp%nr2,dfftp%nr3,n_bands))
allocate(eigenvector(nbnd,n_bands))
radmax=no_radius/alat
nrsmin=min(dense%nr1,dense%nr2)
nrsmin=min(dense%nr3,nrsmin)
nrsmin=min(dfftp%nr1,dfftp%nr2)
nrsmin=min(dfftp%nr3,nrsmin)
!if nrsmin is even set to nrsmin -1,
if(is_even(nrsmin)) then
nrsmin=nrsmin-1
@ -129,10 +129,10 @@ SUBROUTINE ultralocalization(nbndv,ultra_thr,isubspace,max_array)
!open outpu file
iunrealwan = find_free_unit()
CALL diropn( iunrealwan, 'real_whole', smooth%nrxx, exst )
CALL diropn( iunrealwan, 'real_whole', dffts%nnr, exst )
!read in wave-functions
do iw=n_first,n_last
CALL davcio( tmpreali(:,iw-n_first+1),smooth%nrxx,iunrealwan,iw,-1)
CALL davcio( tmpreali(:,iw-n_first+1),dffts%nnr,iunrealwan,iw,-1)
enddo
CLOSE(iunrealwan)
!first valence subspace
@ -144,13 +144,13 @@ SUBROUTINE ultralocalization(nbndv,ultra_thr,isubspace,max_array)
exp_x(:)=(0.d0,0.d0)
exp_y(:)=(0.d0,0.d0)
exp_z(:)=(0.d0,0.d0)
do ix=1,smooth%nr1
do iy=1,smooth%nr2
do iz=1,smooth%nr3
nn=(iz-1)*smooth%nr1x*smooth%nr2x+(iy-1)*smooth%nr1x+ix
exp_x(nn)=exp((0.d0,1.d0)*tpi*real(ix)/real(smooth%nr1))
exp_y(nn)=exp((0.d0,1.d0)*tpi*real(iy)/real(smooth%nr2))
exp_z(nn)=exp((0.d0,1.d0)*tpi*real(iz)/real(smooth%nr3))
do ix=1,dffts%nr1
do iy=1,dffts%nr2
do iz=1,dffts%nr3
nn=(iz-1)*dffts%nr1x*dffts%nr2x+(iy-1)*dffts%nr1x+ix
exp_x(nn)=exp((0.d0,1.d0)*tpi*real(ix)/real(dffts%nr1))
exp_y(nn)=exp((0.d0,1.d0)*tpi*real(iy)/real(dffts%nr2))
exp_z(nn)=exp((0.d0,1.d0)*tpi*real(iz)/real(dffts%nr3))
enddo
enddo
enddo
@ -164,14 +164,14 @@ SUBROUTINE ultralocalization(nbndv,ultra_thr,isubspace,max_array)
eigz(iw,jw)=(0.d0,0.d0)
tmp_s(:)=tmpreali(:,iww)*tmpreali(:,jww)
do ir=1,smooth%nrxx
do ir=1,dffts%nnr
eigx(iw,jw)=eigx(iw,jw)+exp_x(ir)*tmp_s(ir)
eigy(iw,jw)=eigy(iw,jw)+exp_y(ir)*tmp_s(ir)
eigz(iw,jw)=eigz(iw,jw)+exp_z(ir)*tmp_s(ir)
enddo
eigx(iw,jw)=eigx(iw,jw)/real(smooth%nr1*smooth%nr2*smooth%nr3)
eigy(iw,jw)=eigy(iw,jw)/real(smooth%nr1*smooth%nr2*smooth%nr3)
eigz(iw,jw)=eigz(iw,jw)/real(smooth%nr1*smooth%nr2*smooth%nr3)
eigx(iw,jw)=eigx(iw,jw)/real(dffts%nr1*dffts%nr2*dffts%nr3)
eigy(iw,jw)=eigy(iw,jw)/real(dffts%nr1*dffts%nr2*dffts%nr3)
eigz(iw,jw)=eigz(iw,jw)/real(dffts%nr1*dffts%nr2*dffts%nr3)
eigx(jw,iw)=eigx(iw,jw)
eigy(jw,iw)=eigy(iw,jw)
eigz(jw,iw)=eigz(iw,jw)
@ -184,13 +184,13 @@ SUBROUTINE ultralocalization(nbndv,ultra_thr,isubspace,max_array)
exp_x(:)=(0.d0,0.d0)
exp_y(:)=(0.d0,0.d0)
exp_z(:)=(0.d0,0.d0)
do ix=1,dense%nr1
do iy=1,dense%nr2
do iz=1,dense%nr3
nn=(iz-1)*dense%nr1x*dense%nr2x+(iy-1)*dense%nr1x+ix
exp_x(nn)=exp((0.d0,1.d0)*tpi*real(ix)/real(dense%nr1))
exp_y(nn)=exp((0.d0,1.d0)*tpi*real(iy)/real(dense%nr2))
exp_z(nn)=exp((0.d0,1.d0)*tpi*real(iz)/real(dense%nr3))
do ix=1,dfftp%nr1
do iy=1,dfftp%nr2
do iz=1,dfftp%nr3
nn=(iz-1)*dfftp%nr1x*dfftp%nr2x+(iy-1)*dfftp%nr1x+ix
exp_x(nn)=exp((0.d0,1.d0)*tpi*real(ix)/real(dfftp%nr1))
exp_y(nn)=exp((0.d0,1.d0)*tpi*real(iy)/real(dfftp%nr2))
exp_z(nn)=exp((0.d0,1.d0)*tpi*real(iz)/real(dfftp%nr3))
enddo
enddo
enddo
@ -204,14 +204,14 @@ SUBROUTINE ultralocalization(nbndv,ultra_thr,isubspace,max_array)
scac1=(0.d0,0.d0)
scac2=(0.d0,0.d0)
scac3=(0.d0,0.d0)
do ir=1,dense%nrxx
do ir=1,dfftp%nnr
scac1=scac1+exp_x(ir)*tmp_r(ir)
scac2=scac2+exp_y(ir)*tmp_r(ir)
scac3=scac3+exp_z(ir)*tmp_r(ir)
enddo
eigx(iw,jw)=eigx(iw,jw)+scac1/real(dense%nr1*dense%nr2*dense%nr3)
eigy(iw,jw)=eigy(iw,jw)+scac2/real(dense%nr1*dense%nr2*dense%nr3)
eigz(iw,jw)=eigz(iw,jw)+scac3/real(dense%nr1*dense%nr2*dense%nr3)
eigx(iw,jw)=eigx(iw,jw)+scac1/real(dfftp%nr1*dfftp%nr2*dfftp%nr3)
eigy(iw,jw)=eigy(iw,jw)+scac2/real(dfftp%nr1*dfftp%nr2*dfftp%nr3)
eigz(iw,jw)=eigz(iw,jw)+scac3/real(dfftp%nr1*dfftp%nr2*dfftp%nr3)
eigx(jw,iw)=eigx(iw,jw)
eigy(jw,iw)=eigy(iw,jw)
eigz(jw,iw)=eigz(iw,jw)
@ -244,17 +244,17 @@ SUBROUTINE ultralocalization(nbndv,ultra_thr,isubspace,max_array)
iqq=iqq+1
if(.not.converged(iqq)) then
do iy=1,smooth%nr2
do iz=1,smooth%nr3
do iy=1,dffts%nr2
do iz=1,dffts%nr3
min_1(iy,iz,iqq)=0
max_1(iy,iz,iqq)=0
min_2(iy,iz,iqq)=0
max_2(iy,iz,iqq)=0
do ix=1,smooth%nr1
nn=(iz-1)*smooth%nr1x*smooth%nr2x+(iy-1)*smooth%nr1x+ix
rx=rdistance(real(ix)*at(1,1)/real(smooth%nr1),center(1,iqq),at(1,1))
ry=rdistance(real(iy)*at(2,2)/real(smooth%nr2),center(2,iqq),at(2,2))
rz=rdistance(real(iz)*at(3,3)/real(smooth%nr3),center(3,iqq),at(3,3))
do ix=1,dffts%nr1
nn=(iz-1)*dffts%nr1x*dffts%nr2x+(iy-1)*dffts%nr1x+ix
rx=rdistance(real(ix)*at(1,1)/real(dffts%nr1),center(1,iqq),at(1,1))
ry=rdistance(real(iy)*at(2,2)/real(dffts%nr2),center(2,iqq),at(2,2))
rz=rdistance(real(iz)*at(3,3)/real(dffts%nr3),center(3,iqq),at(3,3))
if(sqrt(rx**2.d0+ry**2.d0+rz**2.d0) <= radmax) then
if(min_1(iy,iz,iqq)==0) min_1(iy,iz,iqq)=ix
else
@ -264,13 +264,13 @@ SUBROUTINE ultralocalization(nbndv,ultra_thr,isubspace,max_array)
endif
endif
enddo
if(min_1(iy,iz,iqq)/=0 .and. max_1(iy,iz,iqq)==0) max_1(iy,iz,iqq)=smooth%nr1+1
if(min_1(iy,iz,iqq)==1 .and. max_1(iy,iz,iqq)/=(smooth%nr1+1)) then
do ix=smooth%nr1,1,-1
nn=(iz-1)*smooth%nr1x*smooth%nr2x+(iy-1)*smooth%nr1x+ix
rx=rdistance(real(ix)*at(1,1)/real(smooth%nr1),center(1,iqq),at(1,1))
ry=rdistance(real(iy)*at(2,2)/real(smooth%nr2),center(2,iqq),at(2,2))
rz=rdistance(real(iz)*at(3,3)/real(smooth%nr3),center(3,iqq),at(3,3))
if(min_1(iy,iz,iqq)/=0 .and. max_1(iy,iz,iqq)==0) max_1(iy,iz,iqq)=dffts%nr1+1
if(min_1(iy,iz,iqq)==1 .and. max_1(iy,iz,iqq)/=(dffts%nr1+1)) then
do ix=dffts%nr1,1,-1
nn=(iz-1)*dffts%nr1x*dffts%nr2x+(iy-1)*dffts%nr1x+ix
rx=rdistance(real(ix)*at(1,1)/real(dffts%nr1),center(1,iqq),at(1,1))
ry=rdistance(real(iy)*at(2,2)/real(dffts%nr2),center(2,iqq),at(2,2))
rz=rdistance(real(iz)*at(3,3)/real(dffts%nr3),center(3,iqq),at(3,3))
if(sqrt(rx**2.d0+ry**2.d0+rz**2.d0) <= radmax) then
if(max_2(iy,iz,iqq)==0) max_2(iy,iz,iqq)=ix
else
@ -300,11 +300,11 @@ SUBROUTINE ultralocalization(nbndv,ultra_thr,isubspace,max_array)
kww=kw-n_first+1
sums(:,:,:)=0.d0
tmp_s(:)=tmpreali(:,jww)*tmpreali(:,kww)
do iy=1,smooth%nr2
do iz=1,smooth%nr3
do iy=1,dffts%nr2
do iz=1,dffts%nr3
sca=0.d0
do ix=1,smooth%nr1
nn=(iz-1)*smooth%nr1x*smooth%nr2x+(iy-1)*smooth%nr1x+ix
do ix=1,dffts%nr1
nn=(iz-1)*dffts%nr1x*dffts%nr2x+(iy-1)*dffts%nr1x+ix
sca=sca+tmp_s(nn)
sums(ix,iy,iz)=sca
enddo
@ -314,8 +314,8 @@ SUBROUTINE ultralocalization(nbndv,ultra_thr,isubspace,max_array)
do iw=ifirst,ilast
iqq=iqq+1
if(.not.converged(iqq))then
do iy=1,smooth%nr2
do iz=1,smooth%nr3
do iy=1,dffts%nr2
do iz=1,dffts%nr3
if(max_1(iy,iz,iqq)/=0) then
if(min_1(iy,iz,iqq)/=1) then
loc_mat(jww,kww,iqq)=loc_mat(jww,kww,iqq)+&
@ -329,7 +329,7 @@ SUBROUTINE ultralocalization(nbndv,ultra_thr,isubspace,max_array)
endif
enddo
enddo
loc_mat(jww,kww,iqq)=loc_mat(jww,kww,iqq)/real(smooth%nr1*smooth%nr2*smooth%nr3)
loc_mat(jww,kww,iqq)=loc_mat(jww,kww,iqq)/real(dffts%nr1*dffts%nr2*dffts%nr3)
loc_mat(kww,jww,iqq)=loc_mat(jww,kww,iqq)
endif
enddo
@ -344,17 +344,17 @@ SUBROUTINE ultralocalization(nbndv,ultra_thr,isubspace,max_array)
iqq=iqq+1
if(.not.converged(iqq)) then
do iy=1,dense%nr2
do iz=1,dense%nr3
do iy=1,dfftp%nr2
do iz=1,dfftp%nr3
min_1(iy,iz,iqq)=0
max_1(iy,iz,iqq)=0
min_2(iy,iz,iqq)=0
max_2(iy,iz,iqq)=0
do ix=1,dense%nr1
nn=(iz-1)*dense%nr1x*dense%nr2x+(iy-1)*dense%nr1x+ix
rx=rdistance(real(ix)*at(1,1)/real(dense%nr1),center(1,iqq),at(1,1))
ry=rdistance(real(iy)*at(2,2)/real(dense%nr2),center(2,iqq),at(2,2))
rz=rdistance(real(iz)*at(3,3)/real(dense%nr3),center(3,iqq),at(3,3))
do ix=1,dfftp%nr1
nn=(iz-1)*dfftp%nr1x*dfftp%nr2x+(iy-1)*dfftp%nr1x+ix
rx=rdistance(real(ix)*at(1,1)/real(dfftp%nr1),center(1,iqq),at(1,1))
ry=rdistance(real(iy)*at(2,2)/real(dfftp%nr2),center(2,iqq),at(2,2))
rz=rdistance(real(iz)*at(3,3)/real(dfftp%nr3),center(3,iqq),at(3,3))
if(sqrt(rx**2.d0+ry**2.d0+rz**2.d0) <= radmax) then
if(min_1(iy,iz,iqq)==0) min_1(iy,iz,iqq)=ix
else
@ -364,13 +364,13 @@ SUBROUTINE ultralocalization(nbndv,ultra_thr,isubspace,max_array)
endif
endif
enddo
if(min_1(iy,iz,iqq)/=0 .and. max_1(iy,iz,iqq)==0) max_1(iy,iz,iqq)=dense%nr1+1
if(min_1(iy,iz,iqq)==1 .and. max_1(iy,iz,iqq)/=(dense%nr1+1)) then
do ix=dense%nr1,1,-1
nn=(iz-1)*dense%nr1x*dense%nr2x+(iy-1)*dense%nr1x+ix
rx=rdistance(real(ix)*at(1,1)/real(dense%nr1),center(1,iqq),at(1,1))
ry=rdistance(real(iy)*at(2,2)/real(dense%nr2),center(2,iqq),at(2,2))
rz=rdistance(real(iz)*at(3,3)/real(dense%nr3),center(3,iqq),at(3,3))
if(min_1(iy,iz,iqq)/=0 .and. max_1(iy,iz,iqq)==0) max_1(iy,iz,iqq)=dfftp%nr1+1
if(min_1(iy,iz,iqq)==1 .and. max_1(iy,iz,iqq)/=(dfftp%nr1+1)) then
do ix=dfftp%nr1,1,-1
nn=(iz-1)*dfftp%nr1x*dfftp%nr2x+(iy-1)*dfftp%nr1x+ix
rx=rdistance(real(ix)*at(1,1)/real(dfftp%nr1),center(1,iqq),at(1,1))
ry=rdistance(real(iy)*at(2,2)/real(dfftp%nr2),center(2,iqq),at(2,2))
rz=rdistance(real(iz)*at(3,3)/real(dfftp%nr3),center(3,iqq),at(3,3))
if(sqrt(rx**2.d0+ry**2.d0+rz**2.d0) <= radmax) then
if(max_2(iy,iz,iqq)==0) max_2(iy,iz,iqq)=ix
else
@ -400,23 +400,23 @@ SUBROUTINE ultralocalization(nbndv,ultra_thr,isubspace,max_array)
sums(:,:,:)=0.d0
tmp_r(:)=0.d0
call adduspos_gamma_r(jw,kw,tmp_r,1,becp_gw(:,jw),becp_gw(:,kw))
do iy=1,dense%nr2
do iz=1,dense%nr3
do iy=1,dfftp%nr2
do iz=1,dfftp%nr3
sca=0.d0
do ix=1,dense%nr1
nn=(iz-1)*dense%nr1x*dense%nr2x+(iy-1)*dense%nr1x+ix
do ix=1,dfftp%nr1
nn=(iz-1)*dfftp%nr1x*dfftp%nr2x+(iy-1)*dfftp%nr1x+ix
sca=sca+tmp_r(nn)
sums(ix,iy,iz)=sca
enddo
enddo
enddo
sums(:,:,:)=sums(:,:,:)/dble(dense%nr1*dense%nr2*dense%nr3)
sums(:,:,:)=sums(:,:,:)/dble(dfftp%nr1*dfftp%nr2*dfftp%nr3)
iqq=0
do iw=ifirst,ilast
iqq=iqq+1
if(.not.converged(iqq))then
do iy=1,dense%nr2
do iz=1,dense%nr3
do iy=1,dfftp%nr2
do iz=1,dfftp%nr3
if(max_1(iy,iz,iqq)/=0) then
if(min_1(iy,iz,iqq)/=1) then
loc_mat(jww,kww,iqq)=loc_mat(jww,kww,iqq)+&
@ -575,19 +575,19 @@ SUBROUTINE ultralocalization(nbndv,ultra_thr,isubspace,max_array)
!determines integer coordinates of center of wannier wfcs
nc1=aint(center(1,iqq)/(at(1,1))*real(dense%nr1))
nc2=aint(center(2,iqq)/(at(2,2))*real(dense%nr2))
nc3=aint(center(3,iqq)/(at(3,3))*real(dense%nr3))
nc1=aint(center(1,iqq)/(at(1,1))*real(dfftp%nr1))
nc2=aint(center(2,iqq)/(at(2,2))*real(dfftp%nr2))
nc3=aint(center(3,iqq)/(at(3,3))*real(dfftp%nr3))
if(nc1<1) nc1=dense%nr1+nc1
if(nc1>dense%nr1) nc1=nc1-dense%nr1
if(nc1<1) nc1=dfftp%nr1+nc1
if(nc1>dfftp%nr1) nc1=nc1-dfftp%nr1
if(nc2<1) nc2=dense%nr2+nc2
if(nc2>dense%nr2) nc2=nc2-dense%nr2
if(nc2<1) nc2=dfftp%nr2+nc2
if(nc2>dfftp%nr2) nc2=nc2-dfftp%nr2
if(nc3<1) nc3=dense%nr3+nc3
if(nc3>dense%nr3) nc3=nc3-dense%nr3
if(nc3<1) nc3=dfftp%nr3+nc3
if(nc3>dfftp%nr3) nc3=nc3-dfftp%nr3
write(stdout,*)'Wannier :', iw, 'Center :', nc1,nc2,nc3
@ -601,23 +601,23 @@ SUBROUTINE ultralocalization(nbndv,ultra_thr,isubspace,max_array)
do iz=-nll,nll
n1=nc1+ix
if(n1<1) n1=dense%nr1+n1
if(n1>dense%nr1) n1=n1-dense%nr1
if(n1<1) n1=dfftp%nr1+n1
if(n1>dfftp%nr1) n1=n1-dfftp%nr1
n2=nc2+iy
if(n2<1) n2=dense%nr2+n2
if(n2>dense%nr2) n2=n2-dense%nr2
if(n2<1) n2=dfftp%nr2+n2
if(n2>dfftp%nr2) n2=n2-dfftp%nr2
n3=nc3+iz
if(n3<1) n3=dense%nr3+n3
if(n3>dense%nr3) n3=n3-dense%nr3
if(n3<1) n3=dfftp%nr3+n3
if(n3>dfftp%nr3) n3=n3-dfftp%nr3
nn=(n3-1)*dense%nr1x*dense%nr2x+(n2-1)*dense%nr1x+n1
nn=(n3-1)*dfftp%nr1x*dfftp%nr2x+(n2-1)*dfftp%nr1x+n1
norm=norm+tmp_r(nn)
enddo
enddo
enddo
norm=norm/real(dense%nr1*dense%nr2*dense%nr3)
norm=norm/real(dfftp%nr1*dfftp%nr2*dfftp%nr3)
if(norm >= cutoff) then
exit
endif
@ -627,16 +627,16 @@ SUBROUTINE ultralocalization(nbndv,ultra_thr,isubspace,max_array)
!determines integer origin
no1=nc1-nll
if(no1<1) no1=dense%nr1+no1
if(no1>dense%nr1) no1=no1-dense%nr1
if(no1<1) no1=dfftp%nr1+no1
if(no1>dfftp%nr1) no1=no1-dfftp%nr1
no2=nc2-nll
if(no2<1) no2=dense%nr2+no2
if(no2>dense%nr2) no2=no2-dense%nr2
if(no2<1) no2=dfftp%nr2+no2
if(no2>dfftp%nr2) no2=no2-dfftp%nr2
no3=nc3-nll
if(no3<1) no3=dense%nr3+no3
if(no3>dense%nr3) no3=no3-dense%nr3
if(no3<1) no3=dfftp%nr3+no3
if(no3>dfftp%nr3) no3=no3-dfftp%nr3
!put on array
if(doublegrid) then
@ -650,17 +650,17 @@ SUBROUTINE ultralocalization(nbndv,ultra_thr,isubspace,max_array)
do iz=0,2*nll
n1=no1+ix
if(n1<1) n1=dense%nr1+n1
if(n1>dense%nr1) n1=n1-dense%nr1
if(n1<1) n1=dfftp%nr1+n1
if(n1>dfftp%nr1) n1=n1-dfftp%nr1
n2=no2+iy
if(n2<1) n2=dense%nr2+n2
if(n2>dense%nr2) n2=n2-dense%nr2
if(n2<1) n2=dfftp%nr2+n2
if(n2>dfftp%nr2) n2=n2-dfftp%nr2
n3=no3+iz
if(n3<1) n3=dense%nr3+n3
if(n3>dense%nr3) n3=n3-dense%nr3
nn=(n3-1)*dense%nr1x*dense%nr2x+(n2-1)*dense%nr1x+n1
if(n3<1) n3=dfftp%nr3+n3
if(n3>dfftp%nr3) n3=n3-dfftp%nr3
nn=(n3-1)*dfftp%nr1x*dfftp%nr2x+(n2-1)*dfftp%nr1x+n1
tmpreal(iz*(2*nll+1)*(2*nll+1)+iy*(2*nll+1)+ix+1)=&
& tmp_r(nn)
enddo

8
GWW/pw4gww/wannier_pmat_terms_ggrid.f90
View File

@ -19,7 +19,7 @@
USE mp, ONLY : mp_bcast, mp_sum
USE kinds, ONLY : DP
USE gvect
USE grid_dimensions, ONLY : dense
USE fft_base, ONLY : dfftp
USE basis
USE klist
USE constants, ONLY : e2, pi, tpi, fpi
@ -88,9 +88,9 @@
call flush_unit(stdout)
rspacel(1)=dense%nr1
rspacel(2)=dense%nr2
rspacel(3)=dense%nr3
rspacel(1)=dfftp%nr1
rspacel(2)=dfftp%nr2
rspacel(3)=dfftp%nr3
! if(.not.lnonorthogonal) pmat(1:3,1:numw_prod,1:numw_prod)=(0.d0,0.d0)
omat(:,:)=0.d0

26
Gamma/cg_setup.f90
View File

@ -22,7 +22,7 @@ SUBROUTINE cg_setup
USE cgcom
USE funct, ONLY : dft_is_gradient, dmxc
USE dfunct, ONLY : newd
USE grid_dimensions, ONLY : dense
USE fft_base, ONLY : dfftp
!
IMPLICIT NONE
!
@ -41,32 +41,32 @@ SUBROUTINE cg_setup
!
! sum self-consistent part (vr) and local part (vltot) of potential
!
CALL set_vrs(vrs,vltot,v%of_r,kedtau, v%kin_r, dense%nrxx,nspin,doublegrid)
CALL set_vrs(vrs,vltot,v%of_r,kedtau, v%kin_r, dfftp%nnr,nspin,doublegrid)
!
! allocate memory for various arrays
!
ALLOCATE (dmuxc( dense%nrxx))
ALLOCATE (dmuxc( dfftp%nnr))
ALLOCATE (dvpsi( npwx, nbnd))
ALLOCATE ( dpsi( npwx, nbnd))
ALLOCATE ( auxr( dense%nrxx))
ALLOCATE ( aux2( dense%nrxx))
ALLOCATE ( aux3( dense%nrxx))
ALLOCATE ( auxr( dfftp%nnr))
ALLOCATE ( aux2( dfftp%nnr))
ALLOCATE ( aux3( dfftp%nnr))
!
! allocate memory for gradient corrections (if needed)
!
IF ( dft_is_gradient() ) THEN
ALLOCATE ( dvxc_rr(dense%nrxx,nspin,nspin))
ALLOCATE ( dvxc_sr(dense%nrxx,nspin,nspin))
ALLOCATE ( dvxc_ss(dense%nrxx,nspin,nspin))
ALLOCATE ( dvxc_s (dense%nrxx,nspin,nspin))
ALLOCATE ( grho (3, dense%nrxx, nspin))
ALLOCATE ( dvxc_rr(dfftp%nnr,nspin,nspin))
ALLOCATE ( dvxc_sr(dfftp%nnr,nspin,nspin))
ALLOCATE ( dvxc_ss(dfftp%nnr,nspin,nspin))
ALLOCATE ( dvxc_s (dfftp%nnr,nspin,nspin))
ALLOCATE ( grho (3, dfftp%nnr, nspin))
ENDIF
!
!
! initialize structure factor array
!
CALL struc_fact ( nat, tau, ntyp, ityp, ngm, g, bg, &
& dense%nr1, dense%nr2, dense%nr3, strf, eigts1, eigts2, eigts3 )
& dfftp%nr1, dfftp%nr2, dfftp%nr3, strf, eigts1, eigts2, eigts3 )
!
! compute drhocore/dtau for each atom type (if needed)
!
@ -84,7 +84,7 @@ SUBROUTINE cg_setup
! derivative of the xc potential
!
dmuxc(:) = 0.d0
DO i = 1,dense%nrxx
DO i = 1,dfftp%nnr
rhotot = rho%of_r(i,current_spin)+rho_core(i)
IF ( rhotot> 1.d-30 ) dmuxc(i)= dmxc( rhotot)
IF ( rhotot<-1.d-30 ) dmuxc(i)=-dmxc(-rhotot)

8
Gamma/cg_setupdgc.f90
View File

@ -16,7 +16,7 @@ SUBROUTINE cg_setupdgc
USE scf, ONLY : rho, rho_core, rhog_core
USE cgcom
USE funct, ONLY: gcxc, gcx_spin, gcc_spin, dgcxc, dgcxc_spin, dft_is_gradient
USE grid_dimensions, ONLY: dense
USE fft_base, ONLY: dfftp
!
IMPLICIT NONE
INTEGER k, is
@ -51,12 +51,12 @@ SUBROUTINE cg_setupdgc
ENDDO
ENDIF
DO is=1,nspin
CALL gradrho (dense%nr1x,dense%nr2x,dense%nr3x,dense%nr1,dense%nr2,dense%nr3,dense%nrxx,rho%of_g(1,is), &
CALL gradrho (dfftp%nr1x,dfftp%nr2x,dfftp%nr3x,dfftp%nr1,dfftp%nr2,dfftp%nr3,dfftp%nnr,rho%of_g(1,is), &
ngm,g,nl,grho(1,1,is))
ENDDO
!
IF (nspin==1) THEN
DO k = 1,dense%nrxx
DO k = 1,dfftp%nnr
grho2(1)=grho(1,k,1)**2+grho(2,k,1)**2+grho(3,k,1)**2
IF (abs(rho%of_r(k,1))>epsr.and.grho2(1)>epsg) THEN
CALL gcxc(rho%of_r(k,nspin),grho2(1),sx,sc,v1x,v2x,v1c,v2c)
@ -68,7 +68,7 @@ SUBROUTINE cg_setupdgc
ENDIF
ENDDO
ELSE
DO k = 1,dense%nrxx
DO k = 1,dfftp%nnr
grho2(2)=grho(1,k,2)**2+grho(2,k,2)**2+grho(3,k,2)**2
rh=rho%of_r(k,1)+rho%of_r(k,2)
grh2= (grho(1,k,1)+grho(1,k,2))**2 &

6
Gamma/make.depend
View File

@ -22,8 +22,8 @@ cg_readin.o : ../PW/noncol.o
cg_readin.o : ../PW/pwcom.o
cg_readin.o : ../PW/symm_base.o
cg_readin.o : cgcom.o
cg_setup.o : ../Modules/fft_base.o
cg_setup.o : ../Modules/funct.o
cg_setup.o : ../Modules/griddim.o
cg_setup.o : ../Modules/io_files.o
cg_setup.o : ../Modules/ions_base.o
cg_setup.o : ../Modules/kind.o
@ -34,8 +34,8 @@ cg_setup.o : ../PW/newd.o
cg_setup.o : ../PW/pwcom.o
cg_setup.o : ../PW/scf_mod.o
cg_setup.o : cgcom.o
cg_setupdgc.o : ../Modules/fft_base.o
cg_setupdgc.o : ../Modules/funct.o
cg_setupdgc.o : ../Modules/griddim.o
cg_setupdgc.o : ../Modules/kind.o
cg_setupdgc.o : ../PW/pwcom.o
cg_setupdgc.o : ../PW/scf_mod.o
@ -122,8 +122,8 @@ phcg.o : ../Modules/check_stop.o
phcg.o : ../Modules/constants.o
phcg.o : ../Modules/control_flags.o
phcg.o : ../Modules/environment.o
phcg.o : ../Modules/fft_base.o
phcg.o : ../Modules/funct.o
phcg.o : ../Modules/griddim.o
phcg.o : ../Modules/io_files.o
phcg.o : ../Modules/io_global.o
phcg.o : ../Modules/ions_base.o

4
Gamma/phcg.f90
View File

@ -395,7 +395,7 @@ SUBROUTINE cg_neweps
USE io_global, ONLY : stdout
USE ions_base, ONLY : nat, tau
USE pwcom
USE grid_dimensions, ONLY : dense
USE fft_base, ONLY : dfftp
USE scf, ONLY : rho, rho_core
USE cgcom
USE funct, ONLY: dmxc
@ -412,7 +412,7 @@ SUBROUTINE cg_neweps
! new derivative of the xc potential
!
dmuxc(:) = 0.d0
DO i = 1,dense%nrxx
DO i = 1,dfftp%nnr
rhotot = rho%of_r(i,current_spin)+rho_core(i)
IF ( rhotot> 1.d-30 ) dmuxc(i)= dmxc( rhotot)
IF ( rhotot<-1.d-30 ) dmuxc(i)=-dmxc(-rhotot)

5
Modules/fft_base.f90
View File

@ -28,7 +28,12 @@
! ... potential grid, and its wave functions sub-grid.
TYPE ( fft_dlay_descriptor ) :: dfftp ! descriptor for dense grid
! Dimensions of the 3D real and reciprocal space FFT grid
! relative to the charge density and potential ("dense" grid)
TYPE ( fft_dlay_descriptor ) :: dffts ! descriptor for smooth grid
! This module contains the dimensions of the 3D real and reciprocal space
! FFT grid relative to the smooth part of the charge density
! (may differ from the full charge density grid for USPP )
TYPE ( fft_dlay_descriptor ) :: dfftb ! descriptor for box grids
SAVE

21
Modules/fft_types.f90
View File

@ -21,15 +21,18 @@ MODULE fft_types
! on proc mpime -> nsp( mpime + 1 )
INTEGER, POINTER :: nsw(:) ! number of sticks per processor ( wave func )
! using proc index as above
INTEGER :: nr1 !
INTEGER :: nr2 ! effective FFT dimensions
INTEGER :: nr3 !
INTEGER :: nr1x !
INTEGER :: nr2x ! FFT grids leading dimensions
INTEGER :: nr3x !
INTEGER :: npl ! number of "Z" planes for this processor = npp( mpime + 1 )
INTEGER :: nnp ! number of 0 and non 0 sticks in a plane ( ~nr1*nr2/nproc )
INTEGER :: nnr ! local number of FFT grid elements ( ~nr1*nr2*nr3/proc )
INTEGER :: nr1 = 0 !
INTEGER :: nr2 = 0 ! effective FFT dimensions of the 3D grid (global)
INTEGER :: nr3 = 0 !
INTEGER :: nr1x = 0 ! FFT grids leading dimensions
INTEGER :: nr2x = 0 ! dimensions of the arrays for the 3D grid (global)
INTEGER :: nr3x = 0 ! may differ from nr1 ,nr2 ,nr3 in order to boost performances
INTEGER :: npl = 0 ! number of "Z" planes for this processor = npp( mpime + 1 )
INTEGER :: nnp = 0 ! number of 0 and non 0 sticks in a plane ( ~nr1*nr2/nproc )
INTEGER :: nnr = 0 ! local number of FFT grid elements ( ~nr1*nr2*nr3/proc )
! size of the arrays allocated for the FFT, local to each processor:
! in parallel execution may differ from nr1x*nr2x*nr3x
! Not to be confused either with nr1*nr2*nr3
INTEGER, POINTER :: ngl(:) ! per proc. no. of non zero charge density/potential components
INTEGER, POINTER :: nwl(:) ! per proc. no. of non zero wave function plane components
INTEGER, POINTER :: npp(:) ! number of "Z" planes per processor

141
Modules/griddim.f90
View File

@ -5,73 +5,6 @@
! in the root directory of the present distribution,
! or http://www.gnu.org/copyleft/gpl.txt .
!
!=----------------------------------------------------------------------------=!
MODULE grid_types
!=----------------------------------------------------------------------------=!
! Types containing dimensions of the 3D real and reciprocal space grid
IMPLICIT NONE
SAVE
TYPE grid_dim
! dimensions of the 3D grid (global)
INTEGER :: nr1 = 0
INTEGER :: nr2 = 0
INTEGER :: nr3 = 0
! dimensions of the arrays for the 3D grid (global)
! may differ from nr1 ,nr2 ,nr3 in order to boost performances
INTEGER :: nr1x = 0
INTEGER :: nr2x = 0
INTEGER :: nr3x = 0
! size of the arrays allocated for the FFT, local to each processor:
! in parallel execution may differ from nr1x*nr2x*nr3x
! Not to be confused either with nr1*nr2*nr3
INTEGER :: nrxx = 0
END TYPE
!=----------------------------------------------------------------------------=!
END MODULE grid_types
!=----------------------------------------------------------------------------=!
!=----------------------------------------------------------------------------=!
MODULE grid_dimensions
!=----------------------------------------------------------------------------=!
USE grid_types
! Dimensions of the 3D real and reciprocal space FFT grid
! relative to the charge density and potential ("dense" grid)
IMPLICIT NONE
SAVE
! dimensions of the "dense" 3D grid (global)
TYPE (grid_dim) :: dense
!=----------------------------------------------------------------------------=!
END MODULE grid_dimensions
!=----------------------------------------------------------------------------=!
!=----------------------------------------------------------------------------=!
MODULE smooth_grid_dimensions
!=----------------------------------------------------------------------------=!
USE grid_types
! This module contains the dimensions of the 3D real and reciprocal space
! FFT grid relative to the smooth part of the charge density
! (may differ from the full charge density grid for USPP )
IMPLICIT NONE
SAVE
! parameter description: same as above but for smooth grid
TYPE (grid_dim) :: smooth
!=----------------------------------------------------------------------------=!
END MODULE smooth_grid_dimensions
!=----------------------------------------------------------------------------=!
!=----------------------------------------------------------------------------=!
MODULE grid_subroutines
@ -80,8 +13,8 @@
! This module contains subroutines that are related to grids
! parameters
USE kinds, ONLY: DP
USE grid_types, ONLY: grid_dim
USE kinds, ONLY: DP
USE fft_types, ONLY: fft_dlay_descriptor
IMPLICIT NONE
SAVE
@ -92,7 +25,7 @@
CONTAINS
SUBROUTINE realspace_grids_init( dense, smooth, at, bg, gcutm, gcuts )
SUBROUTINE realspace_grids_init( dfftp, dffts, at, bg, gcutm, gcuts )
!
USE fft_scalar, only: good_fft_dimension, good_fft_order
USE io_global, only: stdout
@ -101,69 +34,69 @@
!
REAL(DP), INTENT(IN) :: at(3,3), bg(3,3)
REAL(DP), INTENT(IN) :: gcutm, gcuts
TYPE(grid_dim), INTENT(OUT) :: dense, smooth
TYPE(fft_dlay_descriptor), INTENT(OUT) :: dfftp, dffts
!
IF( dense%nr1 == 0 .OR. dense%nr2 == 0 .OR. dense%nr3 == 0 ) THEN
IF( dfftp%nr1 == 0 .OR. dfftp%nr2 == 0 .OR. dfftp%nr3 == 0 ) THEN
!
! ... calculate the size of the real-space dense grid for FFT
! ... first, an estimate of nr1,nr2,nr3, based on the max values
! ... of n_i indices in: G = i*b_1 + j*b_2 + k*b_3
! ... We use G*a_i = n_i => n_i .le. |Gmax||a_i|
!
dense%nr1 = int ( sqrt (gcutm) * &
dfftp%nr1 = int ( sqrt (gcutm) * &
sqrt (at(1, 1)**2 + at(2, 1)**2 + at(3, 1)**2) ) + 1
dense%nr2 = int ( sqrt (gcutm) * &
dfftp%nr2 = int ( sqrt (gcutm) * &
sqrt (at(1, 2)**2 + at(2, 2)**2 + at(3, 2)**2) ) + 1
dense%nr3 = int ( sqrt (gcutm) * &
dfftp%nr3 = int ( sqrt (gcutm) * &
sqrt (at(1, 3)**2 + at(2, 3)**2 + at(3, 3)**2) ) + 1
!
CALL grid_set( bg, gcutm, dense%nr1, dense%nr2, dense%nr3 )
CALL grid_set( bg, gcutm, dfftp%nr1, dfftp%nr2, dfftp%nr3 )
!
ELSE
WRITE( stdout, '( /, 3X,"Info: using nr1, nr2, nr3 values from input" )' )
END IF
dense%nr1 = good_fft_order( dense%nr1 )
dense%nr2 = good_fft_order( dense%nr2 )
dense%nr3 = good_fft_order( dense%nr3 )
dfftp%nr1 = good_fft_order( dfftp%nr1 )
dfftp%nr2 = good_fft_order( dfftp%nr2 )
dfftp%nr3 = good_fft_order( dfftp%nr3 )
dense%nr1x = good_fft_dimension( dense%nr1 )
dense%nr2x = dense%nr2
dense%nr3x = good_fft_dimension( dense%nr3 )
dfftp%nr1x = good_fft_dimension( dfftp%nr1 )
dfftp%nr2x = dfftp%nr2
dfftp%nr3x = good_fft_dimension( dfftp%nr3 )
! ... As above, for the smooth grid
IF( smooth%nr1 == 0 .OR. smooth%nr2 == 0 .OR. smooth%nr3 == 0 ) THEN
IF( dffts%nr1 == 0 .OR. dffts%nr2 == 0 .OR. dffts%nr3 == 0 ) THEN
!
IF ( gcuts == gcutm ) THEN
! ... No double grid, the two grids are the same
smooth%nr1 = dense%nr1 ; smooth%nr2 = dense%nr2 ; smooth%nr3 = dense%nr3
smooth%nr1x= dense%nr1x; smooth%nr2x= dense%nr2x; smooth%nr3x= dense%nr3x
dffts%nr1 = dfftp%nr1 ; dffts%nr2 = dfftp%nr2 ; dffts%nr3 = dfftp%nr3
dffts%nr1x= dfftp%nr1x; dffts%nr2x= dfftp%nr2x; dffts%nr3x= dfftp%nr3x
RETURN
END IF
!
smooth%nr1= int (2 * sqrt (gcuts) * &
dffts%nr1= int (2 * sqrt (gcuts) * &
sqrt (at(1, 1)**2 + at(2, 1)**2 + at(3, 1)**2) ) + 1
smooth%nr2= int (2 * sqrt (gcuts) * &
dffts%nr2= int (2 * sqrt (gcuts) * &
sqrt (at(1, 2)**2 + at(2, 2)**2 + at(3, 2)**2) ) + 1
smooth%nr3= int (2 * sqrt (gcuts) * &
dffts%nr3= int (2 * sqrt (gcuts) * &
sqrt (at(1, 3)**2 + at(2, 3)**2 + at(3, 3)**2) ) + 1
!
CALL grid_set( bg, gcuts, smooth%nr1, smooth%nr2, smooth%nr3 )
CALL grid_set( bg, gcuts, dffts%nr1, dffts%nr2, dffts%nr3 )
!
ELSE
WRITE( stdout, '( /, 3X,"Info: using nr1s, nr2s, nr3s values from input" )' )
END IF
smooth%nr1 = good_fft_order( smooth%nr1 )
smooth%nr2 = good_fft_order( smooth%nr2 )
smooth%nr3 = good_fft_order( smooth%nr3 )
dffts%nr1 = good_fft_order( dffts%nr1 )
dffts%nr2 = good_fft_order( dffts%nr2 )
dffts%nr3 = good_fft_order( dffts%nr3 )
smooth%nr1x = good_fft_dimension(smooth%nr1)
smooth%nr2x = smooth%nr2
smooth%nr3x = good_fft_dimension(smooth%nr3)
dffts%nr1x = good_fft_dimension(dffts%nr1)
dffts%nr2x = dffts%nr2
dffts%nr3x = good_fft_dimension(dffts%nr3)
IF ( smooth%nr1 > dense%nr1 .or. smooth%nr2 > dense%nr2 .or. smooth%nr3 > dense%nr3 ) THEN
IF ( dffts%nr1 > dfftp%nr1 .or. dffts%nr2 > dfftp%nr2 .or. dffts%nr3 > dfftp%nr3 ) THEN
CALL errore(' realspace_grids_init ', ' smooth grid larger than dense grid?',1)
END IF
@ -173,17 +106,15 @@
!=----------------------------------------------------------------------------=!
SUBROUTINE realspace_grids_info ( dense, smooth, dfftp, dffts, nproc_ )
SUBROUTINE realspace_grids_info ( dfftp, dffts, nproc_ )
! Print info on local and global dimensions for real space grids
USE io_global, ONLY: ionode, stdout
USE fft_types, ONLY: fft_dlay_descriptor
USE grid_types, ONLY: grid_dim
IMPLICIT NONE
TYPE(grid_dim), INTENT(IN) :: dense, smooth
TYPE(fft_dlay_descriptor), INTENT(IN) :: dfftp, dffts
INTEGER, INTENT(IN) :: nproc_
@ -194,9 +125,9 @@
WRITE( stdout,*)
WRITE( stdout,*) ' Real Mesh'
WRITE( stdout,*) ' ---------'
WRITE( stdout,1000) dense%nr1, dense%nr2, dense%nr3, dense%nr1, dense%nr2, dfftp%npl, 1, 1, nproc_
WRITE( stdout,1010) dense%nr1x, dense%nr2x, dense%nr3x
WRITE( stdout,1020) dense%nrxx
WRITE( stdout,1000) dfftp%nr1, dfftp%nr2, dfftp%nr3, dfftp%nr1, dfftp%nr2, dfftp%npl, 1, 1, nproc_
WRITE( stdout,1010) dfftp%nr1x, dfftp%nr2x, dfftp%nr3x
WRITE( stdout,1020) dfftp%nnr
WRITE( stdout,*) ' Number of x-y planes for each processors: '
WRITE( stdout, fmt = '( 3X, "nr3l = ", 10I5 )' ) &
( dfftp%npp( i ), i = 1, nproc_ )
@ -204,9 +135,9 @@
WRITE( stdout,*)
WRITE( stdout,*) ' Smooth Real Mesh'
WRITE( stdout,*) ' ----------------'
WRITE( stdout,1000) smooth%nr1, smooth%nr2, smooth%nr3, smooth%nr1, smooth%nr2, dffts%npl,1,1, nproc_
WRITE( stdout,1010) smooth%nr1x, smooth%nr2x, smooth%nr3x
WRITE( stdout,1020) smooth%nrxx
WRITE( stdout,1000) dffts%nr1, dffts%nr2, dffts%nr3, dffts%nr1, dffts%nr2, dffts%npl,1,1, nproc_
WRITE( stdout,1010) dffts%nr1x, dffts%nr2x, dffts%nr3x
WRITE( stdout,1020) dffts%nnr
WRITE( stdout,*) ' Number of x-y planes for each processors: '
WRITE( stdout, fmt = '( 3X, "nr3sl = ", 10I5 )' ) &
( dffts%npp( i ), i = 1, nproc_ )

2
Modules/make.depend
View File

@ -212,7 +212,6 @@ stick_base.o : io_global.o
stick_base.o : kind.o
stick_base.o : mp.o
stick_set.o : fft_types.o
stick_set.o : griddim.o
stick_set.o : io_global.o
stick_set.o : kind.o
stick_set.o : parallel_include.o
@ -253,7 +252,6 @@ xc_vdW_DF.o : control_flags.o
xc_vdW_DF.o : fft_base.o
xc_vdW_DF.o : fft_interfaces.o
xc_vdW_DF.o : fft_scalar.o
xc_vdW_DF.o : griddim.o
xc_vdW_DF.o : input_parameters.o
xc_vdW_DF.o : io_global.o
xc_vdW_DF.o : kernel_table.o

29
Modules/stick_set.f90
View File

@ -17,7 +17,6 @@
USE stick_base
!
USE kinds, ONLY: DP
USE grid_types, ONLY: grid_dim
USE io_global, ONLY: ionode, stdout
USE fft_types, ONLY: fft_dlay_descriptor, fft_dlay_allocate, &
fft_dlay_set, fft_dlay_scalar
@ -33,14 +32,13 @@
!=----------------------------------------------------------------------=
SUBROUTINE pstickset( gamma_only, bg, gcut, gkcut, gcuts, &
dfftp, dffts, ngw, ngm, ngs, dense, smooth, mype, root, nproc, comm, nogrp_ )
dfftp, dffts, ngw, ngm, ngs, mype, root, nproc, comm, nogrp_ )
LOGICAL, INTENT(in) :: gamma_only
! ... bg(:,1), bg(:,2), bg(:,3) reciprocal space base vectors.
REAL(DP), INTENT(in) :: bg(3,3)
REAL(DP), INTENT(in) :: gcut, gkcut, gcuts
TYPE(fft_dlay_descriptor), INTENT(inout) :: dfftp, dffts
TYPE(grid_dim), INTENT(inout) :: dense, smooth
INTEGER, INTENT(out) :: ngw, ngm, ngs
INTEGER, INTENT(IN) :: mype, root, nproc, comm
@ -119,9 +117,9 @@
INTEGER, ALLOCATABLE :: idx(:)
tk = .not. gamma_only
ub(1) = ( dense%nr1 - 1 ) / 2
ub(2) = ( dense%nr2 - 1 ) / 2
ub(3) = ( dense%nr3 - 1 ) / 2
ub(1) = ( dfftp%nr1 - 1 ) / 2
ub(2) = ( dfftp%nr2 - 1 ) / 2
ub(3) = ( dfftp%nr3 - 1 ) / 2
lb = - ub
! ... Allocate maps
@ -191,12 +189,12 @@
#if defined __PARA
CALL fft_dlay_allocate( dfftp, mype, root, nproc, comm, nogrp_ , dense%nr1x, dense%nr2x )
CALL fft_dlay_allocate( dffts, mype, root, nproc, comm, nogrp_ , smooth%nr1x, smooth%nr2x )
CALL fft_dlay_allocate( dfftp, mype, root, nproc, comm, nogrp_ , dfftp%nr1x, dfftp%nr2x )
CALL fft_dlay_allocate( dffts, mype, root, nproc, comm, nogrp_ , dffts%nr1x, dffts%nr2x )
CALL fft_dlay_set( dfftp, tk, nst, dense%nr1, dense%nr2, dense%nr3, dense%nr1x, dense%nr2x, dense%nr3x, &
CALL fft_dlay_set( dfftp, tk, nst, dfftp%nr1, dfftp%nr2, dfftp%nr3, dfftp%nr1x, dfftp%nr2x, dfftp%nr3x, &
ub, lb, idx, ist(:,1), ist(:,2), nstp, nstpw, sstp, sstpw, st, stw )
CALL fft_dlay_set( dffts, tk, nsts, smooth%nr1, smooth%nr2, smooth%nr3, smooth%nr1x, smooth%nr2x, smooth%nr3x, &
CALL fft_dlay_set( dffts, tk, nsts, dffts%nr1, dffts%nr2, dffts%nr3, dffts%nr1x, dffts%nr2x, dffts%nr3x, &
ub, lb, idx, ist(:,1), ist(:,2), nstps, nstpw, sstps, sstpw, sts, stw )
#else
@ -210,16 +208,13 @@
IF( ngm_ /= ngm ) CALL errore( ' pstickset ', ' inconsistent ngm ', abs( ngm - ngm_ ) )
IF( ngs_ /= ngs ) CALL errore( ' pstickset ', ' inconsistent ngs ', abs( ngs - ngs_ ) )
CALL fft_dlay_allocate( dfftp, mype, root, nproc, comm, 1, max(dense%nr1x, dense%nr3x), dense%nr2x )
CALL fft_dlay_allocate( dffts, mype, root, nproc, comm, 1, max(smooth%nr1x, smooth%nr3x), smooth%nr2x )
CALL fft_dlay_allocate( dfftp, mype, root, nproc, comm, 1, max(dfftp%nr1x, dfftp%nr3x), dfftp%nr2x )
CALL fft_dlay_allocate( dffts, mype, root, nproc, comm, 1, max(dffts%nr1x, dffts%nr3x), dffts%nr2x )
CALL fft_dlay_scalar( dfftp, ub, lb, dense%nr1, dense%nr2, dense%nr3, dense%nr1x, dense%nr2x, dense%nr3x, stw )
CALL fft_dlay_scalar( dffts, ub, lb, smooth%nr1, smooth%nr2, smooth%nr3, smooth%nr1x, smooth%nr2x, smooth%nr3x, stw )
CALL fft_dlay_scalar( dfftp, ub, lb, dfftp%nr1, dfftp%nr2, dfftp%nr3, dfftp%nr1x, dfftp%nr2x, dfftp%nr3x, stw )
CALL fft_dlay_scalar( dffts, ub, lb, dffts%nr1, dffts%nr2, dffts%nr3, dffts%nr1x, dffts%nr2x, dffts%nr3x, stw )
#endif
! set the dimensions of the arrays allocated for the FFT
dense%nrxx = dfftp % nnr
smooth%nrxx = dffts % nnr
! ... Maximum number of sticks (potentials)
nstpx = maxval( nstp )

155
Modules/xc_vdW_DF.f90
View File

@ -76,7 +76,7 @@ CONTAINS
!! -------------------------------------------------------------------------
use gvect, ONLY : ngm, nl, g, nlm
USE grid_dimensions, ONLY : dense
USE fft_base, ONLY : dfftp
USE cell_base, ONLY : omega, tpiba
USE fft_scalar, ONLY : cfft3d
!! -------------------------------------------------------------------------
@ -174,7 +174,7 @@ CONTAINS
allocate( procs_Npoints(0:nproc_pool-1), procs_start(0:nproc_pool-1), procs_end(0:nproc_pool-1) )
procs_Npoints(me_pool) = dense%nrxx
procs_Npoints(me_pool) = dfftp%nnr
procs_start(0) = 1
! All processors communicate how many points they have been assigned. Each processor
@ -205,8 +205,8 @@ CONTAINS
! z plane because of the integer division and the fact that arrays in Fortran start at 1.
! +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
my_start_z = procs_start(me_pool)/(dense%nr1x*dense%nr2x)+1
my_end_z = procs_end(me_pool)/(dense%nr1x*dense%nr2x)
my_start_z = procs_start(me_pool)/(dfftp%nr1x*dfftp%nr2x)+1
my_end_z = procs_end(me_pool)/(dfftp%nr1x*dfftp%nr2x)
!write(*,'(A,3I5)') "Parall en [proc, my_start_z, my_end_z]", me_pool, my_start_z, my_end_z
! +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
@ -246,14 +246,14 @@ CONTAINS
!! --------------------------------------------------------------------------------------------------
!! Allocate arrays. nrxx is a PWSCF variable that holds the number of points assigned to
!! Allocate arrays. nnr is a PWSCF variable that holds the number of points assigned to
!! a given processor.
!! ---------------------------------------------------------------------------------------
allocate( q0(dense%nrxx) )
allocate( gradient_rho(dense%nrxx, 3) )
allocate( dq0_drho(dense%nrxx), dq0_dgradrho(dense%nrxx) )
allocate( total_rho(dense%nrxx) )
allocate( q0(dfftp%nnr) )
allocate( gradient_rho(dfftp%nnr, 3) )
allocate( dq0_drho(dfftp%nnr), dq0_dgradrho(dfftp%nnr) )
allocate( total_rho(dfftp%nnr) )
!! ---------------------------------------------------------------------------------------
@ -290,7 +290,7 @@ CONTAINS
if (nproc_pool > 1) then
allocate( full_rho(dense%nr1x*dense%nr2x*dense%nr3x) )
allocate( full_rho(dfftp%nr1x*dfftp%nr2x*dfftp%nr3x) )
full_rho(procs_start(me_pool):procs_end(me_pool)) = total_rho
@ -345,7 +345,7 @@ CONTAINS
!! for the convolution (equation 11 of SOLER). The ffts used here are timed.
!! --------------------------------------------------------------------------------------------------
allocate( thetas(dense%nrxx, Nqs) )
allocate( thetas(dfftp%nnr, Nqs) )
CALL get_thetas_on_grid(total_rho, q0, thetas)
!! ---------------------------------------------------------------------------------------------
@ -389,7 +389,7 @@ CONTAINS
do theta_i = 1, Nqs
!call cft3(thetas(:,theta_i), dense%nr1, dense%nr2, dense%nr3, dense%nr1x, dense%nr2x, dense%nr3x, 1)
!call cft3(thetas(:,theta_i), dfftp%nr1, dfftp%nr2, dfftp%nr3, dfftp%nr1x, dfftp%nr2x, dfftp%nr3x, 1)
CALL invfft('Dense', thetas(:,theta_i), dfftp)
end do
@ -412,7 +412,7 @@ CONTAINS
call start_clock( 'vdW_v' )
allocate( potential(dense%nrxx) )
allocate( potential(dfftp%nnr) )
call get_potential(q0, dq0_drho, dq0_dgradrho, gradient_rho, thetas, potential)
@ -428,9 +428,9 @@ CONTAINS
!! The integral of rho(r)*potential(r) for the vtxc output variable
!! --------------------------------------------------------------------
grid_cell_volume = omega/(dense%nr1*dense%nr2*dense%nr3)
grid_cell_volume = omega/(dfftp%nr1*dfftp%nr2*dfftp%nr3)
do i_grid = 1, dense%nrxx
do i_grid = 1, dfftp%nnr
vtxc = vtxc + e2*grid_cell_volume*rho_valence(i_grid,1)*potential(i_grid)
@ -442,7 +442,7 @@ CONTAINS
call start_clock( 'vdW_v' )
allocate( potential(dense%nr1x*dense%nr2x*dense%nr3x) )
allocate( potential(dfftp%nr1x*dfftp%nr2x*dfftp%nr3x) )
call get_potential(q0, dq0_drho, dq0_dgradrho, Nneighbors, gradient_rho, thetas, potential, my_start_z, my_end_z)
@ -480,9 +480,9 @@ CONTAINS
!! The integral of rho(r)*potential(r) for the vtxc output variable
!! --------------------------------------------------------------------
grid_cell_volume = omega/(dense%nr1x*dense%nr2x*dense%nr3x)
grid_cell_volume = omega/(dfftp%nr1x*dfftp%nr2x*dfftp%nr3x)
do i_grid = 1, dense%nrxx
do i_grid = 1, dfftp%nnr
vtxc = vtxc + e2*grid_cell_volume * total_rho(i_grid)*potential(procs_start(me_pool)+i_grid-1)
@ -505,7 +505,7 @@ CONTAINS
SUBROUTINE stress_vdW_DF(rho_valence, rho_core, sigma)
USE grid_dimensions, ONLY : dense
USE fft_base, ONLY : dfftp
use gvect, ONLY : ngm, nl, g, nlm
USE cell_base, ONLY : tpiba
@ -559,7 +559,7 @@ CONTAINS
allocate( procs_Npoints(0:nproc_pool-1), procs_start(0:nproc_pool-1), procs_end(0:nproc_pool-1) )
procs_Npoints(me_pool) = dense%nrxx
procs_Npoints(me_pool) = dfftp%nnr
procs_start(0) = 1
do i_proc = 0, nproc_pool-1
@ -575,8 +575,8 @@ CONTAINS
end do
my_start_z = procs_start(me_pool)/(dense%nr1x*dense%nr2x)+1
my_end_z = procs_end(me_pool)/(dense%nr1x*dense%nr2x)
my_start_z = procs_start(me_pool)/(dfftp%nr1x*dfftp%nr2x)+1
my_end_z = procs_end(me_pool)/(dfftp%nr1x*dfftp%nr2x)
!write(*,'(A,3I5)') "Parall stress [proc, my_start_z, my_end_z]", me_pool, my_start_z, my_end_z
@ -588,11 +588,11 @@ CONTAINS
!! Allocations
!! ---------------------------------------------------------------------------------------
allocate( gradient_rho(dense%nrxx, 3) )
allocate( total_rho(dense%nrxx) )
allocate( q0(dense%nrxx) )
allocate( dq0_drho(dense%nrxx), dq0_dgradrho(dense%nrxx) )
allocate( thetas(dense%nrxx, Nqs) )
allocate( gradient_rho(dfftp%nnr, 3) )
allocate( total_rho(dfftp%nnr) )
allocate( q0(dfftp%nnr) )
allocate( dq0_drho(dfftp%nnr), dq0_dgradrho(dfftp%nnr) )
allocate( thetas(dfftp%nnr, Nqs) )
!! ---------------------------------------------------------------------------------------
!! Charge
@ -612,7 +612,7 @@ CONTAINS
if (nproc_pool > 1) then
allocate( full_rho(dense%nr1x*dense%nr2x*dense%nr3x) )
allocate( full_rho(dfftp%nr1x*dfftp%nr2x*dfftp%nr3x) )
full_rho(procs_start(me_pool):procs_end(me_pool)) = total_rho
@ -682,7 +682,7 @@ CONTAINS
!! ----------------------------------------------------------------------------------
use gvect, ONLY : ngm, nl, g, nlm, nl, gg, igtongl, &
gl, ngl, gstart
USE grid_dimensions, ONLY : dense
USE fft_base, ONLY : dfftp
USE cell_base, ONLY : omega, tpiba, alat, at, tpiba2
USE fft_scalar, ONLY : cfft3d
@ -717,7 +717,7 @@ CONTAINS
!real(dp) :: at_inverse(3,3)
allocate( d2y_dx2(Nqs, Nqs) )
allocate( u_vdW(dense%nrxx, Nqs) )
allocate( u_vdW(dfftp%nnr, Nqs) )
sigma(:,:) = 0.0_DP
prefactor = 0.0_DP
@ -755,7 +755,7 @@ CONTAINS
!! ----------------------------------------------------------------------------------------------------
do i_grid = 1, dense%nrxx
do i_grid = 1, dfftp%nnr
q_low = 1
q_hi = Nqs
@ -817,7 +817,7 @@ CONTAINS
call mp_sum( sigma, intra_pool_comm )
#endif
call dscal (9, 1.d0 / (dense%nr1 * dense%nr2 * dense%nr3), sigma, 1)
call dscal (9, 1.d0 / (dfftp%nr1 * dfftp%nr2 * dfftp%nr3), sigma, 1)
deallocate( d2y_dx2, u_vdW )
@ -835,7 +835,7 @@ CONTAINS
!! Modules to include
!! ----------------------------------------------------------------------------------
use gvect, ONLY : ngm, nl, g, nl, gg, igtongl, gl, ngl, gstart
USE grid_dimensions, ONLY : dense
USE fft_base, ONLY : dfftp
USE cell_base, ONLY : omega, tpiba, tpiba2
USE constants, ONLY: pi
@ -919,7 +919,7 @@ CONTAINS
!! dq0_dgradrho = total_rho / |gradient_rho| * d q0 / d |gradient_rho|
!!
USE grid_dimensions, ONLY : dense
USE fft_base, ONLY : dfftp
USE kernel_table, ONLY : q_cut, q_min
real(dp), intent(IN) :: total_rho(:), gradient_rho(:,:) !! Input variables needed
@ -953,7 +953,7 @@ CONTAINS
dq0_drho(:) = 0.0_DP
dq0_dgradrho(:) = 0.0_DP
do i_grid = 1, dense%nrxx
do i_grid = 1, dfftp%nnr
!! This prevents numerical problems. If the charge density is negative (an
!! unphysical situation), we simply treat it as very small. In that case,
@ -1474,7 +1474,6 @@ subroutine numerical_gradient(total_rho, gradient_rho)
use gvect, ONLY : ngm, nl, g, nlm
USE cell_base, ONLY : tpiba
USE grid_dimensions, ONLY : dense
USE fft_base, ONLY : dfftp
USE fft_interfaces, ONLY : fwfft, invfft
!
@ -1491,8 +1490,8 @@ subroutine numerical_gradient(total_rho, gradient_rho)
complex(dp), allocatable :: c_grho(:) !! auxiliary complex array for grad rho
! rho in G space
allocate ( c_rho(dense%nrxx), c_grho(dense%nrxx) )
c_rho(1:dense%nrxx) = CMPLX(total_rho(1:dense%nrxx),0.0_DP)
allocate ( c_rho(dfftp%nnr), c_grho(dfftp%nnr) )
c_rho(1:dfftp%nnr) = CMPLX(total_rho(1:dfftp%nnr),0.0_DP)
CALL fwfft ('Dense', c_rho, dfftp)
do icar=1,3
@ -1524,7 +1523,7 @@ end subroutine numerical_gradient
subroutine numerical_gradient(full_rho, Nneighbors, gradient_rho, my_start_z, my_end_z)
USE grid_dimensions, ONLY : dense
USE fft_base, ONLY : dfftp
USE cell_base, ONLY : alat, at
real(dp), intent(in) :: full_rho(:) !! Input array holding the value of the total charge density
@ -1585,9 +1584,9 @@ subroutine numerical_gradient(full_rho, Nneighbors, gradient_rho, my_start_z, my
! Normalize by the number of grid points in each direction
! +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
at_inverse(1,:) = at_inverse(1,:) * dble(dense%nr1x)
at_inverse(2,:) = at_inverse(2,:) * dble(dense%nr2x)
at_inverse(3,:) = at_inverse(3,:) * dble(dense%nr3x)
at_inverse(1,:) = at_inverse(1,:) * dble(dfftp%nr1x)
at_inverse(2,:) = at_inverse(2,:) * dble(dfftp%nr2x)
at_inverse(3,:) = at_inverse(3,:) * dble(dfftp%nr3x)
! +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
@ -1613,8 +1612,8 @@ subroutine numerical_gradient(full_rho, Nneighbors, gradient_rho, my_start_z, my
!! -----------------------------------------------------------------------------------------------
do ix3 = my_start_z, my_end_z
do ix2 = 1, dense%nr2x
do ix1 = 1, dense%nr1x
do ix2 = 1, dfftp%nr2x
do ix1 = 1, dfftp%nr1x
i_grid = i_grid + 1
@ -1651,7 +1650,7 @@ end subroutine numerical_gradient
subroutine thetas_to_uk(thetas, u_vdW)
USE gvect, ONLY : nl, nlm, gg, ngm, igtongl, gl, ngl, gstart
USE grid_dimensions, ONLY : dense
USE fft_base, ONLY : dfftp
USE cell_base, ONLY : tpiba, omega
complex(dp), intent(in) :: thetas(:,:) !! On input this variable holds the theta functions (equation 11, SOLER)
@ -1715,7 +1714,7 @@ end subroutine thetas_to_uk
subroutine vdW_energy(thetas, vdW_xc_energy)
USE gvect, ONLY : nl, nlm, gg, ngm, igtongl, gl, ngl, gstart
USE grid_dimensions, ONLY : dense
USE fft_base, ONLY : dfftp
USE cell_base, ONLY : tpiba, omega
complex(dp), intent(inout) :: thetas(:,:) !! On input this variable holds the theta functions
@ -1741,7 +1740,7 @@ subroutine vdW_energy(thetas, vdW_xc_energy)
vdW_xc_energy = 0.0D0
allocate (u_vdW(dense%nrxx,Nqs))
allocate (u_vdW(dfftp%nnr,Nqs))
u_vdW(:,:) = CMPLX(0.0_DP,0.0_DP)
allocate( kernel_of_k(Nqs, Nqs) )
@ -1822,15 +1821,15 @@ end subroutine vdW_energy
subroutine dv_drho_vdw(rho_valence, rho_core, drho, nspin, dv_drho)
USE gvect, ONLY : nl, g, nlm, ngm
USE grid_dimensions, ONLY : dense
USE fft_base, ONLY : dfftp
USE cell_base, ONLY : alat, tpiba, omega
USE fft_scalar, ONLY : cfft3d
integer :: nspin
real(dp), intent(IN) :: rho_valence(:,:) !
real(dp), intent(IN) :: rho_core(:)
complex(DP), intent(IN) :: drho (dense%nrxx, nspin)
complex(DP), intent(INOUT) :: dv_drho(dense%nrxx, nspin)
complex(DP), intent(IN) :: drho (dfftp%nnr, nspin)
complex(DP), intent(INOUT) :: dv_drho(dfftp%nnr, nspin)
!! -------------------------------------------------------------------------
!! For the potential
@ -1854,14 +1853,14 @@ subroutine dv_drho_vdw(rho_valence, rho_core, drho, nspin, dv_drho)
real(DP), allocatable :: drho_real(:)
allocate( q0(dense%nrxx) )
allocate( gradient_rho(dense%nrxx, 3) )
allocate( dq0_drho(dense%nrxx), dq0_dgradrho(dense%nrxx) )
allocate( total_rho(dense%nrxx) )
allocate( drho_real(dense%nrxx) )
allocate( thetas(dense%nrxx, Nqs) )
allocate( u_vdW(dense%nrxx, Nqs) )
allocate( potential_plus(dense%nrxx), potential_minus(dense%nrxx) )
allocate( q0(dfftp%nnr) )
allocate( gradient_rho(dfftp%nnr, 3) )
allocate( dq0_drho(dfftp%nnr), dq0_dgradrho(dfftp%nnr) )
allocate( total_rho(dfftp%nnr) )
allocate( drho_real(dfftp%nnr) )
allocate( thetas(dfftp%nnr, Nqs) )
allocate( u_vdW(dfftp%nnr, Nqs) )
allocate( potential_plus(dfftp%nnr), potential_minus(dfftp%nnr) )
!! Derivative parameter
@ -1960,7 +1959,7 @@ end subroutine dv_drho_vdw
subroutine get_potential(q0, dq0_drho, dq0_dgradrho, gradient_rho, u_vdW, potential)
use gvect, ONLY : nl, g, nlm
USE grid_dimensions, ONLY : dense
USE fft_base, ONLY : dfftp
USE cell_base, ONLY : alat, tpiba
real(dp), intent(in) :: q0(:), gradient_rho(:,:) !! Input arrays holding the value of q0 for all points assigned
@ -1992,7 +1991,7 @@ subroutine get_potential(q0, dq0_drho, dq0_dgradrho, gradient_rho, u_vdW, potent
real(dp), allocatable ::h_prefactor(:)
complex(dp), allocatable ::h(:)
allocate (h_prefactor(dense%nrxx),h(dense%nrxx))
allocate (h_prefactor(dfftp%nnr),h(dfftp%nnr))
potential = 0.0D0
h_prefactor = 0.0D0
@ -2014,7 +2013,7 @@ subroutine get_potential(q0, dq0_drho, dq0_dgradrho, gradient_rho, u_vdW, potent
!! ---------------------------------------------------------------------------------------------
do i_grid = 1,dense%nrxx
do i_grid = 1,dfftp%nnr
q_low = 1
q_hi = Nqs
@ -2080,7 +2079,7 @@ end subroutine get_potential
subroutine get_potential(q0, dq0_drho, dq0_dgradrho, N, gradient_rho, u_vdW, potential, my_start_z, my_end_z)
USE grid_dimensions, ONLY : dense
USE fft_base, ONLY : dfftp
USE cell_base, ONLY : alat, at
real(dp), intent(in) :: q0(:), gradient_rho(:,:) !! Input arrays holding the value of q0 for all points assigned
@ -2133,9 +2132,9 @@ subroutine get_potential(q0, dq0_drho, dq0_dgradrho, N, gradient_rho, u_vdW, pot
at_inverse = alat * at
call invert_3x3_matrix(at_inverse)
at_inverse(1,:) = at_inverse(1,:) * dble(dense%nr1x)
at_inverse(2,:) = at_inverse(2,:) * dble(dense%nr2x)
at_inverse(3,:) = at_inverse(3,:) * dble(dense%nr3x)
at_inverse(1,:) = at_inverse(1,:) * dble(dfftp%nr1x)
at_inverse(2,:) = at_inverse(2,:) * dble(dfftp%nr2x)
at_inverse(3,:) = at_inverse(3,:) * dble(dfftp%nr3x)
have_at_inverse = .true.
@ -2178,8 +2177,8 @@ i_grid = 0
!! --------------------------------------------------------------------------------------------------------------------
do ix3 = my_start_z, my_end_z
do ix2 = 1, dense%nr2x
do ix1 = 1, dense%nr1x
do ix2 = 1, dfftp%nr2x
do ix1 = 1, dfftp%nr1x
i_grid = i_grid + 1
@ -2358,7 +2357,7 @@ end function gradient_coefficients
function get_3d_indices(N)
USE grid_dimensions, ONLY : dense
USE fft_base, ONLY : dfftp
integer, intent(in), optional :: N !! The number of neighbors in each direction that will
@ -2396,13 +2395,13 @@ function get_3d_indices(N)
! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
allocate( rho_3d(-N+1:dense%nr1x+N, -N+1:dense%nr2x+N, -N+1:dense%nr3x+N) )
allocate( rho_3d(-N+1:dfftp%nr1x+N, -N+1:dfftp%nr2x+N, -N+1:dfftp%nr3x+N) )
i_grid = 0
do ix3 = 1, dense%nr3x
do ix2 = 1, dense%nr2x
do ix1 = 1, dense%nr1x
do ix3 = 1, dfftp%nr3x
do ix2 = 1, dfftp%nr2x
do ix1 = 1, dfftp%nr1x
i_grid = i_grid + 1
@ -2418,13 +2417,13 @@ function get_3d_indices(N)
! direction
! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
rho_3d(-N+1:0,:,:) = rho_3d(dense%nr1x-N+1:dense%nr1x, :, :)
rho_3d(:,-N+1:0,:) = rho_3d(:, dense%nr2x-N+1:dense%nr2x, :)
rho_3d(:,:,-N+1:0) = rho_3d(:, :, dense%nr3x-N+1:dense%nr3x)
rho_3d(-N+1:0,:,:) = rho_3d(dfftp%nr1x-N+1:dfftp%nr1x, :, :)
rho_3d(:,-N+1:0,:) = rho_3d(:, dfftp%nr2x-N+1:dfftp%nr2x, :)
rho_3d(:,:,-N+1:0) = rho_3d(:, :, dfftp%nr3x-N+1:dfftp%nr3x)
rho_3d(dense%nr1x+1:dense%nr1x+N, :, :) = rho_3d(1:N, :, :)
rho_3d(:, dense%nr2x+1:dense%nr2x+N, :) = rho_3d(:, 1:N, :)
rho_3d(:, :, dense%nr3x+1:dense%nr3x+N) = rho_3d(:, :, 1:N)
rho_3d(dfftp%nr1x+1:dfftp%nr1x+N, :, :) = rho_3d(1:N, :, :)
rho_3d(:, dfftp%nr2x+1:dfftp%nr2x+N, :) = rho_3d(:, 1:N, :)
rho_3d(:, :, dfftp%nr3x+1:dfftp%nr3x+N) = rho_3d(:, :, 1:N)
! +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

4
NEB/compute_scf.f90
View File

@ -26,7 +26,7 @@ SUBROUTINE compute_scf( fii, lii, stat )
USE vlocal, ONLY : strf
USE cell_base, ONLY : bg, alat
USE gvect, ONLY : ngm, g, eigts1, eigts2, eigts3
USE grid_dimensions, ONLY : dense
USE fft_base, ONLY : dfftp
USE ions_base, ONLY : tau, nat, nsp, ityp
USE ener, ONLY : etot
USE force_mod, ONLY : force
@ -331,7 +331,7 @@ SUBROUTINE compute_scf( fii, lii, stat )
! ... (needed for the old atomic charge)
!
CALL struc_fact( nat, tauold(:,:,1), nsp, ityp, ngm, g, bg, &
dense%nr1, dense%nr2, dense%nr3, strf, eigts1, eigts2, eigts3 )
dfftp%nr1, dfftp%nr2, dfftp%nr3, strf, eigts1, eigts2, eigts3 )
!
END IF
!

2
NEB/make.depend
View File

@ -2,7 +2,7 @@ compute_scf.o : ../Modules/cell_base.o
compute_scf.o : ../Modules/check_stop.o
compute_scf.o : ../Modules/constants.o
compute_scf.o : ../Modules/control_flags.o
compute_scf.o : ../Modules/griddim.o
compute_scf.o : ../Modules/fft_base.o
compute_scf.o : ../Modules/input_parameters.o
compute_scf.o : ../Modules/io_files.o
compute_scf.o : ../Modules/io_global.o

3
PH/addnlcc.f90
View File

@ -18,7 +18,6 @@ subroutine addnlcc (imode0, drhoscf, npe)
use scf, only : rho, rho_core
USE gvect, ONLY : g, ngm, nl
USE fft_base, ONLY : dfftp
USE grid_dimensions, ONLY : dense
USE noncollin_module, ONLY : nspin_lsda, nspin_gga, nspin_mag
USE dynmat, ONLY : dyn, dyn_rec
USE modes, ONLY : nirr, npert
@ -68,7 +67,7 @@ subroutine addnlcc (imode0, drhoscf, npe)
!
! compute the exchange and correlation potential for this mode
!
nrtot = dense%nr1 * dense%nr2 * dense%nr3
nrtot = dfftp%nr1 * dfftp%nr2 * dfftp%nr3
fac = 1.d0 / DBLE (nspin_lsda)
!
! add core charge to the density

3
PH/addnlcc_zstar_eu_us.f90
View File

@ -17,7 +17,6 @@ SUBROUTINE addnlcc_zstar_eu_us( drhoscf )
USE lsda_mod, ONLY : nspin
USE gvect, ONLY : ngm, nl, g
USE fft_base, ONLY : dfftp
USE grid_dimensions, ONLY : dense
USE noncollin_module, ONLY : nspin_lsda, nspin_gga
USE efield_mod, ONLY : zstareu0
USE qpoint, ONLY : xq
@ -53,7 +52,7 @@ SUBROUTINE addnlcc_zstar_eu_us( drhoscf )
!
! compute the exchange and correlation potential for this mode
!
nrtot = dense%nr1 * dense%nr2 * dense%nr3
nrtot = dfftp%nr1 * dfftp%nr2 * dfftp%nr3
fac = 1.d0 / DBLE (nspin_lsda)
DO ipert = 1, npe
mode = imode0 + ipert

14
PH/chi_test.f90
View File

@ -16,7 +16,7 @@ subroutine chi_test (dvscfs, chif, ik, depsi, auxr, auxg)
USE kinds, ONLY : DP
USE wvfct, ONLY : npwx, nbnd
USE smooth_grid_dimensions, ONLY : smooth
USE fft_base, ONLY : dffts
use ramanm, ONLY : lrd2w, iud2w, jab
USE units_ph, ONLY : iuwfc, lrdwf, iudwf
USE qpoint, ONLY : npwq, nksq
@ -26,8 +26,8 @@ subroutine chi_test (dvscfs, chif, ik, depsi, auxr, auxg)
implicit none
integer :: ik
complex(DP) :: dvscfs(smooth%nrxx,3), chif(npwx,nbnd,6), depsi(npwx,nbnd,3), &
auxr(smooth%nrxx), auxg(npwx)
complex(DP) :: dvscfs(dffts%nnr,3), chif(npwx,nbnd,6), depsi(npwx,nbnd,3), &
auxr(dffts%nnr), auxg(npwx)
complex(DP) :: tmp
complex(DP), EXTERNAL :: zdotc
@ -39,7 +39,7 @@ subroutine chi_test (dvscfs, chif, ik, depsi, auxr, auxg)
allocate (ps2 (nbnd,3,6) )
allocate (ps3 (nbnd,3,nbnd,3) )
allocate (ps4 (nbnd,3,nbnd) )
allocate (au2r (smooth%nrxx) )
allocate (au2r (dffts%nnr) )
!
!----------------------------------------------------------
@ -75,7 +75,7 @@ subroutine chi_test (dvscfs, chif, ik, depsi, auxr, auxg)
do ib = 1, nbnd_occ (ik)
call cft_wave ( evc (1, ib), au2r, +1 )
do ip = 1, 3
do ir = 1, smooth%nrxx
do ir = 1, dffts%nnr
auxr (ir) = au2r (ir) * dvscfs (ir, ip)
end do
auxg (:) = (0.d0, 0.d0)
@ -108,7 +108,7 @@ subroutine chi_test (dvscfs, chif, ik, depsi, auxr, auxg)
do ib = 1, nbnd_occ (ik)
call cft_wave (depsi (1, ib, ip), au2r, +1 )
do ipa = 1, 3
do ir = 1, smooth%nrxx
do ir = 1, dffts%nnr
auxr (ir) = au2r (ir) * dvscfs (ir, ipa)
enddo
auxg (:) = (0.d0, 0.d0)
@ -134,7 +134,7 @@ subroutine chi_test (dvscfs, chif, ik, depsi, auxr, auxg)
call daxpy (2 * npwq, -1.d0, dvpsi (1,ib), 1, auxg, 1)
call cft_wave (evc (1, ib), auxr, +1 )
do ir = 1, smooth%nrxx
do ir = 1, dffts%nnr
auxr (ir) = auxr (ir) * dvscfs (ir, ip)
enddo
call cft_wave (auxg, auxr, -1 )

3
PH/drho.f90
View File

@ -19,7 +19,6 @@ subroutine drho
!
USE kinds, ONLY : DP
USE gvecs, ONLY : doublegrid
USE smooth_grid_dimensions, ONLY : smooth
USE fft_base, ONLY : dfftp, dffts
USE lsda_mod, ONLY : nspin
USE cell_base, ONLY : omega
@ -145,7 +144,7 @@ subroutine drho
allocate (dvlocin(dffts%nnr))
wdyn (:,:) = (0.d0, 0.d0)
nrstot = smooth%nr1 * smooth%nr2 * smooth%nr3
nrstot = dffts%nr1 * dffts%nr2 * dffts%nr3
do nu_i = 1, 3 * nat
call compute_dvloc (nu_i, dvlocin)
do nu_j = 1, 3 * nat

3
PH/drhodvloc.f90
View File

@ -15,7 +15,6 @@ subroutine drhodvloc (nu_i0, npe, drhoscf, wdyn)
!
USE kinds, ONLY : DP
USE ions_base, ONLY : nat
USE smooth_grid_dimensions, ONLY : smooth
USE fft_base, ONLY : dfftp, dffts
USE cell_base, ONLY : omega
USE lsda_mod, ONLY : nspin
@ -55,7 +54,7 @@ subroutine drhodvloc (nu_i0, npe, drhoscf, wdyn)
do is = 1, nspin_lsda
dynwrk (nu_i, nu_j) = dynwrk (nu_i, nu_j) + &
zdotc (dffts%nnr, drhoscf (1, is, ipert), 1, dvloc, 1) * &
omega / (smooth%nr1 * smooth%nr2 * smooth%nr3)
omega / (dffts%nr1 * dffts%nr2 * dffts%nr3)
enddo
enddo

3
PH/drhodvus.f90
View File

@ -21,7 +21,6 @@ subroutine drhodvus (irr, imode0, dvscfin, npe)
!
USE kinds, ONLY : DP
USE ions_base, ONLY : nat, ntyp=>nsp, ityp
USE grid_dimensions, ONLY : dense
USE cell_base, ONLY : omega
USE ions_base, ONLY : nat
USE fft_base, ONLY : dfftp
@ -67,7 +66,7 @@ subroutine drhodvus (irr, imode0, dvscfin, npe)
call start_clock ('drhodvus')
allocate (drhous ( dfftp%nnr, nspin_mag))
dyn1 (:,:) = (0.d0, 0.d0)
nrtot = dense%nr1 * dense%nr2 * dense%nr3
nrtot = dfftp%nr1 * dfftp%nr2 * dfftp%nr3
mode0 = 0
do irr1 = 1, nirr
do ipert = 1, npert (irr1)

3
PH/el_opt.f90
View File

@ -14,7 +14,6 @@ subroutine el_opt
use kinds, only : DP
USE cell_base, ONLY : omega, at, bg
USE constants, ONLY : e2, fpi
USE grid_dimensions, ONLY : dense
USE klist, ONLY : wk, ngk
USE ions_base, ONLY : nat
USE fft_base, ONLY : dfftp
@ -119,7 +118,7 @@ subroutine el_opt
aux3(:,ipa) * &
aux3(:,ipb) * &
aux3(:,ipc) ) ) * &
omega / (dense%nr1*dense%nr2*dense%nr3)
omega / (dfftp%nr1*dfftp%nr2*dfftp%nr3)
enddo
enddo
enddo

30
PH/make.depend
View File

@ -60,7 +60,6 @@ adddvscf.o : phcom.o
addnlcc.o : ../Modules/cell_base.o
addnlcc.o : ../Modules/fft_base.o
addnlcc.o : ../Modules/funct.o
addnlcc.o : ../Modules/griddim.o
addnlcc.o : ../Modules/ions_base.o
addnlcc.o : ../Modules/kind.o
addnlcc.o : ../Modules/mp.o
@ -72,7 +71,6 @@ addnlcc.o : phcom.o
addnlcc_zstar_eu_us.o : ../Modules/cell_base.o
addnlcc_zstar_eu_us.o : ../Modules/fft_base.o
addnlcc_zstar_eu_us.o : ../Modules/funct.o
addnlcc_zstar_eu_us.o : ../Modules/griddim.o
addnlcc_zstar_eu_us.o : ../Modules/kind.o
addnlcc_zstar_eu_us.o : ../Modules/mp_global.o
addnlcc_zstar_eu_us.o : ../Modules/recvec.o
@ -209,7 +207,7 @@ check_initial_status.o : ph_restart.o
check_initial_status.o : phcom.o
check_initial_status.o : save_ph_input.o
check_q_points_sym.o : ../Modules/kind.o
chi_test.o : ../Modules/griddim.o
chi_test.o : ../Modules/fft_base.o
chi_test.o : ../Modules/kind.o
chi_test.o : ../Modules/wavefunctions.o
chi_test.o : ../PW/pwcom.o
@ -370,7 +368,6 @@ dielec_test.o : phcom.o
dielec_test.o : ramanm.o
drho.o : ../Modules/cell_base.o
drho.o : ../Modules/fft_base.o
drho.o : ../Modules/griddim.o
drho.o : ../Modules/ions_base.o
drho.o : ../Modules/kind.o
drho.o : ../Modules/mp.o
@ -398,7 +395,6 @@ drhodv.o : ../PW/pwcom.o
drhodv.o : phcom.o
drhodvloc.o : ../Modules/cell_base.o
drhodvloc.o : ../Modules/fft_base.o
drhodvloc.o : ../Modules/griddim.o
drhodvloc.o : ../Modules/ions_base.o
drhodvloc.o : ../Modules/kind.o
drhodvloc.o : ../Modules/mp.o
@ -416,7 +412,6 @@ drhodvnl.o : ../PW/pwcom.o
drhodvnl.o : phcom.o
drhodvus.o : ../Modules/cell_base.o
drhodvus.o : ../Modules/fft_base.o
drhodvus.o : ../Modules/griddim.o
drhodvus.o : ../Modules/io_global.o
drhodvus.o : ../Modules/ions_base.o
drhodvus.o : ../Modules/kind.o
@ -578,7 +573,6 @@ ef_shift.o : phcom.o
el_opt.o : ../Modules/cell_base.o
el_opt.o : ../Modules/constants.o
el_opt.o : ../Modules/fft_base.o
el_opt.o : ../Modules/griddim.o
el_opt.o : ../Modules/io_global.o
el_opt.o : ../Modules/ions_base.o
el_opt.o : ../Modules/kind.o
@ -762,7 +756,6 @@ open_dvscf_star_q.o : ../Modules/cell_base.o
open_dvscf_star_q.o : ../Modules/constants.o
open_dvscf_star_q.o : ../Modules/control_flags.o
open_dvscf_star_q.o : ../Modules/fft_base.o
open_dvscf_star_q.o : ../Modules/griddim.o
open_dvscf_star_q.o : ../Modules/io_files.o
open_dvscf_star_q.o : ../Modules/io_global.o
open_dvscf_star_q.o : ../Modules/ions_base.o
@ -776,7 +769,6 @@ open_dvscf_star_q.o : elph.o
open_dvscf_star_q.o : phcom.o
openfilq.o : ../Modules/control_flags.o
openfilq.o : ../Modules/fft_base.o
openfilq.o : ../Modules/griddim.o
openfilq.o : ../Modules/input_parameters.o
openfilq.o : ../Modules/io_files.o
openfilq.o : ../Modules/io_global.o
@ -907,8 +899,8 @@ phq_setup.o : ramanm.o
phq_summary.o : ../Modules/cell_base.o
phq_summary.o : ../Modules/constants.o
phq_summary.o : ../Modules/control_flags.o
phq_summary.o : ../Modules/fft_base.o
phq_summary.o : ../Modules/funct.o
phq_summary.o : ../Modules/griddim.o
phq_summary.o : ../Modules/io_global.o
phq_summary.o : ../Modules/ions_base.o
phq_summary.o : ../Modules/kind.o
@ -964,24 +956,20 @@ psidspsi.o : ../PW/noncol.o
psidspsi.o : ../PW/pwcom.o
psidspsi.o : phcom.o
psym_dmag.o : ../Modules/fft_base.o
psym_dmag.o : ../Modules/griddim.o
psym_dmag.o : ../Modules/kind.o
psym_dmag.o : ../Modules/mp_global.o
psym_dmag.o : ../PW/noncol.o
psym_dmag.o : phcom.o
psym_dmage.o : ../Modules/fft_base.o
psym_dmage.o : ../Modules/griddim.o
psym_dmage.o : ../Modules/kind.o
psym_dmage.o : ../Modules/mp_global.o
psym_dmage.o : ../PW/pwcom.o
psymdvscf.o : ../Modules/fft_base.o
psymdvscf.o : ../Modules/griddim.o
psymdvscf.o : ../Modules/kind.o
psymdvscf.o : ../Modules/mp_global.o
psymdvscf.o : ../PW/noncol.o
psymdvscf.o : phcom.o
psyme.o : ../Modules/fft_base.o
psyme.o : ../Modules/griddim.o
psyme.o : ../Modules/kind.o
psyme.o : ../Modules/mp_global.o
psyme.o : ../PW/noncol.o
@ -990,7 +978,6 @@ psyme2.o : ../Modules/kind.o
psyme2.o : ../Modules/mp_global.o
punch_plot_e.o : ../Modules/cell_base.o
punch_plot_e.o : ../Modules/fft_base.o
punch_plot_e.o : ../Modules/griddim.o
punch_plot_e.o : ../Modules/io_global.o
punch_plot_e.o : ../Modules/ions_base.o
punch_plot_e.o : ../Modules/kind.o
@ -1001,7 +988,6 @@ punch_plot_e.o : ../PW/pwcom.o
punch_plot_e.o : phcom.o
punch_plot_ph.o : ../Modules/cell_base.o
punch_plot_ph.o : ../Modules/fft_base.o
punch_plot_ph.o : ../Modules/griddim.o
punch_plot_ph.o : ../Modules/io_global.o
punch_plot_ph.o : ../Modules/ions_base.o
punch_plot_ph.o : ../Modules/kind.o
@ -1074,7 +1060,6 @@ set_asr_c.o : ../Modules/kind.o
set_defaults_pw.o : ../Modules/cell_base.o
set_defaults_pw.o : ../Modules/constants.o
set_defaults_pw.o : ../Modules/control_flags.o
set_defaults_pw.o : ../Modules/griddim.o
set_defaults_pw.o : ../Modules/io_global.o
set_defaults_pw.o : ../Modules/ions_base.o
set_defaults_pw.o : ../Modules/kind.o
@ -1241,19 +1226,19 @@ sym_def.o : ../Modules/kind.o
sym_def.o : phcom.o
sym_dmag.o : ../Modules/cell_base.o
sym_dmag.o : ../Modules/constants.o
sym_dmag.o : ../Modules/griddim.o
sym_dmag.o : ../Modules/fft_base.o
sym_dmag.o : ../Modules/kind.o
sym_dmag.o : ../PW/noncol.o
sym_dmag.o : ../PW/symm_base.o
sym_dmag.o : phcom.o
sym_dmage.o : ../Modules/cell_base.o
sym_dmage.o : ../Modules/griddim.o
sym_dmage.o : ../Modules/fft_base.o
sym_dmage.o : ../Modules/kind.o
sym_dmage.o : ../PW/pwcom.o
sym_dmage.o : ../PW/symm_base.o
symdvscf.o : ../Modules/cell_base.o
symdvscf.o : ../Modules/constants.o
symdvscf.o : ../Modules/griddim.o
symdvscf.o : ../Modules/fft_base.o
symdvscf.o : ../Modules/kind.o
symdvscf.o : ../PW/noncol.o
symdvscf.o : ../PW/symm_base.o
@ -1261,11 +1246,11 @@ symdvscf.o : phcom.o
symdyn_munu.o : ../Modules/kind.o
symdynph_gq.o : ../Modules/constants.o
symdynph_gq.o : ../Modules/kind.o
syme.o : ../Modules/griddim.o
syme.o : ../Modules/fft_base.o
syme.o : ../Modules/kind.o
syme.o : ../PW/noncol.o
syme.o : ../PW/symm_base.o
syme2.o : ../Modules/griddim.o
syme2.o : ../Modules/fft_base.o
syme2.o : ../Modules/kind.o
syme2.o : ../PW/symm_base.o
syme2.o : ramanm.o
@ -1349,7 +1334,6 @@ zstar_eu.o : ../PW/symme.o
zstar_eu.o : phcom.o
zstar_eu_us.o : ../Modules/cell_base.o
zstar_eu_us.o : ../Modules/fft_base.o
zstar_eu_us.o : ../Modules/griddim.o
zstar_eu_us.o : ../Modules/io_files.o
zstar_eu_us.o : ../Modules/ions_base.o
zstar_eu_us.o : ../Modules/kind.o

45
PH/open_dvscf_star_q.f90
View File

@ -27,7 +27,6 @@ SUBROUTINE open_dvscf_star_q( q_index )
USE ions_base, ONLY : nat, ntyp => nsp, ityp, tau, atm, amass
USE wvfct, ONLY : npwx,npw,igk
USE symm_base, ONLY : s, ftau,nsym,irt, invs
USE grid_dimensions, ONLY: dense
USE lsda_mod, ONLY: nspin
USE phcom
USE el_phon
@ -229,9 +228,9 @@ SUBROUTINE open_dvscf_star_q( q_index )
write(stdout,*) '==============================================='
ALLOCATE (dvscf_at (dense%nr1x * dense%nr2x * dense%nr3x , nspin , 3*nat ))
ALLOCATE (dvrot ( dense%nr1x * dense%nr2x * dense%nr3x , nspin , 3*nat) )
ALLOCATE (dvrot_scr ( dense%nr1x * dense%nr2x * dense%nr3x , nspin , 3*nat) )
ALLOCATE (dvscf_at (dfftp%nr1x * dfftp%nr2x * dfftp%nr3x , nspin , 3*nat ))
ALLOCATE (dvrot ( dfftp%nr1x * dfftp%nr2x * dfftp%nr3x , nspin , 3*nat) )
ALLOCATE (dvrot_scr ( dfftp%nr1x * dfftp%nr2x * dfftp%nr3x , nspin , 3*nat) )
dvscf_at=CMPLX(0.d0,0.d0)
dvrot=CMPLX(0.d0,0.d0)
@ -433,9 +432,9 @@ SUBROUTINE open_dvscf_star_q( q_index )
do is=1,nspin
do k = 1, dense%nr3
do j = 1, dense%nr2
do i = 1, dense%nr1
do k = 1, dfftp%nr3
do j = 1, dfftp%nr2
do i = 1, dfftp%nr1
!
@ -454,27 +453,27 @@ SUBROUTINE open_dvscf_star_q( q_index )
rk = s(1, 3, isym2) * (i - 1) + s(2,3, isym2) * (j - 1) &
+ s(3, 3, isym2) * (k - 1) - ftau (3, isym2)
ri = mod (ri, dense%nr1) + 1
ri = mod (ri, dfftp%nr1) + 1
rj = mod (rj, dense%nr2) + 1
rj = mod (rj, dfftp%nr2) + 1
rk = mod (rk, dense%nr3) + 1
rk = mod (rk, dfftp%nr3) + 1
if (ri < 1) then
ri = ri + dense%nr1
ri = ri + dfftp%nr1
endif
if (rj < 1) then
rj = rj + dense%nr2
rj = rj + dfftp%nr2
endif
if (rk < 1) then
rk = rk + dense%nr3
rk = rk + dfftp%nr3
endif
n=(i-1) + (j-1)*dense%nr1 + (k-1)*dense%nr2*dense%nr1 + 1
nn=(ri-1) + (rj-1)*dense%nr1 + (rk-1)*dense%nr2*dense%nr1 + 1
n=(i-1) + (j-1)*dfftp%nr1 + (k-1)*dfftp%nr2*dfftp%nr1 + 1
nn=(ri-1) + (rj-1)*dfftp%nr1 + (rk-1)*dfftp%nr2*dfftp%nr1 + 1
do na=1,nat
@ -553,11 +552,11 @@ SUBROUTINE open_dvscf_star_q( q_index )
do na=1,nat
do ipol=1,3
irr=(na-1)*3+ipol
do k = 1, dense%nr3
do j = 1, dense%nr2
do i = 1, dense%nr1
do k = 1, dfftp%nr3
do j = 1, dfftp%nr2
do i = 1, dfftp%nr1
n=(i-1) + (j-1)*dense%nr1 + (k-1)*dense%nr2*dense%nr1 + 1
n=(i-1) + (j-1)*dfftp%nr1 + (k-1)*dfftp%nr2*dfftp%nr1 + 1
write(iudvrot_asc,'(1i10,2f16.10)') n, dvrot(n,1,irr)
enddo
@ -569,11 +568,11 @@ SUBROUTINE open_dvscf_star_q( q_index )
do na=1,nat
do ipol=1,3
irr=(na-1)*3+ipol
do k = 1, dense%nr3
do j = 1, dense%nr2
do i = 1, dense%nr1
do k = 1, dfftp%nr3
do j = 1, dfftp%nr2
do i = 1, dfftp%nr1
n=(i-1) + (j-1)*dense%nr1 + (k-1)*dense%nr2*dense%nr1 + 1
n=(i-1) + (j-1)*dfftp%nr1 + (k-1)*dfftp%nr2*dfftp%nr1 + 1
write(iudvrot_asc_imq,'(1i10,2f16.10)') n, conjg(dvrot(n,1,irr))
enddo

3
PH/openfilq.f90
View File

@ -26,7 +26,6 @@ SUBROUTINE openfilq()
USE qpoint, ONLY : nksq
USE output, ONLY : fildyn, fildvscf
USE wvfct, ONLY : nbnd, npwx
USE grid_dimensions,ONLY : dense
USE fft_base, ONLY : dfftp
USE lsda_mod, ONLY : nspin
USE uspp, ONLY : nkb, okvan
@ -114,7 +113,7 @@ SUBROUTINE openfilq()
! and solve_linter). Used for third-order calculations.
!
iudrho = 23
lrdrho = 2 * dense%nr1x * dense%nr2x * dense%nr3x * nspin_mag
lrdrho = 2 * dfftp%nr1x * dfftp%nr2x * dfftp%nr3x * nspin_mag
!
!
! Here the sequential files

26
PH/phq_summary.f90
View File

@ -22,10 +22,10 @@ subroutine phq_summary
USE io_global, ONLY : stdout
USE cell_base, ONLY : at, bg, ibrav, alat, omega, celldm
USE klist, ONLY : lgauss, smearing, degauss, ngauss, nkstot, xk, wk
USE grid_dimensions,ONLY: dense
USE fft_base, ONLY : dfftp
USE gvect, ONLY : gcutm, ngm
USE gvecs, ONLY : doublegrid, dual, gcutms, ngms
USE smooth_grid_dimensions, ONLY : smooth
USE fft_base, ONLY : dffts
USE symm_base, ONLY : s, sr, ftau, sname, t_rev
USE constants, ONLY : amconv
USE noncollin_module, ONLY : noncolin
@ -163,21 +163,21 @@ subroutine phq_summary
if (ftau (1, isym) .ne.0.or.ftau (2, isym) .ne.0.or.ftau (3, &
isym) .ne.0) then
ft1 = at (1, 1) * ftau (1, isym) / dense%nr1 + at (1, 2) * ftau ( &
2, isym) / dense%nr2 + at (1, 3) * ftau (3, isym) / dense%nr3
ft2 = at (2, 1) * ftau (1, isym) / dense%nr1 + at (2, 2) * ftau ( &
2, isym) / dense%nr2 + at (2, 3) * ftau (3, isym) / dense%nr3
ft3 = at (3, 1) * ftau (1, isym) / dense%nr1 + at (3, 2) * ftau ( &
2, isym) / dense%nr2 + at (3, 3) * ftau (3, isym) / dense%nr3
ft1 = at (1, 1) * ftau (1, isym) / dfftp%nr1 + at (1, 2) * ftau ( &
2, isym) / dfftp%nr2 + at (1, 3) * ftau (3, isym) / dfftp%nr3
ft2 = at (2, 1) * ftau (1, isym) / dfftp%nr1 + at (2, 2) * ftau ( &
2, isym) / dfftp%nr2 + at (2, 3) * ftau (3, isym) / dfftp%nr3
ft3 = at (3, 1) * ftau (1, isym) / dfftp%nr1 + at (3, 2) * ftau ( &
2, isym) / dfftp%nr2 + at (3, 3) * ftau (3, isym) / dfftp%nr3
WRITE( stdout, '(1x,"cryst.",3x,"s(",i2,") = (",3(i6,5x), &
& " ) f =( ",f10.7," )")') isymq, (s (1, &
& ipol, isym) , ipol = 1, 3) , DBLE (ftau (1, isym) ) / DBLE (dense%nr1)
& ipol, isym) , ipol = 1, 3) , DBLE (ftau (1, isym) ) / DBLE (dfftp%nr1)
WRITE( stdout, '(17x," (",3(i6,5x), &
& " ) ( ",f10.7," )")') (s (2, ipol, &
&isym) , ipol = 1, 3) , DBLE (ftau (2, isym) ) / DBLE (dense%nr2)
&isym) , ipol = 1, 3) , DBLE (ftau (2, isym) ) / DBLE (dfftp%nr2)
WRITE( stdout, '(17x," (",3(i6,5x), &
& " ) ( ",f10.7," )"/)') (s (3, ipol, &
& isym) , ipol = 1, 3) , DBLE (ftau (3, isym) ) / DBLE (dense%nr3)
& isym) , ipol = 1, 3) , DBLE (ftau (3, isym) ) / DBLE (dfftp%nr3)
WRITE( stdout, '(1x,"cart.",4x,"s(",i2,") = (",3f11.7, &
& " ) f =( ",f10.7," )")') isymq, &
& (sr (1, ipol,isym) , ipol = 1, 3) , ft1
@ -207,11 +207,11 @@ subroutine phq_summary
!
WRITE( stdout, '(/5x,"G cutoff =",f10.4," (", &
& i7," G-vectors)"," FFT grid: (",i3, &
& ",",i3,",",i3,")")') gcutm, ngm, dense%nr1, dense%nr2, dense%nr3
& ",",i3,",",i3,")")') gcutm, ngm, dfftp%nr1, dfftp%nr2, dfftp%nr3
if (doublegrid) WRITE( stdout, '(5x,"G cutoff =",f10.4," (", &
& i7," G-vectors)"," smooth grid: (",i3, &
& ",",i3,",",i3,")")') gcutms, ngms, smooth%nr1, smooth%nr2, smooth%nr3
& ",",i3,",",i3,")")') gcutms, ngms, dffts%nr1, dffts%nr2, dffts%nr3
if (.NOT.lgauss) then
WRITE( stdout, '(5x,"number of k points=",i6)') nkstot
else

4
PH/psym_dmag.f90
View File

@ -13,8 +13,6 @@ SUBROUTINE psym_dmag (nper, irr, dvtosym)
! ... p-symmetrize the charge density.
!
USE kinds, ONLY : DP
USE grid_dimensions, ONLY : dense
USE fft_base, ONLY : dfftp
USE noncollin_module, ONLY : nspin_mag
USE modes, ONLY : minus_q, nsymq
USE mp_global, ONLY : me_pool
@ -40,7 +38,7 @@ SUBROUTINE psym_dmag (nper, irr, dvtosym)
IF (nsymq.EQ.1.AND. (.NOT.minus_q) ) RETURN
CALL start_clock ('psym_dmag')
ALLOCATE (ddvtosym ( dense%nr1x * dense%nr2x * dense%nr3x, nspin_mag, nper))
ALLOCATE (ddvtosym ( dfftp%nr1x * dfftp%nr2x * dfftp%nr3x, nspin_mag, nper))
npp0 = 1
DO i = 1, me_pool
npp0 = npp0 + dfftp%npp (i) * dfftp%nnp

4
PH/psym_dmage.f90
View File

@ -13,8 +13,6 @@ SUBROUTINE psym_dmage (dvtosym)
! ... p-symmetrize the magnetization change due to an electric field.
!
USE kinds, ONLY : DP
USE grid_dimensions, ONLY : dense
USE fft_base, ONLY : dfftp
USE lsda_mod, ONLY : nspin
USE mp_global, ONLY : me_pool
USE fft_base, ONLY : dfftp, cgather_sym
@ -34,7 +32,7 @@ SUBROUTINE psym_dmage (dvtosym)
CALL start_clock ('psym_dmage')
ALLOCATE (ddvtosym ( dense%nr1x * dense%nr2x * dense%nr3x, nspin, 3))
ALLOCATE (ddvtosym ( dfftp%nr1x * dfftp%nr2x * dfftp%nr3x, nspin, 3))
npp0 = 1
DO i = 1, me_pool
npp0 = npp0 + dfftp%npp (i) * dfftp%nnp

4
PH/psymdvscf.f90
View File

@ -13,8 +13,6 @@ SUBROUTINE psymdvscf (nper, irr, dvtosym)
! ... p-symmetrize the charge density.
!
USE kinds, ONLY : DP
USE grid_dimensions, ONLY : dense
USE fft_base, ONLY : dfftp
USE noncollin_module, ONLY : nspin_mag
USE modes, ONLY : nsymq, minus_q
USE mp_global, ONLY : me_pool
@ -40,7 +38,7 @@ SUBROUTINE psymdvscf (nper, irr, dvtosym)
IF (nsymq.EQ.1.AND. (.NOT.minus_q) ) RETURN
CALL start_clock ('psymdvscf')
ALLOCATE (ddvtosym ( dense%nr1x * dense%nr2x * dense%nr3x, nspin_mag, nper))
ALLOCATE (ddvtosym ( dfftp%nr1x * dfftp%nr2x * dfftp%nr3x, nspin_mag, nper))
npp0 = 1
DO i = 1, me_pool
npp0 = npp0 + dfftp%npp (i) * dfftp%nnp

3
PH/psyme.f90
View File

@ -13,7 +13,6 @@ SUBROUTINE psyme (dvtosym)
! ... p-symmetrize the charge density.
!
USE kinds, ONLY : DP
USE grid_dimensions, ONLY : dense
USE fft_base, ONLY : dfftp
USE noncollin_module, ONLY : nspin_mag
USE mp_global, ONLY : me_pool
@ -32,7 +31,7 @@ SUBROUTINE psyme (dvtosym)
! the potential to symmet
!
!
ALLOCATE (ddvtosym ( dense%nr1x * dense%nr2x * dense%nr3x, nspin_mag, 3))
ALLOCATE (ddvtosym ( dfftp%nr1x * dfftp%nr2x * dfftp%nr3x, nspin_mag, 3))
npp0 = 0
DO i = 1, me_pool
npp0 = npp0 + dfftp%npp (i)

7
PH/punch_plot_e.f90
View File

@ -23,7 +23,6 @@ SUBROUTINE punch_plot_e()
USE io_global, ONLY : stdout, ionode
USE fft_base, ONLY : grid_gather
USE printout_base, ONLY : title
USE grid_dimensions,ONLY : dense
USE fft_base, ONLY : dfftp
USE gvect, ONLY : gcutm
USE gvecs, ONLY : dual
@ -107,7 +106,7 @@ SUBROUTINE punch_plot_e()
! not used
plot_num = - 1
WRITE (iunplot, '(a)') title
WRITE (iunplot, '(8i8)') dense%nr1x, dense%nr2x, dense%nr3x, dense%nr1, dense%nr2, dense%nr3, nat, &
WRITE (iunplot, '(8i8)') dfftp%nr1x, dfftp%nr2x, dfftp%nr3x, dfftp%nr1, dfftp%nr2, dfftp%nr3, nat, &
ntyp
WRITE (iunplot, '(i6,6f12.8)') ibrav, celldm
WRITE (iunplot, '(3f20.10,i6)') gcutm, dual, ecutwfc, plot_num
@ -124,10 +123,10 @@ SUBROUTINE punch_plot_e()
IF (lsda) CALL daxpy (dfftp%nnr, 1.d0, aux1 (1,2, ipol), 2, raux, 1)
!
#if defined (__PARA)
ALLOCATE (raux1( dense%nr1x * dense%nr2x * dense%nr3x))
ALLOCATE (raux1( dfftp%nr1x * dfftp%nr2x * dfftp%nr3x))
CALL grid_gather (raux, raux1)
IF ( ionode ) WRITE (iunplot, '(5(1pe17.9))') &
(raux1 (ir) , ir = 1, dense%nr1x * dense%nr2x * dense%nr3x)
(raux1 (ir) , ir = 1, dfftp%nr1x * dfftp%nr2x * dfftp%nr3x)
DEALLOCATE (raux1)
#else
WRITE (iunplot, '( 5( 1pe17.9 ) )') (raux (ir) , ir = 1, dfftp%nnr)

7
PH/punch_plot_ph.f90
View File

@ -18,7 +18,6 @@ SUBROUTINE punch_plot_ph()
! a file with the name in the variable fildrho# given in input.
!
USE kinds, ONLY : DP
USE grid_dimensions, ONLY : dense
USE fft_base, ONLY : dfftp
USE gvect, ONLY : gcutm
USE gvecs, ONLY : dual
@ -117,7 +116,7 @@ SUBROUTINE punch_plot_ph()
!
plot_num = 0
WRITE (iunplot, '(a)') title
WRITE (iunplot, '(8i8)') dense%nr1x, dense%nr2x, dense%nr3x, dense%nr1, dense%nr2, dense%nr3, nat, &
WRITE (iunplot, '(8i8)') dfftp%nr1x, dfftp%nr2x, dfftp%nr3x, dfftp%nr1, dfftp%nr2, dfftp%nr3, nat, &
ntyp
WRITE (iunplot, '(i6,6f12.8)') ibrav, celldm
WRITE (iunplot, '(3f20.10,i6)') gcutm, dual, ecutwfc, plot_num
@ -135,9 +134,9 @@ SUBROUTINE punch_plot_ph()
IF (lsda) CALL daxpy (dfftp%nnr, 1.d0, aux1 (1, 2), 2, raux, 1)
#if defined (__PARA)
ALLOCATE (raux1( dense%nr1x * dense%nr2x * dense%nr3x))
ALLOCATE (raux1( dfftp%nr1x * dfftp%nr2x * dfftp%nr3x))
CALL grid_gather (raux, raux1)
IF ( ionode ) WRITE (iunplot, * ) (raux1 (ir), ir = 1, dense%nr1x * dense%nr2x * dense%nr3x)
IF ( ionode ) WRITE (iunplot, * ) (raux1 (ir), ir = 1, dfftp%nr1x * dfftp%nr2x * dfftp%nr3x)
DEALLOCATE (raux1)
#else
WRITE (iunplot, * ) (raux (ir), ir = 1, dfftp%nnr)

1
PH/set_defaults_pw.f90
View File

@ -31,7 +31,6 @@ SUBROUTINE setup_nscf ( newgrid, xq )
USE ions_base, ONLY : nat, tau, ntyp => nsp, ityp, zv
USE force_mod, ONLY : force
USE basis, ONLY : natomwfc
USE grid_dimensions, ONLY : dense
USE klist, ONLY : xk, wk, nks, nelec, degauss, lgauss, &
nkstot, qnorm
USE lsda_mod, ONLY : lsda, nspin, current_spin, isk, &

48
PH/sym_dmag.f90
View File

@ -14,7 +14,7 @@ subroutine sym_dmag (nper, irr, dmagtosym)
!
USE kinds, only : DP
USE constants, ONLY: tpi
USE grid_dimensions, ONLY: dense
USE fft_base, ONLY: dfftp
USE cell_base, ONLY : at, bg
USE symm_base, ONLY : s, ftau, t_rev, sname, invs
USE noncollin_module, ONLY: nspin_mag
@ -27,7 +27,7 @@ subroutine sym_dmag (nper, irr, dmagtosym)
! the number of perturbations
! the representation under conside
complex(DP) :: dmagtosym (dense%nr1x, dense%nr2x, dense%nr3x, nspin_mag, nper)
complex(DP) :: dmagtosym (dfftp%nr1x, dfftp%nr2x, dfftp%nr3x, nspin_mag, nper)
! the magnetization to symmetrize (only 2:4 components)
integer :: is, ri, rj, rk, i, j, k, ipert, jpert, ipol, isym, &
@ -59,14 +59,14 @@ subroutine sym_dmag (nper, irr, dmagtosym)
if (nsymq == 1.and. (.not.minus_q) ) return
call start_clock ('sym_dmag')
allocate (dmagsym( dense%nr1x , dense%nr2x , dense%nr3x , 3, nper))
allocate (dmagsym( dfftp%nr1x , dfftp%nr2x , dfftp%nr3x , 3, nper))
allocate (dmags( 3, nper))
!
! if necessary we symmetrize with respect to S(irotmq)*q = -q + Gi
!
in1 = tpi / DBLE (dense%nr1)
in2 = tpi / DBLE (dense%nr2)
in3 = tpi / DBLE (dense%nr3)
in1 = tpi / DBLE (dfftp%nr1)
in2 = tpi / DBLE (dfftp%nr2)
in3 = tpi / DBLE (dfftp%nr3)
if (minus_q) then
g1 (1) = 0.d0
@ -81,21 +81,21 @@ subroutine sym_dmag (nper, irr, dmagtosym)
term (2, 1) = CMPLX(cos (g2 (1) ), sin (g2 (1) ) ,kind=DP)
term (3, 1) = CMPLX(cos (g3 (1) ), sin (g3 (1) ) ,kind=DP)
phase (1) = (1.d0, 0.d0)
do k = 1, dense%nr3
do j = 1, dense%nr2
do i = 1, dense%nr1
do k = 1, dfftp%nr3
do j = 1, dfftp%nr2
do i = 1, dfftp%nr1
ri = s (1, 1, irotmq) * (i - 1) + s (2, 1, irotmq) * (j - 1) &
+ s (3, 1, irotmq) * (k - 1) - ftau (1, irotmq)
ri = mod (ri, dense%nr1) + 1
if (ri < 1) ri = ri + dense%nr1
ri = mod (ri, dfftp%nr1) + 1
if (ri < 1) ri = ri + dfftp%nr1
rj = s (1, 2, irotmq) * (i - 1) + s (2, 2, irotmq) * (j - 1) &
+ s (3, 2, irotmq) * (k - 1) - ftau (2, irotmq)
rj = mod (rj, dense%nr2) + 1
if (rj < 1) rj = rj + dense%nr2
rj = mod (rj, dfftp%nr2) + 1
if (rj < 1) rj = rj + dfftp%nr2
rk = s (1, 3, irotmq) * (i - 1) + s (2, 3, irotmq) * (j - 1) &
+ s (3, 3, irotmq) * (k - 1) - ftau (3, irotmq)
rk = mod (rk, dense%nr3) + 1
if (rk < 1) rk = rk + dense%nr3
rk = mod (rk, dfftp%nr3) + 1
if (rk < 1) rk = rk + dfftp%nr3
do ipert = 1, nper
aux2 = (0.d0, 0.d0)
@ -159,23 +159,23 @@ subroutine sym_dmag (nper, irr, dmagtosym)
do isym = 1, nsymq
phase (isym) = (1.d0, 0.d0)
enddo
do k = 1, dense%nr3
do j = 1, dense%nr2
do i = 1, dense%nr1
do k = 1, dfftp%nr3
do j = 1, dfftp%nr2
do i = 1, dfftp%nr1
do isym = 1, nsymq
irot = irgq (isym)
ri = s (1, 1, irot) * (i - 1) + s (2, 1, irot) * (j - 1) &
+ s (3, 1, irot) * (k - 1) - ftau (1, irot)
ri = mod (ri, dense%nr1) + 1
if (ri < 1) ri = ri + dense%nr1
ri = mod (ri, dfftp%nr1) + 1
if (ri < 1) ri = ri + dfftp%nr1
rj = s (1, 2, irot) * (i - 1) + s (2, 2, irot) * (j - 1) &
+ s (3, 2, irot) * (k - 1) - ftau (2, irot)
rj = mod (rj, dense%nr2) + 1
if (rj < 1) rj = rj + dense%nr2
rj = mod (rj, dfftp%nr2) + 1
if (rj < 1) rj = rj + dfftp%nr2
rk = s (1, 3, irot) * (i - 1) + s (2, 3, irot) * (j - 1) &
+ s (3, 3, irot) * (k - 1) - ftau (3, irot)
rk = mod (rk, dense%nr3) + 1
if (rk < 1) rk = rk + dense%nr3
rk = mod (rk, dfftp%nr3) + 1
if (rk < 1) rk = rk + dfftp%nr3
dmags=(0.d0,0.d0)
do ipert = 1, nper
do jpert = 1, nper

14
PH/sym_dmage.f90
View File

@ -16,12 +16,12 @@ subroutine sym_dmage (dvsym)
!
USE kinds, only : DP
USE cell_base,only : at, bg
USE grid_dimensions, only : dense
USE fft_base, only : dfftp
USE symm_base,only : nsym, sname, s, ftau, t_rev, invs
USE lsda_mod, only : nspin
implicit none
complex(DP) :: dvsym (dense%nr1x, dense%nr2x, dense%nr3x, nspin, 3)
complex(DP) :: dvsym (dfftp%nr1x, dfftp%nr2x, dfftp%nr3x, nspin, 3)
complex(DP), allocatable :: aux (:,:,:,:,:)
complex(DP) :: dmags(3,3), mag(3), magrot(3)
! the potential to symmetrize
@ -40,7 +40,7 @@ subroutine sym_dmage (dvsym)
end do
end do
if (nsym == 1) return
allocate (aux(dense%nr1x , dense%nr2x , dense%nr3x , 3, 3))
allocate (aux(dfftp%nr1x , dfftp%nr2x , dfftp%nr3x , 3, 3))
do is = 2, 4
do ipol = 1, 3
@ -51,12 +51,12 @@ subroutine sym_dmage (dvsym)
!
! symmmetrize
!
do k = 1, dense%nr3
do j = 1, dense%nr2
do i = 1, dense%nr1
do k = 1, dfftp%nr3
do j = 1, dfftp%nr2
do i = 1, dfftp%nr1
do irot = 1, nsym
call ruotaijk (s(1,1,irot), ftau(1,irot), i, j, k, &
dense%nr1, dense%nr2, dense%nr3, ri, rj, rk)
dfftp%nr1, dfftp%nr2, dfftp%nr3, ri, rj, rk)
!
! ruotaijk find the rotated of i,j,k with the inverse of S
!

48
PH/symdvscf.f90
View File

@ -14,7 +14,7 @@ subroutine symdvscf (nper, irr, dvtosym)
!
USE kinds, only : DP
USE constants, ONLY: tpi
USE grid_dimensions, ONLY: dense
USE fft_base, ONLY: dfftp
USE cell_base, ONLY : at
USE symm_base, ONLY : s, ftau
USE noncollin_module, ONLY : nspin_lsda, nspin_mag
@ -25,7 +25,7 @@ subroutine symdvscf (nper, irr, dvtosym)
! the number of perturbations
! the representation under conside
complex(DP) :: dvtosym (dense%nr1x, dense%nr2x, dense%nr3x, nspin_mag, nper)
complex(DP) :: dvtosym (dfftp%nr1x, dfftp%nr2x, dfftp%nr3x, nspin_mag, nper)
! the potential to be symmetrized
integer :: is, ri, rj, rk, i, j, k, ipert, jpert, ipol, isym, &
@ -43,13 +43,13 @@ subroutine symdvscf (nper, irr, dvtosym)
if (nsymq == 1.and. (.not.minus_q) ) return
call start_clock ('symdvscf')
allocate (dvsym( dense%nr1x , dense%nr2x , dense%nr3x , nper))
allocate (dvsym( dfftp%nr1x , dfftp%nr2x , dfftp%nr3x , nper))
!
! if necessary we symmetrize with respect to S(irotmq)*q = -q + Gi
!
n(1) = tpi / DBLE (dense%nr1)
n(2) = tpi / DBLE (dense%nr2)
n(3) = tpi / DBLE (dense%nr3)
n(1) = tpi / DBLE (dfftp%nr1)
n(2) = tpi / DBLE (dfftp%nr2)
n(3) = tpi / DBLE (dfftp%nr3)
if (minus_q) then
gf(:) = gimq (1) * at (1, :) * n(:) + &
gimq (2) * at (2, :) * n(:) + &
@ -57,22 +57,22 @@ subroutine symdvscf (nper, irr, dvtosym)
term (:, 1) = CMPLX(cos (gf (:) ), sin (gf (:) ) ,kind=DP)
do is = 1, nspin_lsda
phase (1) = (1.d0, 0.d0)
do k = 1, dense%nr3
do j = 1, dense%nr2
do i = 1, dense%nr1
do k = 1, dfftp%nr3
do j = 1, dfftp%nr2
do i = 1, dfftp%nr1
ri = s (1, 1, irotmq) * (i - 1) + s (2, 1, irotmq) * (j - 1) &
+ s (3, 1, irotmq) * (k - 1) - ftau (1, irotmq)
ri = mod (ri, dense%nr1) + 1
if (ri < 1) ri = ri + dense%nr1
ri = mod (ri, dfftp%nr1) + 1
if (ri < 1) ri = ri + dfftp%nr1
rj = s (1, 2, irotmq) * (i - 1) + s (2, 2, irotmq) * (j - 1) &
+ s (3, 2, irotmq) * (k - 1) - ftau (2, irotmq)
rj = mod (rj, dense%nr2) + 1
if (rj < 1) rj = rj + dense%nr2
rj = mod (rj, dfftp%nr2) + 1
if (rj < 1) rj = rj + dfftp%nr2
rk = s (1, 3, irotmq) * (i - 1) + s (2, 3, irotmq) * (j - 1) &
+ s (3, 3, irotmq) * (k - 1) - ftau (3, irotmq)
rk = mod (rk, dense%nr3) + 1
rk = mod (rk, dfftp%nr3) + 1
if (rk < 1) rk = rk + dense%nr3
if (rk < 1) rk = rk + dfftp%nr3
do ipert = 1, nper
aux2 = (0.d0, 0.d0)
do jpert = 1, nper
@ -108,24 +108,24 @@ subroutine symdvscf (nper, irr, dvtosym)
do isym = 1, nsymq
phase (isym) = (1.d0, 0.d0)
enddo
do k = 1, dense%nr3
do j = 1, dense%nr2
do i = 1, dense%nr1
do k = 1, dfftp%nr3
do j = 1, dfftp%nr2
do i = 1, dfftp%nr1
do isym = 1, nsymq
irot = irgq (isym)
ri = s (1, 1, irot) * (i - 1) + s (2, 1, irot) * (j - 1) &
+ s (3, 1, irot) * (k - 1) - ftau (1, irot)
ri = mod (ri, dense%nr1) + 1
if (ri < 1) ri = ri + dense%nr1
ri = mod (ri, dfftp%nr1) + 1
if (ri < 1) ri = ri + dfftp%nr1
rj = s (1, 2, irot) * (i - 1) + s (2, 2, irot) * (j - 1) &
+ s (3, 2, irot) * (k - 1) - ftau (2, irot)
rj = mod (rj, dense%nr2) + 1
if (rj < 1) rj = rj + dense%nr2
rj = mod (rj, dfftp%nr2) + 1
if (rj < 1) rj = rj + dfftp%nr2
rk = s (1, 3, irot) * (i - 1) + s (2, 3, irot) * (j - 1) &
+ s (3, 3, irot) * (k - 1) - ftau (3, irot)
rk = mod (rk, dense%nr3) + 1
rk = mod (rk, dfftp%nr3) + 1
if (rk < 1) rk = rk + dense%nr3
if (rk < 1) rk = rk + dfftp%nr3
do ipert = 1, nper
do jpert = 1, nper
dvsym (i, j, k, ipert) = dvsym (i, j, k, ipert) + &

14
PH/syme.f90
View File

@ -17,13 +17,13 @@ subroutine syme (dvsym)
!
!
USE grid_dimensions, only : dense
USE fft_base, only : dfftp
USE symm_base, only : nsym, s, ftau
USE noncollin_module, only : nspin_lsda, nspin_mag
USE kinds, only : DP
implicit none
complex(DP) :: dvsym (dense%nr1x, dense%nr2x, dense%nr3x, nspin_mag, 3)
complex(DP) :: dvsym (dfftp%nr1x, dfftp%nr2x, dfftp%nr3x, nspin_mag, 3)
complex(DP), allocatable :: aux (:,:,:,:)
! the potential to symmetrize
! auxiliary quantity
@ -41,7 +41,7 @@ subroutine syme (dvsym)
end do
end do
if (nsym == 1) return
allocate (aux(dense%nr1x , dense%nr2x , dense%nr3x , 3))
allocate (aux(dfftp%nr1x , dfftp%nr2x , dfftp%nr3x , 3))
do is = 1, nspin_lsda
do ipol = 1, 3
aux(:,:,:,ipol) = dvsym(:,:,:,is,ipol)
@ -50,12 +50,12 @@ subroutine syme (dvsym)
!
! symmmetrize
!
do k = 1, dense%nr3
do j = 1, dense%nr2
do i = 1, dense%nr1
do k = 1, dfftp%nr3
do j = 1, dfftp%nr2
do i = 1, dfftp%nr1
do irot = 1, nsym
call ruotaijk (s(1,1,irot), ftau(1,irot), i, j, k, &
dense%nr1, dense%nr2, dense%nr3, ri, rj, rk)
dfftp%nr1, dfftp%nr2, dfftp%nr3, ri, rj, rk)
!
! ruotaijk find the rotated of i,j,k with the inverse of S
!

18
PH/syme2.f90
View File

@ -17,12 +17,12 @@ subroutine syme2 (dvsym)
! the symmetric 3x3 tensor are given by the common variables: jab; a1j; a2j
!
use kinds, only : DP
USE grid_dimensions, ONLY: dense
USE fft_base, ONLY: dfftp
USE symm_base, ONLY: nsym, s, ftau
USE ramanm, ONLY: jab
implicit none
complex(DP) :: dvsym (dense%nr1x, dense%nr2x, dense%nr3x, 6)
complex(DP) :: dvsym (dfftp%nr1x, dfftp%nr2x, dfftp%nr3x, 6)
complex(DP), allocatable :: aux (:,:,:,:)
! the function to symmetrize
! auxiliary space
@ -34,22 +34,22 @@ subroutine syme2 (dvsym)
! counter on polarizations
if (nsym.eq.1) return
allocate (aux(dense%nr1x , dense%nr2x , dense%nr3x , 6))
allocate (aux(dfftp%nr1x , dfftp%nr2x , dfftp%nr3x , 6))
do ip = 1, 6
call zcopy (dense%nr1x * dense%nr2x * dense%nr3x, dvsym (1, 1, 1, ip), &
call zcopy (dfftp%nr1x * dfftp%nr2x * dfftp%nr3x, dvsym (1, 1, 1, ip), &
1, aux (1, 1, 1, ip), 1)
enddo
dvsym (:,:,:,:) = (0.d0, 0.d0)
!
! symmmetrize
!
do kx = 1, dense%nr3
do jx = 1, dense%nr2
do ix = 1, dense%nr1
do kx = 1, dfftp%nr3
do jx = 1, dfftp%nr2
do ix = 1, dfftp%nr1
do irot = 1, nsym
call ruotaijk(s (1, 1, irot), ftau (1, irot), ix, jx, kx, &
dense%nr1, dense%nr2, dense%nr3, ri, rj, rk)
dfftp%nr1, dfftp%nr2, dfftp%nr3, ri, rj, rk)
!
! ruotaijk finds the rotated of ix,jx,kx with the inverse of S
!
@ -72,7 +72,7 @@ subroutine syme2 (dvsym)
enddo
do ip = 1, 6
call dscal (2 * dense%nr1x * dense%nr2x * dense%nr3x, 1.d0 / DBLE (nsym), &
call dscal (2 * dfftp%nr1x * dfftp%nr2x * dfftp%nr3x, 1.d0 / DBLE (nsym), &
dvsym (1, 1, 1, ip), 1)
enddo

3
PH/zstar_eu_us.f90
View File

@ -20,7 +20,6 @@ subroutine zstar_eu_us
USE ions_base, ONLY : nat, ntyp => nsp, ityp
USE klist, ONLY : xk, wk
USE gvecs, ONLY : doublegrid
USE grid_dimensions, ONLY : dense
USE fft_base, ONLY : dfftp, dffts
USE lsda_mod, ONLY : nspin, current_spin, isk, lsda
USE io_files, ONLY : iunigk
@ -176,7 +175,7 @@ subroutine zstar_eu_us
do is=1,nspin_mag
zstareu0(jpol,mode) = zstareu0(jpol,mode) - &
dot_product(dvscf(1:dfftp%nnr,is,jpol),drhoscfh(1:dfftp%nnr,is)) &
* omega / DBLE(dense%nr1*dense%nr2*dense%nr3)
* omega / DBLE(dfftp%nr1*dfftp%nr2*dfftp%nr3)
end do
end do
end do

18
PP/addusdens1d.f90
View File

@ -18,7 +18,7 @@ SUBROUTINE addusdens1d (plan, prho)
USE kinds, ONLY: DP
USE cell_base, ONLY: alat, omega, celldm
USE ions_base, ONLY: nat, ntyp => nsp, ityp
USE grid_dimensions, ONLY: dense
USE fft_base, ONLY: dfftp
USE gvect, ONLY: nl, eigts1, eigts2, eigts3, mill
USE lsda_mod, ONLY: current_spin
USE uspp, ONLY: becsum
@ -30,8 +30,8 @@ SUBROUTINE addusdens1d (plan, prho)
! here the local variables
!
IMPLICIT NONE
INTEGER :: ig, na, nt, ih, jh, ijh, ngm1d, ig1dto3d (dense%nr3), &
igtongl1d (dense%nr3), nl1d (dense%nr3)
INTEGER :: ig, na, nt, ih, jh, ijh, ngm1d, ig1dto3d (dfftp%nr3), &
igtongl1d (dfftp%nr3), nl1d (dfftp%nr3)
! counter on G vectors
! counter on atoms
! counter on atomic types
@ -43,8 +43,8 @@ SUBROUTINE addusdens1d (plan, prho)
! the correspondence 1D with the 3D shells
! correspondence 1D FFT mesh G with array G
real(DP) :: plan (dense%nr3), dimz, g1d (3, dense%nr3), gg1d (dense%nr3), qmod (dense%nr3), &
qgr (dense%nr3), qgi (dense%nr3), ylmk0 (dense%nr3, lmaxq * lmaxq)
real(DP) :: plan (dfftp%nr3), dimz, g1d (3, dfftp%nr3), gg1d (dfftp%nr3), qmod (dfftp%nr3), &
qgr (dfftp%nr3), qgi (dfftp%nr3), ylmk0 (dfftp%nr3, lmaxq * lmaxq)
! the planar average
! dimension along z
! ngm1d 3D vectors with the 1D G of this proc
@ -54,7 +54,7 @@ SUBROUTINE addusdens1d (plan, prho)
! imaginary part of qg
! the spherical harmonics
COMPLEX(DP) :: skk, prho (dense%nrxx), qg (dense%nr3x)
COMPLEX(DP) :: skk, prho (dfftp%nnr), qg (dfftp%nr3x)
! auxiliary variable
! auxiliary space for the charge
! auxiliary variable for FFT
@ -112,12 +112,12 @@ SUBROUTINE addusdens1d (plan, prho)
CALL mp_sum( qg, intra_pool_comm )
#endif
dimz = alat * celldm (3)
DO ig = 1, dense%nr3
DO ig = 1, dfftp%nr3
qgr (ig) = dble (qg (ig) )
qgi (ig) = aimag (qg (ig) )
ENDDO
CALL cft (qgr, qgi, dense%nr3, dense%nr3, dense%nr3, 1)
DO ig = 1, dense%nr3
CALL cft (qgr, qgi, dfftp%nr3, dfftp%nr3, dfftp%nr3, 1)
DO ig = 1, dfftp%nr3
plan (ig) = qgr (ig) * omega / dimz
ENDDO
DEALLOCATE (aux, qgm)

64
PP/average.f90
View File

@ -48,9 +48,9 @@ PROGRAM average
USE gvect, ONLY : gcutm
USE gvecs, ONLY : doublegrid, gcutms, dual
USE wvfct, ONLY : ecutwfc
USE grid_dimensions, ONLY : dense
USE fft_base, ONLY : dfftp
USE grid_subroutines, ONLY : realspace_grids_init
USE smooth_grid_dimensions,ONLY: smooth
USE fft_base, ONLY : dffts
USE ions_base, ONLY : zv, tau, nat, ntyp => nsp, ityp, atm
USE lsda_mod, ONLY : nspin
USE wavefunctions_module, ONLY : psic
@ -132,7 +132,7 @@ PROGRAM average
1100 CALL errore ('average', 'readin input', abs (ios) )
CALL read_io_header(filename (1), title, dense%nr1x, dense%nr2x, dense%nr3x, dense%nr1, dense%nr2, dense%nr3, &
CALL read_io_header(filename (1), title, dfftp%nr1x, dfftp%nr2x, dfftp%nr3x, dfftp%nr1, dfftp%nr2, dfftp%nr3, &
nat, ntyp, ibrav, celldm, at, gcutm, dual, ecutwfc, plot_num)
nspin = 1
CALL latgen (ibrav, celldm, at(1,1), at(1,2), at(1,3), omega )
@ -144,16 +144,16 @@ PROGRAM average
tpiba2 = tpiba**2
IF (idir==1) THEN
nfft=dense%nr1
nfftx=dense%nr1x
nfft=dfftp%nr1
nfftx=dfftp%nr1x
leng=alat*sqrt(at(1,1)**2+at(2,1)**2+at(3,1)**2)
ELSEIF (idir==2) THEN
nfft=dense%nr2
nfftx=dense%nr2x
nfft=dfftp%nr2
nfftx=dfftp%nr2x
leng=alat*sqrt(at(1,2)**2+at(2,2)**2+at(3,2)**2)
ELSEIF (idir==3) THEN
nfft=dense%nr3
nfftx=dense%nr3x
nfft=dfftp%nr3
nfftx=dfftp%nr3x
leng=alat*sqrt(at(1,3)**2+at(2,3)**2+at(3,3)**2)
ELSE
CALL errore('average','idir is wrong',1)
@ -170,13 +170,13 @@ PROGRAM average
ENDIF
! not sure whether this is the correct thing to do in presence
! of a double grid, but the info on nrXs is not read from file!
smooth%nr1 = dense%nr1 ; smooth%nr2 = dense%nr2 ; smooth%nr3 = dense%nr3
dffts%nr1 = dfftp%nr1 ; dffts%nr2 = dfftp%nr2 ; dffts%nr3 = dfftp%nr3
! as above: this can be used in allocate_fft
nks = 0
CALL volume (alat, at (1, 1), at (1, 2), at (1, 3), omega)
CALL realspace_grids_init ( dense, smooth, at, bg, gcutm, gcutms )
CALL realspace_grids_init ( dfftp, dffts, at, bg, gcutm, gcutms )
CALL allocate_fft ( )
!
@ -184,11 +184,11 @@ PROGRAM average
!
! Read first file
!
CALL plot_io (filename (1), title, dense%nr1x, dense%nr2x, dense%nr3x, dense%nr1, dense%nr2, &
dense%nr3, nat, ntyp, ibrav, celldm, at, gcutm, dual, ecutwfc, &
CALL plot_io (filename (1), title, dfftp%nr1x, dfftp%nr2x, dfftp%nr3x, dfftp%nr1, dfftp%nr2, &
dfftp%nr3, nat, ntyp, ibrav, celldm, at, gcutm, dual, ecutwfc, &
plot_num, atm, ityp, zv, tau, rho%of_r, -1)
!
DO ir = 1, dense%nrxx
DO ir = 1, dfftp%nnr
psic (ir) = weight (1) * cmplx(rho%of_r(ir, 1),0.d0,kind=DP)
ENDDO
!
@ -211,9 +211,9 @@ PROGRAM average
DEALLOCATE (taus)
!
IF (nats>nat) CALL errore ('chdens', 'wrong file order? ', 1)
IF (dense%nr1x/=nr1sxa.or.dense%nr2x/=nr2sxa) &
IF (dfftp%nr1x/=nr1sxa.or.dfftp%nr2x/=nr2sxa) &
CALL errore ('average', 'incompatible nr1x or nr2x', 1)
IF (dense%nr1/=nr1sa.or.dense%nr2/=nr2sa.or.dense%nr3/=nr3sa) &
IF (dfftp%nr1/=nr1sa.or.dfftp%nr2/=nr2sa.or.dfftp%nr3/=nr3sa) &
CALL errore ('average', 'incompatible nr1 or nr2 or nr3', 1)
IF (ibravs/=ibrav) CALL errore ('average', 'incompatible ibrav', 1)
IF (gcutmsa/=gcutm.or.duals/=dual.or.ecuts/=ecutwfc ) &
@ -222,7 +222,7 @@ PROGRAM average
IF (abs( celldm (i)-celldms (i) ) > 1.0d-7 ) &
CALL errore ('chdens', 'incompatible celldm', 1)
ENDDO
DO ir = 1, dense%nrxx
DO ir = 1, dfftp%nnr
psic (ir) = psic (ir) + weight(ifile) * cmplx(rho%of_r(ir, 1),0.d0,kind=DP)
ENDDO
ENDDO
@ -236,40 +236,40 @@ PROGRAM average
! planar averages
!
IF (idir==1) THEN
DO i = 1, dense%nr1
DO i = 1, dfftp%nr1
funcr (i) = 0.d0
funci (i) = 0.d0
DO j = 1, dense%nr2
DO k = 1, dense%nr3
ir = i + (j - 1) * dense%nr1x + (k - 1) * dense%nr1x * dense%nr2x
DO j = 1, dfftp%nr2
DO k = 1, dfftp%nr3
ir = i + (j - 1) * dfftp%nr1x + (k - 1) * dfftp%nr1x * dfftp%nr2x
funcr (i) = funcr (i) + dble (psic(ir))
ENDDO
ENDDO
funcr (i) = funcr (i) / (dble (dense%nr2 * dense%nr3))
funcr (i) = funcr (i) / (dble (dfftp%nr2 * dfftp%nr3))
ENDDO
ELSEIF (idir==2) THEN
DO j = 1, dense%nr2
DO j = 1, dfftp%nr2
funcr (j) = 0.d0
funci (j) = 0.d0
DO i = 1, dense%nr1
DO k = 1, dense%nr3
ir = i + (j - 1) * dense%nr1x + (k - 1) * dense%nr1x * dense%nr2x
DO i = 1, dfftp%nr1
DO k = 1, dfftp%nr3
ir = i + (j - 1) * dfftp%nr1x + (k - 1) * dfftp%nr1x * dfftp%nr2x
funcr (j) = funcr (j) + dble (psic (ir) )
ENDDO
ENDDO
funcr (j) = funcr (j) / (dble (dense%nr1 * dense%nr3) )
funcr (j) = funcr (j) / (dble (dfftp%nr1 * dfftp%nr3) )
ENDDO
ELSEIF (idir==3) THEN
DO k = 1, dense%nr3
DO k = 1, dfftp%nr3
funcr (k) = 0.d0
funci (k) = 0.d0
DO j = 1, dense%nr2
DO i = 1, dense%nr1
ir = i + (j - 1) * dense%nr1x + (k - 1) * dense%nr1x * dense%nr2x
DO j = 1, dfftp%nr2
DO i = 1, dfftp%nr1
ir = i + (j - 1) * dfftp%nr1x + (k - 1) * dfftp%nr1x * dfftp%nr2x
funcr (k) = funcr (k) + dble (psic (ir) )
ENDDO
ENDDO
funcr (k) = funcr (k) / (dble (dense%nr1 * dense%nr2) )
funcr (k) = funcr (k) / (dble (dfftp%nr1 * dfftp%nr2) )
ENDDO
ELSE
CALL errore('average','wrong idir',1)

38
PP/chdens.f90
View File

@ -24,10 +24,8 @@ SUBROUTINE chdens (filplot,plot_num)
USE cell_base
USE ions_base, ONLY : nat, ityp, atm, ntyp => nsp, tau, zv
USE lsda_mod, ONLY : nspin
USE fft_base, ONLY : grid_scatter, dfftp
USE fft_base, ONLY : grid_scatter, dfftp, dffts
USE fft_interfaces, ONLY : fwfft
USE grid_dimensions, ONLY : dense
USE smooth_grid_dimensions, ONLY : smooth
USE grid_subroutines,ONLY : realspace_grids_init
USE gvect
USE gvecs
@ -201,16 +199,16 @@ SUBROUTINE chdens (filplot,plot_num)
!
IF (plot_num==-1) THEN
IF (ionode) &
CALL read_io_header(filepp (1), title, dense%nr1x, dense%nr2x, dense%nr3x, dense%nr1, dense%nr2, &
dense%nr3, nat, ntyp, ibrav, celldm, at, gcutm, dual, ecutwfc, &
CALL read_io_header(filepp (1), title, dfftp%nr1x, dfftp%nr2x, dfftp%nr3x, dfftp%nr1, dfftp%nr2, &
dfftp%nr3, nat, ntyp, ibrav, celldm, at, gcutm, dual, ecutwfc, &
idum )
CALL mp_bcast( title, ionode_id )
CALL mp_bcast( dense%nr1x, ionode_id )
CALL mp_bcast( dense%nr2x, ionode_id )
CALL mp_bcast( dense%nr3x, ionode_id )
CALL mp_bcast( dense%nr1, ionode_id )
CALL mp_bcast( dense%nr2, ionode_id )
CALL mp_bcast( dense%nr3, ionode_id )
CALL mp_bcast( dfftp%nr1x, ionode_id )
CALL mp_bcast( dfftp%nr2x, ionode_id )
CALL mp_bcast( dfftp%nr3x, ionode_id )
CALL mp_bcast( dfftp%nr1, ionode_id )
CALL mp_bcast( dfftp%nr2, ionode_id )
CALL mp_bcast( dfftp%nr3, ionode_id )
CALL mp_bcast( nat, ionode_id )
CALL mp_bcast( ntyp, ionode_id )
CALL mp_bcast( ibrav, ionode_id )
@ -242,11 +240,11 @@ SUBROUTINE chdens (filplot,plot_num)
CALL recips (at(1,1), at(1,2), at(1,3), bg(1,1), bg(1,2), bg(1,3) )
CALL volume (alat, at(1,1), at(1,2), at(1,3), omega)
CALL realspace_grids_init ( dense, smooth, at, bg, gcutm, gcutms )
CALL realspace_grids_init ( dfftp, dffts, at, bg, gcutm, gcutms )
ENDIF
ALLOCATE (rhor(dense%nr1x*dense%nr2x*dense%nr3x))
ALLOCATE (rhos(dense%nr1x*dense%nr2x*dense%nr3x))
ALLOCATE (rhor(dfftp%nr1x*dfftp%nr2x*dfftp%nr3x))
ALLOCATE (rhos(dfftp%nr1x*dfftp%nr2x*dfftp%nr3x))
ALLOCATE (taus( 3 , nat))
ALLOCATE (ityps( nat))
!
@ -269,9 +267,9 @@ SUBROUTINE chdens (filplot,plot_num)
ENDIF
!
IF (nats>nat) CALL errore ('chdens', 'wrong file order? ', 1)
IF (dense%nr1x/=nr1sxa.or.dense%nr2x/=nr2sxa) CALL &
IF (dfftp%nr1x/=nr1sxa.or.dfftp%nr2x/=nr2sxa) CALL &
errore ('chdens', 'incompatible nr1x or nr2x', 1)
IF (dense%nr1/=nr1sa.or.dense%nr2/=nr2sa.or.dense%nr3/=nr3sa) CALL &
IF (dfftp%nr1/=nr1sa.or.dfftp%nr2/=nr2sa.or.dfftp%nr3/=nr3sa) CALL &
errore ('chdens', 'incompatible nr1 or nr2 or nr3', 1)
IF (ibravs/=ibrav) CALL errore ('chdens', 'incompatible ibrav', 1)
IF (abs(gcutmsa-gcutm)>1.d-8.or.abs(duals-dual)>1.d-8.or.&
@ -371,7 +369,7 @@ SUBROUTINE chdens (filplot,plot_num)
!
ENDIF
#ifdef __PARA
ALLOCATE(aux(dense%nrxx))
ALLOCATE(aux(dfftp%nnr))
CALL grid_scatter(rhor, aux)
psic(:) = cmplx(aux(:), 0.d0,kind=DP)
DEALLOCATE(aux)
@ -429,14 +427,14 @@ SUBROUTINE chdens (filplot,plot_num)
!
CALL xsf_struct (alat, at, nat, tau, atm, ityp, ounit)
CALL xsf_fast_datagrid_3d &
(rhor, dense%nr1, dense%nr2, dense%nr3, dense%nr1x, dense%nr2x, dense%nr3x, at, alat, ounit)
(rhor, dfftp%nr1, dfftp%nr2, dfftp%nr3, dfftp%nr1x, dfftp%nr2x, dfftp%nr3x, at, alat, ounit)
ELSEIF (output_format == 6.and.ionode ) THEN
!
! GAUSSIAN CUBE FORMAT
!
CALL write_cubefile (alat, at, bg, nat, tau, atm, ityp, rhor, &
dense%nr1, dense%nr2, dense%nr3, dense%nr1x, dense%nr2x, dense%nr3x, ounit)
dfftp%nr1, dfftp%nr2, dfftp%nr3, dfftp%nr1x, dfftp%nr2x, dfftp%nr3x, ounit)
ELSE
!
@ -447,7 +445,7 @@ SUBROUTINE chdens (filplot,plot_num)
IF (fast3d) THEN
CALL plot_fast (celldm (1), at, nat, tau, atm, ityp, &
dense%nr1x, dense%nr2x, dense%nr3x, dense%nr1, dense%nr2, dense%nr3, rhor, &
dfftp%nr1x, dfftp%nr2x, dfftp%nr3x, dfftp%nr1, dfftp%nr2, dfftp%nr3, rhor, &
bg, m1, m2, m3, x0, e1, e2, e3, output_format, ounit, &
rhotot)
ELSE

9
PP/compute_sigma_avg.f90
View File

@ -20,13 +20,12 @@ SUBROUTINE compute_sigma_avg(sigma_avg,becp_nc,ik,lsigma)
USE wavefunctions_module, ONLY : evc, psic_nc
USE klist, ONLY : nks, xk
USE gvect, ONLY : g,gg
USE grid_dimensions, ONLY : dense
USE gvecs, ONLY : nls, nlsm, doublegrid
USE gvecs, ONLY : nls, nlsm, doublegrid
USE scf, ONLY : rho
USE ions_base, ONLY : nat, ntyp => nsp, ityp
USE mp_global, ONLY : me_pool, intra_pool_comm
USE mp, ONLY : mp_sum
USE fft_base, ONLY : dffts
USE fft_base, ONLY : dffts, dfftp
USE fft_interfaces, ONLY : invfft
@ -186,11 +185,11 @@ SUBROUTINE compute_sigma_avg(sigma_avg,becp_nc,ik,lsigma)
DO ipol=1,3
IF (lsigma(ipol)) THEN
DO ir = 1,dense%nrxx
DO ir = 1,dfftp%nnr
magtot1(ipol) = magtot1(ipol) + rho%of_r(ir,ipol+1)
ENDDO
CALL mp_sum( magtot1(ipol), intra_pool_comm )
magtot1(ipol) = magtot1(ipol) / ( dense%nr1 * dense%nr2 * dense%nr3 )
magtot1(ipol) = magtot1(ipol) / ( dfftp%nr1 * dfftp%nr2 * dfftp%nr3 )
ENDIF
ENDDO

4
PP/do_initial_state.f90
View File

@ -25,7 +25,7 @@ SUBROUTINE do_initial_state (excite)
USE cell_base, ONLY : at, bg, alat, omega
USE ions_base, ONLY : nat, ntyp => nsp, ityp, tau, zv
USE gvect, ONLY : ngm, gstart, ngl, nl, igtongl, g, gg, gcutm, eigts1, eigts2, eigts3
USE grid_dimensions, ONLY : dense
USE fft_base, ONLY : dfftp
USE lsda_mod, ONLY : nspin
USE symme, ONLY : symscalar
USE vlocal, ONLY : strf, vloc
@ -114,7 +114,7 @@ SUBROUTINE do_initial_state (excite)
! ... The local contribution
!
CALL add_shift_lc( nat, tau, ityp, alat, omega, ngm, ngl, igtongl, &
dense%nrxx, g, rho%of_r, nl, nspin, &
dfftp%nnr, g, rho%of_r, nl, nspin, &
gstart, gamma_only, vloc, shift_lc )
!
! ... The NLCC contribution

10
PP/ggen1d.f90
View File

@ -15,15 +15,15 @@ SUBROUTINE ggen1d (ngm1d, g1d, gg1d, ig1dto3d, nl1d, igtongl1d)
USE kinds, ONLY: DP
USE cell_base, ONLY : at
USE gvect, ONLY: ngm, g, gg, igtongl
USE grid_dimensions, ONLY: dense
USE fft_base, ONLY: dfftp
IMPLICIT NONE
INTEGER :: ngm1d, ig1dto3d (dense%nr3), igtongl1d (dense%nr3), nl1d (dense%nr3)
INTEGER :: ngm1d, ig1dto3d (dfftp%nr3), igtongl1d (dfftp%nr3), nl1d (dfftp%nr3)
! output: the number of 1D G vectors on this processor
! output: correspondence 1D with 3D G vectors
! output: the correspondence with the shells
! output: correspondence 1D FFT mesh G with array
real(DP) :: g1d (3, dense%nr3), gg1d (dense%nr3)
real(DP) :: g1d (3, dfftp%nr3), gg1d (dfftp%nr3)
! output: ngm1d 3D vectors with the 1D G of this
! output: ngm1d scalars with the modulus of 1D G
!
@ -47,12 +47,12 @@ SUBROUTINE ggen1d (ngm1d, g1d, gg1d, ig1dto3d, nl1d, igtongl1d)
! a vector of the 1D grid has been found
!
ig1d = ig1d+1
IF (ig1d>dense%nr3) CALL errore ('ggen1d', 'too many G', 1)
IF (ig1d>dfftp%nr3) CALL errore ('ggen1d', 'too many G', 1)
g1d (3, ig1d) = g (3, ig)
gg1d (ig1d) = gg (ig)
ig1dto3d (ig1d) = ig
nl1d (ig1d) = nint (g (3, ig) * at (3, 3) ) + 1
IF (nl1d (ig1d) <1) nl1d (ig1d) = nl1d (ig1d) + dense%nr3
IF (nl1d (ig1d) <1) nl1d (ig1d) = nl1d (ig1d) + dfftp%nr3
ENDIF
ENDDO

8
PP/local_dos_mag.f90
View File

@ -20,8 +20,8 @@ SUBROUTINE local_dos_mag(spin_component, kpoint, kband, raux)
USE fft_base, ONLY : dffts
USE fft_interfaces, ONLY : invfft
USE gvect, ONLY : ngm, g
USE grid_dimensions, ONLY : dense
USE gvecs, ONLY : nls, doublegrid
USE fft_base, ONLY : dfftp
USE gvecs, ONLY : nls, doublegrid
USE klist, ONLY : nks, xk
USE scf, ONLY : rho
USE io_files, ONLY : iunwfc, nwordwfc
@ -38,7 +38,7 @@ SUBROUTINE local_dos_mag(spin_component, kpoint, kband, raux)
! ... local variables
!
INTEGER :: spin_component, kpoint, kband
REAL(DP) :: raux(dense%nrxx)
REAL(DP) :: raux(dfftp%nnr)
INTEGER :: ikb, jkb, ijkb0, ih, jh, ijh, na, np
! counters on beta functions, atoms, pseudopotentials
@ -263,7 +263,7 @@ SUBROUTINE local_dos_mag(spin_component, kpoint, kband, raux)
!
IF ( okvan ) CALL addusdens(rho%of_r(:,:))
DO ir=1,dense%nrxx
DO ir=1,dfftp%nnr
raux(ir)=rho%of_r(ir,spin_component+1)
ENDDO
!

19
PP/make.depend
View File

@ -33,7 +33,7 @@ add_shift_us.o : ../PW/becmod.o
add_shift_us.o : ../PW/pwcom.o
add_shift_us.o : ../PW/symme.o
addusdens1d.o : ../Modules/cell_base.o
addusdens1d.o : ../Modules/griddim.o
addusdens1d.o : ../Modules/fft_base.o
addusdens1d.o : ../Modules/ions_base.o
addusdens1d.o : ../Modules/kind.o
addusdens1d.o : ../Modules/mp.o
@ -52,6 +52,7 @@ atomic_wfc_nc_proj.o : ../PW/pwcom.o
average.o : ../Modules/cell_base.o
average.o : ../Modules/constants.o
average.o : ../Modules/environment.o
average.o : ../Modules/fft_base.o
average.o : ../Modules/griddim.o
average.o : ../Modules/io_files.o
average.o : ../Modules/io_global.o
@ -118,7 +119,6 @@ compute_ppsi.o : ../PW/pwcom.o
compute_sigma_avg.o : ../Modules/cell_base.o
compute_sigma_avg.o : ../Modules/fft_base.o
compute_sigma_avg.o : ../Modules/fft_interfaces.o
compute_sigma_avg.o : ../Modules/griddim.o
compute_sigma_avg.o : ../Modules/ions_base.o
compute_sigma_avg.o : ../Modules/kind.o
compute_sigma_avg.o : ../Modules/mp.o
@ -143,7 +143,7 @@ d_matrix_so.o : ../PW/pwcom.o
d_matrix_so.o : ../PW/symm_base.o
do_initial_state.o : ../Modules/cell_base.o
do_initial_state.o : ../Modules/control_flags.o
do_initial_state.o : ../Modules/griddim.o
do_initial_state.o : ../Modules/fft_base.o
do_initial_state.o : ../Modules/io_global.o
do_initial_state.o : ../Modules/ions_base.o
do_initial_state.o : ../Modules/kind.o
@ -197,7 +197,7 @@ epsilon.o : ../Modules/xml_io_base.o
epsilon.o : ../PW/pwcom.o
epsilon.o : ../iotk/src/iotk_module.o
ggen1d.o : ../Modules/cell_base.o
ggen1d.o : ../Modules/griddim.o
ggen1d.o : ../Modules/fft_base.o
ggen1d.o : ../Modules/kind.o
ggen1d.o : ../Modules/recvec.o
hexspinsym.o : ../Modules/kind.o
@ -245,7 +245,6 @@ local_dos1d.o : ../PW/pwcom.o
local_dos_mag.o : ../Modules/cell_base.o
local_dos_mag.o : ../Modules/fft_base.o
local_dos_mag.o : ../Modules/fft_interfaces.o
local_dos_mag.o : ../Modules/griddim.o
local_dos_mag.o : ../Modules/io_files.o
local_dos_mag.o : ../Modules/ions_base.o
local_dos_mag.o : ../Modules/kind.o
@ -296,7 +295,7 @@ pawplot.o : ../PW/scf_mod.o
plan_avg.o : ../Modules/cell_base.o
plan_avg.o : ../Modules/control_flags.o
plan_avg.o : ../Modules/environment.o
plan_avg.o : ../Modules/griddim.o
plan_avg.o : ../Modules/fft_base.o
plan_avg.o : ../Modules/io_files.o
plan_avg.o : ../Modules/io_global.o
plan_avg.o : ../Modules/ions_base.o
@ -330,7 +329,7 @@ poormanwannier.o : ../PW/symm_base.o
postproc.o : ../Modules/cell_base.o
postproc.o : ../Modules/control_flags.o
postproc.o : ../Modules/environment.o
postproc.o : ../Modules/griddim.o
postproc.o : ../Modules/fft_base.o
postproc.o : ../Modules/io_files.o
postproc.o : ../Modules/io_global.o
postproc.o : ../Modules/ions_base.o
@ -349,7 +348,6 @@ projwfc.o : ../Modules/descriptors.o
projwfc.o : ../Modules/environment.o
projwfc.o : ../Modules/fft_base.o
projwfc.o : ../Modules/fft_interfaces.o
projwfc.o : ../Modules/griddim.o
projwfc.o : ../Modules/io_files.o
projwfc.o : ../Modules/io_global.o
projwfc.o : ../Modules/ions_base.o
@ -426,7 +424,7 @@ pw2wannier90.o : ../PW/noncol.o
pw2wannier90.o : ../PW/pwcom.o
pw_export.o : ../Modules/control_flags.o
pw_export.o : ../Modules/environment.o
pw_export.o : ../Modules/griddim.o
pw_export.o : ../Modules/fft_base.o
pw_export.o : ../Modules/io_files.o
pw_export.o : ../Modules/io_global.o
pw_export.o : ../Modules/ions_base.o
@ -470,7 +468,6 @@ sym_band.o : ../Modules/cell_base.o
sym_band.o : ../Modules/constants.o
sym_band.o : ../Modules/fft_base.o
sym_band.o : ../Modules/fft_interfaces.o
sym_band.o : ../Modules/griddim.o
sym_band.o : ../Modules/io_files.o
sym_band.o : ../Modules/io_global.o
sym_band.o : ../Modules/ions_base.o
@ -507,7 +504,6 @@ wannier_plot.o : ../Modules/constants.o
wannier_plot.o : ../Modules/environment.o
wannier_plot.o : ../Modules/fft_base.o
wannier_plot.o : ../Modules/fft_interfaces.o
wannier_plot.o : ../Modules/griddim.o
wannier_plot.o : ../Modules/io_files.o
wannier_plot.o : ../Modules/io_global.o
wannier_plot.o : ../Modules/ions_base.o
@ -527,7 +523,6 @@ wfdd.o : ../Modules/constants.o
work_function.o : ../Modules/cell_base.o
work_function.o : ../Modules/constants.o
work_function.o : ../Modules/fft_base.o
work_function.o : ../Modules/griddim.o
work_function.o : ../Modules/io_global.o
work_function.o : ../Modules/mp.o
work_function.o : ../Modules/recvec.o

24
PP/plan_avg.f90
View File

@ -15,7 +15,7 @@ PROGRAM plan_avg
USE kinds, ONLY : DP
USE printout_base, ONLY: title
USE cell_base, ONLY : ibrav, celldm, at
USE grid_dimensions, ONLY : dense
USE fft_base, ONLY : dfftp
USE gvect, ONLY : gcutm
USE gvecs, ONLY : dual
USE klist, ONLY : nkstot, xk
@ -87,7 +87,7 @@ PROGRAM plan_avg
CALL openfil_pp ( )
!
ALLOCATE (averag( nat, nbnd, nkstot))
ALLOCATE (plan(dense%nr3, nbnd, nkstot))
ALLOCATE (plan(dfftp%nr3, nbnd, nkstot))
!
CALL do_plan_avg (averag, plan, ninter)
!
@ -97,7 +97,7 @@ PROGRAM plan_avg
STATUS = 'unknown', err = 100, IOSTAT = ios)
100 CALL errore ('plan_avg', 'opening file '//trim(filplot), abs (ios) )
WRITE (iunplot, '(a)') title
WRITE (iunplot, '(8i8)') dense%nr1x, dense%nr2x, dense%nr3x, dense%nr1, dense%nr2, dense%nr3, nat, ntyp
WRITE (iunplot, '(8i8)') dfftp%nr1x, dfftp%nr2x, dfftp%nr3x, dfftp%nr1, dfftp%nr2, dfftp%nr3, nat, ntyp
WRITE (iunplot, '(i6,6f12.8)') ibrav, celldm
IF (ibrav == 0) THEN
WRITE ( iunplot, * ) at(:,1)
@ -117,7 +117,7 @@ PROGRAM plan_avg
ik) , ibnd
WRITE (iunplot, '(4(1pe17.9))') (averag (ir, ibnd, ik) , ir = 1, &
ninter)
DO ir = 1, dense%nr3
DO ir = 1, dfftp%nr3
WRITE (iunplot, * ) ir, plan (ir, ibnd, ik)
ENDDO
ENDDO
@ -161,7 +161,7 @@ SUBROUTINE do_plan_avg (averag, plan, ninter)
IMPLICIT NONE
INTEGER :: ninter
! output: the number of planes
real(DP) :: averag (nat, nbnd, nkstot), plan (dense%nr3, nbnd, nkstot)
real(DP) :: averag (nat, nbnd, nkstot), plan (dfftp%nr3, nbnd, nkstot)
! output: the average charge on ea
! output: the planar average
!
@ -215,8 +215,8 @@ SUBROUTINE do_plan_avg (averag, plan, ninter)
!
DO iin = 1, ninter
z1 (iin) = mod (avg (iin), celldm (3) ) / ntau (iin)
ind = (z1 (iin) / celldm (3) ) * dense%nr3 + 1
IF (ind<=0) ind = ind+dense%nr3
ind = (z1 (iin) / celldm (3) ) * dfftp%nr3 + 1
IF (ind<=0) ind = ind+dfftp%nr3
i1 (iin) = ind
ENDDO
!
@ -232,7 +232,7 @@ SUBROUTINE do_plan_avg (averag, plan, ninter)
ENDIF
ENDDO
ENDDO
ntau (ninter + 1) = ntau (1) + dense%nr3
ntau (ninter + 1) = ntau (1) + dfftp%nr3
!
! and compute the point associated to each plane
!
@ -262,23 +262,23 @@ SUBROUTINE do_plan_avg (averag, plan, ninter)
DO ir = 1, i1 (1) - 1
averag (1, ibnd, ik) = averag (1, ibnd, ik) + plan (ir, ibnd, ik)
ENDDO
DO ir = i1 (ninter), dense%nr3
DO ir = i1 (ninter), dfftp%nr3
averag (1, ibnd, ik) = averag (1, ibnd, ik) + plan (ir, ibnd, ik)
ENDDO
averag (1, ibnd, ik) = averag (1, ibnd, ik) * zdim / dense%nr3
averag (1, ibnd, ik) = averag (1, ibnd, ik) * zdim / dfftp%nr3
sum = averag (1, ibnd, ik)
DO iin = 2, ninter
DO ir = i1 (iin - 1), i1 (iin) - 1
averag(iin,ibnd,ik) = averag(iin,ibnd,ik) + plan(ir,ibnd,ik)
ENDDO
averag (iin, ibnd, ik) = averag (iin, ibnd, ik) * zdim / dense%nr3
averag (iin, ibnd, ik) = averag (iin, ibnd, ik) * zdim / dfftp%nr3
sum = sum + averag (iin, ibnd, ik)
ENDDO
ENDDO
ENDDO
CALL deallocate_bec_type (becp)
#ifdef __PARA
CALL poolrecover (plan, dense%nr3 * nbnd, nkstot, nks)
CALL poolrecover (plan, dfftp%nr3 * nbnd, nkstot, nks)
CALL poolrecover (averag, nat * nbnd, nkstot, nks)
CALL poolrecover (xk, 3, nkstot, nks)
#endif

4
PP/postproc.f90
View File

@ -62,7 +62,7 @@ SUBROUTINE extract (filplot,plot_num)
USE ener, ONLY : ef
USE ions_base, ONLY : nat, ntyp=>nsp, ityp, tau
USE gvect
USE grid_dimensions, ONLY : dense
USE fft_base, ONLY : dfftp
USE klist, ONLY : two_fermi_energies
USE vlocal, ONLY : strf
USE io_files, ONLY : tmp_dir, prefix
@ -181,7 +181,7 @@ SUBROUTINE extract (filplot,plot_num)
! 'post-processing paw routines not yet tested',1)
CALL openfil_pp ( )
CALL struc_fact (nat, tau, ntyp, ityp, ngm, g, bg, dense%nr1, dense%nr2, dense%nr3, &
CALL struc_fact (nat, tau, ntyp, ityp, ngm, g, bg, dfftp%nr1, dfftp%nr2, dfftp%nr3, &
strf, eigts1, eigts2, eigts3)
! CALL init_us_1 ( )
!

18
PP/projwfc.f90
View File

@ -334,7 +334,7 @@ SUBROUTINE projwave( filproj, lsym, lgww )
USE constants, ONLY: rytoev, eps4
USE gvect
USE gvecs, ONLY: dual
USE grid_dimensions, ONLY : dense
USE fft_base, ONLY : dfftp
USE klist, ONLY: xk, nks, nkstot, nelec
USE ldaU
USE lsda_mod, ONLY: nspin, isk, current_spin
@ -663,8 +663,8 @@ SUBROUTINE projwave( filproj, lsym, lgww )
nkslast=nkstot
ENDIF
iunproj=33
CALL write_io_header(filename, iunproj, title, dense%nr1x, dense%nr2x, dense%nr3x, &
dense%nr1, dense%nr2, dense%nr3, nat, ntyp, ibrav, celldm, at, gcutm, dual, &
CALL write_io_header(filename, iunproj, title, dfftp%nr1x, dfftp%nr2x, dfftp%nr3x, &
dfftp%nr1, dfftp%nr2, dfftp%nr3, nat, ntyp, ibrav, celldm, at, gcutm, dual, &
ecutwfc, nkstot/nspin, nbnd, natomwfc)
DO nwfc = 1, natomwfc
WRITE(iunproj,'(2i5,a3,3i5)') &
@ -820,7 +820,7 @@ SUBROUTINE projwave_nc(filproj, lsym )
USE constants, ONLY: rytoev, eps4
USE gvect
USE gvecs, ONLY: dual
USE grid_dimensions, ONLY : dense
USE fft_base, ONLY : dfftp
USE klist, ONLY: xk, nks, nkstot, nelec
USE ldaU
USE lsda_mod, ONLY: nspin
@ -1195,8 +1195,8 @@ SUBROUTINE projwave_nc(filproj, lsym )
!
IF (filproj/=' ') THEN
iunproj=33
CALL write_io_header(filproj, iunproj, title, dense%nr1x, dense%nr2x, dense%nr3x, &
dense%nr1, dense%nr2, dense%nr3, nat, ntyp, ibrav, celldm, at, gcutm, dual, ecutwfc, &
CALL write_io_header(filproj, iunproj, title, dfftp%nr1x, dfftp%nr2x, dfftp%nr3x, &
dfftp%nr1, dfftp%nr2, dfftp%nr3, nat, ntyp, ibrav, celldm, at, gcutm, dual, ecutwfc, &
nkstot,nbnd,natomwfc)
DO nwfc = 1, natomwfc
IF (lspinorb) THEN
@ -2116,7 +2116,7 @@ SUBROUTINE pprojwave( filproj, lsym )
USE constants, ONLY: rytoev, eps4
USE gvect
USE gvecs, ONLY: dual
USE grid_dimensions, ONLY : dense
USE fft_base, ONLY : dfftp
USE klist, ONLY: xk, nks, nkstot, nelec
USE ldaU
USE lsda_mod, ONLY: nspin, isk, current_spin
@ -2531,8 +2531,8 @@ SUBROUTINE pprojwave( filproj, lsym )
nkslast=nkstot
ENDIF
iunproj=33
CALL write_io_header(filename, iunproj, title, dense%nr1x, dense%nr2x, dense%nr3x, &
dense%nr1, dense%nr2, dense%nr3, nat, ntyp, ibrav, celldm, at, gcutm, dual, &
CALL write_io_header(filename, iunproj, title, dfftp%nr1x, dfftp%nr2x, dfftp%nr3x, &
dfftp%nr1, dfftp%nr2, dfftp%nr3, nat, ntyp, ibrav, celldm, at, gcutm, dual, &
ecutwfc, nkstot/nspin,nbnd,natomwfc)
DO nwfc = 1, natomwfc
WRITE(iunproj,'(2i5,a3,3i5)') &

14
PP/pw_export.f90
View File

@ -268,7 +268,7 @@ PROGRAM pw_export
USE wrappers, ONLY : f_mkdir
USE pwcom
USE grid_dimensions, ONLY : dense
USE fft_base, ONLY : dfftp
USE io_global, ONLY : stdout, ionode, ionode_id
USE io_files, ONLY : psfile, pseudo_dir
USE io_files, ONLY : prefix, tmp_dir, outdir
@ -631,9 +631,9 @@ SUBROUTINE write_export (pp_file,kunit,uspp_spsi, ascii, single_file, raw)
CALL iotk_write_attr ( attr,"name", trim(sname(i)), FIRST=.true. )
CALL iotk_write_empty(50,"info"//trim(iotk_index(i)), ATTR=attr )
!
tmp(1) = ftau(1,i) / dble( dense%nr1 )
tmp(2) = ftau(2,i) / dble( dense%nr2 )
tmp(3) = ftau(3,i) / dble( dense%nr3 )
tmp(1) = ftau(1,i) / dble( dfftp%nr1 )
tmp(2) = ftau(2,i) / dble( dfftp%nr2 )
tmp(3) = ftau(3,i) / dble( dfftp%nr3 )
!
CALL iotk_write_attr(attr,"units","crystal",first=.true.)
!
@ -658,9 +658,9 @@ SUBROUTINE write_export (pp_file,kunit,uspp_spsi, ascii, single_file, raw)
CALL iotk_write_attr(attr,"rho",dual*ecutwfc)
CALL iotk_write_attr(attr,"units","Rydberg")
CALL iotk_write_empty(50,"Cutoff",attr)
CALL iotk_write_attr(attr,"nr1",dense%nr1,first=.true.)
CALL iotk_write_attr(attr,"nr2",dense%nr2)
CALL iotk_write_attr(attr,"nr3",dense%nr3)
CALL iotk_write_attr(attr,"nr1",dfftp%nr1,first=.true.)
CALL iotk_write_attr(attr,"nr2",dfftp%nr2)
CALL iotk_write_attr(attr,"nr3",dfftp%nr3)
CALL iotk_write_empty(50,"Space_grid",attr)
CALL iotk_write_attr(attr,"nelec",nelec,first=.true.)
CALL iotk_write_empty(50,"Charge",attr)

14
PP/sym_band.f90
View File

@ -14,7 +14,7 @@ SUBROUTINE sym_band(filband, spin_component, firstk, lastk)
USE ions_base, ONLY : nat, ityp, ntyp => nsp
USE cell_base, ONLY : tpiba2, at, bg, ibrav
USE constants, ONLY : rytoev
USE grid_dimensions, ONLY : dense
USE fft_base, ONLY : dfftp
USE gvect, ONLY : ngm, nl, g
USE lsda_mod, ONLY : nspin
USE wvfct, ONLY : et, nbnd, npwx, npw, igk, g2kin, ecutwfc
@ -115,19 +115,19 @@ SUBROUTINE sym_band(filband, spin_component, firstk, lastk)
IF (noncolin) THEN
IF (domag) THEN
CALL find_band_sym_so(evc,et(1,ik),at,nbnd,npw,nsym_is, &
ngm,sk_is,ftau_is,d_spin_is,gk_is,xk(1,ik),igk,nl,dense%nr1,dense%nr2,&
dense%nr3,dense%nr1x,dense%nr2x,dense%nr3x,dense%nrxx,npwx,rap_et(1,ik),times(1,1,ik), &
ngm,sk_is,ftau_is,d_spin_is,gk_is,xk(1,ik),igk,nl,dfftp%nr1,dfftp%nr2,&
dfftp%nr3,dfftp%nr1x,dfftp%nr2x,dfftp%nr3x,dfftp%nnr,npwx,rap_et(1,ik),times(1,1,ik), &
ngroup(ik),istart(1,ik),accuracy)
ELSE
CALL find_band_sym_so(evc,et(1,ik),at,nbnd,npw,nsymk,ngm, &
sk,ftauk,d_spink,gk,xk(1,ik),igk,nl,dense%nr1,dense%nr2,dense%nr3,dense%nr1x, &
dense%nr2x,dense%nr3x,dense%nrxx,npwx,rap_et(1,ik),times(1,1,ik),ngroup(ik),&
sk,ftauk,d_spink,gk,xk(1,ik),igk,nl,dfftp%nr1,dfftp%nr2,dfftp%nr3,dfftp%nr1x, &
dfftp%nr2x,dfftp%nr3x,dfftp%nnr,npwx,rap_et(1,ik),times(1,1,ik),ngroup(ik),&
istart(1,ik),accuracy)
ENDIF
ELSE
CALL find_band_sym (evc, et(1,ik), at, nbnd, npw, nsymk, ngm, &
sk, ftauk, gk, xk(1,ik), igk, nl, dense%nr1, dense%nr2, dense%nr3, dense%nr1x, &
dense%nr2x, dense%nr3x, dense%nrxx, npwx, rap_et(1,ik), times(1,1,ik), ngroup(ik),&
sk, ftauk, gk, xk(1,ik), igk, nl, dfftp%nr1, dfftp%nr2, dfftp%nr3, dfftp%nr1x, &
dfftp%nr2x, dfftp%nr3x, dfftp%nnr, npwx, rap_et(1,ik), times(1,1,ik), ngroup(ik),&
istart(1,ik),accuracy)
ENDIF

5
PP/wannier_plot.f90
View File

@ -99,10 +99,9 @@ SUBROUTINE plot_wannier(nc,n0)
USE buffers
USE symm_base, ONLY : nsym
USE ldaU, ONLY : swfcatom
USE fft_base, ONLY : dffts
USE fft_base, ONLY : dffts, dfftp
USE fft_interfaces,ONLY : invfft
USE gvect
USE grid_dimensions,ONLY: dense
USE gvecs
USE cell_base
USE ions_base, ONLY : nat, ntyp=>nsp, ityp, tau, atm, zv
@ -131,7 +130,7 @@ SUBROUTINE plot_wannier(nc,n0)
CALL init_us_1
CALL init_at_1
CALL struc_fact (nat, tau, ntyp, ityp, ngm, g, bg, dense%nr1, dense%nr2, dense%nr3, &
CALL struc_fact (nat, tau, ntyp, ityp, ngm, g, bg, dfftp%nr1, dfftp%nr2, dfftp%nr3, &
strf, eigts1, eigts2, eigts3)
current_spin = 1

41
PP/work_function.f90
View File

@ -17,9 +17,8 @@ SUBROUTINE work_function (wf)
USE lsda_mod, ONLY : nspin, current_spin
USE scf, ONLY : rho, vltot, v, rho_core, rhog_core
USE gvect
USE grid_dimensions, ONLY : dense
USE cell_base, ONLY : omega, alat
USE fft_base, ONLY : grid_gather
USE fft_base, ONLY : grid_gather, dfftp
USE mp, ONLY : mp_bcast
IMPLICIT NONE
@ -31,14 +30,14 @@ SUBROUTINE work_function (wf)
REAL(DP), ALLOCATABLE :: vxc(:,:)
! auxiliary vectors for charge and potential
ALLOCATE (raux1( dense%nr1x * dense%nr2x * dense%nr3x))
ALLOCATE (vaux1( dense%nr1x * dense%nr2x * dense%nr3x))
ALLOCATE (vaux2( dense%nr1x * dense%nr2x * dense%nr3x))
ALLOCATE (raux1( dfftp%nr1x * dfftp%nr2x * dfftp%nr3x))
ALLOCATE (vaux1( dfftp%nr1x * dfftp%nr2x * dfftp%nr3x))
ALLOCATE (vaux2( dfftp%nr1x * dfftp%nr2x * dfftp%nr3x))
nspin0=nspin
IF (nspin==4) nspin0=1
ALLOCATE (vxc(dense%nrxx,nspin))
ALLOCATE (vxc(dfftp%nnr,nspin))
CALL v_xc (rho, rho_core, rhog_core, etxc, vtxc, vxc)
IF ( ionode ) THEN
@ -53,11 +52,11 @@ SUBROUTINE work_function (wf)
DO current_spin=1,nspin0
#ifdef __PARA
ALLOCATE (aux ( dense%nrxx))
ALLOCATE (aux ( dfftp%nnr))
aux(:) = rho%of_r(:,current_spin) + rho_core(:)/nspin0
CALL grid_gather (aux, raux1)
#else
raux1(1:dense%nrxx) = rho%of_r(1:dense%nrxx,current_spin) + rho_core(1:dense%nrxx)/nspin0
raux1(1:dfftp%nnr) = rho%of_r(1:dfftp%nnr,current_spin) + rho_core(1:dfftp%nnr)/nspin0
#endif
!
#ifdef __PARA
@ -66,8 +65,8 @@ SUBROUTINE work_function (wf)
aux(:) = aux(:) - vxc(:,current_spin)
CALL grid_gather (aux, vaux2)
#else
vaux1(1:dense%nrxx) = vltot(1:dense%nrxx) + v%of_r(1:dense%nrxx,current_spin)
vaux2(1:dense%nrxx) = vaux1(1:dense%nrxx) -vxc(1:dense%nrxx,current_spin)
vaux1(1:dfftp%nnr) = vltot(1:dfftp%nnr) + v%of_r(1:dfftp%nnr,current_spin)
vaux2(1:dfftp%nnr) = vaux1(1:dfftp%nnr) -vxc(1:dfftp%nnr,current_spin)
#endif
!
#ifdef __PARA
@ -84,16 +83,16 @@ SUBROUTINE work_function (wf)
WRITE(19,*) " SPIN DOWN "
ENDIF
ENDIF
DO nmean = 1, dense%nr3
DO nmean = 1, dfftp%nr3
wmean1 = 0.d0
wmean2 = 0.d0
meancharge = 0.d0
wx1 = 0.d0
wx2 = 0.d0
wxm = 0.d0
DO n2 = 1, dense%nr2
DO n1 = 1, dense%nr1
ni = n1 + (n2 - 1) * dense%nr1x + (nmean - 1) * dense%nr1x * dense%nr2x
DO n2 = 1, dfftp%nr2
DO n1 = 1, dfftp%nr1
ni = n1 + (n2 - 1) * dfftp%nr1x + (nmean - 1) * dfftp%nr1x * dfftp%nr2x
meancharge = meancharge+raux1 (ni)
wxm = wxm + raux1 (ni) **2
wmean1 = wmean1 + vaux1 (ni)
@ -102,13 +101,13 @@ SUBROUTINE work_function (wf)
wx2 = wx2 + vaux2 (ni) **2
ENDDO
ENDDO
wmean1 = wmean1 / dble (dense%nr1 * dense%nr2)
wmean2 = wmean2 / dble (dense%nr1 * dense%nr2)
meancharge = meancharge / dble (dense%nr1 * dense%nr2)
wx1 = dsqrt (wx1 / dble (dense%nr1 * dense%nr2) - wmean1 * wmean1)
wx2 = dsqrt (wx2 / dble (dense%nr1 * dense%nr2) - wmean2 * wmean2)
wxm = dsqrt (wxm / dble (dense%nr1 * dense%nr2) - meancharge**2)
IF (nmean== (dense%nr3 + 1) / 2) THEN
wmean1 = wmean1 / dble (dfftp%nr1 * dfftp%nr2)
wmean2 = wmean2 / dble (dfftp%nr1 * dfftp%nr2)
meancharge = meancharge / dble (dfftp%nr1 * dfftp%nr2)
wx1 = dsqrt (wx1 / dble (dfftp%nr1 * dfftp%nr2) - wmean1 * wmean1)
wx2 = dsqrt (wx2 / dble (dfftp%nr1 * dfftp%nr2) - wmean2 * wmean2)
wxm = dsqrt (wxm / dble (dfftp%nr1 * dfftp%nr2) - meancharge**2)
IF (nmean== (dfftp%nr3 + 1) / 2) THEN
wf = wf + (wmean2 - ef)
IF (nspin == 2) THEN
IF (current_spin==1) THEN

32
PW/add_bfield.f90
View File

@ -28,7 +28,7 @@ SUBROUTINE add_bfield (v,rho)
USE io_global, ONLY : stdout
USE ions_base, ONLY : nat, ntyp => nsp, ityp
USE cell_base, ONLY : omega
USE grid_dimensions, ONLY : dense
USE fft_base, ONLY : dfftp
USE lsda_mod, ONLY : nspin
USE mp_global, ONLY : intra_pool_comm
USE mp, ONLY : mp_sum
@ -36,8 +36,8 @@ SUBROUTINE add_bfield (v,rho)
pointlist, factlist, noncolin
IMPLICIT NONE
! input/outpt variables
REAL(DP), INTENT(IN) :: rho(dense%nrxx,nspin)
REAL(DP), INTENT(INOUT) :: v(dense%nrxx, nspin)
REAL(DP), INTENT(IN) :: rho(dfftp%nnr,nspin)
REAL(DP), INTENT(INOUT) :: v(dfftp%nnr, nspin)
! local variables
REAL(DP) :: ma, mperp, xx, fact, m1(3), etcon, fact1(3)
REAL(DP), allocatable :: m2(:,:), m_loc(:,:), r_loc(:)
@ -88,17 +88,17 @@ SUBROUTINE add_bfield (v,rho)
END DO ! na
if (noncolin) then
DO ir = 1, dense%nrxx
DO ir = 1, dfftp%nnr
if (pointlist(ir) .eq. 0 ) cycle
fact = 2.D0*lambda*factlist(ir)*omega/(dense%nr1*dense%nr2*dense%nr3)
fact = 2.D0*lambda*factlist(ir)*omega/(dfftp%nr1*dfftp%nr2*dfftp%nr3)
DO ipol = 1,3
v(ir,ipol+1) = v(ir,ipol+1) + fact*m2(ipol,pointlist(ir))
END DO ! ipol
END DO ! points
else
DO ir = 1, dense%nrxx
DO ir = 1, dfftp%nnr
if (pointlist(ir) .eq. 0 ) cycle
fact = 2.D0*lambda*factlist(ir)*omega/(dense%nr1*dense%nr2*dense%nr3)
fact = 2.D0*lambda*factlist(ir)*omega/(dfftp%nr1*dfftp%nr2*dfftp%nr3)
v(ir,1) = v(ir,1) + fact*m2(1,pointlist(ir))
v(ir,2) = v(ir,2) - fact*m2(1,pointlist(ir))
END DO ! points
@ -109,16 +109,16 @@ SUBROUTINE add_bfield (v,rho)
ELSE IF (i_cons==3.or.i_cons==6) THEN
m1 = 0.d0
IF (npol==1) THEN
DO ir = 1,dense%nrxx
DO ir = 1,dfftp%nnr
m1(1) = m1(1) + rho(ir,1) - rho(ir,2)
END DO
m1(1) = m1(1) * omega / ( dense%nr1 * dense%nr2 * dense%nr3 )
m1(1) = m1(1) * omega / ( dfftp%nr1 * dfftp%nr2 * dfftp%nr3 )
ELSE
DO ipol = 1, 3
DO ir = 1,dense%nrxx
DO ir = 1,dfftp%nnr
m1(ipol) = m1(ipol) + rho(ir,ipol+1)
END DO
m1(ipol) = m1(ipol) * omega / ( dense%nr1 * dense%nr2 * dense%nr3 )
m1(ipol) = m1(ipol) * omega / ( dfftp%nr1 * dfftp%nr2 * dfftp%nr3 )
END DO
END IF
CALL mp_sum( m1, intra_pool_comm )
@ -127,7 +127,7 @@ SUBROUTINE add_bfield (v,rho)
IF (npol==1) THEN
fact = 2.D0*lambda
bfield(1)=-fact*(m1(1)-mcons(1,1))
DO ir =1,dense%nrxx
DO ir =1,dfftp%nnr
v(ir,1) = v(ir,1)-bfield(1)
v(ir,2) = v(ir,2)+bfield(1)
END DO
@ -135,7 +135,7 @@ SUBROUTINE add_bfield (v,rho)
fact = 2.D0*lambda
DO ipol=1,3
bfield(ipol)=-fact*(m1(ipol)-mcons(ipol,1))
DO ir =1,dense%nrxx
DO ir =1,dfftp%nnr
v(ir,ipol+1) = v(ir,ipol+1)-bfield(ipol)
END DO
END DO
@ -170,7 +170,7 @@ SUBROUTINE add_bfield (v,rho)
etcon = lambda * xx**2
bfield(:) = 2.D0 * lambda * xx * fact1(:)
DO ipol = 1,3
DO ir =1,dense%nrxx
DO ir =1,dfftp%nnr
v(ir,ipol+1) = v(ir,ipol+1)+bfield(ipol)
END DO
END DO
@ -193,13 +193,13 @@ SUBROUTINE add_bfield (v,rho)
write(stdout,'(5x," External magnetic field: ", 3f13.5)') &
(bfield(ipol),ipol=1,npol)
IF (npol==1) THEN
DO ir =1,dense%nrxx
DO ir =1,dfftp%nnr
v(ir,1) = v(ir,1)-bfield(ipol)
v(ir,2) = v(ir,2)+bfield(ipol)
END DO
ELSE
DO ipol = 1,3
DO ir =1,dense%nrxx
DO ir =1,dfftp%nnr
v(ir,ipol+1) = v(ir,ipol+1)-bfield(ipol)
END DO
END DO

Some files were not shown because too many files have changed in this diff Show More