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

More static arrays and dimensions removed: rho_at rho_atc natx nbndxx 

git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@4365 c92efa57-630b-4861-b058-cf58834340f0
This commit is contained in:
giannozz 2007-10-24 15:36:52 +00:00
parent 45338d9069
commit a2f2848f92
30 changed files with 156 additions and 133 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
CPV/cg_sub.f90
View File

@ -19,7 +19,6 @@
use control_flags, only: ndr, ndw, nbeg, nomore, tsde, tortho, tnosee, &
tnosep, trane, tranp, tsdp, tcp, tcap, ampre, amprp, tnoseh
use atom, only: nlcc
use core, only: nlcc_any
!---ensemble-DFT
use energies, only: eht, epseu, exc, etot, eself, enl, ekin, &

2
CPV/cplib.f90
View File

@ -3002,7 +3002,7 @@ end function set_Hubbard_l
!
use control_flags, ONLY: tfor, tprnfor
use kinds, ONLY: DP
use parameters, ONLY: natx, nsx
use parameters, ONLY: nsx
use ions_base, only: na, nat, nsp
use gvecw, only: ngw
use reciprocal_vectors, only: ng0 => gstart

2
CPV/cprsub.f90
View File

@ -325,7 +325,7 @@ subroutine nlinit
use ions_base, ONLY : na, nsp
use uspp, ONLY : aainit, beta, qq, dvan, nhtol, nhtolm, indv
use uspp_param, ONLY : upf, lmaxq, nbetam, lmaxkb, nhm, nh
use atom, ONLY : rgrid, nlcc
use atom, ONLY : rgrid
use qradb_mod, ONLY : qradb
use qgb_mod, ONLY : qgb
use gvecb, ONLY : ngb

3
CPV/inner_loop.f90
View File

@ -1,5 +1,5 @@
!
! Copyright (C) 2002 CP90 group
! Copyright (C) 2002-2007 Quantum-Espresso group
! This file is distributed under the terms of the
! GNU General Public License. See the file `License'
! in the root directory of the present distribution,
@ -26,7 +26,6 @@
tsde, tortho, tnosee, tnosep, trane, &
tranp, tsdp, tcp, tcap, ampre, &
amprp, tnoseh
USE atom, ONLY: nlcc
USE core, ONLY: nlcc_any
USE energies, ONLY: eht, epseu, exc, etot, eself, enl, &
ekin, atot, entropy, egrand

4
CPV/inner_loop_cold.f90
View File

@ -26,7 +26,6 @@
tsde, tortho, tnosee, tnosep, trane, &
tranp, tsdp, tcp, tcap, ampre, &
amprp, tnoseh
USE atom, ONLY: nlcc
USE core, ONLY: nlcc_any
USE energies, ONLY: eht, epseu, exc, etot, eself, enl, &
ekin, atot, entropy, egrand
@ -345,7 +344,6 @@
tsde, tortho, tnosee, tnosep, trane, &
tranp, tsdp, tcp, tcap, ampre, &
amprp, tnoseh
USE atom, ONLY: nlcc
USE core, ONLY: nlcc_any
USE energies, ONLY: eht, epseu, exc, etot, eself, enl, &
ekin, atot, entropy, egrand
@ -543,8 +541,6 @@
tsde, tortho, tnosee, tnosep, trane, &
tranp, tsdp, tcp, tcap, ampre, &
amprp, tnoseh
USE atom, ONLY: nlcc
USE core, ONLY: nlcc_any
USE energies, ONLY: eht, epseu, exc, etot, eself, enl, &
ekin, atot, entropy, egrand
USE electrons_base, ONLY: f, nspin, nel, iupdwn, nupdwn, nudx, &

4
CPV/mainvar.f90
View File

@ -12,7 +12,7 @@ MODULE cp_main_variables
!----------------------------------------------------------------------------
!
USE kinds, ONLY : DP
USE parameters, ONLY : natx, nsx, nacx
USE parameters, ONLY : nsx, nacx
USE control_flags, ONLY : program_name
USE funct, ONLY : dft_is_meta
USE metagga, ONLY : kedtaur, kedtaus, kedtaug
@ -199,7 +199,7 @@ MODULE cp_main_variables
allocate(rho_gaus(nnr))
allocate(v_vol(nnr))
if (jellium.or.t_gauss) allocate(posv(3,nr1*nr2*nr3))
if (t_gauss) allocate(f_vol(3,natx,nsx))
if (t_gauss) allocate(f_vol(3,nax,nsx))
!
end if
!

4
CPV/modules.f90
View File

@ -1,5 +1,5 @@
!
! Copyright (C) 2002-2005 FPMD-CPV groups
! Copyright (C) 2002-2007 Quantum-Espresso group
! This file is distributed under the terms of the
! GNU General Public License. See the file `License'
! in the root directory of the present distribution,
@ -397,9 +397,9 @@ end module ldaU
! Occupation constraint ...to be implemented...
!
module step_constraint
use parameters, only: natx_ => natx
USE kinds
implicit none
integer, parameter :: natx_ = 5000
real(DP) :: E_con
real(DP) :: A_con(natx_,2), sigma_con(natx_), alpha_con(natx_)
logical :: step_con

17
CPV/nlcc.f90
View File

@ -1,5 +1,5 @@
!
! Copyright (C) 2002-2005 FPMD-CPV groups
! Copyright (C) 2002-2007 Quantum-Espresso group
! This file is distributed under the terms of the
! GNU General Public License. See the file `License'
! in the root directory of the present distribution,
@ -18,7 +18,8 @@
use kinds, ONLY : DP
use control_flags, ONLY : program_name
use ions_base, ONLY : nsp
use atom, ONLY : nlcc, rgrid, rho_atc
use atom, ONLY : rgrid
use uspp_param, ONLY : upf
use gvecb, ONLY : ngb, gb
use small_box, ONLY : omegab, tpibab
use pseudo_base, ONLY : compute_rhocg
@ -47,12 +48,13 @@
!
do is = 1, nsp
!
if( nlcc( is ) ) then
if( upf(is)%nlcc ) then
!
IF( program_name == 'CP90' ) THEN
!
CALL compute_rhocg( rhocb(:,is), rhocb(:,is), rgrid(is)%r, rgrid(is)%rab, &
rho_atc(:,is), gb, omegab, tpibab**2, rgrid(is)%mesh, ngb, 0 )
CALL compute_rhocg( rhocb(:,is), rhocb(:,is), rgrid(is)%r, &
rgrid(is)%rab, upf(is)%rho_atc(:), gb, omegab, tpibab**2, &
rgrid(is)%mesh, ngb, 0 )
!
END IF
!
@ -74,8 +76,9 @@
!
ELSE
CALL compute_rhocg( rhocg(:,is), drhocg(:,is), rgrid(is)%r, rgrid(is)%rab, &
rho_atc(:,is), g, omega, tpiba2, rgrid(is)%mesh, ngm, 1 )
CALL compute_rhocg( rhocg(:,is), drhocg(:,is), rgrid(is)%r, &
rgrid(is)%rab, upf(is)%rho_atc(:), g, &
omega, tpiba2, rgrid(is)%mesh, ngm, 1 )
END IF
!

2
CPV/pseudopot.f90
View File

@ -1,5 +1,5 @@
!
! Copyright (C) 2002-2005 FPMD-CPV groups
! Copyright (C) 2002-2007 Quantum-Espresso group
! This file is distributed under the terms of the
! GNU General Public License. See the file `License'
! in the root directory of the present distribution,

13
CPV/pseudopot_sub.f90
View File

@ -1,5 +1,5 @@
!
! Copyright (C) 2002-2005 FPMD-CPV groups
! Copyright (C) 2002-2007 Quantum-Espresso group
! This file is distributed under the terms of the
! GNU General Public License. See the file `License'
! in the root directory of the present distribution,
@ -68,7 +68,6 @@
use uspp, only: nhtol, &!
nhtolm, &!
indv !
use atom, only: nlcc !
use pseudopotential, ONLY: nsanl
USE read_pseudo_module_fpmd, ONLY: nspnl
@ -97,7 +96,7 @@
ish(is)=nkb
nkb = nkb + na(is) * nh(is)
if( upf(is)%tvanp ) nkbus = nkbus + na(is) * nh(is)
nlcc_any = nlcc_any .OR. nlcc(is)
nlcc_any = nlcc_any .OR. upf(is)%nlcc
end do
nhm = MAXVAL( nh(1:nsp) )
nbetam = MAXVAL( upf(1:nsp)%nbeta )
@ -300,7 +299,8 @@
SUBROUTINE build_cctab_x( )
USE kinds, ONLY : DP
USE atom, ONLY : rgrid, nlcc, rho_atc
USE atom, ONLY : rgrid
USE uspp_param, ONLY : upf
USE ions_base, ONLY : nsp, rcmax
USE cell_base, ONLY : tpiba, tpiba2
USE splines, ONLY : init_spline, allocate_spline, kill_spline, nullify_spline
@ -342,13 +342,14 @@
CALL nullify_spline( rhoc1_sp( is ) )
CALL nullify_spline( rhocp_sp( is ) )
IF( nlcc( is ) ) THEN
IF( upf(is)%nlcc ) THEN
!
CALL allocate_spline( rhoc1_sp(is), mmx, xgmin, xgmax )
CALL allocate_spline( rhocp_sp(is), mmx, xgmin, xgmax )
!
CALL compute_rhocg( rhoc1_sp(is)%y, rhocp_sp(is)%y, rgrid(is)%r, &
rgrid(is)%rab, rho_atc(:,is), xgtab, 1.0d0, tpiba2, rgrid(is)%mesh, mmx, 1 )
rgrid(is)%rab, upf(is)%rho_atc(:), xgtab, 1.0d0, tpiba2, &
rgrid(is)%mesh, mmx, 1 )
!
CALL init_spline( rhoc1_sp(is) )
CALL init_spline( rhocp_sp(is) )

8
CPV/vol_clu.f90
View File

@ -1,5 +1,5 @@
!
! Copyright (C) 2002-2005 FPMD-CPV groups
! Copyright (C) 2002-2007 Quantum-Espresso groups
! This file is distributed under the terms of the
! GNU General Public License. See the file `License'
! in the root directory of the present distribution,
@ -53,7 +53,7 @@
real(kind=8) dx, dxx, xcc(4500)
real(kind=8) weight0, wpiu, wmeno, maxr, minr
real(kind=8) tauv(3,natx,nsx), tau00(3), dist
real(kind=8) tau00(3), dist
real(kind=8) rho_real(nnr,nspin), rhoc
real(kind=8) alfa(nsx), alfa0, sigma, hgt
real(kind=8) pos_cry(3), pos_car(3), pos_aux(3)
@ -67,6 +67,7 @@
real(kind=8), allocatable:: drho(:,:), d2rho(:,:)
real(kind=8), allocatable:: dxdyrho(:), dxdzrho(:)
real(kind=8), allocatable:: dydzrho(:)
real(kind=8), allocatable:: tauv(:,:,:)
complex(kind=8) s_fac(ngs,nsp), ci
complex(kind=8) sum_sf, aux, auxx, fact, rho_g(ngm,nspin)
@ -146,6 +147,8 @@
end if
end if
n_at = MAXVAL ( na(1:nsp) )
allocate ( tauv(3,n_at,nsp) )
n_at = 0
do is = 1,nsp
alfa(is) = step_rad(is)/2.d0
@ -408,6 +411,7 @@
end do
end do
deallocate( tauv )
if ( abisur ) deallocate( drho )
if ( abisur ) deallocate( d2rho )
if ( abisur ) deallocate( dxdyrho )

5
GIPAW/gipaw_module.f90
View File

@ -1,5 +1,5 @@
!
! Copyright (C) 2001-2005 Quantum-ESPRESSO group
! Copyright (C) 2001-2007 Quantum-ESPRESSO group
! This file is distributed under the terms of the
! GNU General Public License. See the file `License'
! in the root directory of the present distribution,
@ -13,11 +13,12 @@ MODULE gipaw_module
!
USE kinds, ONLY : DP
USE constants, ONLY : a0_to_cm => bohr_radius_cm
USE parameters, ONLY : npk, ntypx, lmaxx, natx
USE parameters, ONLY : npk, ntypx, lmaxx
IMPLICIT NONE
SAVE
INTEGER, PARAMETER:: natx=5000 ! max number of atoms
! alpha
REAL(DP), PARAMETER :: alpha = 1.0_dp / 137.03599911_dp

30
Gamma/dvpsi_kb.f90
View File

@ -1,5 +1,5 @@
!
! Copyright (C) 2003 PWSCF group
! Copyright (C) 2003-2007 Quantum-Espresso group
! This file is distributed under the terms of the
! GNU General Public License. See the file `License'
! in the root directory of the present distribution,
@ -12,11 +12,17 @@ subroutine dvpsi_kb(kpoint,nu)
! calculates dVion/dtau * psi and stores it in dvpsi
!
#include "f_defs.h"
USE ions_base, ONLY : ntyp => nsp, nat, ityp, tau
USE kinds, only: DP
use pwcom
USE uspp_param, ONLY: nh, nhm
USE atom, ONLY: nlcc, rgrid, rho_atc
USE kinds, ONLY: DP
USE constants, ONLY: tpi
USE atom, ONLY: rgrid
USE cell_base, ONLY: omega, tpiba, tpiba2
USE ions_base, ONLY: ntyp => nsp, nat, ityp, tau
USE uspp_param, ONLY: upf, nh, nhm
USE uspp, ONLY: dvan, nkb, vkb
USE gvect, ONLY : gstart, nl, nlm, nr1, nr2, nr3, nrx1, nrx2, nrx3, &
nrxx, ngm, g, gg, igtongl
USE vlocal, ONLY: vloc
USE wvfct, ONLY: nbnd, npwx, npw, g2kin, igk
USE wavefunctions_module, ONLY: evc, psic
use cgcom
!
@ -41,10 +47,10 @@ subroutine dvpsi_kb(kpoint,nu)
mu = 3*(na-1)
if ( u(mu+1,nu)**2+u(mu+2,nu)**2+u(mu+3,nu)**2.gt. 1.0d-12) then
nt=ityp(na)
if (nlcc(nt)) call drhoc (ngm, gg, omega, tpiba2, rgrid(nt)%mesh, &
rgrid(nt)%dx, rgrid(nt)%r, rho_atc(1,nt),&
if (upf(nt)%nlcc) call drhoc (ngm, gg, omega, tpiba2, rgrid(nt)%mesh,&
rgrid(nt)%dx, rgrid(nt)%r, upf(nt)%rho_atc,&
workcc)
has_nlcc = has_nlcc .or. nlcc(nt)
has_nlcc = has_nlcc .or. upf(nt)%nlcc
do ng = 1,ngm
gtau = tpi * ( g(1,ng)*tau(1,na) + &
g(2,ng)*tau(2,na) + &
@ -54,7 +60,7 @@ subroutine dvpsi_kb(kpoint,nu)
g(3,ng)*u(mu+3,nu) )
exc = gu * CMPLX(-sin(gtau),-cos(gtau))
dvloc (nl(ng))=dvloc (nl(ng)) + vloc(igtongl(ng),nt)*exc
if (nlcc(nt)) dvb_cc(nl(ng)) = dvb_cc(nl(ng)) + workcc(ng) * exc
if (upf(nt)%nlcc) dvb_cc(nl(ng)) = dvb_cc(nl(ng)) + workcc(ng) * exc
end do
end if
end do
@ -64,7 +70,7 @@ subroutine dvpsi_kb(kpoint,nu)
!
! dVloc/dtau in real space
!
call cft3(dvloc, nr1,nr2,nr3,nrx1,nr2,nr3,+1)
call cft3(dvloc, nr1,nr2,nr3,nrx1,nrx2,nrx3,+1)
do ir = 1,nrxx
dv(ir) = DBLE(dvloc(ir))
end do
@ -72,7 +78,7 @@ subroutine dvpsi_kb(kpoint,nu)
do ng = gstart,ngm
dvb_cc (nlm(ng))=CONJG(dvb_cc(nl(ng)))
end do
call cft3(dvb_cc,nr1,nr2,nr3,nrx1,nr2,nr3,+1)
call cft3(dvb_cc,nr1,nr2,nr3,nrx1,nrx2,nrx3,+1)
do ir = 1,nrxx
dv(ir) = dv(ir) + DBLE(dvb_cc(ir)) * dmuxc(ir)
end do

34
Gamma/dynmatcc.f90
View File

@ -1,5 +1,5 @@
!
! Copyright (C) 2003 PWSCF group
! Copyright (C) 2003-2007 Quantum-Espresso group
! This file is distributed under the terms of the
! GNU General Public License. See the file `License'
! in the root directory of the present distribution,
@ -11,10 +11,21 @@ subroutine dynmatcc(dyncc)
!--------------------------------------------------------------------
!
#include "f_defs.h"
USE ions_base, ONLY : ntyp => nsp, nat, ityp, tau
use pwcom
USE atom, ONLY: nlcc, rgrid, rho_atc
USE kinds, ONLY : DP
USE ions_base, ONLY : ntyp => nsp, nat, ityp, tau
USE atom, ONLY: rgrid, nlcc
USE constants, ONLY: tpi
USE cell_base, ONLY: omega, tpiba2
USE ener, ONLY: etxc, vtxc
USE ions_base, ONLY: ntyp => nsp, nat, ityp, tau
USE uspp_param, ONLY: upf
USE gvect, ONLY : nl, nr1, nr2, nr3, nrx1, nrx2, nrx3, &
nrxx, ngm, g, gg
USE scf, ONLY : rho, rhog, rho_core, rhog_core
USE uspp_param, ONLY: upf
USE wavefunctions_module, ONLY: psic
USE wvfct, ONLY: nbnd, npwx, npw, g2kin, igk
use cgcom
implicit none
real(DP):: dyncc(3*nat,nmodes)
@ -28,9 +39,7 @@ subroutine dynmatcc(dyncc)
!
dyncc(:,:) = 0.d0
!
do nt=1,ntyp
if(nlcc(nt)) go to 10
end do
if ( ANY( upf(1:ntyp)%nlcc ) ) go to 10
return
10 continue
!
@ -42,14 +51,14 @@ subroutine dynmatcc(dyncc)
!
call v_xc (rho, rhog, rho_core, rhog_core, etxc, vtxc, vxc)
!
call cft3(vxc,nr1,nr2,nr3,nrx1,nr2,nr3,-1)
call cft3(vxc,nr1,nr2,nr3,nrx1,nrx2,nrx3,-1)
!
dyncc1(:,:,:,:) = 0.d0
do na=1,nat
nta=ityp(na)
if (nlcc(nta)) then
if ( upf(nta)%nlcc ) then
call drhoc (ngm, gg, omega, tpiba2, rgrid(nta)%mesh, rgrid(nta)%dx, &
rgrid(nta)%r, rho_atc(1,nta), drhocc)
rgrid(nta)%r, upf(nta)%rho_atc, drhocc)
do ig=1,ngm
exg = tpi* ( g(1,ig)*tau(1,na) + &
g(2,ig)*tau(2,na) + &
@ -74,9 +83,10 @@ subroutine dynmatcc(dyncc)
end do
do nb=1,nat
ntb=ityp(nb)
if (nlcc(ntb)) then
if ( upf(ntb)%nlcc ) then
call drhoc (ngm, gg, omega, tpiba2, rgrid(ntb)%mesh, &
rgrid(ntb)%dx, rgrid(ntb)%r, rho_atc(1,ntb), drhocc)
rgrid(ntb)%dx, rgrid(ntb)%r, upf(ntb)%rho_atc,&
drhocc)
do ig=1,ngm
exg = tpi* ( g(1,ig)*tau(1,nb) + &
g(2,ig)*tau(2,nb) + &

5
Modules/atom.f90
View File

@ -13,7 +13,7 @@ MODULE atom
!
USE kinds, ONLY : DP
USE parameters, ONLY : npsx
USE radial_grids, ONLY : ndmx, radial_grid_type
USE radial_grids, ONLY : radial_grid_type
!
SAVE
!
@ -21,9 +21,6 @@ MODULE atom
rgrid(npsx) ! the information on atomic radial grids.
! NB: some of the subsequent data are therefore redundant
! and will be eliminated in due course asap
REAL(DP) :: &
rho_at(ndmx,npsx), &! radial atomic charge density
rho_atc(ndmx,npsx) ! radial core charge density
INTEGER :: &
msh(npsx) ! the point at rcut
LOGICAL :: &

2
Modules/parameters.f90
View File

@ -30,8 +30,6 @@ MODULE parameters
INTEGER, PARAMETER :: nacx = 10 ! max number of averaged
! quantities saved to the restart
INTEGER, PARAMETER :: nsx = ntypx ! maximum number of species
INTEGER, PARAMETER :: natx = 5000 ! maximum number of atoms
INTEGER, PARAMETER :: nbndxx = 10000 ! maximum number of electronic states
INTEGER, PARAMETER :: npkx = npk ! maximum number of K points
INTEGER, PARAMETER :: nspinx = 2 ! maximum number of spinors

38
Modules/read_cards.f90
View File

@ -23,8 +23,6 @@ MODULE read_cards_module
!
IMPLICIT NONE
!
INTEGER, PARAMETER :: nbndxx = 10000
!
SAVE
!
PRIVATE
@ -1947,28 +1945,33 @@ MODULE read_cards_module
CHARACTER(LEN=256) :: input_line
LOGICAL, SAVE :: tread = .FALSE.
INTEGER :: i, s, nksx
INTEGER, ALLOCATABLE :: is( :, : )
TYPE occupancy_type
INTEGER, pointer :: occs(:)
END TYPE occupancy_type
TYPE(occupancy_type), ALLOCATABLE :: is(:)
!
IF ( tread ) THEN
CALL errore( ' card_ksout ', ' two occurrence ', 2 )
END IF
!
ALLOCATE( is( nbndxx, nspin ) )
!
nprnks = 0
nksx = 0
!
ALLOCATE ( is (nspin) )
!
DO s = 1, nspin
!
CALL read_line( input_line )
READ(input_line, *) nprnks( s )
!
IF ( nprnks( s ) > nbndxx .OR. nprnks( s ) < 1 ) THEN
IF ( nprnks( s ) < 1 ) THEN
CALL errore( ' card_ksout ', ' wrong number of states ', 2 )
END IF
!
ALLOCATE( is(s)%occs( 1:nprnks(s) ) )
!
CALL read_line( input_line )
READ(input_line, *) ( is( i, s ), i = 1, nprnks( s ) )
READ(input_line, *) ( is(s)%occs(i), i = 1, nprnks( s ) )
!
nksx = MAX( nksx, nprnks( s ) )
!
@ -1980,10 +1983,12 @@ MODULE read_cards_module
!
DO i = 1, nprnks( s )
!
iprnks( i, s ) = is( i, s )
iprnks( i, s ) = is(s)%occs(i)
!
END DO
!
DEALLOCATE( is(s)%occs )
!
END DO
!
DEALLOCATE( is )
@ -2048,13 +2053,16 @@ MODULE read_cards_module
CHARACTER(LEN=256) :: input_line
LOGICAL, SAVE :: tread = .FALSE.
INTEGER :: nksx, i, s
INTEGER, ALLOCATABLE :: is( :, : )
TYPE occupancy_type
INTEGER, pointer :: occs(:)
END TYPE occupancy_type
TYPE(occupancy_type), ALLOCATABLE :: is(:)
!
IF ( tread ) THEN
CALL errore( ' card_ksout_empty ', ' two occurrence ', 2 )
END IF
!
ALLOCATE( is( nbndxx, nspin ) )
ALLOCATE ( is (nspin) )
!
nprnks_empty = 0
nksx = 0
@ -2064,12 +2072,14 @@ MODULE read_cards_module
CALL read_line( input_line )
READ(input_line,*) nprnks_empty( s )
!
IF ( ( nprnks_empty( s ) > nbndxx ) .OR. ( nprnks_empty( s ) < 1 ) ) THEN
IF ( nprnks_empty( s ) < 1 ) THEN
CALL errore( ' card_ksout_empty ', ' wrong number of states ', 2 )
END IF
!
ALLOCATE( is(s)%occs( 1:nprnks_empty( s ) ) )
!
CALL read_line( input_line )
READ(input_line,*) ( is( i, s ), i = 1, nprnks_empty( s ) )
READ(input_line,*) ( is(s)%occs( i ), i = 1, nprnks_empty( s ) )
!
nksx = MAX( nksx, nprnks_empty( s ) )
!
@ -2081,10 +2091,12 @@ MODULE read_cards_module
!
DO i = 1, nprnks_empty( s )
!
iprnks_empty( i, s ) = is( i, s )
iprnks_empty( i, s ) = is(s)%occs( i )
!
END DO
!
DEALLOCATE( is(s)%occs )
!
END DO
!
DEALLOCATE( is )

13
Modules/read_paw.f90
View File

@ -328,7 +328,7 @@ subroutine set_pseudo_paw (is, pawset)
!
! PWSCF modules
!
USE atom, ONLY: rgrid, msh, rho_at, rho_atc, nlcc
USE atom, ONLY: rgrid, msh, nlcc
USE uspp_param, ONLY: upf
USE funct, ONLY: set_dft_from_name, dft_is_meta, dft_is_hybrid
!
@ -545,10 +545,10 @@ subroutine set_pseudo_paw (is, pawset)
!!$ endif
!
if ( pawset%nlcc) then
rho_atc(1:pawset%grid%mesh, is) = pawset%psccharge(1:pawset%grid%mesh) &
& / FPI / pawset%grid%r2(1:pawset%grid%mesh)
else
rho_atc(:,is) = 0.d0
allocate ( upf(is)%rho_atc(pawset%grid%mesh) )
upf(is)%rho_atc(1:pawset%grid%mesh) = &
pawset%psccharge(1:pawset%grid%mesh) &
/ FPI / pawset%grid%r2(1:pawset%grid%mesh)
end if
aerho_atc(1:pawset%grid%mesh, is) = pawset%aeccharge(1:pawset%grid%mesh) &
@ -560,7 +560,8 @@ subroutine set_pseudo_paw (is, pawset)
psrho_atc(:,is) = 0._dp
end if
!
rho_at (1:pawset%grid%mesh, is) = pawset%pscharge(1:pawset%grid%mesh)
allocate ( upf(is)%rho_atc(pawset%grid%mesh) )
upf(is)%rho_at (1:pawset%grid%mesh) = pawset%pscharge(1:pawset%grid%mesh)
allocate (upf(is)%vloc(1:pawset%grid%mesh))
upf(is)%vloc(1:pawset%grid%mesh) = pawset%psloc(1:pawset%grid%mesh)

9
Modules/upf_to_internal.f90
View File

@ -28,7 +28,7 @@ subroutine set_pseudo_upf (is, upf)
! set "is"-th pseudopotential using the Unified Pseudopotential Format
! dummy argument ( upf ) - convert and copy to internal variables
!
USE atom, ONLY: rgrid, rho_at, rho_atc, nlcc
USE atom, ONLY: rgrid, nlcc
USE uspp_param, ONLY: tvanp
USE funct, ONLY: set_dft_from_name, set_dft_from_indices, dft_is_meta
!
@ -65,13 +65,6 @@ subroutine set_pseudo_upf (is, upf)
rgrid(is)%r (1:upf%mesh) = upf%r (1:upf%mesh)
rgrid(is)%rab(1:upf%mesh) = upf%rab(1:upf%mesh)
!
if ( upf%nlcc) then
rho_atc(1:upf%mesh, is) = upf%rho_atc(1:upf%mesh)
else
rho_atc(:,is) = 0.0_DP
end if
rho_at (1:upf%mesh, is) = upf%rho_at (1:upf%mesh)
end subroutine set_pseudo_upf

13
PH/set_drhoc.f90
View File

@ -13,9 +13,12 @@ subroutine set_drhoc (q)
! used to calculate derivatives of the core charge
!
#include "f_defs.h"
USE constants, ONLY : fpi
USE cell_base, ONLY : omega, tpiba2
USE gvect, ONLY : g, ngm
USE ions_base, ONLY : ntyp => nsp
use pwcom
USE atom, ONLY : nlcc, msh, rgrid, rho_atc
USE atom, ONLY : msh, rgrid
USE uspp_param, ONLY : upf
USE kinds, only : DP
use phcom
implicit none
@ -43,17 +46,17 @@ subroutine set_drhoc (q)
gq2 = gq2 * tpiba2
do nt = 1, ntyp
rhocgnt = 0.d0
if (nlcc (nt) ) then
if ( upf(nt)%nlcc ) then
if (gq2 < 1.0d-8) then
do ir = 1, msh (nt)
aux (ir) = rgrid(nt)%r(ir) **2 * rho_atc (ir, nt)
aux (ir) = rgrid(nt)%r(ir) **2 * upf(nt)%rho_atc (ir)
enddo
call simpson (msh (nt), aux, rgrid(nt)%rab, rhocgip)
else
gx = sqrt (gq2)
call sph_bes (msh (nt), rgrid(nt)%r, gx, 0, aux)
do ir = 1, msh (nt)
aux (ir) = rgrid(nt)%r(ir) **2 * rho_atc (ir, nt) * aux (ir)
aux (ir) = rgrid(nt)%r(ir) **2 * upf(nt)%rho_atc(ir) * aux(ir)
enddo
call simpson (msh (nt), aux, rgrid(nt)%rab, rhocgip)
endif

13
PP/add_shift_cc.f90
View File

@ -1,5 +1,5 @@
!
! Copyright (C) 2001 PWSCF group
! Copyright (C) 2001-2007 Quantum-Espresso group
! This file is distributed under the terms of the
! GNU General Public License. See the file `License'
! in the root directory of the present distribution,
@ -13,7 +13,8 @@ subroutine add_shift_cc (shift_cc)
#include "f_defs.h"
USE kinds, ONLY : DP
USE constants, ONLY: tpi
USE atom, ONLY: rho_atc, rgrid, nlcc
USE atom, ONLY: rgrid
USE uspp_param, ONLY: upf
USE ions_base, ONLY: nat, ntyp => nsp, ityp, tau
USE cell_base, ONLY: alat, omega, tpiba, tpiba2
USE gvect, ONLY: ngm, gstart, nr1, nr2, nr3, nrx1, nrx2, nrx3, &
@ -43,9 +44,7 @@ subroutine add_shift_cc (shift_cc)
! radial fourier trasform of rho core
real(DP) :: arg, fact
!
do nt = 1, ntyp
if (nlcc (nt) ) goto 15
enddo
if ( ANY (upf(1:ntyp)%nlcc) ) goto 15
return
!
15 continue
@ -83,10 +82,10 @@ subroutine add_shift_cc (shift_cc)
! g = 0 term gives no contribution
!
do nt = 1, ntyp
if (nlcc (nt) ) then
if ( upf(nt)%nlcc ) then
call drhoc (ngl, gl, omega, tpiba2, rgrid(nt)%mesh, rgrid(nt)%r, &
rgrid(nt)%rab, rho_atc (1, nt), rhocg)
rgrid(nt)%rab, upf(nt)%rho_atc, rhocg)
do na = 1, nat
if (nt == ityp (na) ) then
if (gstart.eq.2) shift_(na) = omega * rhocg (igtongl (1) ) * &

12
PW/atomic_rho.f90
View File

@ -1,5 +1,5 @@
!
! Copyright (C) 2001 PWSCF group
! Copyright (C) 2001-2007 Quantum-Espresso group
! This file is distributed under the terms of the
! GNU General Public License. See the file `License'
! in the root directory of the present distribution,
@ -28,7 +28,7 @@ subroutine atomic_rho (rhoa, nspina)
!
USE kinds, ONLY : DP
USE io_global, ONLY : stdout
USE atom, ONLY : rgrid, msh, rho_at
USE atom, ONLY : rgrid, msh
USE ions_base, ONLY : ntyp => nsp
USE cell_base, ONLY : tpiba, omega
USE gvect, ONLY : ngm, ngl, nrxx, nr1, nr2, nr3, nrx1, nrx2, &
@ -38,6 +38,7 @@ subroutine atomic_rho (rhoa, nspina)
USE wvfct, ONLY : gamma_only
USE wavefunctions_module, ONLY : psic
USE noncollin_module, ONLY : angle1, angle2
USE uspp_param, ONLY : upf
!
implicit none
!
@ -71,7 +72,7 @@ subroutine atomic_rho (rhoa, nspina)
!
if (gstart == 2) then
do ir = 1, msh (nt)
aux (ir) = rho_at (ir, nt)
aux (ir) = upf(nt)%rho_at (ir)
enddo
call simpson (msh (nt), aux, rgrid(nt)%rab, rhocgnt (1) )
endif
@ -82,9 +83,10 @@ subroutine atomic_rho (rhoa, nspina)
gx = sqrt (gl (igl) ) * tpiba
do ir = 1, msh (nt)
if (rgrid(nt)%r(ir) < 1.0d-8) then
aux(ir) = rho_at(ir,nt)
aux(ir) = upf(nt)%rho_at(ir)
else
aux(ir) = rho_at(ir,nt) * sin(gx*rgrid(nt)%r(ir)) / (rgrid(nt)%r(ir)*gx)
aux(ir) = upf(nt)%rho_at(ir) * &
sin(gx*rgrid(nt)%r(ir)) / (rgrid(nt)%r(ir)*gx)
endif
enddo
call simpson (msh (nt), aux, rgrid(nt)%rab, rhocgnt (igl) )

11
PW/force_cc.f90
View File

@ -13,7 +13,8 @@ subroutine force_cc (forcecc)
!
USE kinds, ONLY : DP
USE constants, ONLY : tpi
USE atom, ONLY : rho_atc, rgrid, nlcc
USE atom, ONLY : rgrid
USE uspp_param, ONLY : upf
USE ions_base, ONLY : nat, ntyp => nsp, ityp, tau
USE cell_base, ONLY : alat, omega, tpiba, tpiba2
USE gvect, ONLY : ngm, gstart, nr1, nr2, nr3, nrx1, nrx2, &
@ -47,9 +48,7 @@ subroutine force_cc (forcecc)
!
forcecc(:,:) = 0.d0
do nt = 1, ntyp
if (nlcc (nt) ) goto 15
enddo
if ( ANY ( upf(1:ntyp)%nlcc ) ) go to 15
return
!
15 continue
@ -85,10 +84,10 @@ subroutine force_cc (forcecc)
! g = 0 term gives no contribution
!
do nt = 1, ntyp
if (nlcc (nt) ) then
if ( upf(nt)%nlcc ) then
call drhoc (ngl, gl, omega, tpiba2, rgrid(nt)%mesh, rgrid(nt)%r,&
rgrid(nt)%rab, rho_atc (1, nt), rhocg)
rgrid(nt)%rab, upf(nt)%rho_atc, rhocg)
do na = 1, nat
if (nt.eq.ityp (na) ) then
do ig = gstart, ngm

10
PW/force_corr.f90
View File

@ -1,5 +1,5 @@
!
! Copyright (C) 2001-2003 PWSCF group
! Copyright (C) 2001-2007 Quantum-Espresso group
! This file is distributed under the terms of the
! GNU General Public License. See the file `License'
! in the root directory of the present distribution,
@ -20,7 +20,8 @@ subroutine force_corr (forcescc)
!
USE kinds, ONLY : DP
USE constants, ONLY : tpi
USE atom, ONLY : rho_at, msh, rgrid
USE atom, ONLY : msh, rgrid
USE uspp_param, ONLY : upf
USE ions_base, ONLY : nat, ntyp => nsp, ityp, tau
USE cell_base, ONLY : tpiba
USE gvect, ONLY : ngm, gstart, nr1, nr2, nr3, nrx1, nrx2, &
@ -72,9 +73,10 @@ subroutine force_corr (forcescc)
gx = sqrt (gl (ig) ) * tpiba
do ir = 1, msh (nt)
if (rgrid(nt)%r(ir) .lt.1.0d-8) then
aux (ir) = rho_at (ir, nt)
aux (ir) = upf(nt)%rho_at (ir)
else
aux (ir) = rho_at (ir, nt) * sin(gx*rgrid(nt)%r(ir))/(rgrid(nt)%r(ir)*gx)
aux (ir) = upf(nt)%rho_at (ir) * &
sin(gx*rgrid(nt)%r(ir)) / (rgrid(nt)%r(ir)*gx)
endif
enddo
call simpson (msh (nt), aux, rgrid(nt)%rab, rhocgnt (ig) )

2
PW/potinit.f90
View File

@ -1,5 +1,5 @@
!
! Copyright (C) 2001-2006 Quantum-ESPRESSO group
! Copyright (C) 2001-2007 Quantum-Espresso group
! This file is distributed under the terms of the
! GNU General Public License. See the file `License'
! in the root directory of the present distribution,

2
PW/rad_paw_routines.f90
View File

@ -49,7 +49,7 @@
MODULE rad_paw_routines
!
USE kinds, ONLY : DP
USe parameters, ONLY : ntypx, natx
USe parameters, ONLY : ntypx
!
IMPLICIT NONE

2
PW/rad_paw_trash.f90
View File

@ -646,7 +646,7 @@ END SUBROUTINE integrate_pfunc
USE gvect, ONLY : nr1, nr2, nr3, nrx1, nrx2, nrx3, nrxx, &
ngm, nl, nlm, gg, g
USE lsda_mod, ONLY : nspin
USE uspp_param, ONLY : lmaxq, tvanp, nh, nhm
USE uspp_param, ONLY : lmaxq, nh, nhm
USE wvfct, ONLY : gamma_only
USE wavefunctions_module, ONLY : psic
!

11
PW/set_rhoc.f90
View File

@ -16,7 +16,8 @@ subroutine set_rhoc
!
USE io_global, ONLY : stdout
USE kinds, ONLY : DP
USE atom, ONLY : rho_atc, msh, rgrid, nlcc
USE atom, ONLY : msh, rgrid
USE uspp_param,ONLY : upf
USE ions_base, ONLY : ntyp => nsp
USE cell_base, ONLY : omega, tpiba2
USE ener, ONLY : etxcc
@ -51,9 +52,7 @@ subroutine set_rhoc
! counter on g vectors
etxcc = 0.0_DP
do nt = 1, ntyp
if (nlcc (nt) ) goto 10
enddo
if ( ANY( upf(1:ntyp)%nlcc ) ) goto 10
rhog_core(:) = 0.0_DP
rho_core(:) = 0.0_DP
@ -68,12 +67,12 @@ subroutine set_rhoc
! the sum is on atom types
!
do nt = 1, ntyp
if (nlcc (nt) ) then
if ( upf(nt)%nlcc ) then
!
! drhoc compute the radial fourier transform for each shell of g vec
!
call drhoc (ngl, gl, omega, tpiba2, msh (nt), rgrid(nt)%r, &
rgrid(nt)%rab, rho_atc (1, nt), rhocg)
rgrid(nt)%rab, upf(nt)%rho_atc, rhocg)
!
! multiply by the structure factor and sum
!

13
PW/stres_cc.f90
View File

@ -12,7 +12,8 @@ subroutine stres_cc (sigmaxcc)
!-----------------------------------------------------------------------
!
USE kinds, ONLY : DP
USE atom, ONLY : rho_atc, rgrid, nlcc
USE atom, ONLY : rgrid
USE uspp_param, ONLY : upf
USE ions_base, ONLY : ntyp => nsp
USE cell_base, ONLY : alat, omega, tpiba, tpiba2
USE gvect, ONLY : ngm, gstart, nr1, nr2, nr3, nrx1, nrx2, &
@ -35,9 +36,7 @@ subroutine stres_cc (sigmaxcc)
real(DP) , allocatable:: rhocg (:), vxc (:,:)
sigmaxcc(:,:) = 0.d0
do nt = 1, ntyp
if (nlcc (nt) ) goto 15
enddo
if ( ANY (upf(1:ntyp)%nlcc) ) goto 15
return
@ -69,9 +68,9 @@ subroutine stres_cc (sigmaxcc)
fact = 1.d0
end if
do nt = 1, ntyp
if (nlcc (nt) ) then
if ( upf(nt)%nlcc ) then
call drhoc (ngl, gl, omega, tpiba2, rgrid(nt)%mesh, rgrid(nt)%r, &
rgrid(nt)%rab, rho_atc (1, nt), rhocg)
rgrid(nt)%rab, upf(nt)%rho_atc, rhocg)
! diagonal term
if (gstart==2) sigmadiag = sigmadiag + &
CONJG(psic (nl(1) ) ) * strf (1,nt) * rhocg (igtongl (1) )
@ -81,7 +80,7 @@ subroutine stres_cc (sigmaxcc)
enddo
call deriv_drhoc (ngl, gl, omega, tpiba2, rgrid(nt)%mesh, &
rgrid(nt)%r, rgrid(nt)%rab, rho_atc (1, nt), rhocg)
rgrid(nt)%r, rgrid(nt)%rab, upf(nt)%rho_atc, rhocg)
! non diagonal term (g=0 contribution missing)
do ng = gstart, ngm
do l = 1, 3

4
PW/summary.f90
View File

@ -404,7 +404,7 @@ SUBROUTINE print_ps_info
USE io_global, ONLY : stdout
USE io_files, ONLY : psfile
USE ions_base, ONLY : ntyp => nsp
USE atom, ONLY : rgrid, nlcc
USE atom, ONLY : rgrid
USE uspp_param, ONLY : upf
USE grid_paw_variables, ONLY: tpawp
!
@ -421,7 +421,7 @@ SUBROUTINE print_ps_info
ps='Norm-conserving'
END IF
!
IF ( nlcc(nt) ) ps = TRIM(ps) // ' + core correction'
IF ( upf(nt)%nlcc ) ps = TRIM(ps) // ' + core correction'
!
WRITE( stdout, '(/5x,"PseudoPot. #",i2," for ",a2," read from file ",a)')&
nt, upf(nt)%psd, TRIM (psfile(nt))