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

First batch of changes to make atomic positions in CP and in PW more 

similar: removed redundant variables, notably structures "atom_type"


git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@9238 c92efa57-630b-4861-b058-cf58834340f0
This commit is contained in:
giannozz 2012-07-26 16:00:04 +00:00
parent 560d53e316
commit 5aedeefd40
10 changed files with 14 additions and 636 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
CPV/src/Makefile
View File

@ -6,7 +6,6 @@ include ../../make.sys
MODFLAGS= $(MOD_FLAG)../../iotk/src $(MOD_FLAG)../../Modules $(MOD_FLAG).
FOBJS = \
atoms_type.o \
berryion.o \
berry_phase.o \
bforceion.o \

184
CPV/src/atoms_type.f90
View File

@ -1,184 +0,0 @@
!
! Copyright (C) 2002-2005 FPMD-CPV 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,
! or http://www.gnu.org/copyleft/gpl.txt .
!
!=----------------------------------------------------------------------------=!
MODULE atoms_type_module
!=----------------------------------------------------------------------------=!
! this module contains the definition of TYPE structure
! relative to the ionic degrees of freedom
USE kinds
USE parameters, ONLY: nsx
IMPLICIT NONE
SAVE
PRIVATE
! ... title ...
TYPE atoms_type
INTEGER :: doft ! total number of degree_of_freedom
INTEGER :: nsp ! number of species
INTEGER :: nat ! total number of atoms
INTEGER :: nax ! maximum number of atoms per specie
INTEGER :: dof(nsx) ! degree_of_freedom for each specie
CHARACTER(LEN=3) :: label(nsx) ! atomic labels
INTEGER :: na(nsx) ! number of atoms per specie
INTEGER :: isa(nsx) ! index of the first atom (in the whole list) of a given specie
REAL(DP) :: m(nsx) ! atomic masses
REAL(DP), POINTER :: taur(:,:) ! (3,nat)
REAL(DP), POINTER :: taus(:,:) ! (3,nat)
! ... tau: atomic positions, sorted by specie. Atomic positions of specie "is" are
! stored in array elements whose index are "isa(is) ... isa(is)+na(is)-1"
REAL(DP), POINTER :: vels(:,:) ! (3,nat) ! scaled velocities, same layout of "tau"
REAL(DP), POINTER :: for (:,:) ! (3,nat) ! total force acting on the atom
INTEGER, POINTER :: mobile(:,:) ! (3,nat) ! atomic freedom, same layout of "tau" ( 1 atom can move )
INTEGER, POINTER :: ityp(:) ! (nat) ! index of the specie to which the atom belong
LOGICAL :: tscfor ! indicate if the force are scaled or real
REAL(DP) :: ekin(nsx) ! kinetic energy per specie
REAL(DP) :: ekint ! total kinetic energy
END TYPE atoms_type
PUBLIC :: atoms_type
PUBLIC :: atoms_type_init
!=----------------------------------------------------------------------------=!
CONTAINS
!=----------------------------------------------------------------------------=!
! subroutines
SUBROUTINE specie_index(isa, na, is, ia)
INTEGER, INTENT(IN) :: isa, na(:)
INTEGER, INTENT(OUT) :: is, ia
INTEGER :: i, nat
nat = 0
ia = 0
is = 0
LOOP: DO i = 1, SIZE( na )
IF( (nat + na(i) ) >= isa ) THEN
ia = isa - nat
is = i
EXIT LOOP
ELSE
nat = nat + na(i)
END IF
END DO LOOP
RETURN
END SUBROUTINE specie_index
SUBROUTINE atoms_type_init(atoms, staur, ismbl, label, pma, na, nsp, h)
USE cell_base, ONLY: s_to_r
TYPE (atoms_type) :: atoms
REAL(DP), INTENT(IN) :: staur(:,:)
LOGICAL, INTENT(IN) :: ismbl(:,:)
REAL(DP), INTENT(IN) :: pma(:), h(3,3)
INTEGER, INTENT(IN) :: na(:), nsp
CHARACTER(LEN=3), INTENT(IN) :: label(:)
INTEGER :: nax, nat
INTEGER :: ierr, is, ia, isa, isatop
nat = SUM( na( 1 : nsp ) )
nax = MAXVAL( na( 1 : nsp ) )
IF( SIZE( na ) < nsp ) &
CALL errore(' atoms_type_init ', ' wrong na dimensions ', 1)
IF( SIZE( pma ) < nsp ) &
CALL errore(' atoms_type_init ', ' wrong pma dimensions ', 1)
IF( nsp < 1 ) THEN
CALL errore(' atoms_type_init ', ' nsp less than one ', 3)
END IF
IF( nax < 1 ) THEN
CALL errore(' atoms_type_init ', ' nax less than one ', 4)
END IF
IF( nat < 1 ) THEN
CALL errore(' atoms_type_init ', ' nat less than one ', 5)
END IF
IF( ( nat > SIZE(ismbl, 2) ) ) THEN
CALL errore(' atoms_type_init ', ' invalid nat ', 6)
END IF
IF( ( nat > SIZE(staur, 2) ) ) THEN
CALL errore(' atoms_type_init ', ' invalid nat ', 6)
END IF
atoms%nsp = nsp
atoms%nat = nat
atoms%nax = nax
atoms%ekint = 0.0d0
isa = 1
atoms%taus = 0.0d0
atoms%vels = 0.0d0
atoms%for = 0.0d0
atoms%mobile = 0
atoms%ityp = 0
atoms%tscfor = .FALSE.
DO is = 1, nsp
atoms%na(is) = na(is)
atoms%m(is) = pma(is)
atoms%isa(is) = isa
isatop = isa + na(is) - 1
atoms%label(is) = TRIM( label(is) )
atoms%taus(1:3,isa:isatop) = staur(1:3,isa:isatop)
WHERE( ismbl(1:3,isa:isatop) ) atoms%mobile(1:3,isa:isatop) = 1
atoms%ityp(isa:isatop) = is
atoms%dof(is) = MAX( COUNT( atoms%mobile(1:3,isa:isatop) == 1 ), 1 )
atoms%ekin(is) = 0.0d0
isa = isa + na(is)
END DO
CALL s_to_r( atoms%taus, atoms%taur, atoms%na, atoms%nsp, h )
atoms%doft = MAX( SUM( atoms%dof(1:nsp) )-3, 1 )
RETURN
END SUBROUTINE atoms_type_init
SUBROUTINE allocate_atoms_type( atoms, nsp, nat )
INTEGER, INTENT(IN) :: nsp, nat
TYPE (atoms_type) :: atoms
ALLOCATE( atoms % taur( 3, nat ) )
ALLOCATE( atoms % taus( 3, nat ) )
ALLOCATE( atoms % vels( 3, nat ) )
ALLOCATE( atoms % for ( 3, nat ) )
ALLOCATE( atoms % mobile ( 3, nat ) )
ALLOCATE( atoms % ityp ( nat ) )
RETURN
END SUBROUTINE allocate_atoms_type
SUBROUTINE deallocate_atoms_type( atoms )
TYPE (atoms_type) :: atoms
IF( ASSOCIATED( atoms % taur ) ) DEALLOCATE( atoms % taur )
IF( ASSOCIATED( atoms % taus ) ) DEALLOCATE( atoms % taus )
IF( ASSOCIATED( atoms % vels ) ) DEALLOCATE( atoms % vels )
IF( ASSOCIATED( atoms % for ) ) DEALLOCATE( atoms % for )
IF( ASSOCIATED( atoms % mobile ) ) DEALLOCATE( atoms % mobile )
IF( ASSOCIATED( atoms % ityp ) ) DEALLOCATE( atoms % ityp )
RETURN
END SUBROUTINE deallocate_atoms_type
!=----------------------------------------------------------------------------=!
END MODULE atoms_type_module
!=----------------------------------------------------------------------------=!

13
CPV/src/cp_interfaces.f90
View File

@ -79,7 +79,6 @@
PUBLIC :: vofloc
PUBLIC :: force_loc
PUBLIC :: self_vofhar
PUBLIC :: localisation
!
PUBLIC :: set_eitot
PUBLIC :: set_evtot
@ -747,18 +746,6 @@
END SUBROUTINE
END INTERFACE
INTERFACE localisation
SUBROUTINE localisation_x( wfc, atoms_m, ht)
USE kinds, ONLY: DP
USE cell_base, ONLY: boxdimensions
USE atoms_type_module, ONLY: atoms_type
IMPLICIT NONE
COMPLEX(DP), INTENT(IN) :: wfc(:)
TYPE (atoms_type), INTENT(in) :: atoms_m
TYPE (boxdimensions), INTENT(in) :: ht
END SUBROUTINE
END INTERFACE
INTERFACE set_eitot
SUBROUTINE set_eitot_x( eitot )
USE kinds, ONLY: DP

8
CPV/src/fromscra.f90
View File

@ -14,7 +14,7 @@ SUBROUTINE from_scratch( )
lwf, tprnfor, tortho, amprp, ampre, &
tsde, ortho_eps, ortho_max, &
force_pairing
USE ions_positions, ONLY : taus, tau0, tausm, vels, fion, fionm, atoms0
USE ions_positions, ONLY : taus, tau0, tausm, vels, fion, fionm
USE ions_base, ONLY : na, nsp, randpos, zv, ions_vel
USE ions_base, ONLY : cdmi, nat, iforce
USE ions_nose, ONLY : xnhp0, xnhpm, vnhp
@ -48,7 +48,6 @@ SUBROUTINE from_scratch( )
USE cp_interfaces, ONLY : print_lambda, nlfq_bgrp, setval_lambda
USE printout_base, ONLY : printout_pos
USE orthogonalize_base, ONLY : updatc, calphi_bgrp
USE atoms_type_module, ONLY : atoms_type
USE wave_base, ONLY : wave_steepest
USE wavefunctions_module, ONLY : c0_bgrp, cm_bgrp, phi_bgrp
USE fft_base, ONLY : dfftp
@ -106,7 +105,7 @@ SUBROUTINE from_scratch( )
!
END IF
!
CALL phfacs( eigts1, eigts2, eigts3, eigr, mill, atoms0%taus, dfftp%nr1, dfftp%nr2, dfftp%nr3, atoms0%nat )
CALL phfacs( eigts1, eigts2, eigts3, eigr, mill, taus, dfftp%nr1, dfftp%nr2, dfftp%nr3, nat )
!
CALL strucf( sfac, eigts1, eigts2, eigts3, mill, ngms )
!
@ -139,8 +138,7 @@ SUBROUTINE from_scratch( )
!
CALL occn_info( f )
!
atoms0%for = 0.D0
atoms0%vels = 0.D0
vels = 0.D0
hold = h
velh = 0.0d0
fion = 0.0d0

19
CPV/src/init.f90
View File

@ -216,13 +216,11 @@
use cell_base, only: at, alat, r_to_s, cell_init, deth
use cell_base, only: ibrav, ainv, h, hold, tcell_base_init
USE ions_positions, ONLY: allocate_ions_positions, atoms_init, &
atoms0, atomsm, atomsp
USE ions_positions, ONLY: allocate_ions_positions, tau0, taus
use cp_restart, only: cp_read_cell
USE fft_base, ONLY: dfftb
USE fft_types, ONLY: fft_box_allocate
USE cp_main_variables,ONLY: ht0, htm, taub
USE atoms_type_module,ONLY: atoms_type
USE cp_interfaces, ONLY: newinit
USE constants, ONLY: amu_au
@ -252,18 +250,11 @@
CALL allocate_ions_positions( nsp, nat )
!
! Scale positions that have been read from standard input
! according to the cell given in the standard input too
! taus_srt = scaled, tau_srt = atomic units
! tau0 = initial positions, sorted wrt order read from input
! taus = initial positions, scaled with the cell read from input
!
ALLOCATE( taus_srt( 3, nat ), pmass(nsp) )
CALL r_to_s( tau_srt, taus_srt, na, nsp, ainv )
pmass (:) = amass(1:nsp) * amu_au
CALL atoms_init( atomsm, atoms0, atomsp, taus_srt, ind_srt, if_pos, atm, ht0%hmat, nat, nsp, na, pmass )
!
DEALLOCATE( pmass, taus_srt )
tau0(:,:) = tau_srt(:,:)
CALL r_to_s( tau_srt, taus, na, nsp, ainv )
!
! Allocate box descriptor
!

8
CPV/src/init_run.f90
View File

@ -19,13 +19,11 @@ SUBROUTINE init_run()
USE cp_electronic_mass, ONLY : emass, emass_cutoff
USE ions_base, ONLY : na, nax, nat, nsp, iforce, amass, ityp, cdms
USE ions_positions, ONLY : tau0, taum, taup, taus, tausm, tausp, &
vels, velsm, velsp, fion, fionm, &
atoms0, atomsm, atomsp
vels, velsm, velsp, fion, fionm
USE gvecw, ONLY : ngw, ngw_g, ggp
USE smallbox_gvec, ONLY : ngb
USE smallbox_gvec, ONLY : ngb
USE gvecs, ONLY : ngms
USE gvect, ONLY : ngm
USE gvect, ONLY : gstart
USE gvect, ONLY : ngm, gstart
USE fft_base, ONLY : dfftp, dffts
USE electrons_base, ONLY : nspin, nbsp, nbspx, nupdwn, f
USE uspp, ONLY : nkb, vkb, deeq, becsum,nkbus

229
CPV/src/ions_positions.f90
View File

@ -1,5 +1,5 @@
!
! Copyright (C) 2002-2005 FPMD-CPV groups
! Copyright (C) 2002-2012 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,
@ -10,11 +10,10 @@ MODULE ions_positions
!------------------------------------------------------------------------------!
!
USE kinds, ONLY : DP
USE atoms_type_module, ONLY : atoms_type, atoms_type_init
!
IMPLICIT NONE
!
! ... Atomic positions arrays used in the cp codes during the dynamic
! ... Atomic positions arrays used in the cp codes during the dynamics
!
REAL(DP), TARGET, ALLOCATABLE :: tau0(:,:), taum(:,:), taup(:,:)
REAL(DP), TARGET, ALLOCATABLE :: taus(:,:), tausm(:,:), tausp(:,:)
@ -22,11 +21,9 @@ MODULE ions_positions
REAL(DP), TARGET, ALLOCATABLE :: fion(:,:), fionm(:,:), fionp(:,:)
INTEGER, TARGET, ALLOCATABLE :: ityp(:), mobil(:,:)
!
TYPE (atoms_type) :: atoms0, atomsp, atomsm
!
CONTAINS
!
! ... meaning of some variables appearing in the folloving subs.
! ... meaning of some variables appearing in the following subs.
!
! nsp number of atomic species
! nax maximum number of atoms per specie
@ -35,7 +32,6 @@ MODULE ions_positions
! pmass(:) mass (converted to a.u.) of ions
!
!
!
SUBROUTINE allocate_ions_positions( nsp, nat )
INTEGER, INTENT(IN) :: nsp, nat
!
@ -69,44 +65,6 @@ MODULE ions_positions
ALLOCATE( ityp( nat ) )
ALLOCATE( mobil( 3, nat ) )
!
NULLIFY( atoms0 % taur )
NULLIFY( atoms0 % taus )
NULLIFY( atoms0 % vels )
NULLIFY( atoms0 % for )
NULLIFY( atoms0 % mobile )
NULLIFY( atoms0 % ityp )
NULLIFY( atomsm % taur )
NULLIFY( atomsm % taus )
NULLIFY( atomsm % vels )
NULLIFY( atomsm % for )
NULLIFY( atomsm % mobile )
NULLIFY( atomsm % ityp )
NULLIFY( atomsp % taur )
NULLIFY( atomsp % taus )
NULLIFY( atomsp % vels )
NULLIFY( atomsp % for )
NULLIFY( atomsp % mobile )
NULLIFY( atomsp % ityp )
!
atoms0 % taur => tau0
atoms0 % taus => taus
atoms0 % vels => vels
atoms0 % for => fion
atoms0 % mobile => mobil
atoms0 % ityp => ityp
atomsm % taur => taum
atomsm % taus => tausm
atomsm % vels => velsm
atomsm % for => fionm
atomsm % mobile => mobil
atomsm % ityp => ityp
atomsp % taur => taup
atomsp % taus => tausp
atomsp % vels => velsp
atomsp % for => fionp
atomsp % mobile => mobil
atomsp % ityp => ityp
!
RETURN
END SUBROUTINE allocate_ions_positions
@ -127,29 +85,9 @@ MODULE ions_positions
IF( ALLOCATED( fionp ) ) DEALLOCATE( fionp )
IF( ALLOCATED( ityp ) ) DEALLOCATE( ityp )
IF( ALLOCATED( mobil ) ) DEALLOCATE( mobil )
NULLIFY( atoms0 % taur )
NULLIFY( atoms0 % taus )
NULLIFY( atoms0 % vels )
NULLIFY( atoms0 % for )
NULLIFY( atoms0 % mobile )
NULLIFY( atoms0 % ityp )
NULLIFY( atomsm % taur )
NULLIFY( atomsm % taus )
NULLIFY( atomsm % vels )
NULLIFY( atomsm % for )
NULLIFY( atomsm % mobile )
NULLIFY( atomsm % ityp )
NULLIFY( atomsp % taur )
NULLIFY( atomsp % taus )
NULLIFY( atomsp % vels )
NULLIFY( atomsp % for )
NULLIFY( atomsp % mobile )
NULLIFY( atomsp % ityp )
RETURN
END SUBROUTINE deallocate_ions_positions
!--------------------------------------------------------------------------
SUBROUTINE ions_hmove( taus, tausm, iforce, pmass, fion, ainv, delt, na, nsp )
!--------------------------------------------------------------------------
@ -348,167 +286,6 @@ MODULE ions_positions
END DO
RETURN
END SUBROUTINE set_velocities
!
!
!
!
SUBROUTINE atoms_init(atoms_m, atoms_0, atoms_p, stau, ind_srt, if_pos, atml, h, nat, nsp, na, pmass )
! Allocate and fill the three atoms structure using scaled position an cell
USE printout_base, ONLY : printout_pos
USE io_global, ONLY : ionode, stdout
IMPLICIT NONE
TYPE (atoms_type) :: atoms_0, atoms_p, atoms_m
REAL(DP), INTENT(IN) :: h( 3, 3 )
REAL(DP), INTENT(IN) :: stau(:,:)
CHARACTER(LEN=3), INTENT(IN) :: atml(:)
INTEGER, INTENT(IN) :: ind_srt( : )
INTEGER, INTENT(IN) :: if_pos( :, : )
INTEGER, INTENT(IN) :: nat, nsp
INTEGER, INTENT(IN) :: na( : )
REAL(DP), INTENT(IN) :: pmass( : )
CHARACTER(LEN=3), ALLOCATABLE :: labels( : )
LOGICAL, ALLOCATABLE :: ismb(:,:)
INTEGER :: ia, is, isa
LOGICAL :: nofx
ALLOCATE( ismb( 3, nat ) )
ismb = .TRUE.
nofx = .TRUE.
DO isa = 1, nat
ia = ind_srt( isa )
ismb( 1, isa ) = ( if_pos( 1, ia ) /= 0 )
ismb( 2, isa ) = ( if_pos( 2, ia ) /= 0 )
ismb( 3, isa ) = ( if_pos( 3, ia ) /= 0 )
nofx = nofx .AND. ismb( 1, isa )
nofx = nofx .AND. ismb( 2, isa )
nofx = nofx .AND. ismb( 3, isa )
END DO
CALL atoms_type_init(atoms_m, stau, ismb, atml, pmass, na, nsp, h)
CALL atoms_type_init(atoms_0, stau, ismb, atml, pmass, na, nsp, h)
CALL atoms_type_init(atoms_p, stau, ismb, atml, pmass, na, nsp, h)
IF( ionode ) THEN
!
ALLOCATE( labels( nat ) )
!
isa = 0
DO is = 1, nsp
DO ia = 1, na( is )
isa = isa + 1
labels( isa ) = atml( is )
END DO
END DO
WRITE( stdout, * )
CALL printout_pos( stdout, stau, nat, label = labels, &
head = 'Scaled positions from standard input' )
IF( .NOT. nofx ) THEN
WRITE( stdout, 10 )
10 FORMAT( /, &
3X, 'Position components with 0 are kept fixed', /, &
3X, ' ia x y z ' )
DO isa = 1, nat
ia = ind_srt( isa )
WRITE( stdout, 20 ) isa, if_pos( 1, ia ), if_pos( 2, ia ), if_pos( 3, ia )
END DO
20 FORMAT( 3X, I4, I3, I3, I3 )
END IF
DEALLOCATE( labels )
END IF
DEALLOCATE( ismb )
RETURN
END SUBROUTINE atoms_init
! --------------------------------------------------------------------------
SUBROUTINE ions_shiftval(atoms_m, atoms_0, atoms_p)
! Update ionic positions and velocities in atoms structures
IMPLICIT NONE
TYPE(atoms_type) :: atoms_m, atoms_0, atoms_p
INTEGER :: is, ia, ub
ub = atoms_m%nat
atoms_m%taus(1:3,1:ub) = atoms_0%taus(1:3,1:ub)
atoms_m%vels(1:3,1:ub) = atoms_0%vels(1:3,1:ub)
atoms_m%for(1:3,1:ub) = atoms_0%for(1:3,1:ub)
atoms_0%taus(1:3,1:ub) = atoms_p%taus(1:3,1:ub)
atoms_0%vels(1:3,1:ub) = atoms_p%vels(1:3,1:ub)
atoms_0%for(1:3,1:ub) = atoms_p%for(1:3,1:ub)
RETURN
END SUBROUTINE ions_shiftval
REAL(DP) FUNCTION max_ion_forces( atoms )
IMPLICIT NONE
TYPE (atoms_type) :: atoms
INTEGER :: ia
REAL(DP) :: fmax
fmax = 0.0d0
DO ia = 1, atoms%nat
IF( atoms%mobile(1, ia) > 0 ) fmax = MAX( fmax, ABS( atoms%for(1, ia) ) )
IF( atoms%mobile(2, ia) > 0 ) fmax = MAX( fmax, ABS( atoms%for(2, ia) ) )
IF( atoms%mobile(3, ia) > 0 ) fmax = MAX( fmax, ABS( atoms%for(3, ia) ) )
END DO
max_ion_forces = fmax
RETURN
END FUNCTION max_ion_forces
!
!
SUBROUTINE resort_position( pos, fion, atoms, isrt, ht )
! This subroutine copys positions and forces into
! array "pos" and "for" using the same atoms sequence
! as in the input file
USE cell_base, ONLY: s_to_r
USE cell_base, ONLY: boxdimensions
IMPLICIT NONE
REAL(DP), INTENT(OUT) :: pos(:,:), fion(:,:)
TYPE (atoms_type), INTENT(IN) :: atoms
TYPE (boxdimensions), INTENT(IN) :: ht
INTEGER, INTENT(IN) :: isrt( : )
INTEGER :: ia, is, isa, ipos
isa = 0
DO is = 1, atoms%nsp
DO ia = 1, atoms%na(is)
isa = isa + 1
ipos = isrt( isa )
CALL s_to_r( atoms%taus( : , isa ), pos( :, ipos ), ht )
fion( :, ipos ) = atoms%for( : , isa )
END DO
END DO
RETURN
END SUBROUTINE resort_position
!
!------------------------------------------------------------------------------!
END MODULE ions_positions

9
CPV/src/make.depend
View File

@ -1,6 +1,3 @@
atoms_type.o : ../../Modules/cell_base.o
atoms_type.o : ../../Modules/kind.o
atoms_type.o : ../../Modules/parameters.o
berry_phase.o : ../../Modules/io_global.o
berry_phase.o : ../../Modules/mp.o
berry_phase.o : ../../Modules/mp_global.o
@ -112,7 +109,6 @@ 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
cp_interfaces.o : atoms_type.o
cp_restart.o : ../../Modules/cell_base.o
cp_restart.o : ../../Modules/constants.o
cp_restart.o : ../../Modules/control_flags.o
@ -365,7 +361,6 @@ fromscra.o : ../../Modules/timestep.o
fromscra.o : ../../Modules/uspp.o
fromscra.o : ../../Modules/wave_base.o
fromscra.o : ../../Modules/wavefunctions.o
fromscra.o : atoms_type.o
fromscra.o : cell_nose.o
fromscra.o : cg.o
fromscra.o : cp_emass.o
@ -421,7 +416,6 @@ init.o : ../../Modules/recvec.o
init.o : ../../Modules/recvec_subs.o
init.o : ../../Modules/stick_set.o
init.o : ../../Modules/uspp.o
init.o : atoms_type.o
init.o : berry_phase.o
init.o : cp_interfaces.o
init.o : cp_restart.o
@ -537,7 +531,6 @@ ions_nose.o : ../../Modules/kind.o
ions_positions.o : ../../Modules/cell_base.o
ions_positions.o : ../../Modules/io_global.o
ions_positions.o : ../../Modules/kind.o
ions_positions.o : atoms_type.o
ions_positions.o : printout_base.o
ksstates.o : ../../Modules/electrons_base.o
ksstates.o : ../../Modules/fft_base.o
@ -729,7 +722,6 @@ potentials.o : ../../Modules/mp.o
potentials.o : ../../Modules/mp_global.o
potentials.o : ../../Modules/recvec.o
potentials.o : ../../Modules/sic.o
potentials.o : atoms_type.o
potentials.o : gvecw.o
pres_ai_mod.o : ../../Modules/constants.o
pres_ai_mod.o : ../../Modules/kind.o
@ -844,7 +836,6 @@ restart_sub.o : ../../Modules/timestep.o
restart_sub.o : ../../Modules/uspp.o
restart_sub.o : ../../Modules/wave_base.o
restart_sub.o : ../../Modules/wavefunctions.o
restart_sub.o : atoms_type.o
restart_sub.o : cp_interfaces.o
restart_sub.o : efield.o
restart_sub.o : electrons.o

178
CPV/src/potentials.f90
View File

@ -721,181 +721,3 @@
!=----------------------------------------------------------------------------=!
END SUBROUTINE self_vofhar_x
!=----------------------------------------------------------------------------=!
!=----------------------------------------------------------------------------=!
SUBROUTINE localisation_x( wfc, atoms_m, ht)
!=----------------------------------------------------------------------------=!
USE kinds, ONLY: DP
USE constants, ONLY: fpi
USE control_flags, ONLY: gamma_only
USE atoms_type_module, ONLY: atoms_type
USE sic_module, ONLY: ind_localisation, nat_localisation, print_localisation
USE sic_module, ONLY: sic_rloc, pos_localisation
USE ions_base, ONLY: ind_srt
USE fft_base, ONLY: dfftp, dffts
USE cell_base, ONLY: tpiba2, boxdimensions, s_to_r
USE gvect, ONLY: gstart, gg
USE gvect, ONLY: ngm
USE gvecw, ONLY: ngw
USE fft_interfaces, ONLY: fwfft, invfft
IMPLICIT NONE
! ... Arguments
COMPLEX(DP), INTENT(IN) :: wfc(:)
TYPE (atoms_type), INTENT(in) :: atoms_m
TYPE (boxdimensions), INTENT(in) :: ht
! ... Locals
REAL(DP) :: ehte
INTEGER :: ig, at, ia, is, isa_input, isa_sorted, isa_loc
REAL(DP) :: fpibg, omega, aRe, aR2, R(3)
INTEGER :: Xmin, Ymin, Zmin, Xmax, Ymax, Zmax, i,j,k, ir
REAL(DP) :: work, work2
COMPLEX(DP) :: rhog
COMPLEX(DP), ALLOCATABLE :: density(:), psi(:)
COMPLEX(DP), ALLOCATABLE :: k_density(:)
COMPLEX(DP) :: vscreen
COMPLEX(DP), ALLOCATABLE :: screen_coul(:)
INTEGER :: nr3l
! ... Subroutine body ...
IF( .FALSE. ) THEN
ALLOCATE( screen_coul( ngm ) )
CALL cluster_bc( screen_coul, gg, ht%deth, ht%hmat )
END IF
nr3l = dfftp%npl
omega = ht%deth
ALLOCATE( density( dfftp%nnr ) )
ALLOCATE( psi( dfftp%nnr ) )
ALLOCATE( k_density( ngm ) )
CALL c2psi( psi, dffts%nnr, wfc, wfc, ngw, 1 )
CALL invfft( 'Wave', psi, dffts )
psi = DBLE( psi )
isa_sorted = 0
isa_loc = 0
DO is = 1, atoms_m%nsp
DO ia = 1, atoms_m%na( is )
isa_sorted = isa_sorted + 1 ! index of the atom as is in the sorted %tau atom_type component
isa_input = ind_srt( isa_sorted ) ! index of the atom as is in the input card ATOMIC_POSITIONS
IF( ind_localisation( isa_input ) > 0 ) THEN
isa_loc = isa_loc + 1 ! index of the localised atom ( 1 ... nat_localisation )
IF( isa_loc > SIZE( pos_localisation, 2 ) ) &
CALL errore( ' localisation ', ' too many localization ', isa_loc )
ehte = 0.D0
R( : ) = atoms_m%taus( :, isa_sorted )
CALL s_to_r ( R, pos_localisation( 1:3 , isa_loc ), ht )
!WRITE(6,*) 'ATOM ', ind_localisation( isa_input )
!WRITE(6,*) 'POS ', atoms_m%taus( :, isa_sorted )
work = dfftp%nr1
work2 = sic_rloc * work
work = work * R(1) - work2
Xmin = FLOOR(work)
work = work + 2*work2
Xmax = FLOOR(work)
IF ( Xmax > dfftp%nr1 ) Xmax = dfftp%nr1
IF ( Xmin < 1 ) Xmin = 1
work = dfftp%nr2
work2 = sic_rloc * work
work = work * R(2) - work2
Ymin = FLOOR(work)
work = work + 2*work2
Ymax = FLOOR(work)
IF ( Ymax > dfftp%nr2 ) Ymax = dfftp%nr2
IF ( Ymin < 1 ) Ymin = 1
work = nr3l
work2 = sic_rloc * work
work = work * R(3) - work2
Zmin = FLOOR(work)
work = work + 2*work2
Zmax = FLOOR(work)
IF ( Zmax > nr3l ) Zmax = nr3l
IF ( Zmin < 1 ) Zmin = 1
density = 0.D0
DO k = Zmin, Zmax
DO j = Ymin, Ymax
DO i = Xmin, Xmax
ir = i + (j-1)*dfftp%nr1x + (k-1)*dfftp%nr1x*dfftp%nr2x
density( ir ) = psi( ir ) * psi( ir )
END DO
END DO
END DO
CALL fwfft( 'Dense', density, dfftp )
CALL psi2rho( 'Dense', density, dfftp%nnr, k_density, ngm )
! ... G /= 0 elements
DO IG = gstart, ngm
rhog = k_density(ig)
IF( .FALSE. ) THEN
FPIBG = fpi / ( gg(ig) * tpiba2 ) + screen_coul(ig)
ELSE
FPIBG = fpi / ( gg(ig) * tpiba2 )
END IF
ehte = ehte + fpibg * DBLE(rhog * CONJG(rhog))
END DO
! ... G = 0 element
IF ( gstart == 2 ) THEN
IF( .FALSE. ) THEN
vscreen = screen_coul(1)
ELSE
vscreen = 0.0d0
END IF
rhog = k_density(1)
ehte = ehte + vscreen * DBLE(rhog * CONJG(rhog))
END IF
! ...
IF( .NOT. gamma_only ) THEN
ehte = ehte * 0.5d0
END IF
ehte = ehte * omega
pos_localisation( 4, isa_loc ) = ehte
END IF ! ind_localisation
END DO ! ia
END DO ! is
! CALL errore( 'DEBUG', ' qui ', 1 )
! ...
IF( ALLOCATED(screen_coul) ) DEALLOCATE( screen_coul )
DEALLOCATE( k_density, density, psi )
RETURN
END SUBROUTINE localisation_x

1
CPV/src/restart_sub.f90
View File

@ -35,7 +35,6 @@ SUBROUTINE from_restart( )
USE cp_main_variables, ONLY : ht0, htm, lambdap, lambda, lambdam, eigr, &
sfac, taub, irb, eigrb, edft, bec_bgrp, dbec, descla
USE time_step, ONLY : delt
USE atoms_type_module, ONLY : atoms_type
USE fft_base, ONLY : dfftp
!
IMPLICIT NONE