diff --git a/CPV/src/chargedensity.f90 b/CPV/src/chargedensity.f90 index 4a6ea9526..646d524c7 100644 --- a/CPV/src/chargedensity.f90 +++ b/CPV/src/chargedensity.f90 @@ -100,7 +100,7 @@ USE kinds, ONLY: DP USE control_flags, ONLY: iprint, iverbosity, thdyn, tpre, trhor, ndr USE ions_base, ONLY: nat - USE gvect, ONLY: ngm, nl, nlm, gstart, ig_l2g + USE gvect, ONLY: ngm, gstart, ig_l2g USE gvecs, ONLY: ngms, nls, nlsm USE smallbox_gvec, ONLY: ngb USE gvecw, ONLY: ngw diff --git a/CPV/src/fft.f90 b/CPV/src/fft.f90 index 748ec516d..391809f99 100644 --- a/CPV/src/fft.f90 +++ b/CPV/src/fft.f90 @@ -10,9 +10,8 @@ ! ---------------------------------------------- !----------------------------------------------------------------------- - - SUBROUTINE c2psi( psi, nnr, c, ca, ng, iflg ) +!----------------------------------------------------------------------- ! use gvecs, only: nlsm, nls use kinds, only: DP @@ -70,179 +69,6 @@ return END SUBROUTINE c2psi -! -! -! - - SUBROUTINE rho2psi( grid_type, psi, nnr, rho, ng ) - ! - use gvect, only: nlm, nl - use gvecs, only: nlsm, nls - use kinds, only: DP - - implicit none - - complex(DP) :: psi(*), rho(*) - integer, intent(in) :: nnr, ng - character(len=*), intent(in) :: grid_type - - integer :: ig - - psi( 1 : nnr ) = 0.0d0 - - SELECT CASE ( grid_type ) - ! - ! Case 0, 1 and 2 SMOOTH MESH - ! - CASE ( 'Smooth' ) - ! - ! without gamma sym - ! do ig = 1, ng - ! psi( nls( ig ) ) = rho( ig ) - ! end do - ! - do ig = 1, ng - psi( nlsm( ig ) ) = CONJG( rho( ig ) ) - psi( nls( ig ) ) = rho( ig ) - end do - ! - CASE ( 'Dense' ) - ! - ! do ig = 1, ng - ! psi( np( ig ) ) = rho( ig ) - ! end do - ! - do ig = 1, ng - psi( nlm( ig ) ) = CONJG( rho( ig ) ) - psi( nl( ig ) ) = rho( ig ) - end do - ! - CASE DEFAULT - ! - CALL errore(" rho2psi "," wrong grid "//grid_type , 1 ) - - END SELECT - - return - END SUBROUTINE rho2psi - -!----------------------------------------------------------------------- - - SUBROUTINE psi2c( psi, nnr, c, ca, ng, iflg ) - - use gvect, only: nlm, nl - use gvecs, only: nlsm, nls - use kinds, only: DP - - implicit none - - complex(DP) :: psi(*), c(*), ca(*) - integer, intent(in) :: nnr, ng, iflg - - complex(DP), parameter :: ci=(0.0d0,1.0d0) - integer :: ig - - ! - ! iflg "cases" - ! - ! 0, 10 Do not use gamma symmetry - ! - ! 1, 11 set psi using a wf with Gamma symmetry - ! - ! 2, 12 set psi combining two wf with Gamma symmetry - ! - - SELECT CASE ( iflg ) - - ! - ! Case 0, 1 and 2 SMOOTH MESH - ! - CASE ( 0 ) - ! - do ig = 1, ng - c( ig ) = psi( nls( ig ) ) - end do - ! - CASE ( 1 ) - ! - CALL errore(" psi2c "," wrong value for iflg ", 11 ) - ! - CASE ( 2 ) - ! - DO ig = 1, ng - ca(ig) = psi( nlsm( ig ) ) - c (ig) = psi( nls( ig ) ) - END DO - - ! - ! Case 10, 11 and 12 DENSE MESH - ! - CASE ( 10 ) - ! - do ig = 1, ng - c( ig ) = psi( nl( ig ) ) - end do - ! - CASE ( 11 ) - ! - CALL errore(" psi2c "," wrong value for iflg ", 1 ) - ! - CASE ( 12 ) - ! - DO ig = 1, ng - ca(ig) = psi( nlm( ig ) ) - c (ig) = psi( nl( ig ) ) - END DO - - CASE DEFAULT - ! - CALL errore(" psi2c "," wrong value for iflg ", ABS( iflg ) ) - - END SELECT - - return - END SUBROUTINE psi2c - -!----------------------------------------------------------------------- - - SUBROUTINE psi2rho( grid_type, psi, nnr, rho, ng ) - - use gvect, only: nlm, nl - use gvecs, only: nlsm, nls - use kinds, only: DP - - implicit none - - complex(DP) :: psi(*), rho(*) - integer, intent(in) :: nnr, ng - character(len=*), intent(in) :: grid_type - - integer :: ig - - SELECT CASE ( grid_type ) - ! - CASE ( 'Smooth' ) - ! - do ig = 1, ng - rho( ig ) = psi( nls( ig ) ) - end do - ! - CASE ( 'Dense' ) - ! - do ig = 1, ng - rho( ig ) = psi( nl( ig ) ) - end do - ! - CASE DEFAULT - ! - CALL errore(" psi2rho "," wrong grid "//grid_type , 1 ) - - END SELECT - - return - END SUBROUTINE psi2rho - - !----------------------------------------------------------------------- SUBROUTINE box2grid(irb,nfft,qv,vr) @@ -413,38 +239,3 @@ RETURN END FUNCTION boxdotgrid - -! -!!---------------------------------------------------------------------- -! subroutine parabox(nr3b,irb3,nr3,imin3,imax3) -!!---------------------------------------------------------------------- -!! -!! find if box grid planes in the z direction have component on the dense -!! grid on this processor, and if, which range imin3-imax3 -!! -! use mp_global, only: me_bgrp -! use fft_base, only: dfftp -!! input -! integer nr3b,irb3,nr3 -!! output -! integer imin3,imax3 -!! local -! integer ir3, ibig3, me -!! -! me = me_bgrp + 1 -! imin3=nr3b -! imax3=1 -! do ir3=1,nr3b -! ibig3=1+mod(irb3+ir3-2,nr3) -! if(ibig3.lt.1.or.ibig3.gt.nr3) & -! & call errore('cfftpb','ibig3 wrong',ibig3) -! ibig3=ibig3-dfftp%my_i0r3p -! if (ibig3.gt.0.and.ibig3.le.dfftp%my_nr3p) then -! imin3=min(imin3,ir3) -! imax3=max(imax3,ir3) -! end if -! end do -!! -! return -! end subroutine parabox -! diff --git a/CPV/src/potentials.f90 b/CPV/src/potentials.f90 index 9b1a3ae03..62f102ed4 100644 --- a/CPV/src/potentials.f90 +++ b/CPV/src/potentials.f90 @@ -38,6 +38,7 @@ USE gvect, ONLY: ngm USE constants, ONLY: gsmall, pi USE cell_base, ONLY: tpiba2, s_to_r, alat + USE fft_rho IMPLICIT NONE @@ -49,8 +50,8 @@ ! ... Locals ! - COMPLEX(DP), ALLOCATABLE :: grr(:) - COMPLEX(DP), ALLOCATABLE :: grg(:) + REAL(DP), ALLOCATABLE :: grr(:,:) + COMPLEX(DP), ALLOCATABLE :: grg(:,:) REAL(DP) :: rc, r(3), s(3), rmod, g2, rc2, arg, fact INTEGER :: ig, i, j, k, ir INTEGER :: ir1, ir2, ir3, nr3l @@ -63,8 +64,8 @@ END DO nr3l = dfftp%my_nr3p - ALLOCATE( grr( dfftp%nnr ) ) - ALLOCATE( grg( SIZE( screen_coul ) ) ) + ALLOCATE( grr( dfftp%nnr, 1 ) ) + ALLOCATE( grg( dfftp%nnr, 1 ) ) grr = 0.0d0 @@ -85,9 +86,9 @@ rmod = SQRT( r(1)**2 + r(2)**2 + r(3)**2 ) ir = i + (j-1)*dfftp%nr1x + (k-1)*dfftp%nr1x*dfftp%nr2x IF( rmod < gsmall ) THEN - grr( ir ) = fact * 2.0d0 * rc / SQRT( pi ) + grr( ir, 1 ) = fact * 2.0d0 * rc / SQRT( pi ) ELSE - grr( ir ) = fact * qe_erf( rc * rmod ) / rmod + grr( ir, 1 ) = fact * qe_erf( rc * rmod ) / rmod END IF END DO END DO @@ -95,16 +96,15 @@ ! grg = FFT( grr ) - CALL fwfft( 'Dense', grr, dfftp ) - CALL psi2rho( 'Dense', grr, dfftp%nnr, grg, ngm ) + CALL rho_r2g( grr, grg ) DO ig = 1, SIZE( screen_coul ) IF( hg(ig) < gsmall ) THEN - screen_coul(ig) = grg(1) - ( - pi / rc2 ) + screen_coul(ig) = grg(1,1) - ( - pi / rc2 ) ELSE g2 = tpiba2 * hg(ig) arg = - g2 / ( 4.0d0 * rc2 ) - screen_coul(ig) = grg(ig) - ( 4.0d0 * pi * EXP( arg ) / g2 ) + screen_coul(ig) = grg(ig,1) - ( 4.0d0 * pi * EXP( arg ) / g2 ) END IF END DO diff --git a/CPV/src/vofrho.f90 b/CPV/src/vofrho.f90 index 151a65785..1c99ea6aa 100644 --- a/CPV/src/vofrho.f90 +++ b/CPV/src/vofrho.f90 @@ -27,7 +27,7 @@ SUBROUTINE vofrho_x( nfi, rhor, drhor, rhog, drhog, rhos, rhoc, tfirst, & USE ions_base, ONLY: nsp, na, nat, rcmax, compute_eextfor USE ions_base, ONLY: ind_srt, ind_bck USE gvecs - USE gvect, ONLY: ngm, nl, nlm + USE gvect, ONLY: ngm USE cell_base, ONLY: omega, r_to_s USE cell_base, ONLY: alat, at, tpiba2, h, ainv USE cell_base, ONLY: ibrav, isotropic !True if volume option is chosen for cell_dofree diff --git a/CPV/src/vol_clu.f90 b/CPV/src/vol_clu.f90 index 1e77e6eff..2825e9b9d 100644 --- a/CPV/src/vol_clu.f90 +++ b/CPV/src/vol_clu.f90 @@ -21,7 +21,7 @@ SUBROUTINE vol_clu(rho_real,rho_g,s_fac,flag) USE electrons_base, ONLY: nspin USE ions_base, ONLY: na, nsp, amass USE ions_positions, ONLY: tau0 - USE gvect, ONLY: g, gg, ngm, nl, nlm + USE gvect, ONLY: g, gg, ngm USE gvecs, ONLY: ngms USE cp_main_variables, only: drhor USE control_flags, ONLY: tpre