mirror of https://gitlab.com/QEF/q-e.git
Protect access to gl and igtongl
This commit is contained in:
parent
bd4e9ea602
commit
542ccadb18
|
@ -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()
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
!=----------------------------------------------------------------------------=!
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 )
|
||||
!
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue