Merge branch 'requests' into 'develop'

Additional k-points for scf EXX bands calculation

See merge request QEF/q-e!1114
This commit is contained in:
giannozz 2020-11-12 20:28:16 +00:00
commit 7eef73c92e
24 changed files with 38577 additions and 421 deletions

View File

@ -1,4 +1,4 @@
# Makefile for Modules
#/a Makefile for Modules
include ../make.inc
@ -9,6 +9,7 @@ MODFLAGS=$(BASEMOD_FLAGS) \
# list of modules
MODULES = \
additional_kpoints.o \
autopilot.o \
basic_algebra_routines.o \
becmod.o \

View File

@ -0,0 +1,116 @@
!
! Copyright (C) 2020-2014 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,
! or http://www.gnu.org/copyleft/gpl.txt .
!
! Written by Lorenzo Paulatto <paulatz@gmail.com>, July 2020
!
MODULE additional_kpoints
USE kinds, ONLY : DP
USE parameters, ONLY : npk
IMPLICIT NONE
REAL(DP),ALLOCATABLE :: xk_add(:,:) !, wk_add(:)
INTEGER :: nkstot_add=0
CONTAINS
!
SUBROUTINE bcast_additional_kpoints
USE mp, ONLY : mp_bcast
USE io_global, ONLY : ionode_id
USE mp_images, ONLY: intra_image_comm
!
IMPLICIT NONE
CALL mp_bcast(nkstot_add, ionode_id, intra_image_comm)
IF(nkstot_add==0) RETURN
CALL mp_bcast(xk_add, ionode_id, intra_image_comm)
END SUBROUTINE
!
SUBROUTINE add_additional_kpoints(nkstot, xk, wk)
USE input_parameters, ONLY : nqx1, nqx2, nqx3
USE cell_base, ONLY : bg
USE io_global, ONLY : stdout
IMPLICIT NONE
INTEGER,INTENT(inout) :: nkstot
REAL(DP),INTENT(inout) :: xk(3,npk), wk(npk)
!
REAL(DP),ALLOCATABLE :: xk_old(:,:), wk_old(:)
INTEGER :: nkstot_old
INTEGER :: nk1_old, nk2_old, nk3_old
INTEGER :: k1_old, k2_old, k3_old
INTEGER :: nqtot, i,j,k, iq, jq
REAL(DP) :: xq(3), rq(3)
!
! IF(.not.allocated(xk) .or. .not.allocated(wk))&
! CALL errore("add_kpoints", "K-points not ready yet",1)
CALL bcast_additional_kpoints()
IF(nkstot_add==0) RETURN
! Back-up existing points
nkstot_old = nkstot
ALLOCATE(xk_old(3,nkstot_old))
ALLOCATE(wk_old(nkstot_old))
xk_old = xk(1:3, 1:nkstot)
wk_old = wk(1:nkstot)
! DEALLOCATE(xk,wk)
nkstot = 0
!
! Simple case, EXX not used or used with self-exchange only:
IF( nqx1<=1 .and. nqx2<=1 .and. nqx3<=1 ) THEN
print*, "CASE ONE ============================================================", nkstot_old
nkstot = nkstot_old + nkstot_add
IF(nkstot>npk) CALL errore("add_kpoint", "Number of k-points exceeded: increase npk in pwcom", 1)
! ALLOCATE(xk(3,nkstot))
! ALLOCATE(wk(nkstot))
xk(:,1:nkstot_old) = xk_old
xk(:,nkstot_old+1:nkstot_old+nkstot_add) = xk_add
wk(1:nkstot_old) = wk_old
wk(nkstot_old+1:nkstot_old+nkstot_add) = 0._dp
nqtot=1
ELSE
print*, "CASE TWO ============================================================"
! Complex case, EXX with a finite grid of q-points. Ideally, we would want to use
! The grid from module EXX, but it may not have been computed at this points.
! Furthermore, the q-point grid is obtained by opening the k-points one, so this would
! be a dog wagging its own tails
nqtot = nqx1*nqx2*nqx3
nkstot = nkstot_old + nkstot_add*nqtot
IF(nkstot>npk) CALL errore("add_kpoint", "Number of k-points exceeded: increase npk in pwcom", 1)
! ALLOCATE(xk(3,nkstot))
! ALLOCATE(wk(nkstot))
xk(:,1:nkstot_old) = xk_old
wk(1:nkstot_old) = wk_old
rq = (/nqx1,nqx2,nqx3/)
rq = 1._dp / rq
iq = nqtot
! We do these loops backward, in this way the path is found in the last k-points
DO i = 0,nqx1-1
DO j = 0,nqx2-1
DO k = 0,nqx3-1
xq = rq*(/i,j,k/)
CALL cryst_to_cart(1,xq,bg,+1)
DO jq = 1, nkstot_add
iq = iq + 1
xk(:,iq) = xk_add(:,jq) + xq
ENDDO
ENDDO
ENDDO
ENDDO
ENDIF
WRITE(stdout,"(5x,a)") " --- Additional k-points: --- "
WRITE(stdout,"(5x,a,i6,a)") "A request of ",nkstot_add," k-points with zero weight added to list"
IF(nqtot>1) WRITE(stdout,"(5x,a,i6,a)") "Furthermore, ",nkstot_add*nqtot, " k-points where added to perform EXX calculation"
! WRITE(stdout,"(5x,a)") "They can be extracted with bands.x using:"
WRITE(stdout,"(5x,a,i6,a,i6)") "first=",nkstot_old+1,", last=",nkstot_old+nkstot_add
WRITE(stdout,*)
END SUBROUTINE
!
END MODULE

View File

@ -1,3 +1,10 @@
additional_kpoints.o : ../UtilXlib/mp.o
additional_kpoints.o : cell_base.o
additional_kpoints.o : input_parameters.o
additional_kpoints.o : io_global.o
additional_kpoints.o : kind.o
additional_kpoints.o : mp_images.o
additional_kpoints.o : parameters.o
atom_weight.o : kind.o
autopilot.o : ../UtilXlib/mp.o
autopilot.o : io_global.o
@ -297,6 +304,7 @@ qmmm.o : mp_pools.o
qmmm.o : mp_world.o
radial_gradients.o : kind.o
random_numbers.o : kind.o
read_cards.o : additional_kpoints.o
read_cards.o : autopilot.o
read_cards.o : bz_form.o
read_cards.o : cell_base.o

View File

@ -178,6 +178,10 @@ CONTAINS
CALL card_kpoints( input_line )
ENDIF
!
ELSEIF ( trim(card) == 'ADDITIONAL_K_POINTS' ) THEN
!
CALL card_add_kpoints( input_line )
ELSEIF ( trim(card) == 'OCCUPATIONS' ) THEN
!
CALL card_occupations( input_line )
@ -870,6 +874,68 @@ CONTAINS
& // trim(k_points) // ' k points', 1)
!
END SUBROUTINE card_kpoints
SUBROUTINE card_add_kpoints( input_line )
USE additional_kpoints, ONLY : nkstot_add, xk_add
IMPLICIT NONE
CHARACTER(len=*),INTENT(in) :: input_line
CHARACTER(len=256) :: input_line_aux
REAL(DP),ALLOCATABLE :: xk_old(:,:), wk_old(:)
INTEGER :: nk1_old, nk2_old, nk3_old, nkstot_old
INTEGER :: k1_old, k2_old, k3_old
LOGICAL, EXTERNAL :: matches
!
IF(.not.allocated(xk) .or. .not.allocated(wk))&
CALL errore("add_kpoints", "ADDITIONAL_K_POINTS must appear after K_POINTS",1)
IF(.not.tkpoints) &
CALL errore("add_kpoints", "ADDITIONAL_K_POINTS must appear after K_POINTS",2)
IF(matches( "AUTOMATIC", input_line )) &
CALL errore("add_kpoints", "ADDITIONAL_K_POINTS cannot be 'automatic'", 3)
! Back-up existing points
nkstot_old = nkstot
ALLOCATE(xk_old(3,nkstot_old))
ALLOCATE(wk_old(nkstot_old))
xk_old = xk
wk_old = wk
nk1_old = nk1
nk2_old = nk2
nk3_old = nk3
k1_old = k1
k2_old = k2
k3_old = k3
DEALLOCATE(xk,wk)
! Prepare to read k-points again
nkstot = 0
input_line_aux = TRIM(ADJUSTL(input_line))
input_line_aux = input_line_aux(12:)
tkpoints = .false.
CALL card_kpoints(input_line_aux)
!
! Backup new points to module
nkstot_add = nkstot
IF(nkstot_add==0) CALL errore("add_kpoints", "No new k_points?",1)
ALLOCATE(xk_add(3,nkstot_add))
xk_add = xk
! Put back previous stuff
DEALLOCATE(xk, wk)
nkstot = nkstot_old
ALLOCATE(xk(3,nkstot))
ALLOCATE(wk(nkstot))
xk = xk_old
wk = wk_old
nk1 = nk1_old
nk2 = nk2_old
nk3 = nk3_old
k1 = k1_old
k2 = k2_old
k3 = k3_old
DEALLOCATE(xk_old,wk_old)
RETURN
END SUBROUTINE card_add_kpoints
!
!------------------------------------------------------------------------
! BEGIN manual

View File

@ -144,3 +144,14 @@ ACF_example:
Y. Jiao, E. Schr\"oder, and P. Hyldgaard, Phys. Rev. B 97, 085115 (2018);
Y. Jiao, E. Schr\"oder, P. Hyldgaard, J. Chem. Phys. 148, 194115 (2018).
W90_open_grid_example:
This shows how to obtain Wannier functions without doing the intermediate
non-self consistent calculation, which is replaced by the utility open_grid.x
See also WAN90_example for the standard procedure.
exx_scf_bands_example:
This example shows how to use pw.x to calculate the band structure of Silicon
using hybrid HSE functional, inclufing zero-weight dummy k-points. in the scf
calculation.

View File

@ -0,0 +1,10 @@
This example shows how to use pw.x to calculate the total energy
and the band structure of Silicon using hybrid HSE functional.
Additional k-points along high-symmetry directions are included
in the self-consistent calculation with zero weight, using the
ADDITIONAL_K_POINTS card.
The path is extracted from the results of bands.x using plotbands.x

View File

@ -0,0 +1,6 @@
&bands
prefix = 'silicon'
outdir = '/home/paulatto/espresso/tempdir/'
filband = 'sibands.dat'
lsym=.false.,
/

View File

@ -0,0 +1,92 @@
Program BANDS v.6.6 starts on 24Sep2020 at 12:53: 7
This program is part of the open-source Quantum ESPRESSO suite
for quantum simulation of materials; please cite
"P. Giannozzi et al., J. Phys.:Condens. Matter 21 395502 (2009);
"P. Giannozzi et al., J. Phys.:Condens. Matter 29 465901 (2017);
URL http://www.quantum-espresso.org",
in publications or presentations arising from this work. More details at
http://www.quantum-espresso.org/quote
Parallel version (MPI), running on 4 processors
MPI processes distributed on 1 nodes
R & G space division: proc/nbgrp/npool/nimage = 4
Reading xml data from directory:
/home/paulatto/espresso/tempdir/silicon.save/
EXX fraction changed: 0.25
EXX Screening parameter changed: 0.1060000
IMPORTANT: XC functional enforced from input :
Exchange-correlation= HSE
( 1 4 12 4 0 0 0)
EXX-fraction = 0.25
Any further DFT definition will be discarded
Please, verify this is what you really want
Parallelization info
--------------------
sticks: dense smooth PW G-vecs: dense smooth PW
Min 63 63 30 682 682 205
Max 64 64 31 686 686 206
Sum 253 253 121 2733 2733 821
Reading collected, re-writing distributed wavefunctions
high-symmetry point: -0.2500 0.2500 0.2500 x coordinate 0.0000
high-symmetry point: 0.2500-0.2500 0.7500 x coordinate 0.8660
high-symmetry point: 0.0000 1.0000 1.0000 x coordinate 2.1651
high-symmetry point: -0.5000 0.5000 0.5000 x coordinate 3.0311
high-symmetry point: -0.5000 1.5000 0.5000 x coordinate 4.0311
high-symmetry point: 0.5000 1.5000 0.5000 x coordinate 4.0311
high-symmetry point: -0.5000 0.5000 0.5000 x coordinate 5.4453
high-symmetry point: 0.5000 0.5000 1.5000 x coordinate 5.4453
high-symmetry point: 0.0000 0.0000 1.0000 x coordinate 6.3113
high-symmetry point: 0.0000 1.0000 1.0000 x coordinate 7.3113
high-symmetry point: 1.0000 1.0000 1.0000 x coordinate 7.3113
high-symmetry point: 0.0000 0.0000 1.0000 x coordinate 8.7255
high-symmetry point: -0.5000 0.5000 0.5000 x coordinate 8.7255
high-symmetry point: -1.0000 0.0000 0.0000 x coordinate 9.5916
high-symmetry point: -1.0000 1.0000 0.0000 x coordinate 10.5916
high-symmetry point: 0.0000 1.0000 0.0000 x coordinate 10.5916
high-symmetry point: -1.0000 0.0000 0.0000 x coordinate 12.0058
high-symmetry point: 0.0000 0.0000 1.0000 x coordinate 12.0058
high-symmetry point: -0.5000-0.5000 0.5000 x coordinate 12.8718
high-symmetry point: -0.5000 0.5000 0.5000 x coordinate 13.8718
high-symmetry point: 0.5000 0.5000 0.5000 x coordinate 13.8718
high-symmetry point: -0.5000-0.5000 0.5000 x coordinate 15.2860
high-symmetry point: 0.5000 1.5000 0.5000 x coordinate 15.2860
high-symmetry point: 0.0000 1.0000 0.0000 x coordinate 16.1520
high-symmetry point: 0.0000 2.0000 0.0000 x coordinate 17.1520
high-symmetry point: 1.0000 2.0000 0.0000 x coordinate 17.1520
high-symmetry point: 0.0000 1.0000 0.0000 x coordinate 18.5663
high-symmetry point: 1.0000 1.0000 1.0000 x coordinate 18.5663
high-symmetry point: 0.5000 0.5000 0.5000 x coordinate 19.4323
high-symmetry point: 0.5000 1.5000 0.5000 x coordinate 20.4323
high-symmetry point: 1.5000 1.5000 0.5000 x coordinate 20.4323
high-symmetry point: 0.5000 0.5000 0.5000 x coordinate 21.8465
high-symmetry point: 0.0000 1.0000 0.0000 x coordinate 21.8465
high-symmetry point: -0.5000 0.5000-0.5000 x coordinate 22.7125
high-symmetry point: -0.5000 1.5000-0.5000 x coordinate 23.7125
high-symmetry point: 0.5000 1.5000-0.5000 x coordinate 23.7125
high-symmetry point: -0.5000 0.5000-0.5000 x coordinate 25.1267
high-symmetry point: 0.5000 0.5000 0.5000 x coordinate 25.1267
high-symmetry point: 0.0000 0.0000 0.0000 x coordinate 25.9928
high-symmetry point: 0.0000 1.0000 0.0000 x coordinate 26.9928
high-symmetry point: 1.0000 1.0000 0.0000 x coordinate 26.9928
high-symmetry point: 0.0000 0.0000 0.0000 x coordinate 28.4070
Plottable bands (eV) written to file sibands.dat.gnu
Bands written to file sibands.dat
BANDS : 0.52s CPU 0.55s WALL
This run was terminated on: 12:53: 8 24Sep2020
=------------------------------------------------------------------------------=
JOB DONE.
=------------------------------------------------------------------------------=

View File

@ -0,0 +1,5 @@
sibands.dat
-10 20 507 578
sibands-p.dat

View File

@ -0,0 +1,8 @@
Input file > Reading 8 bands at 578 k-points
Range: -4.9250 18.2900eV Emin, Emax, [firstk, lastk] > high-symmetry point: 0.5000 0.5000 0.5000 x coordinate 0.0000
high-symmetry point: 0.0000 0.0000 0.0000 x coordinate 0.8660
high-symmetry point: 0.0000 1.0000 0.0000 x coordinate 1.8660
high-symmetry point: 1.0000 1.0000 0.0000 x coordinate 1.8660
high-symmetry point: 0.0000 0.0000 0.0000 x coordinate 3.2802
output file (gnuplot/xmgr) > bands in gnuplot/xmgr format written to file sibands-p.dat
output file (ps) > stopping ...

View File

@ -0,0 +1,34 @@
&control
calculation = 'scf'
restart_mode='from_scratch',
prefix='silicon',
pseudo_dir = '/home/paulatto/espresso/pseudo/',
outdir='/home/paulatto/espresso/tempdir/'
verbosity='high'
/
&system
ibrav= 2, celldm(1) =10.20, nat= 2, ntyp= 1,
ecutwfc =18.0,
input_dft='HSE'
nqx1=2, nqx2=2, nqx3=2
nbnd=8
/
&electrons
mixing_mode = 'plain'
mixing_beta = 0.7
conv_thr = 1.0d-8
/
ATOMIC_SPECIES
Si 28.086 Si.pz-vbc.UPF
ATOMIC_POSITIONS alat
Si 0.00 0.00 0.00
Si 0.25 0.25 0.25
K_POINTS automatic
2 2 2 1 1 1
ADDITIONAL_K_POINTS tpiba_b
5
L 20
gG 20
X 0
1.0 1.0 0.0 30
gG 1

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,584 @@
0.0000 -1.4630
0.0433 -1.5030
0.0866 -1.6140
0.1299 -1.7770
0.1732 -1.9640
0.2165 -2.1660
0.2598 -2.3680
0.3031 -2.5670
0.3464 -2.7570
0.3897 -2.9370
0.4330 -3.1040
0.4763 -3.2570
0.5196 -3.3960
0.5629 -3.5200
0.6062 -3.6280
0.6495 -3.7200
0.6928 -3.7960
0.7361 -3.8550
0.7794 -3.8960
0.8227 -3.9210
0.8660 -3.9290
0.9160 -3.9180
0.9660 -3.8850
1.0160 -3.8290
1.0660 -3.7500
1.1160 -3.6490
1.1660 -3.5270
1.2160 -3.3810
1.2660 -3.2150
1.3160 -3.0250
1.3660 -2.8150
1.4160 -2.5840
1.4660 -2.3310
1.5160 -2.0590
1.5660 -1.7650
1.6160 -1.4550
1.6660 -1.1270
1.7160 -0.7810
1.7660 -0.4170
1.8160 -0.0380
1.8660 0.3550
1.8660 0.3550
1.9131 0.3530
1.9603 0.3440
2.0074 0.3250
2.0546 0.2930
2.1017 0.2410
2.1488 0.1630
2.1960 0.0470
2.2431 -0.1050
2.2903 -0.2930
2.3374 -0.5120
2.3845 -0.7550
2.4317 -1.0120
2.4788 -1.2760
2.5260 -1.5440
2.5731 -1.8050
2.6202 -2.0590
2.6674 -2.3030
2.7145 -2.5330
2.7617 -2.7490
2.8088 -2.9490
2.8560 -3.1310
2.9031 -3.2970
2.9502 -3.4440
2.9974 -3.5720
3.0445 -3.6800
3.0917 -3.7700
3.1388 -3.8400
3.1859 -3.8900
3.2331 -3.9190
3.2802 -3.9290
0.0000 1.0070
0.0433 1.0630
0.0866 1.2220
0.1299 1.4610
0.1732 1.7600
0.2165 2.1020
0.2598 2.4780
0.3031 2.8800
0.3464 3.3050
0.3897 3.7470
0.4330 4.2070
0.4763 4.6800
0.5196 5.1610
0.5629 5.6480
0.6062 6.1380
0.6495 6.6240
0.6928 7.0970
0.7361 7.5410
0.7794 7.9280
0.8227 8.2080
0.8660 8.3150
0.9160 8.2410
0.9660 8.0350
1.0160 7.7370
1.0660 7.3800
1.1160 6.9850
1.1660 6.5660
1.2160 6.1330
1.2660 5.6860
1.3160 5.2360
1.3660 4.7820
1.4160 4.3250
1.4660 3.8660
1.5160 3.4050
1.5660 2.9510
1.6160 2.5000
1.6660 2.0540
1.7160 1.6150
1.7660 1.1820
1.8160 0.7630
1.8660 0.3550
1.8660 0.3550
1.9131 0.3660
1.9603 0.3980
2.0074 0.4510
2.0546 0.5250
2.1017 0.6180
2.1488 0.7360
2.1960 0.8740
2.2431 1.0320
2.2903 1.2110
2.3374 1.4110
2.3845 1.6310
2.4317 1.8750
2.4788 2.1360
2.5260 2.4160
2.5731 2.7170
2.6202 3.0370
2.6674 3.3760
2.7145 3.7350
2.7617 4.1100
2.8088 4.5010
2.8560 4.9110
2.9031 5.3330
2.9502 5.7700
2.9974 6.2160
3.0445 6.6650
3.0917 7.1110
3.1388 7.5380
3.1859 7.9200
3.2331 8.2060
3.2802 8.3150
0.0000 7.0310
0.0433 7.0350
0.0866 7.0490
0.1299 7.0710
0.1732 7.1040
0.2165 7.1450
0.2598 7.1950
0.3031 7.2550
0.3464 7.3230
0.3897 7.3990
0.4330 7.4830
0.4763 7.5750
0.5196 7.6730
0.5629 7.7760
0.6062 7.8820
0.6495 7.9870
0.6928 8.0870
0.7361 8.1770
0.7794 8.2510
0.8227 8.2980
0.8660 8.3150
0.9160 8.2590
0.9660 8.1070
1.0160 7.8960
1.0660 7.6560
1.1160 7.4040
1.1660 7.1530
1.2160 6.9080
1.2660 6.6730
1.3160 6.4530
1.3660 6.2490
1.4160 6.0610
1.4660 5.8920
1.5160 5.7410
1.5660 5.6090
1.6160 5.4980
1.6660 5.4060
1.7160 5.3340
1.7660 5.2820
1.8160 5.2510
1.8660 5.2400
1.8660 5.2400
1.9131 5.1620
1.9603 4.9540
2.0074 4.6770
2.0546 4.3790
2.1017 4.0970
2.1488 3.8530
2.1960 3.6630
2.2431 3.5360
2.2903 3.4760
2.3374 3.4790
2.3845 3.5380
2.4317 3.6480
2.4788 3.8000
2.5260 3.9880
2.5731 4.2060
2.6202 4.4520
2.6674 4.7210
2.7145 5.0110
2.7617 5.3170
2.8088 5.6390
2.8560 5.9730
2.9031 6.3130
2.9502 6.6550
2.9974 6.9940
3.0445 7.3220
3.0917 7.6290
3.1388 7.9010
3.1859 8.1190
3.2331 8.2640
3.2802 8.3150
0.0000 7.0310
0.0433 7.0350
0.0866 7.0490
0.1299 7.0710
0.1732 7.1040
0.2165 7.1450
0.2598 7.1950
0.3031 7.2550
0.3464 7.3230
0.3897 7.3990
0.4330 7.4830
0.4763 7.5750
0.5196 7.6730
0.5629 7.7760
0.6062 7.8820
0.6495 7.9870
0.6928 8.0870
0.7361 8.1770
0.7794 8.2510
0.8227 8.2980
0.8660 8.3150
0.9160 8.2590
0.9660 8.1070
1.0160 7.8960
1.0660 7.6560
1.1160 7.4040
1.1660 7.1530
1.2160 6.9080
1.2660 6.6730
1.3160 6.4530
1.3660 6.2490
1.4160 6.0610
1.4660 5.8920
1.5160 5.7410
1.5660 5.6090
1.6160 5.4980
1.6660 5.4060
1.7160 5.3340
1.7660 5.2820
1.8160 5.2510
1.8660 5.2400
1.8660 5.2400
1.9131 5.2490
1.9603 5.2740
2.0074 5.3150
2.0546 5.3720
2.1017 5.4450
2.1488 5.5340
2.1960 5.6370
2.2431 5.7550
2.2903 5.8860
2.3374 6.0300
2.3845 6.1840
2.4317 6.3480
2.4788 6.5200
2.5260 6.6970
2.5731 6.8770
2.6202 7.0570
2.6674 7.2340
2.7145 7.4050
2.7617 7.5620
2.8088 7.7100
2.8560 7.8430
2.9031 7.9570
2.9502 8.0530
2.9974 8.1310
3.0445 8.1930
3.0917 8.2410
3.1388 8.2750
3.1859 8.2980
3.2331 8.3110
3.2802 8.3150
0.0000 9.6420
0.0433 9.6470
0.0866 9.6690
0.1299 9.6930
0.1732 9.7270
0.2165 9.7710
0.2598 9.8280
0.3031 9.8910
0.3464 9.9630
0.3897 10.0430
0.4330 10.1290
0.4763 10.2270
0.5196 10.3270
0.5629 10.4220
0.6062 10.5150
0.6495 10.6000
0.6928 10.6670
0.7361 10.7010
0.7794 10.6890
0.8227 10.6310
0.8660 10.6080
0.9160 10.5760
0.9660 10.4850
1.0160 10.3470
1.0660 10.1750
1.1160 9.9820
1.1660 9.7770
1.2160 9.5740
1.2660 9.3760
1.3160 9.1900
1.3660 9.0170
1.4160 8.8620
1.4660 8.7260
1.5160 8.6120
1.5660 8.5210
1.6160 8.4550
1.6660 8.4080
1.7160 8.3920
1.7660 8.4000
1.8160 8.4390
1.8660 8.5080
1.8660 8.5080
1.9131 8.5180
1.9603 8.5460
2.0074 8.5930
2.0546 8.6590
2.1017 8.7420
2.1488 8.8470
2.1960 8.9660
2.2431 9.1030
2.2903 9.2550
2.3374 9.4240
2.3845 9.6040
2.4317 9.7960
2.4788 9.9960
2.5260 10.2010
2.5731 10.4060
2.6202 10.6030
2.6674 10.7860
2.7145 10.9440
2.7617 11.0660
2.8088 11.1470
2.8560 11.1880
2.9031 11.1910
2.9502 11.1070
2.9974 10.9750
3.0445 10.8630
3.0917 10.7710
3.1388 10.6990
3.1859 10.6480
3.2331 10.6180
3.2802 10.6080
0.0000 11.3170
0.0433 11.3230
0.0866 11.3420
0.1299 11.3710
0.1732 11.4120
0.2165 11.4560
0.2598 11.5020
0.3031 11.5450
0.3464 11.5770
0.3897 11.5900
0.4330 11.5750
0.4763 11.5310
0.5196 11.4520
0.5629 11.3430
0.6062 11.2120
0.6495 11.0700
0.6928 10.9290
0.7361 10.8010
0.7794 10.6980
0.8227 10.6310
0.8660 10.6080
0.9160 10.6770
0.9660 10.8690
1.0160 11.1470
1.0660 11.4810
1.1160 11.8520
1.1660 12.2490
1.2160 12.2180
1.2660 11.8200
1.3160 11.4010
1.3660 10.9870
1.4160 10.5930
1.4660 10.2280
1.5160 9.8940
1.5660 9.5960
1.6160 9.3310
1.6660 9.0990
1.7160 8.9020
1.7660 8.7390
1.8160 8.6080
1.8660 8.5080
1.8660 8.5080
1.9131 8.6190
1.9603 8.9210
2.0074 9.3590
2.0546 9.8870
2.1017 10.4760
2.1488 11.1130
2.1960 11.7780
2.2431 12.4650
2.2903 13.1570
2.3374 13.8220
2.3845 14.2150
2.4317 13.8540
2.4788 13.5110
2.5260 13.1830
2.5731 12.8750
2.6202 12.5860
2.6674 12.3150
2.7145 12.0660
2.7617 11.8320
2.8088 11.6200
2.8560 11.4320
2.9031 11.2590
2.9502 11.1680
2.9974 11.1230
3.0445 11.0620
3.0917 10.9230
3.1388 10.8000
3.1859 10.7000
3.2331 10.6320
3.2802 10.6080
0.0000 11.3170
0.0433 11.3230
0.0866 11.3420
0.1299 11.3710
0.1732 11.4120
0.2165 11.4560
0.2598 11.5020
0.3031 11.5450
0.3464 11.5770
0.3897 11.5900
0.4330 11.5750
0.4763 11.5310
0.5196 11.4520
0.5629 11.3430
0.6062 11.2120
0.6495 11.0700
0.6928 10.9290
0.7361 10.8010
0.7794 10.6980
0.8227 10.6380
0.8660 10.6080
0.9160 10.6770
0.9660 10.8690
1.0160 11.1470
1.0660 11.4810
1.1160 11.8520
1.1660 12.2490
1.2160 12.6640
1.2660 13.0850
1.3160 13.5240
1.3660 13.9680
1.4160 14.4190
1.4660 14.8750
1.5160 15.3310
1.5660 15.7980
1.6160 16.2690
1.6660 16.7380
1.7160 17.2070
1.7660 17.6630
1.8160 18.0770
1.8660 18.2900
1.8660 18.2900
1.9131 18.1810
1.9603 17.9020
2.0074 17.5260
2.0546 17.1100
2.1017 16.6780
2.1488 16.2480
2.1960 15.8140
2.2431 15.3940
2.2903 14.9850
2.3374 14.5930
2.3845 14.2550
2.4317 14.1640
2.4788 13.8770
2.5260 13.5660
2.5731 13.2620
2.6202 12.9700
2.6674 12.6950
2.7145 12.4390
2.7617 12.1940
2.8088 11.9660
2.8560 11.7570
2.9031 11.5590
2.9502 11.3790
2.9974 11.2140
3.0445 11.0660
3.0917 10.9940
3.1388 10.9030
3.1859 10.7870
3.2331 10.6650
3.2802 10.6080
0.0000 15.2610
0.0433 15.2700
0.0866 15.2990
0.1299 15.3440
0.1732 15.4050
0.2165 15.4760
0.2598 15.5470
0.3031 15.5890
0.3464 15.5490
0.3897 15.3640
0.4330 15.0490
0.4763 14.6700
0.5196 14.2600
0.5629 13.8360
0.6062 13.4070
0.6495 12.9810
0.6928 12.5740
0.7361 12.2070
0.7794 11.9180
0.8227 11.7420
0.8660 11.6860
0.9160 11.7580
0.9660 11.9510
1.0160 12.2140
1.0660 12.4730
1.1160 12.6120
1.1660 12.5210
1.2160 12.6640
1.2660 13.0850
1.3160 13.5240
1.3660 13.9680
1.4160 14.4190
1.4660 14.8750
1.5160 15.3310
1.5660 15.7980
1.6160 16.2690
1.6660 16.7380
1.7160 17.2070
1.7660 17.6630
1.8160 18.0770
1.8660 18.2900
1.8660 18.2900
1.9131 18.2290
1.9603 18.0610
2.0074 17.8150
2.0546 17.5200
2.1017 17.1970
2.1488 16.8650
2.1960 16.4140
2.2431 15.9850
2.2903 15.5870
2.3374 15.2600
2.3845 15.1890
2.4317 14.9270
2.4788 14.6560
2.5260 14.4070
2.5731 14.1860
2.6202 13.9980
2.6674 13.8490
2.7145 13.7450
2.7617 13.6860
2.8088 13.6730
2.8560 13.6880
2.9031 13.6880
2.9502 13.6170
2.9974 13.4130
3.0445 13.0800
3.0917 12.6780
3.1388 12.2800
3.1859 11.9550
3.2331 11.7520
3.2802 11.6860

File diff suppressed because it is too large Load Diff

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,152 @@
#!/bin/sh
# run from directory where this script is
cd `echo $0 | sed 's/\(.*\)\/.*/\1/'` # extract pathname
EXAMPLE_DIR=`pwd`
# check whether echo has the -e option
if test "`echo -e`" = "-e" ; then ECHO=echo ; else ECHO="echo -e" ; fi
$ECHO
$ECHO "$EXAMPLE_DIR : starting"
$ECHO
$ECHO "This example shows how to use pw.x to calculate the total energy and"
$ECHO "the band structure of four simple systems: Si, Al, Cu, Ni."
# set the needed environment variables
. ../../../environment_variables
# required executables and pseudopotentials
BIN_LIST="pw.x bands.x"
PSEUDO_LIST="Si.pz-vbc.UPF"
$ECHO
$ECHO " executables directory: $BIN_DIR"
$ECHO " pseudo directory: $PSEUDO_DIR"
$ECHO " temporary directory: $TMP_DIR"
$ECHO " checking that needed directories and files exist...\c"
# check for directories
for DIR in "$BIN_DIR" "$PSEUDO_DIR" ; do
if test ! -d $DIR ; then
$ECHO
$ECHO "ERROR: $DIR not existent or not a directory"
$ECHO "Aborting"
exit 1
fi
done
for DIR in "$TMP_DIR" "$EXAMPLE_DIR/results" ; do
if test ! -d $DIR ; then
mkdir $DIR
fi
done
cd $EXAMPLE_DIR/results
# check for executables
for FILE in $BIN_LIST ; do
if test ! -x $BIN_DIR/$FILE ; then
$ECHO
$ECHO "ERROR: $BIN_DIR/$FILE not existent or not executable"
$ECHO "Aborting"
exit 1
fi
done
# check for pseudopotentials
for FILE in $PSEUDO_LIST ; do
if test ! -r $PSEUDO_DIR/$FILE ; then
$ECHO
$ECHO "Downloading $FILE to $PSEUDO_DIR...\c"
$WGET $PSEUDO_DIR/$FILE $NETWORK_PSEUDO/$FILE 2> /dev/null
fi
if test $? != 0; then
$ECHO
$ECHO "ERROR: $PSEUDO_DIR/$FILE not existent or not readable"
$ECHO "Aborting"
exit 1
fi
done
$ECHO " done"
# how to run executables
PW_COMMAND="$PARA_PREFIX $BIN_DIR/pw.x $PARA_POSTFIX"
BANDS_COMMAND="$PARA_PREFIX $BIN_DIR/bands.x $PARA_POSTFIX"
PLOTBAND_COMMAND="$BIN_DIR/plotband.x"
$ECHO
$ECHO " running pw.x as: $PW_COMMAND"
$ECHO " running bands.x as: $BANDS_COMMAND"
$ECHO " running plotband.x as: $PLOTBAND_COMMAND"
$ECHO
# self-consistent calculation
cat > si.scf.in << EOF
&control
calculation = 'scf'
restart_mode='from_scratch',
prefix='silicon',
pseudo_dir = '$PSEUDO_DIR/',
outdir='$TMP_DIR/'
verbosity='high'
/
&system
ibrav= 2, celldm(1) =10.20, nat= 2, ntyp= 1,
ecutwfc =18.0,
input_dft='HSE'
nqx1=2, nqx2=2, nqx3=2
nbnd=8
/
&electrons
mixing_mode = 'plain'
mixing_beta = 0.7
conv_thr = 1.0d-8
/
ATOMIC_SPECIES
Si 28.086 Si.pz-vbc.UPF
ATOMIC_POSITIONS alat
Si 0.00 0.00 0.00
Si 0.25 0.25 0.25
K_POINTS automatic
2 2 2 1 1 1
ADDITIONAL_K_POINTS tpiba_b
5
L 20
gG 20
X 0
1.0 1.0 0.0 30
gG 1
EOF
$ECHO " running the scf calculation for Si...\c"
$PW_COMMAND < si.scf.in > si.scf.out
check_failure $?
$ECHO " done"
# post-processing for band structure
cat > si.bands.in << EOF
&bands
prefix = 'silicon'
outdir = '$TMP_DIR/'
filband = 'sibands.dat'
lsym=.false.,
/
EOF
$ECHO " running the post-processing for band structure...\c"
$BANDS_COMMAND < si.bands.in > si.bands.out
check_failure $?
$ECHO " done"
# plotband.x
cat > si.plotband.in << EOF
sibands.dat
-10 20 507 578
sibands-p.dat
EOF
$ECHO " running plotband.x to generate sibands.ps...\c"
$PLOTBAND_COMMAND < si.plotband.in > si.plotband.out
check_failure $?
$ECHO " done"

View File

@ -25,6 +25,7 @@ PROGRAM do_bands
USE io_global, ONLY : ionode, ionode_id, stdout
USE mp, ONLY : mp_bcast
USE mp_images, ONLY : intra_image_comm
USE parameters,ONLY : npk
!
IMPLICIT NONE
!
@ -58,7 +59,7 @@ PROGRAM do_bands
lp=.false.
filp='p_avg.dat'
firstk=0
lastk=10000000
lastk=npk
spin_component = 1
!
ios = 0

View File

@ -30,7 +30,8 @@ PROGRAM plotband
real, ALLOCATABLE :: e_rap(:,:), k_rap(:,:)
INTEGER, ALLOCATABLE :: nbnd_rapk(:), rap(:,:)
INTEGER, ALLOCATABLE :: npoints(:)
INTEGER :: nks = 0, nbnd = 0, ios, nlines, n,i,j,ni,nf,nl
CHARACTER(len=1024) aux
INTEGER :: nks = 0, nbnd = 0, ios, nlines, n,i,j,ni,nf,nl, firstk, lastk
INTEGER :: nks_rap = 0, nbnd_rap = 0
LOGICAL, ALLOCATABLE :: high_symmetry(:), is_in_range(:), is_in_range_rap(:)
CHARACTER(len=256) :: filename, filename1, filenamegnu
@ -254,8 +255,15 @@ PROGRAM plotband
emax = max(emax, e(i,n))
ENDDO
ENDDO
WRITE(*,'("Range:",2f10.4,"eV Emin, Emax > ")', advance="NO") emin, emax
READ(5,*) emin, emax
WRITE(*,'("Range:",2f10.4,"eV Emin, Emax, [firstk, lastk] > ")', advance="NO") emin, emax
READ(5,'(a1024)') aux
READ(aux,*,iostat=ios) emin, emax,firstk,lastk
IF(ios/=0) THEN
READ(aux,*) emin, emax
firstk=1
lastk=nks
ENDIF
IF(firstk>1) kx = kx-kx(firstk)
!
! Since the minimum and miximum energies are given in input we can
! sign the bands that are completely outside this range.
@ -269,7 +277,7 @@ PROGRAM plotband
! The first point of this path: point(iline)
! How many points are in each path: npoints(iline)
!
DO n=1,nks
DO n=firstk,lastk
IF (high_symmetry(n)) THEN
IF (n==1) THEN
!
@ -333,9 +341,9 @@ PROGRAM plotband
DO i=1,nbnd
IF (is_in_range(i)) THEN
IF (exist_proj) THEN
WRITE (2,'(3f10.4)') (kx(n), e(i,n), sumproj(i,n),n=1,nks)
WRITE (2,'(3f10.4)') (kx(n), e(i,n), sumproj(i,n),n=firstk,lastk)
ELSE
WRITE (2,'(2f10.4)') (kx(n), e(i,n),n=1,nks)
WRITE (2,'(2f10.4)') (kx(n), e(i,n),n=firstk,lastk)
ENDIF
WRITE (2,*)
ENDIF

View File

@ -83,6 +83,9 @@ input_description -distribution {Quantum Espresso} -package PWscf -program pw.x
label_1 Fx(1) Fy(1) Fz(1)
.....
label_n Fx(n) Fy(n) Fz(n) ]
[ @b ADDITIONAL_K_POINTS
see: K_POINTS ]
}
#
@ -3056,6 +3059,17 @@ input_description -distribution {Quantum Espresso} -package PWscf -program pw.x
}
}
#
# card ADDITIONAL_K_POINTS
#
card ADDITIONAL_K_POINTS {
label { Optional card. Adds a list of k-points with zero weight, after those used for the scf calculation.
When doing an EXX calculation and nq1x, nq2x or nq3x are different from one, also include the
required k+q points. The main use of this card is do band plots with EXX. }
syntax { message { Same as K_POINTS, but does not accept 'automatic'. } }
}
#
# CELL_PARAMETERS
#

File diff suppressed because it is too large Load Diff

View File

@ -88,6 +88,9 @@ if (tpipa_b or crystal_b in a 'bands' calculation) see Doc/brillouin_zones.pdf
.....
label_n Fx(n) Fy(n) Fz(n) ]
[ ADDITIONAL_K_POINTS
see: K_POINTS ]
========================================================================
@ -151,8 +154,8 @@ NAMELIST: &CONTROL
perform a non-scf calculations. Works only if the calculation was
cleanly stopped using variable "max_seconds", or by user request
with an "exit file" (i.e.: create a file "prefix".EXIT, in directory
"outdir"; see variables "prefix", "outdir"). Overrides "startingwfc"
and "startingpot".
"outdir"; see variables "prefix", "outdir"). The default for
"startingwfc" and "startingpot" is set to 'file'.
+--------------------------------------------------------------------
+--------------------------------------------------------------------
@ -165,7 +168,7 @@ NAMELIST: &CONTROL
.TRUE. collect wavefunctions from all processors, store them
into the output data directory "outdir"/"prefix".save
The resulting format is portable to a different number
of processor, or different kind of parallelization
of processors, or different kind of parallelization
.FALSE. OBSOLETE - NO LONGER IMPLEMENTED
do not collect wavefunctions, leave them in temporary
@ -732,28 +735,29 @@ NAMELIST: &SYSTEM
Variable: starting_magnetization(i), i=1,ntyp
Type: REAL
Default: 0
Description: Starting spin polarization on atomic type 'i' in a spin
polarized calculation. Values range between -1 (all spins
down for the valence electrons of atom type 'i') to 1
(all spins up). Breaks the symmetry and provides a starting
point for self-consistency. The default value is zero, BUT a
value MUST be specified for AT LEAST one atomic type in spin
polarized calculations, unless you constrain the magnetization
(see "tot_magnetization" and "constrained_magnetization").
Note that if you start from zero initial magnetization, you
will invariably end up in a nonmagnetic (zero magnetization)
state. If you want to start from an antiferromagnetic state,
you may need to define two different atomic species
corresponding to sublattices of the same atomic type.
starting_magnetization is ignored if you are performing a
non-scf calculation, if you are restarting from a previous
run, or restarting from an interrupted run.
If you fix the magnetization with "tot_magnetization",
you should not specify starting_magnetization.
In the spin-orbit case starting with zero
polarized (LSDA or noncollinear/spin-orbit) calculation.
Allowed values range between -1 (all spins down for the
valence electrons of atom type 'i') to 1 (all spins up).
If you expect a nonzero magnetization in your ground state,
you MUST either specify a nonzero value for at least one
atomic type, or constrain the magnetization using variable
"tot_magnetization" for LSDA, "constrained_magnetization"
for noncollinear/spin-orbit calculations. If you don't,
you will get a nonmagnetic (zero magnetization) state.
In order to perform LSDA calculations for an antiferromagnetic
state, define two different atomic species corresponding to
sublattices of the same atomic type.
NOTE 1: starting_magnetization is ignored in most BUT NOT ALL
cases in non-scf calculations: it is safe to keep the same
values for the scf and subsequent non-scf calculation.
NOTE 2: If you fix the magnetization with
"tot_magnetization", do not specify starting_magnetization.
NOTE 3: In the noncollinear/spin-orbit case, starting with zero
starting_magnetization on all atoms imposes time reversal
symmetry. The magnetization is never calculated and
kept zero (the internal variable domag is .FALSE.).
symmetry. The magnetization is never calculated and is
set to zero (the internal variable domag is set to .FALSE.).
+--------------------------------------------------------------------
+--------------------------------------------------------------------
@ -1211,13 +1215,15 @@ NAMELIST: &SYSTEM
a few selected elements. Modify Modules/set_hubbard_l.f90 and
PW/src/tabd.f90 if you plan to use DFT+U with an element that
is not configured there.
Description: Specify "lda_plus_u" = .TRUE. to enable DFT+U calculations
Description: Specify "lda_plus_u" = .TRUE. to enable DFT+U, DFT+U+V, or
DFT+U+J calculations.
See: Anisimov, Zaanen, and Andersen, PRB 44, 943 (1991);
Anisimov et al., PRB 48, 16929 (1993);
Liechtenstein, Anisimov, and Zaanen, PRB 52, R5467 (1994).
You must specify, for each species with a U term, the value of
U and (optionally) alpha, J of the Hubbard model (all in eV):
see "lda_plus_u_kind", "Hubbard_U", "Hubbard_alpha", "Hubbard_J"
You must specify, for each Hubbard atom, the value of
U and (optionally) V, J, alpha of the Hubbard model (all in eV):
see "lda_plus_u_kind", "Hubbard_U", "Hubbard_V",
"Hubbard_J", "Hubbard_alpha"
+--------------------------------------------------------------------
+--------------------------------------------------------------------
@ -1284,9 +1290,13 @@ NAMELIST: &SYSTEM
Type: REAL
Default: 0.D0 for all species
Description: Hubbard_alpha(i) is the perturbation (on atom i, in eV)
used to compute U with the linear-response method of
used to compute U (and V) with the linear-response method of
Cococcioni and de Gironcoli, PRB 71, 035105 (2005)
(only for "lda_plus_u_kind"=0)
(only for "lda_plus_u_kind"=0 and 2).
Note: Hubbard U and V can be computed using the HP code
which is based on density-functional perturbation theory,
and it gives exactly the same result as the method of
Cococcioni and de Gironcoli.
+--------------------------------------------------------------------
+--------------------------------------------------------------------
@ -1297,7 +1307,7 @@ NAMELIST: &SYSTEM
Description: Hubbard_beta(i) is the perturbation (on atom i, in eV)
used to compute J0 with the linear-response method of
Cococcioni and de Gironcoli, PRB 71, 035105 (2005)
(only for "lda_plus_u_kind"=0). See also
(only for "lda_plus_u_kind"=0 and 2). See also
PRB 84, 115108 (2011).
+--------------------------------------------------------------------
@ -1324,7 +1334,7 @@ NAMELIST: &SYSTEM
Description: In the first iteration of an DFT+U run it overwrites
the m-th eigenvalue of the ns occupation matrix for the
ispin component of atomic species ityp.
For the noncolin case the ispin index runs up to npol.
For the noncollinear case, the ispin index runs up to npol=2
The value lmax is given by the maximum angular momentum
number to which the Hubbard U is applied.
Leave unchanged eigenvalues that are not set.
@ -1518,8 +1528,8 @@ NAMELIST: &SYSTEM
where i runs over the cartesian components (or just z
in the collinear case) and itype over the types (1-ntype).
mcons(:,:) array is defined from starting_magnetization,
(and angle1, angle2 in the non-collinear case). lambda is
a real number
(also from angle1, angle2 in the noncollinear case).
lambda is a real number
'total direction' :
the angle theta of the total magnetization
@ -3218,6 +3228,26 @@ CARD: K_POINTS { tpiba | automatic | crystal | gamma | tpiba_b | crystal_b | tpi
===END OF CARD==========================================================
========================================================================
CARD: ADDITIONAL_K_POINTS
OPTIONAL CARD. ADDS A LIST OF K-POINTS WITH ZERO WEIGHT, AFTER THOSE USED FOR THE SCF CALCULATION.
WHEN DOING AN EXX CALCULATION AND NQ1X, NQ2X OR NQ3X ARE DIFFERENT FROM ONE, ALSO INCLUDE THE
REQUIRED K+Q POINTS. THE MAIN USE OF THIS CARD IS DO BAND PLOTS WITH EXX.
/////////////////////////////////////////
// Syntax: //
/////////////////////////////////////////
ADDITIONAL_K_POINTS
Same as K_POINTS, but does not accept 'automatic'.
/////////////////////////////////////////
===END OF CARD==========================================================
========================================================================
CARD: CELL_PARAMETERS { alat | bohr | angstrom }
@ -3506,4 +3536,4 @@ CARD: ATOMIC_FORCES
===END OF CARD==========================================================
This file has been created by helpdoc utility on Sun Jul 19 17:15:18 CEST 2020
This file has been created by helpdoc utility on Tue Sep 29 12:44:54 CEST 2020

View File

@ -255,14 +255,14 @@ SUBROUTINE electrons()
ENDIF
!
IF ( dexx < 0.0_dp ) THEN
IF( Doloc ) THEN
!IF( Doloc ) THEN
WRITE(stdout,'(5x,a,1e12.3)') "BEWARE: negative dexx:", dexx
dexx = ABS ( dexx )
ELSE
CALL errore( 'electrons', 'dexx is negative! &
& Check that exxdiv_treatment is appropriate for the system,&
& or ecutfock may be too low', 1 )
ENDIF
!ELSE
! CALL errore( 'electrons', 'dexx is negative! &
! & Check that exxdiv_treatment is appropriate for the system,&
! & or ecutfock may be too low', 1 )
!ENDIF
ENDIF
!
! remove the estimate exchange energy exxen used in the inner SCF

View File

@ -1882,6 +1882,7 @@ setlocal.o : extfield.o
setlocal.o : martyna_tuckerman.o
setlocal.o : pwcom.o
setlocal.o : scf_mod.o
setup.o : ../../Modules/additional_kpoints.o
setup.o : ../../Modules/cell_base.o
setup.o : ../../Modules/constants.o
setup.o : ../../Modules/control_flags.o

View File

@ -93,6 +93,7 @@ SUBROUTINE setup()
USE paw_variables, ONLY : okpaw
USE fcp_variables, ONLY : lfcpopt, lfcpdyn
USE extfield, ONLY : gate
USE additional_kpoints, ONLY : add_additional_kpoints
!
IMPLICIT NONE
!
@ -514,6 +515,8 @@ SUBROUTINE setup()
END IF
END IF
!
CALL add_additional_kpoints(nkstot, xk, wk)
!
IF ( nat==0 ) THEN
!
nsym=nrot