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

Cleanup of PP routines - band plotting simplified 

git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@321 c92efa57-630b-4861-b058-cf58834340f0
This commit is contained in:
giannozz 2003-10-03 11:17:13 +00:00
parent 0462b8441d
commit d44dc1ac81
16 changed files with 1032 additions and 1109 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
PP/Makefile
View File

@ -5,10 +5,8 @@ include ../make.rules
include ../make.sys
#
PPOBJS = addusdens1d.o \
average.o \
cft.o \
cgracsc.o \
chdens.o \
xsf.o \
plot_whole_cell.o \
dosg.o \
@ -19,14 +17,10 @@ local_dos1d.o \
local_dos.o \
plan_avg.o \
plot_io.o \
projwave.o \
punch_band.o \
punch_plot.o \
start_postproc.o \
do_postproc.o \
stm.o \
stop_pp.o \
voronoy.o \
work_function.o
MODULES = ../Modules/*.o
@ -283,14 +277,14 @@ pp.x: $(PPOBJS) postproc.o
projwfc.x: $(PPOBJS) projwfc.o
$(LD) -o projwfc.x projwfc.o $(PPOBJS) $(PWOBJS) $(MODULES) $(LDFLAGS)
chdens.x: $(PPOBJS) chmain.o
$(LD) -o chdens.x chmain.o $(PPOBJS) $(PWOBJS) $(MODULES) $(LDFLAGS)
chdens.x: $(PPOBJS) chdens.o
$(LD) -o chdens.x chdens.o $(PPOBJS) $(PWOBJS) $(MODULES) $(LDFLAGS)
average.x: $(PPOBJS) avmain.o
$(LD) -o average.x avmain.o $(PPOBJS) $(PWOBJS) $(MODULES) $(LDFLAGS)
average.x: $(PPOBJS) average.o
$(LD) -o average.x average.o $(PPOBJS) $(PWOBJS) $(MODULES) $(LDFLAGS)
voronoy.x: $(PPOBJS) voromain.o
$(LD) -o voronoy.x voromain.o $(PPOBJS) $(PWOBJS) $(MODULES) $(LDFLAGS)
voronoy.x: $(PPOBJS) voronoy.o
$(LD) -o voronoy.x voronoy.o $(PPOBJS) $(PWOBJS) $(MODULES) $(LDFLAGS)
dos.x: $(PPOBJS) dos.o
$(LD) -o dos.x dos.o $(PPOBJS) $(PWOBJS) $(MODULES) $(LDFLAGS)

21
PP/average.f90
View File

@ -7,7 +7,7 @@
!
!
!-----------------------------------------------------------------------
subroutine average
program average
!-----------------------------------------------------------------------
!
! This program calculates planar and macroscopic averages
@ -40,7 +40,10 @@ subroutine average
#include "machine.h"
use parameters, only: DP
use pwcom
use io_files, only: nd_nmbr
#ifdef __PARA
use para, only: me
#endif
implicit none
integer :: npixmax, nfilemax
! maximum number of pixel
@ -86,6 +89,13 @@ subroutine average
character (len=80) :: filename (nfilemax)
! names of the files with the charge
!
call start_postproc (nd_nmbr)
#ifdef __PARA
!
! Works for parallel machines but only for one processor !!!
!
if (me == 1) then
#endif
inunit = 5
read (inunit, *, err = 1100, iostat = ios) nfile
if (nfile.le.0.or.nfile.gt.nfilemax) call errore ('average ', &
@ -303,5 +313,8 @@ subroutine average
i = 1, npt)
deallocate(funci)
deallocate(funcr)
return
end subroutine average
#ifdef __PARA
end if
#endif
call stop_pp
end program average

16
PP/avmain.f90
View File

@ -1,16 +0,0 @@
!
! Copyright (C) 2001 PWSCF 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 .
!
program macroscopic
character :: nodenumber * 3
call start_postproc (nodenumber)
!
! work in parallel machines but only with one node!!!
!
call average
end program macroscopic

272
PP/bands.f90
View File

@ -1,18 +1,278 @@
!
! Copyright (C) 2003 PWSCF group
! Copyright (C) 2001-2003 PWSCF 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 .
!
!
!-----------------------------------------------------------------------
program bands
character :: nodenumber * 3
call start_postproc (nodenumber)
!-----------------------------------------------------------------------
use pwcom
use becmod
use io_files, only: nd_nmbr, prefix, tmp_dir
#ifdef __PARA
use para, only: me
use io_global, only: ionode_id
use mp, only: mp_bcast
#endif
implicit none
!
call do_bands (nodenumber)
character (len=80) :: filband
character(len=256) :: outdir
integer :: ios
namelist / inputpp / outdir, prefix, filband
!
call start_postproc (nd_nmbr)
!
! set default values for variables in namelist
!
prefix = 'pwscf'
outdir = './'
filband = 'bands.out'
!
#ifdef __PARA
if (me == 1) then
#endif
read (5, inputpp, err = 200, iostat = ios)
200 call errore ('do_bands', 'reading inputpp namelist', abs (ios) )
!
tmp_dir = trim(outdir)
!
#ifdef __PARA
end if
!
! ... Broadcast variables
!
CALL mp_bcast( tmp_dir, ionode_id )
CALL mp_bcast( prefix, ionode_id )
CALL mp_bcast( filband, ionode_id )
#endif
!
! Now allocate space for pwscf variables, read and check them.
!
call read_file
call openfil
call init_us_1
!
call punch_band (filband)
!
call stop_pp
stop
end program bands
!
!-----------------------------------------------------------------------
subroutine punch_band (filband)
!-----------------------------------------------------------------------
!
! This routine writes the band energies on a file. The routine orders
! the eigenvalues using the overlap of the eigenvectors to give
! an estimate crossing and anticrossing of the bands. This simplified
! method works in many, but not in all the cases.
!
!
#include "machine.h"
#ifdef __PARA
use para, only: me
#endif
use pwcom
use becmod
implicit none
character (len=*) :: filband
real(kind=DP) :: proold
! the best overlap product
complex(kind=DP) :: pro
! the product of wavefunctions
complex(kind=DP), allocatable :: psiold (:,:), old (:), new (:), &
becpold (:,:)
! psiold: eigenfunctions at previous k-point, ordered
! old, new: contain one band resp. at previous and current k-point
! becpold: <psi|beta> at previous k-point
integer :: ibnd, jbnd, ik, ikb, ig, npwold, ios
! counters
integer, allocatable :: ok (:), igkold (:), il (:)
! ok: keeps track of which bands have been already ordered
! igkold: indices of k+G at previous k-point
! il: band ordering
integer, parameter :: maxdeg = 4
! maxdeg : max allowed degeneracy
integer :: ndeg, deg, nd
! ndeg : number of degenerate states
integer, allocatable :: degeneracy(:), degbands(:,:), index(:)
! degbands keeps track of which states are degenerate
real(kind=DP), allocatable:: edeg(:)
real(kind=DP), parameter :: eps = 0.001
! threshold (Ry) for degenerate states
complex(kind=DP), external :: cgracsc
! scalar product with the S matrix
if (filband == ' ') return
iunpun = 18
#ifdef __PARA
if (me == 1) then
#endif
open (unit = iunpun, file = filband, status = 'unknown', form = &
'formatted', err = 100, iostat = ios)
100 call errore ('punch_band', 'Opening filband file', abs (ios) )
rewind (iunpun)
#ifdef __PARA
endif
#endif
allocate (psiold( npwx, nbnd))
allocate (old(ngm), new(ngm))
allocate (becpold(nkb, nbnd))
allocate (igkold (npwx))
allocate (ok (nbnd), il (nbnd))
allocate (degeneracy(nbnd), edeg(nbnd))
allocate (index(maxdeg), degbands(nbnd,maxdeg))
!
do ik = 1, nks
!
! prepare the indices of this k point
!
call gk_sort (xk (1, ik), ngm, g, ecutwfc / tpiba2, npw, &
igk, g2kin)
!
! read eigenfunctions
!
call davcio (evc, nwordwfc, iunwfc, ik, - 1)
!
! calculate becp = <psi|beta>
!
call init_us_2 (npw, igk, xk (1, ik), vkb)
call ccalbec (nkb, npwx, npw, nbnd, becp, vkb, evc)
!
if (ik == 1) then
!
! first k-point in the list:
! save eigenfunctions in the current order (increasing energy)
!
do ibnd = 1, nbnd
il (ibnd) = ibnd
end do
else
!
! following k-points in the list:
! determine eigenfunction order in array il
!
do ibnd = 1, nbnd
ok (ibnd) = 0
enddo
do ibnd = 1, nbnd
old(:) = (0.d0, 0.d0)
do ig = 1, npwold
old (igkold (ig) ) = psiold (ig, ibnd)
enddo
proold = 0.d0
do jbnd = 1, nbnd
if (ok (jbnd) == 0) then
new (:) = (0.d0, 0.d0)
do ig = 1, npw
new (igk (ig) ) = evc (ig, jbnd)
enddo
pro = cgracsc (nkb, becp (1, jbnd), becpold (1, ibnd), &
nhm, ntyp, nh, qq, nat, ityp, ngm, new, old, tvanp)
if (abs (pro) > proold) then
il (ibnd) = jbnd
proold = abs (pro)
endif
endif
enddo
ok (il (ibnd) ) = 1
enddo
!
! if there were bands crossing at degenerate eigenvalues
! at previous k-point, re-order those bands so as to keep
! lower band indices corresponding to lower bands
!
do nd = 1, ndeg
do deg = 1, degeneracy (nd)
index(deg) = il(degbands(nd,deg))
edeg (deg) = et(il(degbands(nd,deg)), ik)
end do
call hpsort(degeneracy (nd), edeg, index)
do deg = 1, degeneracy (nd)
il(degbands(nd,deg)) = index(deg)
end do
end do
end if
!
! Now the order of eigenfunctions has been established
! for this k-point -- prepare data for next k point
!
do ibnd = 1, nbnd
do ig = 1, npw
psiold (ig, ibnd) = evc (ig, il (ibnd) )
enddo
do ikb = 1, nkb
becpold (ikb, ibnd) = becp (ikb, il (ibnd) )
enddo
enddo
do ig = 1, npw
igkold (ig) = igk (ig)
enddo
npwold = npw
!
! find degenerate eigenvalues
!
deg = 0
ndeg = 0
do ibnd = 2, nbnd
if ( abs (et(ibnd, ik) - et(ibnd-1, ik)) < eps ) then
if ( deg == 0 ) then
ndeg = ndeg + 1
edeg (ndeg) = et(ibnd, ik)
end if
deg = 1
else
deg = 0
end if
end do
!
! locate band crossings at degenerate eigenvalues
!
do nd = 1, ndeg
deg = 0
do ibnd = 1, nbnd
if ( abs (et(il(ibnd), ik) - edeg (nd)) < eps ) then
deg = deg + 1
if (deg > maxdeg) call errore ('punch_band', &
' increase maxdeg', deg)
degbands(nd,deg) = ibnd
end if
end do
degeneracy (nd) = deg
end do
!
#ifdef __PARA
if (me == 1) then
#endif
write (iunpun, '(14x,3f7.4)') xk(1,ik),xk(2,ik),xk(3,ik)
write (iunpun, '(10f8.3)') (et (il (ibnd) , ik) &
* rytoev, ibnd = 1, nbnd)
#ifdef __PARA
endif
#endif
enddo
deallocate (index, degbands)
deallocate (edeg, degeneracy)
deallocate (il, ok)
deallocate (igkold)
deallocate (becpold)
deallocate (new, old)
deallocate (psiold)
#ifdef __PARA
if (me == 1) then
#endif
close (iunpun)
#ifdef __PARA
endif
#endif
return
end subroutine punch_band

83
PP/chdens.f90
View File

@ -7,8 +7,7 @@
!
!
!-----------------------------------------------------------------------
subroutine do_chdens
program chdens
!-----------------------------------------------------------------------
! Charge density/polarization plotting program
!-----------------------------------------------------------------------
@ -16,7 +15,6 @@ subroutine do_chdens
! DESCRIPTION of the INPUT: see file INPUT_CHDENS in pwdocs/
!
#include "machine.h"
! use pwcom
use constants, only: pi, fpi
use brilz
use basis
@ -27,7 +25,10 @@ subroutine do_chdens
use pseud, only: zv
use scf, only: rho
use workspace
! use io
use io_files, only: nd_nmbr
#ifdef __PARA
use para, only: me
#endif
implicit none
integer, parameter :: nfilemax = 7
@ -57,7 +58,14 @@ subroutine do_chdens
namelist /input/ &
nfile, filepp, weight, iflag, idpol, e1, e2, e3, nx, ny, nz, x0, &
plot_out, output_format, fileout, epsilon, filepol
!
call start_postproc (nd_nmbr)
#ifdef __PARA
!
! Works for parallel machines but only for one processor !!!
!
if (me == 1) then
#endif
!
! set the DEFAULT values
!
@ -396,9 +404,12 @@ subroutine do_chdens
deallocate(rhor)
deallocate(rhog)
return
#ifdef __PARA
end if
#endif
call stop_pp
1100 call errore ('chdens', 'reading input data', abs (ios) )
end subroutine do_chdens
end program chdens
!
!-----------------------------------------------------------------------
subroutine plot_1d (nx, m1, x0, e, ngm, g, rhog, alat, plot_out, ounit)
@ -1172,18 +1183,18 @@ subroutine write_openmol_file (alat, at, nat, tau, atm, ityp, x0, &
end subroutine write_openmol_file
subroutine write_dipol(dipol,tau,nat,alat,zv,ntyp,ityp,idpol)
use parameters, only : dp
implicit none
use parameters, only : dp
implicit none
integer :: nat, ntyp, ityp(nat), idpol
real(kind=dp) :: dipol(0:3), tau(3,nat), zv(ntyp), alat
integer :: nat, ntyp, ityp(nat), idpol
real(kind=dp) :: dipol(0:3), tau(3,nat), zv(ntyp), alat
real(kind=dp) :: debye, dipol_ion(3)
real(kind=dp) :: debye, dipol_ion(3)
integer :: na, ipol
!
! compute ion dipole moments
!
integer :: na, ipol
!
! compute ion dipole moments
!
if (idpol.eq.1) then
dipol_ion=0.d0
do na=1,nat
@ -1192,39 +1203,39 @@ integer :: na, ipol
enddo
enddo
endif
!
! Charge inside the Wigner-Seitz cell
!
!
! Charge inside the Wigner-Seitz cell
!
write(6, '(/4x," Charge density inside the Wigner-Seitz cell:",3f14.8," el.")') &
dipol(0)
dipol(0)
!
! print the electron dipole moment calculated by the plotting 3d routines
! A positive dipole goes from the - charge to the + charge.
!
!
! print the electron dipole moment calculated by the plotting 3d routines
! A positive dipole goes from the - charge to the + charge.
!
write(6, '(/4x,"Electrons dipole moments",3f14.8," a.u.")') &
(-dipol(ipol),ipol=1,3)
!
! print the ionic and total dipole moment
!
(-dipol(ipol),ipol=1,3)
!
! print the ionic and total dipole moment
!
if (idpol.eq.1) then
write(6, '(4x," Ions dipole moments",3f14.8," a.u.")') &
(dipol_ion(ipol),ipol=1,3)
(dipol_ion(ipol),ipol=1,3)
write(6,'(4x," Total dipole moments",3f14.8," a.u.")') &
((-dipol(ipol)+dipol_ion(ipol)),ipol=1,3)
((-dipol(ipol)+dipol_ion(ipol)),ipol=1,3)
endif
!
! Print the same information in Debye
!
!
! Print the same information in Debye
!
debye=2.54176d0
write(6,'(/4x,"Electrons dipole moments",3f14.8," Debye")') &
(-dipol(ipol)*debye,ipol=1,3)
(-dipol(ipol)*debye,ipol=1,3)
if (idpol.eq.1) then
write(6,'(4x," Ions dipole moments",3f14.8," Debye")') &
(dipol_ion(ipol)*debye,ipol=1,3)
(dipol_ion(ipol)*debye,ipol=1,3)
write(6,'(4x," Total dipole moments",3f14.8," Debye")') &
((-dipol(ipol)+dipol_ion(ipol))*debye,ipol=1,3)
((-dipol(ipol)+dipol_ion(ipol))*debye,ipol=1,3)
endif
end subroutine write_dipol

19
PP/chmain.f90
View File

@ -1,19 +0,0 @@
!
! Copyright (C) 2001 PWSCF 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 .
!
!
program chdens
character :: nodenumber * 3
call start_postproc (nodenumber)
!
! Works on parallel machines but only with one node !!!
!
call do_chdens
call stop_pp
stop
end program chdens

116
PP/do_postproc.f90
View File

@ -1,116 +0,0 @@
!
! Copyright (C) 2001-2003 PWSCF 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 .
!
!
!-----------------------------------------------------------------------
subroutine do_postproc (nodenumber)
!-----------------------------------------------------------------------
!
! This routine reads the output file produced by pw.x
! extracts and calculates the desired quantity (rho, V, ...)
! writes it to a file for further processing or plotting
!
! DESCRIPTION of the INPUT: see file pwdocs/INPUT_PP
!
use pwcom
use io_files, only: tmp_dir, nd_nmbr, prefix
#ifdef __PARA
use para, only: me
use mp
#endif
implicit none
character(len=3) :: nodenumber
character(len=80) :: filplot
integer :: n_atom_wfc, plot_num, kpoint, kband, spin_component, ios
logical :: stm_wfc_matching, lsign
integer :: ionode_id = 0
real(kind=DP) :: emin, emax, sample_bias, z, dz
! directory for temporary files
character(len=256) :: outdir
namelist / inputpp / outdir, prefix, plot_num, stm_wfc_matching, &
sample_bias, spin_component, z, dz, emin, emax, kpoint, kband,&
filplot, lsign
!
nd_nmbr = nodenumber
!
! set default values for variables in namelist
!
prefix = 'pwscf'
outdir = './'
filplot = 'pp.out'
plot_num = 0
spin_component = 0
sample_bias = 0.01d0
z = 1.d0
dz = 0.05d0
stm_wfc_matching = .true.
lsign=.false.
emin = - 999.0d0
emax = ef*13.6058d0
!
! reading the namelist inputpp
!
#ifdef __PARA
if (me == 1) then
#endif
read (5, inputpp, err = 200, iostat = ios)
200 call errore ('postproc', 'reading inputpp namelist', abs (ios) )
tmp_dir = trim(outdir)
#ifdef __PARA
end if
!
! ... Broadcast variables
!
CALL mp_bcast( tmp_dir, ionode_id )
CALL mp_bcast( prefix, ionode_id )
CALL mp_bcast( plot_num, ionode_id )
CALL mp_bcast( stm_wfc_matching, ionode_id )
CALL mp_bcast( sample_bias, ionode_id )
CALL mp_bcast( spin_component, ionode_id )
CALL mp_bcast( z, ionode_id )
CALL mp_bcast( dz, ionode_id )
CALL mp_bcast( emin, ionode_id )
CALL mp_bcast( emax, ionode_id )
CALL mp_bcast( kpoint, ionode_id )
CALL mp_bcast( kband, ionode_id )
CALL mp_bcast( kpoint, ionode_id )
CALL mp_bcast( filplot, ionode_id )
CALL mp_bcast( lsign, ionode_id )
#endif
! Check of namelist variables
!
if (plot_num < 0 .or. plot_num > 12) call errore ('postproc', &
'Wrong plot_num', abs (plot_num) )
if ( (plot_num == 0 .or. plot_num == 1) .and. &
(spin_component < 0 .or. spin_component > 2) ) call errore &
('postproc', 'wrong value of spin_component', 1)
if (plot_num == 10) then
emin = emin / 13.6058d0
emax = emax / 13.6058d0
end if
!
! Now allocate space for pwscf variables, read and check them.
!
call read_file
call openfil
call struc_fact (nat, tau, ntyp, ityp, ngm, g, bg, nr1, nr2, nr3, &
strf, eigts1, eigts2, eigts3)
call init_us_1
!
! Now do whatever you want
!
call punch_plot (filplot, plot_num, sample_bias, z, dz, &
stm_wfc_matching, emin, emax, kpoint, kband, spin_component, lsign)
return
end subroutine do_postproc

36
PP/dos.f90
View File

@ -5,18 +5,8 @@
! in the root directory of the present distribution,
! or http://www.gnu.org/copyleft/gpl.txt .
!
program dos_e
character(len=3) :: nodenumber
call start_postproc (nodenumber)
call dos (nodenumber)
call stop_pp
stop
end program dos_e
!
!--------------------------------------------------------------------
subroutine dos (nodenumber)
program dos
!--------------------------------------------------------------------
!
! Input (namelist &inputpp ... &end): Default value
@ -39,18 +29,26 @@ subroutine dos (nodenumber)
!
use pwcom
use io_files, only: nd_nmbr, prefix, tmp_dir
character(len=3) :: nodenumber
#ifdef __PARA
use para, only: me
#endif
implicit none
character(len=80) :: fildos
character(len=256) :: outdir
real(kind=DP) :: E, DOSofE (2), DOSint, Elw, Eup, DeltaE, Emin, Emax, &
degauss1
integer :: nrot, ik, n, ndos, ngauss1
integer :: nrot, ik, n, ndos, ngauss1, ios
namelist /inputpp/ outdir, prefix, fildos, degauss1,ngauss1,&
Emin, Emax, DeltaE
logical :: minus_q
!
nd_nmbr = nodenumber
call start_postproc (nd_nmbr)
#ifdef __PARA
!
! Works for parallel machines but only for one processor !!!
!
if (me == 1) then
#endif
!
! set default values for variables in namelist
!
@ -130,5 +128,9 @@ subroutine dos (nodenumber)
enddo
close (unit = 4)
return
end subroutine dos
#ifdef __PARA
end if
#endif
call stop_pp
end program dos

102
PP/plotband.f90
View File

@ -2,21 +2,21 @@
program read_bands
implicit none
integer, parameter:: maxk=100, maxbands=50, maxtotbands=500
real :: k(3,maxk), e(maxbands,maxk), kx(maxk)
real :: ewrk(maxtotbands)
real :: e_in(maxk)
integer, parameter:: maxk=100
real :: k(3,maxk), e_in(maxk), kx(maxk)
real, allocatable :: e(:,:)
real :: k1(3), k2(3), xk1, xk2, ps
integer :: npoints(maxk)
integer :: npk, nbands, first, last, nlines, n,i,ni,nf,nl, iargc
integer :: npk, nbands, nlines, n,i,ni,nf,nl, iargc
logical :: high_symmetry(maxk)
logical, allocatable :: is_in_range(:)
character(len=80) :: filename, prgname
integer, parameter :: max_interp=4*maxk
integer :: n_interp, init
real :: k_interp(max_interp), e_interp(max_interp), coef_interp(maxk,4)
real :: emin, emax, etic, eref, deltaE, Ef
real :: emin = 1.e10, emax =-1.e10, etic, eref, deltaE, Ef
real, parameter :: cm=28.453, xdim=15.0*cm, ydim=10.0*cm, &
x0=2.0*cm, y0=2.0*cm
@ -35,22 +35,10 @@ program read_bands
print '("number of bands > ",$)'
read(5,*) nbands
print '("first and last band to plot > ",$)'
read(5,*) first,last
print '("Emin, Emax > ",$)'
read(5,*) emin, emax
print '("Efermi > ",$)'
read(5,*) Ef
print '("deltaE, reference E (for tics) ",$)'
read(5,*) deltaE, eref
if (last-first+1 > maxbands) stop ' maxbands!'
if (nbands > maxtotbands) stop ' maxtotbands!'
allocate (e(nbands,maxk))
do n=1,maxk
read(1,*,end=20,err=30) ( k(i,n), i=1,3 )
read(1,*,end=30,err=30) (ewrk(i),i=1,nbands)
do i=1,last-first+1
e(i,n) = ewrk(i+first-1)
end do
read(1,*,end=30,err=30) (e(i,n),i=1,nbands)
if (n==1) then
kx(n) = 0.0
else
@ -63,6 +51,26 @@ program read_bands
print '("Warning: max # of k-point (",i3,") read")', maxk
20 npk=n-1
print '(i3," k-point read")', npk
do n=1,npk
do i=1,nbands
emin = min(emin, e(i,n))
emax = max(emax, e(i,n))
end do
end do
print '("Range:",2f8.4,"eV Emin, Emax > ",$)', emin, emax
read(5,*) emin, emax
print '("Efermi > ",$)'
read(5,*) Ef
print '("deltaE, reference E (for tics) ",$)'
read(5,*) deltaE, eref
allocate (is_in_range(nbands))
is_in_range(:) = .false.
do i=1,nbands
is_in_range(i) = any (e(i,1:npk) >= emin .and. e(i,1:npk) <= emax)
end do
do n=1,npk
if (n==1 .or. n==npk) then
high_symmetry(n) = .true.
@ -150,37 +158,39 @@ program read_bands
write (1,'(4(f8.3,x)," riga")') &
kx(n)*xdim/kx(npk), 0.0, kx(n)*xdim/kx(npk), ydim
end if
do i=1,last-first+1
write (1,'(2(f8.3,x)," dot")' ) &
do i=1,nbands
if (is_in_range(i)) write (1,'(2(f8.3,x)," dot")' ) &
kx(n)*xdim/kx(npk), (e(i,n)-emin)*ydim/(emax-emin)
end do
end do
! draw bands
do i=1,last-first+1
! No interpolation:
! write (1,'(9(f8.3,x))') ( kx(n)*xdim/kx(npk), &
! (e(i,n)-emin)*ydim/(emax-emin),n=npk,1,-1)
! write (1,'(i4," banda")' ) npk-1
! Spline interpolation with twice as many points:
!
ni=1
nf=1
do nl=1,nlines
ni=nf
nf=nf + npoints(nl)-1
n_interp= 2*(nf-ni)+1
do n=1,n_interp
k_interp(n)=kx(ni)+(n-1)*(kx(nf)-kx(ni))/(n_interp-1)
do i=1,nbands
if (is_in_range(i)) then
! No interpolation:
! write (1,'(9(f8.3,x))') ( kx(n)*xdim/kx(npk), &
! (e(i,n)-emin)*ydim/(emax-emin),n=npk,1,-1)
! write (1,'(i4," banda")' ) npk-1
! Spline interpolation with twice as many points:
!
ni=1
nf=1
do nl=1,nlines
ni=nf
nf=nf + npoints(nl)-1
n_interp= 2*(nf-ni)+1
do n=1,n_interp
k_interp(n)=kx(ni)+(n-1)*(kx(nf)-kx(ni))/(n_interp-1)
end do
do n=ni,nf
e_in(n-ni+1)=e(i,n)
end do
call spline_interpol ( kx(ni), e_in, nf-ni+1, &
k_interp, e_interp, n_interp )
write (1,'(9(f8.3,x))') ( k_interp(n)*xdim/kx(npk), &
(e_interp(n)-emin)*ydim/(emax-emin),n=n_interp,1,-1)
write (1,'(i4," banda")' ) n_interp-1
end do
do n=ni,nf
e_in(n-ni+1)=e(i,n)
end do
call spline_interpol ( kx(ni), e_in, nf-ni+1, &
k_interp, e_interp, n_interp )
write (1,'(9(f8.3,x))') ( k_interp(n)*xdim/kx(npk), &
(e_interp(n)-emin)*ydim/(emax-emin),n=n_interp,1,-1)
write (1,'(i4," banda")' ) n_interp-1
end do
end if
end do
write (1,*) 'grestore'

109
PP/postproc.f90
View File

@ -1,17 +1,116 @@
!
! Copyright (C) 2001 PWSCF group
! Copyright (C) 2001-2003 PWSCF 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 .
!
!
!-----------------------------------------------------------------------
program postproc
!-----------------------------------------------------------------------
!
! This program reads the output file produced by pw.x
! extracts and calculates the desired quantity (rho, V, ...)
! writes it to a file for further processing or plotting
!
! DESCRIPTION of the INPUT: see file pwdocs/INPUT_PP
!
use pwcom
use io_files, only: tmp_dir, nd_nmbr, prefix
#ifdef __PARA
use para, only: me
use mp
#endif
implicit none
character(len=80) :: filplot
character :: nodenumber * 3
call start_postproc (nodenumber)
call do_postproc (nodenumber)
integer :: n_atom_wfc, plot_num, kpoint, kband, spin_component, ios
logical :: stm_wfc_matching, lsign
integer :: ionode_id = 0
real(kind=DP) :: emin, emax, sample_bias, z, dz
! directory for temporary files
character(len=256) :: outdir
namelist / inputpp / outdir, prefix, plot_num, stm_wfc_matching, &
sample_bias, spin_component, z, dz, emin, emax, kpoint, kband,&
filplot, lsign
!
call start_postproc (nd_nmbr)
!
! set default values for variables in namelist
!
prefix = 'pwscf'
outdir = './'
filplot = 'pp.out'
plot_num = 0
spin_component = 0
sample_bias = 0.01d0
z = 1.d0
dz = 0.05d0
stm_wfc_matching = .true.
lsign=.false.
emin = - 999.0d0
emax = ef*13.6058d0
!
! reading the namelist inputpp
!
#ifdef __PARA
if (me == 1) then
#endif
read (5, inputpp, err = 200, iostat = ios)
200 call errore ('postproc', 'reading inputpp namelist', abs (ios) )
tmp_dir = trim(outdir)
#ifdef __PARA
end if
!
! ... Broadcast variables
!
CALL mp_bcast( tmp_dir, ionode_id )
CALL mp_bcast( prefix, ionode_id )
CALL mp_bcast( plot_num, ionode_id )
CALL mp_bcast( stm_wfc_matching, ionode_id )
CALL mp_bcast( sample_bias, ionode_id )
CALL mp_bcast( spin_component, ionode_id )
CALL mp_bcast( z, ionode_id )
CALL mp_bcast( dz, ionode_id )
CALL mp_bcast( emin, ionode_id )
CALL mp_bcast( emax, ionode_id )
CALL mp_bcast( kpoint, ionode_id )
CALL mp_bcast( kband, ionode_id )
CALL mp_bcast( kpoint, ionode_id )
CALL mp_bcast( filplot, ionode_id )
CALL mp_bcast( lsign, ionode_id )
#endif
! Check of namelist variables
!
if (plot_num < 0 .or. plot_num > 12) call errore ('postproc', &
'Wrong plot_num', abs (plot_num) )
if ( (plot_num == 0 .or. plot_num == 1) .and. &
(spin_component < 0 .or. spin_component > 2) ) call errore &
('postproc', 'wrong value of spin_component', 1)
if (plot_num == 10) then
emin = emin / 13.6058d0
emax = emax / 13.6058d0
end if
!
! Now allocate space for pwscf variables, read and check them.
!
call read_file
call openfil
call struc_fact (nat, tau, ntyp, ityp, ngm, g, bg, nr1, nr2, nr3, &
strf, eigts1, eigts2, eigts3)
call init_us_1
!
! Now do whatever you want
!
call punch_plot (filplot, plot_num, sample_bias, z, dz, &
stm_wfc_matching, emin, emax, kpoint, kband, spin_component, lsign)
!
call stop_pp
stop
end program postproc

501
PP/projwave.f90
View File

@ -1,501 +0,0 @@
!
! Copyright (C) 2001-2003 PWSCF 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 .
!
!-----------------------------------------------------------------------
subroutine do_projwfc (nodenumber)
!-----------------------------------------------------------------------
!
! projects wavefunctions onto orthogonalized atomic wavefunctions
! calculates Lowdin charges, spilling parameter
! input: namelist "&inputpp", with variables
! prefix prefix of input files saved by program pwscf
! outdir temporary directory where files resides
!
use pwcom
use io_files, only: nd_nmbr, prefix, tmp_dir
#ifdef __PARA
use para, only: me
use mp
#endif
implicit none
character (len=3) :: nodenumber
character (len=8) :: io_choice
character(len=256) :: outdir
real (kind=DP) :: Emin, Emax, DeltaE, smoothing
integer :: ios, ionode_id = 0
namelist / inputpp / outdir, prefix, io_choice, &
Emin, Emax, DeltaE, smoothing
!
nd_nmbr = nodenumber
!
! set default values for variables in namelist
!
prefix = 'pwscf'
outdir = './'
io_choice ='both'
Emin =-1000000.
Emax =+1000000.
DeltaE = 0.01
smoothing = 0.d0
!
#ifdef __PARA
if (me == 1) then
#endif
read (5, inputpp, err = 200, iostat = ios)
200 call errore ('projwave', 'reading inputpp namelist', abs (ios) )
!
tmp_dir = trim(outdir)
!
#ifdef __PARA
end if
!
! ... Broadcast variables
!
CALL mp_bcast( tmp_dir, ionode_id )
CALL mp_bcast( prefix, ionode_id )
CALL mp_bcast( io_choice, ionode_id )
CALL mp_bcast( smoothing, ionode_id )
CALL mp_bcast( DeltaE, ionode_id )
CALL mp_bcast( Emin, ionode_id )
CALL mp_bcast( Emax, ionode_id )
#endif
if ( smoothing .lt. DeltaE ) smoothing= DeltaE
if (io_choice.ne.'standard' .and. io_choice.ne.'files' .and. &
io_choice.ne.'both') &
call errore ('projwave','io_choice definition is invalid',1)
!
! Now allocate space for pwscf variables, read and check them.
!
call read_file
call openfil
!
call projwave (io_choice,Emin, Emax, DeltaE, smoothing)
!
return
end subroutine do_projwfc
!-----------------------------------------------------------------------
subroutine projwave (io_choice,Emin, Emax, DeltaE, smoothing)
!-----------------------------------------------------------------------
!
#include "machine.h"
use pwcom
use becmod
use io_files, only: nd_nmbr, prefix, tmp_dir
#ifdef __PARA
use para
#endif
implicit none
character (len=80) :: filproj
character (len=8) :: io_choice
character (len=33) :: filextension
character (len=1) :: l_label(0:3)=(/'s','p','d','f'/)
!
type wfc_label
integer na, n, l, m
end type wfc_label
type(wfc_label), allocatable :: nlmchi(:)
!
integer :: ik, ibnd, i, j, k, na, nb, nt, isym, n, m, m1, l, lm, nwfc,&
nwfc1, lmax_wfc, c_tab, ne, ie_mid, ie_delta, ie, is
logical :: exst
real(kind=DP) :: psum, totcharge, Emin, Emax, DeltaE, smoothing, etev, &
delta, w0gauss, Elw, Eup
real(kind=DP), allocatable :: e (:), proj (:,:,:), charges(:,:), pdos(:,:,:)
complex(kind=DP), allocatable :: wfcatom (:,:), overlap (:,:), &
work (:,:), work1(:), proj0(:,:)
integer, allocatable :: index(:)
external w0gauss
!
!
write (6, '(/5x,"Calling projwave .... ")')
if (io_choice.eq.'standard' ) &
write (6, '(5x,"Projections are written on standard output")')
if (io_choice.eq.'files' ) &
write (6, '(5x,"Projections are written on files")')
if (io_choice.eq.'both' ) &
write (6, '(5x,"Projections are written on both standard output and file")')
!
allocate(swfcatom (npwx , natomwfc ) )
allocate(wfcatom (npwx, natomwfc) )
allocate(proj (natomwfc, nbnd, nkstot) )
allocate(overlap (natomwfc, natomwfc) )
allocate(e (natomwfc) )
proj = 0.d0
overlap= (0.d0,0.d0)
!
! initialize D_Sl for l=1, l=2 and l=3, for l=0 D_S0 is 1
!
call d_matrix (d1, d2, d3)
!
! fill structure nlmchi
!
allocate (nlmchi(natomwfc))
nwfc=0
lmax_wfc = 0
do na = 1, nat
nt = ityp (na)
do n = 1, nchi (nt)
if (oc (n, nt) .gt.0.d0.or..not.newpseudo (nt) ) then
l = lchi (n, nt)
lmax_wfc = max (lmax_wfc, l )
do m = 1, 2 * l + 1
nwfc=nwfc+1
nlmchi(nwfc)%na = na
nlmchi(nwfc)%n = n
nlmchi(nwfc)%l = l
nlmchi(nwfc)%m = m
enddo
endif
enddo
enddo
if (lmax_wfc.gt.3) call errore ('projwave', 'l > 3 not yet implemented', 1)
if (nwfc.ne.natomwfc) call errore ('projwave', 'wrong # of atomic wfcs?', 1)
!
! loop on k points
!
call init_us_1
!
do ik = 1, nks
npw = npwx
call gk_sort (xk (1, ik), ngm, g, ecutwfc / tpiba2, npw, igk, g2kin)
call davcio (evc, nwordwfc, iunwfc, ik, - 1)
call atomic_wfc (ik, wfcatom)
call init_us_2 (npw, igk, xk (1, ik), vkb)
call ccalbec (nkb, npwx, npw, natomwfc, becp, vkb, wfcatom)
call s_psi (npwx, npw, natomwfc, wfcatom, swfcatom)
!
! wfcatom = |phi_i> , swfcatom = \hat S |phi_i>
! calculate overlap matrix O_ij = <phi_i|\hat S|\phi_j>
!
call ZGEMM ('c', 'n', natomwfc, natomwfc, npw, (1.d0, 0.d0) , &
wfcatom, npwx, swfcatom, npwx, (0.d0, 0.d0) , overlap, natomwfc)
#ifdef __PARA
call reduce (2 * natomwfc * natomwfc, overlap)
#endif
!
! calculate O^{-1/2}
!
allocate(work (natomwfc, natomwfc) )
call cdiagh (natomwfc, overlap, natomwfc, e, work)
do i = 1, natomwfc
e (i) = 1.d0 / dsqrt (e (i) )
enddo
do i = 1, natomwfc
do j = i, natomwfc
overlap (i, j) = (0.d0, 0.d0)
do k = 1, natomwfc
overlap (i, j) = overlap (i, j) + e (k) * work (j, k) * conjg (work (i, k) )
enddo
if (j.ne.i) overlap (j, i) = conjg (overlap (i, j))
enddo
enddo
deallocate (work)
!
! calculate wfcatom = O^{-1/2} \hat S | phi>
!
call ZGEMM ('n', 't', npw, natomwfc, natomwfc, (1.d0, 0.d0) , &
swfcatom, npwx, overlap, natomwfc, (0.d0, 0.d0), wfcatom, npwx)
!
! make the projection <psi_i| O^{-1/2} \hat S | phi_j>
!
allocate(proj0(natomwfc,nbnd) )
call ZGEMM ('c', 'n', natomwfc, nbnd, npw, (1.d0, 0.d0) , &
wfcatom, npwx, evc, npwx, (0.d0, 0.d0) , proj0, natomwfc)
#ifdef __PARA
call reduce (2 * natomwfc * nbnd, proj0)
#endif
!
! symmetrize the projections
!
allocate(work1 (nbnd) )
do nwfc = 1, natomwfc
!
! atomic wavefunction nwfc is on atom na
!
na= nlmchi(nwfc)%na
n = nlmchi(nwfc)%n
l = nlmchi(nwfc)%l
m = nlmchi(nwfc)%m
!
do isym = 1, nsym
nb = irt (isym, na)
do nwfc1 =1, natomwfc
if (nlmchi(nwfc1)%na.eq. nb .and. &
nlmchi(nwfc1)%n .eq. nlmchi(nwfc)%n .and. &
nlmchi(nwfc1)%l .eq. nlmchi(nwfc)%l .and. &
nlmchi(nwfc1)%m .eq. 1 ) go to 10
end do
call errore('projwave','cannot symmetrize',1)
10 nwfc1=nwfc1-1
!
! nwfc1 is the first rotated atomic wfc corresponding to nwfc
!
if (l.eq.0) then
work1(:) = proj0 (nwfc1 + 1,:)
else if (l.eq.1) then
work1(:) = 0.d0
do m1 = 1, 3
work1(:) = work1(:) + d1 (m1, m, isym) * proj0 (nwfc1 + m1,:)
enddo
else if (l.eq.2) then
work1(:) = 0.d0
do m1 = 1, 5
work1(:) = work1(:) + d2 (m1, m, isym) * proj0 (nwfc1 + m1,:)
enddo
else if (l.eq.3) then
work1(:) = 0.d0
do m1 = 1, 7
work1(:) = work1(:) + d3 (m1, m, isym) * proj0 (nwfc1 + m1,:)
enddo
endif
do ibnd = 1, nbnd
proj (nwfc, ibnd, ik) = proj (nwfc, ibnd, ik) + &
work1(ibnd) * conjg (work1(ibnd)) / nsym
enddo
enddo
enddo
deallocate (work1)
deallocate (proj0 )
! on k-points
enddo
#ifdef __PARA
!
! recover the vector proj over the pools
!
call poolrecover (et, nbnd, nkstot, nks)
call poolrecover (proj, nbnd * natomwfc, nkstot, nks)
!
if (me.eq.1.and.mypool.eq.1) then
#endif
!
! write on the standard output file
!
if (io_choice.eq.'standard' .or.io_choice.eq.'both' ) then
write(6,'(/"Projection on atomic states:"/)')
do nwfc = 1, natomwfc
write(6,'(5x,"state #",i3,": atom ",i3," (",a3,"), wfc ",i2, &
& " (l=",i1," m=",i2,")")') &
nwfc, nlmchi(nwfc)%na, atm(ityp(nlmchi(nwfc)%na)), &
nlmchi(nwfc)%n, nlmchi(nwfc)%l, nlmchi(nwfc)%m
end do
!
allocate(index (natomwfc) )
do ik = 1, nkstot
write (6, '(/" k = ",3f14.10)') (xk (i, ik) , i = 1, 3)
do ibnd = 1, nbnd
write (6, '(5x,"e = ",f14.10," eV")') et (ibnd, ik) * rytoev
!
! sort projections by magnitude, in decreasing order
!
do nwfc = 1, natomwfc
index (nwfc) = 0
e (nwfc) = - proj (nwfc, ibnd, ik)
end do
call hpsort (natomwfc, e, index)
!
! only projections that are larger than 0.001 are written
!
do nwfc = 1, natomwfc
e (nwfc) = - e(nwfc)
if ( abs (e(nwfc)).lt.0.001 ) go to 20
end do
nwfc = natomwfc + 1
20 nwfc = nwfc -1
!
! fancy (?!?) formatting
!
write (6, '(5x,"psi = ",5(f5.3,"*[#",i3,"]+"))') &
(e (i), index(i), i = 1, min(5,nwfc))
do j = 1, (nwfc-1)/5
write (6, '(10x,"+",5(f5.3,"*[#",i3,"]+"))') &
(e (i), index(i), i = 5*j+1, min(5*(j+1),nwfc))
end do
psum = 0.d0
do nwfc = 1, natomwfc
psum = psum + proj (nwfc, ibnd, ik)
end do
write (6, '(4x,"|psi|^2 = ",f5.3)') psum
!
enddo
enddo
deallocate (index)
end if
!
! estimate partial charges (Loewdin) on each atom
!
allocate ( charges (nat, 0:lmax_wfc ) )
charges = 0.0
do ik = 1, nkstot
do ibnd = 1, nbnd
do nwfc = 1, natomwfc
na= nlmchi(nwfc)%na
l = nlmchi(nwfc)%l
charges(na,l) = charges(na,l) + wg (ibnd,ik) * &
proj (nwfc, ibnd, ik)
enddo
end do
end do
!
write (6, '(/"Lowdin Charges: "/)')
!
psum = 0.0
do na = 1, nat
totcharge = 0.d0
do l = 0, lmax_wfc
totcharge = totcharge + charges(na,l)
end do
psum = psum + totcharge
write (6, '(5x,"Atom # ",i3,": total charge = ",f8.4, &
& ", s, p, d, f = ",4f8.4 )') &
na, totcharge, ( charges(na,l), l= 0,lmax_wfc)
end do
psum = psum / nelec
write (6, '(5x,"Spilling Parameter: ",f8.4)') 1.0 - psum
!
! Sanchez-Portal et al., Sol. State Commun. 95, 685 (1995).
! The spilling parameter measures the ability of the basis provided by
! the pseudo-atomic wfc to represent the PW eigenstates,
! by measuring how much of the subspace of the Hamiltonian
! eigenstates falls outside the subspace spanned by the atomic basis
!
deallocate (charges)
if (io_choice.eq.'files' .or. io_choice.eq.'both') then
!
! find band extrema
!
Elw = et (1, 1)
Eup = et (nbnd, 1)
do ik = 2, nkstot
Elw = min (Elw, et (1, ik) )
Eup = max (Eup, et (nbnd, ik) )
enddo
Emin = max (Emin, Elw*rytoev - 5*smoothing )
Emax = min (Emax, Eup*rytoev + 5*smoothing )
ne = nint( (Emax-Emin)/DeltaE )
allocate (pdos(0:ne,0:natomwfc+1,nspin))
pdos(:,:,:) = 0.d0
current_spin = 1
ie_delta = 5 * smoothing / DeltaE+1
do ik = 1,nkstot
if ( nspin.eq.2 ) current_spin = isk ( ik )
do ibnd = 1, nbnd
etev = et(ibnd,ik) * rytoev
ie_mid = nint( (etev-Emin)/DeltaE )
do ie = max(ie_mid-ie_delta, 0), min(ie_mid+ie_delta, ne)
delta = w0gauss((Emin+DeltaE*ie-etev)/smoothing,0)/smoothing
do nwfc = 1, natomwfc
pdos(ie,nwfc,current_spin) = pdos(ie,nwfc,current_spin) + &
wk(ik) * delta * proj (nwfc, ibnd, ik)
end do
pdos(ie,0,current_spin) = pdos(ie,0,current_spin) + &
wk(ik) * delta
end do
end do
end do
do is=1,nspin
do ie=0,ne
pdos(ie,natomwfc+1,is) = sum(pdos(ie,1:natomwfc,is))
end do
end do
do nwfc = 1, natomwfc
if (nlmchi(nwfc)%m .eq. 1) then
filextension='.pdos_atm#'
! 12345678901
c_tab = 11
if (nlmchi(nwfc)%na.lt.10) then
write (filextension( c_tab : c_tab ),'(i1)') nlmchi(nwfc)%na
c_tab = c_tab + 1
else if (nlmchi(nwfc)%na.lt.100) then
write (filextension( c_tab : c_tab+1 ),'(i2)') nlmchi(nwfc)%na
c_tab = c_tab + 2
else if (nlmchi(nwfc)%na.lt.1000) then
write (filextension( c_tab : c_tab+2 ),'(i3)') nlmchi(nwfc)%na
c_tab = c_tab + 3
else
call errore('projwave',&
'file extension not supporting so many atoms', &
nwfc)
endif
write (filextension(c_tab:c_tab+4),'(a1,a)') &
'(',trim(atm(ityp(nlmchi(nwfc)%na)))
c_tab = c_tab + len_trim(atm(ityp(nlmchi(nwfc)%na))) + 1
if (nlmchi(nwfc)%n.ge.10) &
call errore('projwave',&
'file extension not supporting so many atmic wfc',&
nwfc)
if (nlmchi(nwfc)%l.gt.3) &
call errore('projwave',&
'file extension not supporting so many l', &
nwfc)
write (filextension(c_tab:),'(")_wfc#",i1,"(",a1,")")') &
nlmchi(nwfc)%n, l_label(nlmchi(nwfc)%l)
open (4,file=trim(prefix)//filextension,form='formatted', &
status='unknown')
write (4,'("# E (eV) ",$)')
do m=1,2 * nlmchi(nwfc)%l + 1
if (nspin.eq.1) then
write(4,'(" dos(E) ",$)')
else
write(4,'(" dosup(E) ",$)')
write(4,'(" dosdw(E) ",$)')
end if
end do
write(4,*)
do ie= 0, ne
etev = Emin + ie * DeltaE
write (4,'(f7.3,14e11.3)') etev, &
((pdos(ie,nwfc+m-1,is), is=1,nspin), &
m=1,2*nlmchi(nwfc)%l+1)
end do
close (4)
end if
end do
open (4,file=trim(prefix)//".pdos_tot",form='formatted', &
status='unknown')
if (nspin.eq.1) then
write (4,'("# E (eV) dos(E) pdos(E)")')
else
write (4,'("# E (eV) dosup(E) dosdw(E) pdosup(E) pdosdw(E)")')
end if
do ie= 0, ne
etev = Emin + ie * DeltaE
write (4,'(f7.3,4e11.3)') etev, (pdos(ie,0,is), is=1,nspin), &
(pdos(ie,natomwfc+1,is), is=1,nspin)
end do
close (4)
deallocate (pdos)
end if
#ifdef __PARA
endif
#endif
deallocate (nlmchi)
deallocate (e)
deallocate (overlap)
deallocate (proj)
deallocate (wfcatom)
deallocate (swfcatom)
return
end subroutine projwave

498
PP/projwfc.f90
View File

@ -1,17 +1,501 @@
!
! Copyright (C) 2001 PWSCF group
! Copyright (C) 2001-2003 PWSCF 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 .
!
!-----------------------------------------------------------------------
program projwfc
!-----------------------------------------------------------------------
!
! projects wavefunctions onto orthogonalized atomic wavefunctions
! calculates Lowdin charges, spilling parameter
! input: namelist "&inputpp", with variables
! prefix prefix of input files saved by program pwscf
! outdir temporary directory where files resides
!
use pwcom
use io_files, only: nd_nmbr, prefix, tmp_dir
#ifdef __PARA
use para, only: me
use mp
#endif
implicit none
character (len=8) :: io_choice
character(len=256) :: outdir
real (kind=DP) :: Emin, Emax, DeltaE, smoothing
integer :: ios, ionode_id = 0
namelist / inputpp / outdir, prefix, io_choice, &
Emin, Emax, DeltaE, smoothing
!
call start_postproc (nd_nmbr)
!
! set default values for variables in namelist
!
prefix = 'pwscf'
outdir = './'
io_choice ='both'
Emin =-1000000.
Emax =+1000000.
DeltaE = 0.01
smoothing = 0.d0
!
#ifdef __PARA
if (me == 1) then
#endif
read (5, inputpp, err = 200, iostat = ios)
200 call errore ('projwave', 'reading inputpp namelist', abs (ios) )
!
tmp_dir = trim(outdir)
!
#ifdef __PARA
end if
!
! ... Broadcast variables
!
CALL mp_bcast( tmp_dir, ionode_id )
CALL mp_bcast( prefix, ionode_id )
CALL mp_bcast( io_choice, ionode_id )
CALL mp_bcast( smoothing, ionode_id )
CALL mp_bcast( DeltaE, ionode_id )
CALL mp_bcast( Emin, ionode_id )
CALL mp_bcast( Emax, ionode_id )
#endif
if ( smoothing .lt. DeltaE ) smoothing= DeltaE
if (io_choice.ne.'standard' .and. io_choice.ne.'files' .and. &
io_choice.ne.'both') &
call errore ('projwave','io_choice definition is invalid',1)
character :: nodenumber * 3
call start_postproc (nodenumber)
call do_projwfc (nodenumber)
!
! Now allocate space for pwscf variables, read and check them.
!
call read_file
call openfil
!
call projwave (io_choice,Emin, Emax, DeltaE, smoothing)
!
call stop_pp
stop
!
end program projwfc
!-----------------------------------------------------------------------
subroutine projwave (io_choice,Emin, Emax, DeltaE, smoothing)
!-----------------------------------------------------------------------
!
#include "machine.h"
use pwcom
use becmod
use io_files, only: nd_nmbr, prefix, tmp_dir
#ifdef __PARA
use para
#endif
implicit none
character (len=80) :: filproj
character (len=8) :: io_choice
character (len=33) :: filextension
character (len=1) :: l_label(0:3)=(/'s','p','d','f'/)
!
type wfc_label
integer na, n, l, m
end type wfc_label
type(wfc_label), allocatable :: nlmchi(:)
!
integer :: ik, ibnd, i, j, k, na, nb, nt, isym, n, m, m1, l, lm, nwfc,&
nwfc1, lmax_wfc, c_tab, ne, ie_mid, ie_delta, ie, is
logical :: exst
real(kind=DP) :: psum, totcharge, Emin, Emax, DeltaE, smoothing, etev, &
delta, w0gauss, Elw, Eup
real(kind=DP), allocatable :: e (:), proj (:,:,:), charges(:,:), pdos(:,:,:)
complex(kind=DP), allocatable :: wfcatom (:,:), overlap (:,:), &
work (:,:), work1(:), proj0(:,:)
integer, allocatable :: index(:)
external w0gauss
!
!
write (6, '(/5x,"Calling projwave .... ")')
if (io_choice.eq.'standard' ) &
write (6, '(5x,"Projections are written on standard output")')
if (io_choice.eq.'files' ) &
write (6, '(5x,"Projections are written on files")')
if (io_choice.eq.'both' ) &
write (6, '(5x,"Projections are written on both standard output and file")')
!
allocate(swfcatom (npwx , natomwfc ) )
allocate(wfcatom (npwx, natomwfc) )
allocate(proj (natomwfc, nbnd, nkstot) )
allocate(overlap (natomwfc, natomwfc) )
allocate(e (natomwfc) )
proj = 0.d0
overlap= (0.d0,0.d0)
!
! initialize D_Sl for l=1, l=2 and l=3, for l=0 D_S0 is 1
!
call d_matrix (d1, d2, d3)
!
! fill structure nlmchi
!
allocate (nlmchi(natomwfc))
nwfc=0
lmax_wfc = 0
do na = 1, nat
nt = ityp (na)
do n = 1, nchi (nt)
if (oc (n, nt) .gt.0.d0.or..not.newpseudo (nt) ) then
l = lchi (n, nt)
lmax_wfc = max (lmax_wfc, l )
do m = 1, 2 * l + 1
nwfc=nwfc+1
nlmchi(nwfc)%na = na
nlmchi(nwfc)%n = n
nlmchi(nwfc)%l = l
nlmchi(nwfc)%m = m
enddo
endif
enddo
enddo
if (lmax_wfc.gt.3) call errore ('projwave', 'l > 3 not yet implemented', 1)
if (nwfc.ne.natomwfc) call errore ('projwave', 'wrong # of atomic wfcs?', 1)
!
! loop on k points
!
call init_us_1
!
do ik = 1, nks
npw = npwx
call gk_sort (xk (1, ik), ngm, g, ecutwfc / tpiba2, npw, igk, g2kin)
call davcio (evc, nwordwfc, iunwfc, ik, - 1)
call atomic_wfc (ik, wfcatom)
call init_us_2 (npw, igk, xk (1, ik), vkb)
call ccalbec (nkb, npwx, npw, natomwfc, becp, vkb, wfcatom)
call s_psi (npwx, npw, natomwfc, wfcatom, swfcatom)
!
! wfcatom = |phi_i> , swfcatom = \hat S |phi_i>
! calculate overlap matrix O_ij = <phi_i|\hat S|\phi_j>
!
call ZGEMM ('c', 'n', natomwfc, natomwfc, npw, (1.d0, 0.d0) , &
wfcatom, npwx, swfcatom, npwx, (0.d0, 0.d0) , overlap, natomwfc)
#ifdef __PARA
call reduce (2 * natomwfc * natomwfc, overlap)
#endif
!
! calculate O^{-1/2}
!
allocate(work (natomwfc, natomwfc) )
call cdiagh (natomwfc, overlap, natomwfc, e, work)
do i = 1, natomwfc
e (i) = 1.d0 / dsqrt (e (i) )
enddo
do i = 1, natomwfc
do j = i, natomwfc
overlap (i, j) = (0.d0, 0.d0)
do k = 1, natomwfc
overlap (i, j) = overlap (i, j) + e (k) * work (j, k) * conjg (work (i, k) )
enddo
if (j.ne.i) overlap (j, i) = conjg (overlap (i, j))
enddo
enddo
deallocate (work)
!
! calculate wfcatom = O^{-1/2} \hat S | phi>
!
call ZGEMM ('n', 't', npw, natomwfc, natomwfc, (1.d0, 0.d0) , &
swfcatom, npwx, overlap, natomwfc, (0.d0, 0.d0), wfcatom, npwx)
!
! make the projection <psi_i| O^{-1/2} \hat S | phi_j>
!
allocate(proj0(natomwfc,nbnd) )
call ZGEMM ('c', 'n', natomwfc, nbnd, npw, (1.d0, 0.d0) , &
wfcatom, npwx, evc, npwx, (0.d0, 0.d0) , proj0, natomwfc)
#ifdef __PARA
call reduce (2 * natomwfc * nbnd, proj0)
#endif
!
! symmetrize the projections
!
allocate(work1 (nbnd) )
do nwfc = 1, natomwfc
!
! atomic wavefunction nwfc is on atom na
!
na= nlmchi(nwfc)%na
n = nlmchi(nwfc)%n
l = nlmchi(nwfc)%l
m = nlmchi(nwfc)%m
!
do isym = 1, nsym
nb = irt (isym, na)
do nwfc1 =1, natomwfc
if (nlmchi(nwfc1)%na.eq. nb .and. &
nlmchi(nwfc1)%n .eq. nlmchi(nwfc)%n .and. &
nlmchi(nwfc1)%l .eq. nlmchi(nwfc)%l .and. &
nlmchi(nwfc1)%m .eq. 1 ) go to 10
end do
call errore('projwave','cannot symmetrize',1)
10 nwfc1=nwfc1-1
!
! nwfc1 is the first rotated atomic wfc corresponding to nwfc
!
if (l.eq.0) then
work1(:) = proj0 (nwfc1 + 1,:)
else if (l.eq.1) then
work1(:) = 0.d0
do m1 = 1, 3
work1(:) = work1(:) + d1 (m1, m, isym) * proj0 (nwfc1 + m1,:)
enddo
else if (l.eq.2) then
work1(:) = 0.d0
do m1 = 1, 5
work1(:) = work1(:) + d2 (m1, m, isym) * proj0 (nwfc1 + m1,:)
enddo
else if (l.eq.3) then
work1(:) = 0.d0
do m1 = 1, 7
work1(:) = work1(:) + d3 (m1, m, isym) * proj0 (nwfc1 + m1,:)
enddo
endif
do ibnd = 1, nbnd
proj (nwfc, ibnd, ik) = proj (nwfc, ibnd, ik) + &
work1(ibnd) * conjg (work1(ibnd)) / nsym
enddo
enddo
enddo
deallocate (work1)
deallocate (proj0 )
! on k-points
enddo
#ifdef __PARA
!
! recover the vector proj over the pools
!
call poolrecover (et, nbnd, nkstot, nks)
call poolrecover (proj, nbnd * natomwfc, nkstot, nks)
!
if (me.eq.1.and.mypool.eq.1) then
#endif
!
! write on the standard output file
!
if (io_choice.eq.'standard' .or.io_choice.eq.'both' ) then
write(6,'(/"Projection on atomic states:"/)')
do nwfc = 1, natomwfc
write(6,'(5x,"state #",i3,": atom ",i3," (",a3,"), wfc ",i2, &
& " (l=",i1," m=",i2,")")') &
nwfc, nlmchi(nwfc)%na, atm(ityp(nlmchi(nwfc)%na)), &
nlmchi(nwfc)%n, nlmchi(nwfc)%l, nlmchi(nwfc)%m
end do
!
allocate(index (natomwfc) )
do ik = 1, nkstot
write (6, '(/" k = ",3f14.10)') (xk (i, ik) , i = 1, 3)
do ibnd = 1, nbnd
write (6, '(5x,"e = ",f14.10," eV")') et (ibnd, ik) * rytoev
!
! sort projections by magnitude, in decreasing order
!
do nwfc = 1, natomwfc
index (nwfc) = 0
e (nwfc) = - proj (nwfc, ibnd, ik)
end do
call hpsort (natomwfc, e, index)
!
! only projections that are larger than 0.001 are written
!
do nwfc = 1, natomwfc
e (nwfc) = - e(nwfc)
if ( abs (e(nwfc)).lt.0.001 ) go to 20
end do
nwfc = natomwfc + 1
20 nwfc = nwfc -1
!
! fancy (?!?) formatting
!
write (6, '(5x,"psi = ",5(f5.3,"*[#",i3,"]+"))') &
(e (i), index(i), i = 1, min(5,nwfc))
do j = 1, (nwfc-1)/5
write (6, '(10x,"+",5(f5.3,"*[#",i3,"]+"))') &
(e (i), index(i), i = 5*j+1, min(5*(j+1),nwfc))
end do
psum = 0.d0
do nwfc = 1, natomwfc
psum = psum + proj (nwfc, ibnd, ik)
end do
write (6, '(4x,"|psi|^2 = ",f5.3)') psum
!
enddo
enddo
deallocate (index)
end if
!
! estimate partial charges (Loewdin) on each atom
!
allocate ( charges (nat, 0:lmax_wfc ) )
charges = 0.0
do ik = 1, nkstot
do ibnd = 1, nbnd
do nwfc = 1, natomwfc
na= nlmchi(nwfc)%na
l = nlmchi(nwfc)%l
charges(na,l) = charges(na,l) + wg (ibnd,ik) * &
proj (nwfc, ibnd, ik)
enddo
end do
end do
!
write (6, '(/"Lowdin Charges: "/)')
!
psum = 0.0
do na = 1, nat
totcharge = 0.d0
do l = 0, lmax_wfc
totcharge = totcharge + charges(na,l)
end do
psum = psum + totcharge
write (6, '(5x,"Atom # ",i3,": total charge = ",f8.4, &
& ", s, p, d, f = ",4f8.4 )') &
na, totcharge, ( charges(na,l), l= 0,lmax_wfc)
end do
psum = psum / nelec
write (6, '(5x,"Spilling Parameter: ",f8.4)') 1.0 - psum
!
! Sanchez-Portal et al., Sol. State Commun. 95, 685 (1995).
! The spilling parameter measures the ability of the basis provided by
! the pseudo-atomic wfc to represent the PW eigenstates,
! by measuring how much of the subspace of the Hamiltonian
! eigenstates falls outside the subspace spanned by the atomic basis
!
deallocate (charges)
if (io_choice.eq.'files' .or. io_choice.eq.'both') then
!
! find band extrema
!
Elw = et (1, 1)
Eup = et (nbnd, 1)
do ik = 2, nkstot
Elw = min (Elw, et (1, ik) )
Eup = max (Eup, et (nbnd, ik) )
enddo
Emin = max (Emin, Elw*rytoev - 5*smoothing )
Emax = min (Emax, Eup*rytoev + 5*smoothing )
ne = nint( (Emax-Emin)/DeltaE )
allocate (pdos(0:ne,0:natomwfc+1,nspin))
pdos(:,:,:) = 0.d0
current_spin = 1
ie_delta = 5 * smoothing / DeltaE+1
do ik = 1,nkstot
if ( nspin.eq.2 ) current_spin = isk ( ik )
do ibnd = 1, nbnd
etev = et(ibnd,ik) * rytoev
ie_mid = nint( (etev-Emin)/DeltaE )
do ie = max(ie_mid-ie_delta, 0), min(ie_mid+ie_delta, ne)
delta = w0gauss((Emin+DeltaE*ie-etev)/smoothing,0)/smoothing
do nwfc = 1, natomwfc
pdos(ie,nwfc,current_spin) = pdos(ie,nwfc,current_spin) + &
wk(ik) * delta * proj (nwfc, ibnd, ik)
end do
pdos(ie,0,current_spin) = pdos(ie,0,current_spin) + &
wk(ik) * delta
end do
end do
end do
do is=1,nspin
do ie=0,ne
pdos(ie,natomwfc+1,is) = sum(pdos(ie,1:natomwfc,is))
end do
end do
do nwfc = 1, natomwfc
if (nlmchi(nwfc)%m .eq. 1) then
filextension='.pdos_atm#'
! 12345678901
c_tab = 11
if (nlmchi(nwfc)%na.lt.10) then
write (filextension( c_tab : c_tab ),'(i1)') nlmchi(nwfc)%na
c_tab = c_tab + 1
else if (nlmchi(nwfc)%na.lt.100) then
write (filextension( c_tab : c_tab+1 ),'(i2)') nlmchi(nwfc)%na
c_tab = c_tab + 2
else if (nlmchi(nwfc)%na.lt.1000) then
write (filextension( c_tab : c_tab+2 ),'(i3)') nlmchi(nwfc)%na
c_tab = c_tab + 3
else
call errore('projwave',&
'file extension not supporting so many atoms', &
nwfc)
endif
write (filextension(c_tab:c_tab+4),'(a1,a)') &
'(',trim(atm(ityp(nlmchi(nwfc)%na)))
c_tab = c_tab + len_trim(atm(ityp(nlmchi(nwfc)%na))) + 1
if (nlmchi(nwfc)%n.ge.10) &
call errore('projwave',&
'file extension not supporting so many atmic wfc',&
nwfc)
if (nlmchi(nwfc)%l.gt.3) &
call errore('projwave',&
'file extension not supporting so many l', &
nwfc)
write (filextension(c_tab:),'(")_wfc#",i1,"(",a1,")")') &
nlmchi(nwfc)%n, l_label(nlmchi(nwfc)%l)
open (4,file=trim(prefix)//filextension,form='formatted', &
status='unknown')
write (4,'("# E (eV) ",$)')
do m=1,2 * nlmchi(nwfc)%l + 1
if (nspin.eq.1) then
write(4,'(" dos(E) ",$)')
else
write(4,'(" dosup(E) ",$)')
write(4,'(" dosdw(E) ",$)')
end if
end do
write(4,*)
do ie= 0, ne
etev = Emin + ie * DeltaE
write (4,'(f7.3,14e11.3)') etev, &
((pdos(ie,nwfc+m-1,is), is=1,nspin), &
m=1,2*nlmchi(nwfc)%l+1)
end do
close (4)
end if
end do
open (4,file=trim(prefix)//".pdos_tot",form='formatted', &
status='unknown')
if (nspin.eq.1) then
write (4,'("# E (eV) dos(E) pdos(E)")')
else
write (4,'("# E (eV) dosup(E) dosdw(E) pdosup(E) pdosdw(E)")')
end if
do ie= 0, ne
etev = Emin + ie * DeltaE
write (4,'(f7.3,4e11.3)') etev, (pdos(ie,0,is), is=1,nspin), &
(pdos(ie,natomwfc+1,is), is=1,nspin)
end do
close (4)
deallocate (pdos)
end if
#ifdef __PARA
endif
#endif
deallocate (nlmchi)
deallocate (e)
deallocate (overlap)
deallocate (proj)
deallocate (wfcatom)
deallocate (swfcatom)
return
end subroutine projwave

278
PP/punch_band.f90
View File

@ -1,278 +0,0 @@
!
! Copyright (C) 2001-2003 PWSCF 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 .
!
!-----------------------------------------------------------------------
subroutine do_bands (nodenumber)
!-----------------------------------------------------------------------
use pwcom
use becmod
use io_files, only: nd_nmbr, prefix, tmp_dir
#ifdef __PARA
use para, only: me
use io_global, only: ionode_id
use mp, only: mp_bcast
#endif
implicit none
character (len=3) :: nodenumber
!
character (len=80) :: filband
character(len=256) :: outdir
integer :: ios
namelist / inputpp / outdir, prefix, filband
!
nd_nmbr = nodenumber
!
! set default values for variables in namelist
!
prefix = 'pwscf'
outdir = './'
filband = 'bands.out'
!
#ifdef __PARA
if (me == 1) then
#endif
read (5, inputpp, err = 200, iostat = ios)
200 call errore ('do_bands', 'reading inputpp namelist', abs (ios) )
!
tmp_dir = trim(outdir)
!
#ifdef __PARA
end if
!
! ... Broadcast variables
!
CALL mp_bcast( tmp_dir, ionode_id )
CALL mp_bcast( prefix, ionode_id )
CALL mp_bcast( filband, ionode_id )
#endif
!
! Now allocate space for pwscf variables, read and check them.
!
call read_file
call openfil
call init_us_1
!
call punch_band (filband)
!
return
end subroutine do_bands
!
!-----------------------------------------------------------------------
subroutine punch_band (filband)
!-----------------------------------------------------------------------
!
! This routine writes the band energies on a file. The routine orders
! the eigenvalues using the overlap of the eigenvectors to give
! an estimate crossing and anticrossing of the bands. This simplified
! method works in many, but not in all the cases.
!
!
#include "machine.h"
#ifdef __PARA
use para, only: me
#endif
use pwcom
use becmod
implicit none
character (len=*) :: filband
real(kind=DP) :: proold
! the best overlap product
complex(kind=DP) :: pro
! the product of wavefunctions
complex(kind=DP), allocatable :: psiold (:,:), old (:), new (:), &
becpold (:,:)
! psiold: eigenfunctions at previous k-point, ordered
! old, new: contain one band resp. at previous and current k-point
! becpold: <psi|beta> at previous k-point
integer :: ibnd, jbnd, ik, ikb, ig, npwold, ios
! counters
integer, allocatable :: ok (:), igkold (:), il (:)
! ok: keeps track of which bands have been already ordered
! igkold: indices of k+G at previous k-point
! il: band ordering
integer, parameter :: maxdeg = 4
! maxdeg : max allowed degeneracy
integer :: ndeg, deg, nd
! ndeg : number of degenerate states
integer, allocatable :: degeneracy(:), degbands(:,:), index(:)
! degbands keeps track of which states are degenerate
real(kind=DP), allocatable:: edeg(:)
real(kind=DP), parameter :: eps = 0.001
! threshold (Ry) for degenerate states
complex(kind=DP), external :: cgracsc
! scalar product with the S matrix
if (filband == ' ') return
iunpun = 18
#ifdef __PARA
if (me == 1) then
#endif
open (unit = iunpun, file = filband, status = 'unknown', form = &
'formatted', err = 100, iostat = ios)
100 call errore ('punch_band', 'Opening filband file', abs (ios) )
rewind (iunpun)
#ifdef __PARA
endif
#endif
allocate (psiold( npwx, nbnd))
allocate (old(ngm), new(ngm))
allocate (becpold(nkb, nbnd))
allocate (igkold (npwx))
allocate (ok (nbnd), il (nbnd))
allocate (degeneracy(nbnd), edeg(nbnd))
allocate (index(maxdeg), degbands(nbnd,maxdeg))
!
do ik = 1, nks
!
! prepare the indices of this k point
!
call gk_sort (xk (1, ik), ngm, g, ecutwfc / tpiba2, npw, &
igk, g2kin)
!
! read eigenfunctions
!
call davcio (evc, nwordwfc, iunwfc, ik, - 1)
!
! calculate becp = <psi|beta>
!
call init_us_2 (npw, igk, xk (1, ik), vkb)
call ccalbec (nkb, npwx, npw, nbnd, becp, vkb, evc)
!
if (ik == 1) then
!
! first k-point in the list:
! save eigenfunctions in the current order (increasing energy)
!
do ibnd = 1, nbnd
il (ibnd) = ibnd
end do
else
!
! following k-points in the list:
! determine eigenfunction order in array il
!
do ibnd = 1, nbnd
ok (ibnd) = 0
enddo
do ibnd = 1, nbnd
old(:) = (0.d0, 0.d0)
do ig = 1, npwold
old (igkold (ig) ) = psiold (ig, ibnd)
enddo
proold = 0.d0
do jbnd = 1, nbnd
if (ok (jbnd) == 0) then
new (:) = (0.d0, 0.d0)
do ig = 1, npw
new (igk (ig) ) = evc (ig, jbnd)
enddo
pro = cgracsc (nkb, becp (1, jbnd), becpold (1, ibnd), &
nhm, ntyp, nh, qq, nat, ityp, ngm, new, old, tvanp)
if (abs (pro) > proold) then
il (ibnd) = jbnd
proold = abs (pro)
endif
endif
enddo
ok (il (ibnd) ) = 1
enddo
!
! if there were bands crossing at degenerate eigenvalues
! at previous k-point, re-order those bands so as to keep
! lower band indices corresponding to lower bands
!
do nd = 1, ndeg
do deg = 1, degeneracy (nd)
index(deg) = il(degbands(nd,deg))
edeg (deg) = et(il(degbands(nd,deg)), ik)
end do
call hpsort(degeneracy (nd), edeg, index)
do deg = 1, degeneracy (nd)
il(degbands(nd,deg)) = index(deg)
end do
end do
end if
!
! Now the order of eigenfunctions has been established
! for this k-point -- prepare data for next k point
!
do ibnd = 1, nbnd
do ig = 1, npw
psiold (ig, ibnd) = evc (ig, il (ibnd) )
enddo
do ikb = 1, nkb
becpold (ikb, ibnd) = becp (ikb, il (ibnd) )
enddo
enddo
do ig = 1, npw
igkold (ig) = igk (ig)
enddo
npwold = npw
!
! find degenerate eigenvalues
!
deg = 0
ndeg = 0
do ibnd = 2, nbnd
if ( abs (et(ibnd, ik) - et(ibnd-1, ik)) < eps ) then
if ( deg == 0 ) then
ndeg = ndeg + 1
edeg (ndeg) = et(ibnd, ik)
end if
deg = 1
else
deg = 0
end if
end do
!
! locate band crossings at degenerate eigenvalues
!
do nd = 1, ndeg
deg = 0
do ibnd = 1, nbnd
if ( abs (et(il(ibnd), ik) - edeg (nd)) < eps ) then
deg = deg + 1
if (deg > maxdeg) call errore ('punch_band', &
' increase maxdeg', deg)
degbands(nd,deg) = ibnd
end if
end do
degeneracy (nd) = deg
end do
!
#ifdef __PARA
if (me == 1) then
#endif
write (iunpun, '(14x,3f7.4)') xk(1,ik),xk(2,ik),xk(3,ik)
write (iunpun, '(10f8.3)') (et (il (ibnd) , ik) &
* rytoev, ibnd = 1, nbnd)
#ifdef __PARA
endif
#endif
enddo
deallocate (index, degbands)
deallocate (edeg, degeneracy)
deallocate (il, ok)
deallocate (igkold)
deallocate (becpold)
deallocate (new, old)
deallocate (psiold)
#ifdef __PARA
if (me == 1) then
#endif
close (iunpun)
#ifdef __PARA
endif
#endif
return
end subroutine punch_band

27
PP/pw2wan.f90
View File

@ -1,42 +1,26 @@
!
! Copyright (C) 2001 PWSCF group
! Copyright (C) 2003 PWSCF 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 .
!
!
!-----------------------------------------------------------------------
program wannier
!-----------------------------------------------------------------------
!
character (len=3) :: nodenumber
!
call start_postproc (nodenumber)
call do_wannier (nodenumber)
!
call stop_pp
stop
end program wannier
!
!-----------------------------------------------------------------------
subroutine do_wannier(nodenumber)
!-----------------------------------------------------------------------
!
use pwcom
use para, only: kunit
use io_files
!
implicit none
character(len=3) :: nodenumber
integer , dimension(3):: nk
real(kind=8), dimension(3):: s0
integer :: ik, i, kunittmp
namelist / inputpp / tmp_dir, nk, s0, prefix
!
nd_nmbr = nodenumber
call start_postproc (nd_nmbr)
!
! set default values for variables in namelist
!
@ -85,8 +69,9 @@ subroutine do_wannier(nodenumber)
write(6,fmt="(' ik = ',I3,3F10.6)" ) ik, xk(1,ik), xk(2,ik), xk(3,ik)
end do
!
return
end subroutine do_wannier
call stop_pp
stop
end program wannier
!
!-----------------------------------------------------------------------
subroutine write_wannier (nk, s0, kunit)

18
PP/voromain.f90
View File

@ -1,18 +0,0 @@
!
! Copyright (C) 2001 PWSCF 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 .
!
!
program voronoy
character :: nodenumber * 3
call start_postproc (nodenumber)
!
! Works on parallel machines but only with one node !!!
!
call do_voronoy
stop
end program voronoy

27
PP/voronoy.f90
View File

@ -7,12 +7,12 @@
!
!
!--------------------------------------------------------------------
subroutine do_voronoy
program voronoy
!--------------------------------------------------------------------
!
! Calculates charges on atoms by dividing the space into Voronoy polyhe
! A Voronoy polyhedron around a given atom is defined as the region
! of space that is closer to that atom than to the others
! Calculates charges on atoms by dividing the space into Voronoy
! polyhedra. A Voronoy polyhedron around a given atom is defined
! as the region of space that is closer to that atom than to the others
!
! Note that this is a very rough way to associate charges to atoms
! and that it is well defined only if all atoms are of the same type!
@ -24,6 +24,10 @@ subroutine do_voronoy
use parameters
use pwcom
use fft_scalar, only: good_fft_dimension
use io_files, only: nd_nmbr
#ifdef __PARA
use para, only: me
#endif
implicit none
integer :: nr1big, nr2big, nr3big, nrx1big
integer :: n, i, j, ng, na, plot_num
@ -33,6 +37,13 @@ subroutine do_voronoy
complex(kind=DP), allocatable :: rhobig (:)
character(len=80) :: filename
!
call start_postproc (nd_nmbr)
#ifdef __PARA
!
! Works for parallel machines but only for one processor !!!
!
if (me == 1) then
#endif
!
print '(" Input file > ",$)'
read (5, '(a)') filename
@ -104,9 +115,11 @@ subroutine do_voronoy
enddo
write (6, '(" Check: total charge = ",f8.4)') total_charge
stop
end subroutine do_voronoy
#ifdef __PARA
end if
#endif
call stop_pp
end program voronoy
!-----------------------------------------------------------------------
subroutine get_fftindex (g, ngm, nr1, nr2, nr3, nrx1, nrx2, nrx3, &