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

Protect access to gl and igtongl

This commit is contained in:
Pietro 2019-02-22 11:53:54 +00:00 committed by giannozz
parent bd4e9ea602
commit 542ccadb18
9 changed files with 77 additions and 79 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
CPV/src/dealloc.f90
View File

@ -59,7 +59,8 @@ SUBROUTINE deallocate_modules_var()
CALL deallocate_cg( )
CALL deallocate_core()
CALL deallocate_uspp()
CALL deallocate_gvect()
CALL deallocate_gvect(.TRUE.) ! Value .true. is hard coded in init.f90:195,
! here it prevents double free of gg variable.
CALL deallocate_gvecw()
CALL deallocate_smallbox_gvec( )
CALL deallocate_local_pseudo()

2
CPV/src/init.f90
View File

@ -31,7 +31,7 @@
USE recvec_subs, ONLY: ggen, ggens
USE gvect, ONLY: mill_g, eigts1,eigts2,eigts3, g, gg, &
ecutrho, gcutm, gvect_init, mill, &
ig_l2g, gstart, ngm, ngm_g
ig_l2g, gstart, ngm, ngm_g, gshells
use gvecs, only: gcutms, gvecs_init, ngms
use gvecw, only: gkcut, gvecw_init, g2kin_init
USE smallbox_subs, ONLY: ggenb

70
Modules/recvec.f90
View File

@ -41,8 +41,8 @@
! gl(i) = i-th shell of G^2 (in units of tpiba2)
! igtongl(n) = shell index for n-th G-vector
!
REAL(DP), POINTER :: gl(:)
INTEGER, ALLOCATABLE, TARGET :: igtongl(:)
REAL(DP), POINTER, PROTECTED :: gl(:)
INTEGER, ALLOCATABLE, TARGET, PROTECTED :: igtongl(:)
!
! G-vectors cartesian components ( in units tpiba =(2pi/a) )
!
@ -103,7 +103,18 @@
!
END SUBROUTINE gvect_init
SUBROUTINE deallocate_gvect()
SUBROUTINE deallocate_gvect(vc)
IMPLICIT NONE
!
LOGICAL, OPTIONAL, INTENT(IN) :: vc
LOGICAL :: vc_
!
vc_ = .false.
IF (PRESENT(vc)) vc_ = vc
IF ( .NOT. vc_ ) THEN
IF ( ASSOCIATED( gl ) ) DEALLOCATE ( gl )
END IF
!
IF( ALLOCATED( gg ) ) DEALLOCATE( gg )
IF( ALLOCATED( g ) ) DEALLOCATE( g )
IF( ALLOCATED( mill_g ) ) DEALLOCATE( mill_g )
@ -122,6 +133,59 @@
IF( ALLOCATED( igtongl ) ) DEALLOCATE( igtongl )
IF( ALLOCATED( ig_l2g ) ) DEALLOCATE( ig_l2g )
END SUBROUTINE deallocate_gvect_exx
!
!-----------------------------------------------------------------------
SUBROUTINE gshells ( vc )
!----------------------------------------------------------------------
!
! calculate number of G shells: ngl, and the index ng = igtongl(ig)
! that gives the shell index ng for (local) G-vector of index ig
!
USE kinds, ONLY : DP
USE constants, ONLY : eps8
!
IMPLICIT NONE
!
LOGICAL, INTENT(IN) :: vc
!
INTEGER :: ng, igl
!
IF ( vc ) THEN
!
! in case of a variable cell run each G vector has its shell
!
ngl = ngm
gl => gg
DO ng = 1, ngm
igtongl (ng) = ng
ENDDO
ELSE
!
! G vectors are grouped in shells with the same norm
!
ngl = 1
igtongl (1) = 1
DO ng = 2, ngm
IF (gg (ng) > gg (ng - 1) + eps8) THEN
ngl = ngl + 1
ENDIF
igtongl (ng) = ngl
ENDDO
ALLOCATE (gl( ngl))
gl (1) = gg (1)
igl = 1
DO ng = 2, ngm
IF (gg (ng) > gg (ng - 1) + eps8) THEN
igl = igl + 1
gl (igl) = gg (ng)
ENDIF
ENDDO
IF (igl /= ngl) CALL errore ('gshells', 'igl <> ngl', ngl)
ENDIF
END SUBROUTINE gshells
!=----------------------------------------------------------------------------=!
END MODULE gvect
!=----------------------------------------------------------------------------=!

55
Modules/recvec_subs.f90
View File

@ -318,58 +318,3 @@ CONTAINS
!=----------------------------------------------------------------------=
END MODULE recvec_subs
!=----------------------------------------------------------------------=
!
!-----------------------------------------------------------------------
SUBROUTINE gshells ( vc )
!----------------------------------------------------------------------
!
! calculate number of G shells: ngl, and the index ng = igtongl(ig)
! that gives the shell index ng for (local) G-vector of index ig
!
USE kinds, ONLY : DP
USE gvect, ONLY : gg, ngm, gl, ngl, igtongl
USE constants, ONLY : eps8
!
IMPLICIT NONE
!
LOGICAL, INTENT(IN) :: vc
!
INTEGER :: ng, igl
!
IF ( vc ) THEN
!
! in case of a variable cell run each G vector has its shell
!
ngl = ngm
gl => gg
DO ng = 1, ngm
igtongl (ng) = ng
ENDDO
ELSE
!
! G vectors are grouped in shells with the same norm
!
ngl = 1
igtongl (1) = 1
DO ng = 2, ngm
IF (gg (ng) > gg (ng - 1) + eps8) THEN
ngl = ngl + 1
ENDIF
igtongl (ng) = ngl
ENDDO
ALLOCATE (gl( ngl))
gl (1) = gg (1)
igl = 1
DO ng = 2, ngm
IF (gg (ng) > gg (ng - 1) + eps8) THEN
igl = igl + 1
gl (igl) = gg (ng)
ENDIF
ENDDO
IF (igl /= ngl) CALL errore ('gshells', 'igl <> ngl', ngl)
ENDIF
END SUBROUTINE gshells

2
PP/src/vasp_xml_module.f90
View File

@ -110,7 +110,7 @@ SUBROUTINE readxmlfile_vasp(iexch,icorr,igcx,igcc,inlc,ierr)
USE fft_types, ONLY : fft_type_allocate
USE recvec_subs, ONLY : ggen, ggens
USE gvect, ONLY : gg, ngm, g, gcutm, mill, ngm_g, ig_l2g, &
eigts1, eigts2, eigts3, gstart
eigts1, eigts2, eigts3, gstart, gshells
USE fft_base, ONLY : dfftp, dffts
USE gvecs, ONLY : ngms, gcutms
USE spin_orb, ONLY : lspinorb, domag

18
PW/src/clean_pw.f90
View File

@ -24,12 +24,10 @@ SUBROUTINE clean_pw( lflag )
USE basis, ONLY : swfcatom
USE cellmd, ONLY : lmovecell
USE ions_base, ONLY : deallocate_ions_base
USE gvect, ONLY : g, gg, gl, igtongl, mill, &
eigts1, eigts2, eigts3
USE fixed_occ, ONLY : f_inp
USE ktetra, ONLY : deallocate_tetra
USE klist, ONLY : deallocate_igk
USE gvect, ONLY : ig_l2g
USE gvect, ONLY : deallocate_gvect
USE vlocal, ONLY : strf, vloc
USE wvfct, ONLY : g2kin, et, wg, btype
USE force_mod, ONLY : force
@ -108,21 +106,14 @@ SUBROUTINE clean_pw( lflag )
!
IF ( ALLOCATED( f_inp ) .and. lflag ) DEALLOCATE( f_inp )
!
! ... arrays allocated in ggen.f90
! ... arrays in gvect module
!
IF ( ALLOCATED( ig_l2g ) ) DEALLOCATE( ig_l2g )
IF ( .NOT. lmovecell ) THEN
IF ( ASSOCIATED( gl ) ) DEALLOCATE ( gl )
END IF
CALL deallocate_gvect(lmovecell)
!
CALL sym_rho_deallocate ( )
!
! ... arrays allocated in allocate_fft.f90 ( and never deallocated )
!
IF ( ALLOCATED( g ) ) DEALLOCATE( g )
IF ( ALLOCATED( gg ) ) DEALLOCATE( gg )
IF ( ALLOCATED( igtongl ) ) DEALLOCATE( igtongl )
IF ( ALLOCATED( mill ) ) DEALLOCATE( mill )
call destroy_scf_type(rho)
call destroy_scf_type(v)
call destroy_scf_type(vnew)
@ -143,9 +134,6 @@ SUBROUTINE clean_pw( lflag )
IF ( ALLOCATED( cutoff_2D ) ) DEALLOCATE( cutoff_2D )
IF ( ALLOCATED( lr_Vloc ) ) DEALLOCATE( lr_Vloc )
IF ( ALLOCATED( strf ) ) DEALLOCATE( strf )
IF ( ALLOCATED( eigts1 ) ) DEALLOCATE( eigts1 )
IF ( ALLOCATED( eigts2 ) ) DEALLOCATE( eigts2 )
IF ( ALLOCATED( eigts3 ) ) DEALLOCATE( eigts3 )
!
! ... arrays allocated in allocate_nlpot.f90 ( and never deallocated )
!

2
PW/src/exx_band.f90
View File

@ -943,7 +943,7 @@ MODULE exx_band
USE cellmd, ONLY : lmovecell
USE wvfct, ONLY : npwx
USE gvect, ONLY : gcutm, ig_l2g, g, gg, ngm, ngm_g, mill, &
gstart, gvect_init, deallocate_gvect_exx
gstart, gvect_init, deallocate_gvect_exx, gshells
USE gvecs, ONLY : gcutms, ngms, ngms_g, gvecs_init
USE gvecw, ONLY : gkcut, ecutwfc, gcutw
USE klist, ONLY : xk, nks, ngk

2
PW/src/init_run.f90
View File

@ -14,7 +14,7 @@ SUBROUTINE init_run()
USE wvfct, ONLY : nbnd, et, wg, btype
USE control_flags, ONLY : lmd, gamma_only, smallmem, ts_vdw
USE gvect, ONLY : g, gg, mill, gcutm, ig_l2g, ngm, ngm_g, &
gstart ! to be comunicated to the Solvers if gamma_only
gshells, gstart ! to be comunicated to the Solvers if gamma_only
USE gvecs, ONLY : gcutms, ngms
USE cell_base, ONLY : at, bg, set_h_ainv
USE cellmd, ONLY : lmovecell

2
PW/src/read_file_new.f90
View File

@ -114,7 +114,7 @@ SUBROUTINE read_xml_file ( wfc_is_collected )
USE fft_types, ONLY : fft_type_allocate
USE recvec_subs, ONLY : ggen, ggens
USE gvect, ONLY : gg, ngm, g, gcutm, mill, ngm_g, ig_l2g, &
eigts1, eigts2, eigts3, gstart
eigts1, eigts2, eigts3, gstart, gshells
USE fft_base, ONLY : dfftp, dffts
USE gvecs, ONLY : ngms, gcutms
USE spin_orb, ONLY : lspinorb, domag