mirror of https://gitlab.com/QEF/q-e.git
Tabulators replaced by white spaces (they confuse some compilers).
Recent additions to parameters.f90 moved into the place where they belong (in my opinion). I don't think it is such a great idea to put parameters there, unless they are used throughout the distribution git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@5431 c92efa57-630b-4861-b058-cf58834340f0
This commit is contained in:
giannozz
parent
0c17468d9c
commit
4e7626d2d8
|
|
@ -25,7 +25,7 @@ MODULE input_parameters
|
|||
!=----------------------------------------------------------------------------=!
|
||||
!
|
||||
USE kinds, ONLY : DP
|
||||
USE parameters, ONLY : nsx, npkx, nspinx, lqmax, nhclm, max_nconstr, nwanx
|
||||
USE parameters, ONLY : nsx, npkx, nspinx, lqmax, nhclm, max_nconstr
|
||||
USE wannier_new,ONLY : wannier_data
|
||||
!
|
||||
IMPLICIT NONE
|
||||
|
|
@ -1426,6 +1426,7 @@ MODULE input_parameters
|
|||
! if .TRUE. energy interval is used to generate wannier
|
||||
print_wannier_coeff = .FALSE.
|
||||
! if .TRUE.
|
||||
INTEGER, PARAMETER :: nwanx = 50 ! max number of wannier functions
|
||||
INTEGER :: &
|
||||
nwan, &! number of wannier functions
|
||||
plot_wan_num = 0, &! number of wannier for plotting
|
||||
|
|
@ -1621,7 +1622,6 @@ MODULE input_parameters
|
|||
!
|
||||
! WANNIER_NEW
|
||||
!
|
||||
|
||||
TYPE (wannier_data) :: wan_data(nwanx,2)
|
||||
|
||||
! END manual
|
||||
|
|
|
|||
|
|
@ -278,7 +278,6 @@ vxcgc.o : kind.o
|
|||
vxcgc.o : radial_grids.o
|
||||
wannier.o : kind.o
|
||||
wannier_new.o : kind.o
|
||||
wannier_new.o : parameters.o
|
||||
wave_base.o : kind.o
|
||||
wave_base.o : mp.o
|
||||
wave_base.o : mp_global.o
|
||||
|
|
|
|||
|
|
@ -38,9 +38,5 @@ MODULE parameters
|
|||
! file should be able to handle it, perhaps better
|
||||
! to align nhclm by 4
|
||||
INTEGER, PARAMETER :: max_nconstr = 100 ! max number of constrains
|
||||
|
||||
! For wannier_new code
|
||||
INTEGER, PARAMETER :: nwanx = 50 ! max number of wannier functions
|
||||
INTEGER, PARAMETER :: ningx = 10 ! max number of trial wafefunction ingridients
|
||||
|
||||
END MODULE parameters
|
||||
|
|
|
|||
|
|
@ -280,11 +280,11 @@
|
|||
INTEGER, INTENT(OUT) :: idx(:)
|
||||
|
||||
INTEGER :: mc, nr3x, ic
|
||||
REAL(DP) :: dn3
|
||||
REAL(DP) :: dn3
|
||||
REAL(DP), ALLOCATABLE :: aux(:)
|
||||
|
||||
nr3x = MAXVAL( ngc(1:nct) ) + 1
|
||||
dn3 = REAL( nr3x )
|
||||
dn3 = REAL( nr3x )
|
||||
|
||||
IF( nproc_pool > 1 ) THEN
|
||||
ALLOCATE( aux( nct ) )
|
||||
|
|
|
|||
|
|
@ -13,16 +13,17 @@ MODULE wannier_new
|
|||
! ... Variables to construct and store wannier functions
|
||||
!
|
||||
USE kinds, ONLY : DP
|
||||
USE parameters, ONLY : ningx
|
||||
!
|
||||
SAVE
|
||||
!
|
||||
INTEGER, PARAMETER :: ningx = 10 ! max number of trial wavefunction ingredients
|
||||
|
||||
LOGICAL :: &
|
||||
use_wannier, &! if .TRUE. wannier functions are constructed
|
||||
rkmesh, &! if .TRUE. regular k-mesh without symmetry is used !now used in input_parameters_mod
|
||||
rkmesh, &! if .TRUE. regular k-mesh without symmetry is used !now used in input_parameters_mod
|
||||
plot_wannier, &! if .TRUE. wannier number plot_wan_num is plotted
|
||||
use_energy_int, &! if .TRUE. uses energy interval for wannier generation, not band numbers
|
||||
print_wannier_coeff ! if .TRUE. computes and prints coefficients of wannier decomp. on atomic functions
|
||||
print_wannier_coeff ! if .TRUE. computes and prints coefficients of wannier decomp. on atomic functions
|
||||
INTEGER :: &
|
||||
nwan, &! number of wannier functions
|
||||
plot_wan_num, &! number of wannier for plotting
|
||||
|
|
@ -33,21 +34,21 @@ MODULE wannier_new
|
|||
wannier_occ(:,:,:) ! occupation matrix of wannier functions(of each spin)
|
||||
COMPLEX(kind=DP), allocatable :: &
|
||||
pp(:,:), &! <phi|S|psi> projections
|
||||
coef(:,:,:) ! coefficients of wannier decomp. on atomic functions
|
||||
|
||||
coef(:,:,:) ! coefficients of wannier decomp. on atomic functions
|
||||
|
||||
TYPE ingredient
|
||||
INTEGER :: l = 0, & ! l value for atomic wfc
|
||||
m = 0, & ! m value for atomic wfc
|
||||
iatomwfc = 0 ! number of corresponding atomic orbital
|
||||
REAL :: c = 0.d0 ! coefficient
|
||||
INTEGER :: l = 0, & ! l value for atomic wfc
|
||||
m = 0, & ! m value for atomic wfc
|
||||
iatomwfc = 0 ! number of corresponding atomic orbital
|
||||
REAL :: c = 0.d0 ! coefficient
|
||||
END TYPE ingredient
|
||||
|
||||
TYPE wannier_data
|
||||
INTEGER :: iatom = 0, &
|
||||
ning = 0
|
||||
REAL :: bands_from = 0.d0, &
|
||||
bands_to = 0.d0
|
||||
TYPE (ingredient) :: ing(ningx)
|
||||
INTEGER :: iatom = 0, &
|
||||
ning = 0
|
||||
REAL :: bands_from = 0.d0, &
|
||||
bands_to = 0.d0
|
||||
TYPE (ingredient) :: ing(ningx)
|
||||
END TYPE wannier_data
|
||||
|
||||
TYPE (wannier_data), allocatable :: wan_in(:,:)
|
||||
|
|
|
|||
|
|
@ -35,33 +35,32 @@ PROGRAM wannier_ham
|
|||
ios = 0
|
||||
!
|
||||
IF ( ionode ) THEN
|
||||
!
|
||||
! set default values for variables in namelist
|
||||
!
|
||||
CALL get_env( 'ESPRESSO_TMPDIR', outdir )
|
||||
IF ( TRIM( outdir ) == ' ' ) outdir = './'
|
||||
prefix ='pwscf'
|
||||
nwan = 0
|
||||
plot_bands = .FALSE.
|
||||
u_matrix=.FALSE.
|
||||
!
|
||||
U=0.d0
|
||||
J=0.d0
|
||||
!
|
||||
CALL input_from_file ( )
|
||||
!
|
||||
READ (5, inputpp, iostat=ios )
|
||||
IF(u_matrix) READ (5, Umatrix, iostat=ios )
|
||||
!
|
||||
tmp_dir = trimcheck (outdir)
|
||||
|
||||
CALL read_cards('WANNIER_AC')
|
||||
|
||||
!
|
||||
! set default values for variables in namelist
|
||||
!
|
||||
CALL get_env( 'ESPRESSO_TMPDIR', outdir )
|
||||
IF ( TRIM( outdir ) == ' ' ) outdir = './'
|
||||
prefix ='pwscf'
|
||||
nwan = 0
|
||||
plot_bands = .FALSE.
|
||||
u_matrix=.FALSE.
|
||||
!
|
||||
U=0.d0
|
||||
J=0.d0
|
||||
!
|
||||
CALL input_from_file ( )
|
||||
!
|
||||
READ (5, inputpp, iostat=ios )
|
||||
IF(u_matrix) READ (5, Umatrix, iostat=ios )
|
||||
!
|
||||
tmp_dir = trimcheck (outdir)
|
||||
|
||||
CALL read_cards('WANNIER_AC')
|
||||
|
||||
END IF
|
||||
!
|
||||
CALL mp_bcast( ios, ionode_id )
|
||||
IF ( ios /= 0 ) CALL errore('wannier_ham','reading inputpp namelist',ABS(ios))
|
||||
|
||||
call read_file
|
||||
call openfil_pp
|
||||
|
||||
|
|
@ -115,9 +114,9 @@ SUBROUTINE new_hamiltonian(plot_bands)
|
|||
ek(:,:) = 0.d0
|
||||
|
||||
IF (nsym.GT.1) THEN
|
||||
write(stdout,'(/5x,a103/)') 'WARNING: k-points set is in the irreducible brillouin zone. Wannier energies and occupations are wrong!'
|
||||
write(stdout,'(/5x,a103/)') 'WARNING: k-points set is in the irreducible brillouin zone. Wannier energies and occupations are wrong!'
|
||||
END IF
|
||||
|
||||
|
||||
current_spin = 1
|
||||
call init_us_1
|
||||
call init_at_1
|
||||
|
|
@ -137,41 +136,41 @@ SUBROUTINE new_hamiltonian(plot_bands)
|
|||
ham = ZERO
|
||||
|
||||
do ik = 1, nks
|
||||
CALL gk_sort (xk (1, ik), ngm, g, ecutwfc / tpiba2, npw, igk, g2kin)
|
||||
if (lsda) current_spin = isk(ik)
|
||||
call wannier_proj(ik,wan_func)
|
||||
|
||||
pp = ZERO
|
||||
call get_buffer( pp, nwordwpp, iunwpp, ik)
|
||||
|
||||
hamk(:,:,ik) = ZERO
|
||||
|
||||
do i=1, nwan
|
||||
do j=1,nwan
|
||||
do n = wan_in(i,current_spin)%bands_from, wan_in(i,current_spin)%bands_to
|
||||
! On-site hamiltonian
|
||||
ham(i,j,current_spin) = ham(i,j,current_spin) + pp(i,n)*dcmplx(et(n,ik),0.d0)*dconjg(pp(j,n))*wk(ik)
|
||||
! Hoping integrals
|
||||
hamh(i,j,current_spin) = hamh(i,j,current_spin) + pp(i,n)*dcmplx(et(n,ik),0.d0)*dconjg(pp(j,n))*wk(ik)*&
|
||||
cdexp(dcmplx(0.d0,1.d0)*tpi*(xk(1,ik)*hoping(1)+xk(2,ik)*hoping(2)+xk(3,ik)*hoping(3)))
|
||||
! Current k-point hamiltonian
|
||||
hamk(i,j,ik) = hamk(i,j,ik) + pp(i,n)*dconjg(pp(j,n))*dcmplx(et(n,ik),0.d0)
|
||||
!Overlap mtrx in current k-point (for debug purposes)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
CALL gk_sort (xk (1, ik), ngm, g, ecutwfc / tpiba2, npw, igk, g2kin)
|
||||
if (lsda) current_spin = isk(ik)
|
||||
call wannier_proj(ik,wan_func)
|
||||
|
||||
pp = ZERO
|
||||
call get_buffer( pp, nwordwpp, iunwpp, ik)
|
||||
|
||||
if (plot_bands) call cdiagh(nwan,hamk(:,:,ik),nwan,ek(:,ik),v)
|
||||
hamk(:,:,ik) = ZERO
|
||||
|
||||
!Hermicity check
|
||||
do i=1,nwan
|
||||
do j=1,nwan
|
||||
if(abs(hamk(i,j,ik)-dconjg(hamk(j,i,ik))).ge.1.d-8) then
|
||||
write(stdout,'(5x,"Wrong elements", 2i3," in",i4," k-point")') i,j,ik
|
||||
call errore ('wannier_ham', 'Hamiltonian is not hermitian', ik)
|
||||
end if
|
||||
end do
|
||||
end do
|
||||
do i=1, nwan
|
||||
do j=1,nwan
|
||||
do n = wan_in(i,current_spin)%bands_from, wan_in(i,current_spin)%bands_to
|
||||
! On-site hamiltonian
|
||||
ham(i,j,current_spin) = ham(i,j,current_spin) + pp(i,n)*dcmplx(et(n,ik),0.d0)*dconjg(pp(j,n))*wk(ik)
|
||||
! Hoping integrals
|
||||
hamh(i,j,current_spin) = hamh(i,j,current_spin) + pp(i,n)*dcmplx(et(n,ik),0.d0)*dconjg(pp(j,n))*wk(ik)*&
|
||||
cdexp(dcmplx(0.d0,1.d0)*tpi*(xk(1,ik)*hoping(1)+xk(2,ik)*hoping(2)+xk(3,ik)*hoping(3)))
|
||||
! Current k-point hamiltonian
|
||||
hamk(i,j,ik) = hamk(i,j,ik) + pp(i,n)*dconjg(pp(j,n))*dcmplx(et(n,ik),0.d0)
|
||||
!Overlap mtrx in current k-point (for debug purposes)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
|
||||
if (plot_bands) call cdiagh(nwan,hamk(:,:,ik),nwan,ek(:,ik),v)
|
||||
|
||||
!Hermicity check
|
||||
do i=1,nwan
|
||||
do j=1,nwan
|
||||
if(abs(hamk(i,j,ik)-dconjg(hamk(j,i,ik))).ge.1.d-8) then
|
||||
write(stdout,'(5x,"Wrong elements", 2i3," in",i4," k-point")') i,j,ik
|
||||
call errore ('wannier_ham', 'Hamiltonian is not hermitian', ik)
|
||||
end if
|
||||
end do
|
||||
end do
|
||||
end do !ik
|
||||
|
||||
!Compute wannier parameters
|
||||
|
|
@ -180,65 +179,62 @@ SUBROUTINE new_hamiltonian(plot_bands)
|
|||
|
||||
!output computed
|
||||
do j=1, nspin
|
||||
write(stdout,'(/5x,a4,i2,a)') 'Spin', j,':'
|
||||
do i=1, nwan
|
||||
write(stdout,'(7x,a8,i3)') 'Wannier#',i
|
||||
write(stdout,'(9x,a11,f5.3)') 'occupation:',wannier_occ(i,i,j)
|
||||
write(stdout,'(9x,a7,f7.3,a3)') 'energy:',wannier_energy(i,j)*rytoev,' eV'
|
||||
end do
|
||||
write(stdout,'(7x,a26/)')'Wannier occupation matrix:'
|
||||
do i=1,nwan
|
||||
write(stdout,'(7x,50f7.3)') (wannier_occ(i,k,j),k=1,nwan)
|
||||
end do
|
||||
write(stdout,'(/5x,a4,i2,a)') 'Spin', j,':'
|
||||
do i=1, nwan
|
||||
write(stdout,'(7x,a8,i3)') 'Wannier#',i
|
||||
write(stdout,'(9x,a11,f5.3)') 'occupation:',wannier_occ(i,i,j)
|
||||
write(stdout,'(9x,a7,f7.3,a3)') 'energy:',wannier_energy(i,j)*rytoev,' eV'
|
||||
end do
|
||||
write(stdout,'(7x,a26/)')'Wannier occupation matrix:'
|
||||
do i=1,nwan
|
||||
write(stdout,'(7x,50f7.3)') (wannier_occ(i,k,j),k=1,nwan)
|
||||
end do
|
||||
end do
|
||||
!end of output
|
||||
|
||||
|
||||
! write HMLT file
|
||||
open (outfile, file = 'hamilt', status = 'unknown', form = 'formatted', err = 300, iostat = ios)
|
||||
300 call errore ('HMLT', 'Opening hamilt', abs (ios) )
|
||||
|
||||
|
||||
call wannier_hamiltonian_JK(nwan,hamk,outfile)
|
||||
|
||||
|
||||
close(outfile)
|
||||
|
||||
|
||||
if(nspin.eq.1) then
|
||||
ham = 5.d-1*ham
|
||||
hamh = 5.d-1*hamh
|
||||
ham = 5.d-1*ham
|
||||
hamh = 5.d-1*hamh
|
||||
end if
|
||||
|
||||
|
||||
do i=1, nspin
|
||||
write(stdout,*) ' '
|
||||
|
||||
call cdiagh(nwan,ham(:,:,i),nwan,e,v)
|
||||
write(stdout,'(5x,a39)') 'Projected Hamiltonian eigenvalues (eV):'
|
||||
write(stdout,'(6x,a5,i,4x,50f9.4)') 'spin', i, (e(j)*rytoev,j=1,nwan)
|
||||
write(stdout,*) ' '
|
||||
write(stdout,*) ' '
|
||||
|
||||
call cdiagh(nwan,ham(:,:,i),nwan,e,v)
|
||||
write(stdout,'(5x,a39)') 'Projected Hamiltonian eigenvalues (eV):'
|
||||
write(stdout,'(6x,a5,i,4x,50f9.4)') 'spin', i, (e(j)*rytoev,j=1,nwan)
|
||||
write(stdout,*) ' '
|
||||
|
||||
! hopings integrals
|
||||
if(ANY(hoping.ne.0.d0)) then
|
||||
write(stdout,'(5x,a44,3f6.2,a5)') 'Hopings from the atom in origin to direction', (hoping(j),j=1,3), 'are:'
|
||||
do j=1,nwan
|
||||
write(stdout,'(5x,20f9.5)') (dreal(hamh(j,n,i))*rytoev, n=1, nwan)
|
||||
end do
|
||||
write(stdout,*) ' '
|
||||
end if
|
||||
if(ANY(hoping.ne.0.d0)) then
|
||||
write(stdout,'(5x,a44,3f6.2,a5)') 'Hopings from the atom in origin to direction', (hoping(j),j=1,3), 'are:'
|
||||
do j=1,nwan
|
||||
write(stdout,'(5x,20f9.5)') (dreal(hamh(j,n,i))*rytoev, n=1, nwan)
|
||||
end do
|
||||
write(stdout,*) ' '
|
||||
end if
|
||||
|
||||
! additional check: hamiltonian should be hermitian
|
||||
if(SUM(dimag(hamh)).ge.1d-9) then
|
||||
write(stdout,*) 'ATTENTION! Hamiltonian is NOT hermitian'
|
||||
write(stdout,*) 'Imaginary part is:'
|
||||
do j=1,nwan
|
||||
write(stdout,'(20f9.5)') (dimag(hamh(j,n,i))*rytoev, n=1, nwan)
|
||||
end do
|
||||
write(stdout,*) '---'
|
||||
end if
|
||||
if(SUM(dimag(hamh)).ge.1d-9) then
|
||||
write(stdout,*) 'ATTENTION! Hamiltonian is NOT hermitian'
|
||||
write(stdout,*) 'Imaginary part is:'
|
||||
do j=1,nwan
|
||||
write(stdout,'(20f9.5)') (dimag(hamh(j,n,i))*rytoev, n=1, nwan)
|
||||
end do
|
||||
write(stdout,*) '---'
|
||||
end if
|
||||
end do
|
||||
|
||||
|
||||
if(plot_bands) call plot_wannier_bands(ek)
|
||||
|
||||
|
||||
deallocate(ek)
|
||||
deallocate(hamk)
|
||||
deallocate(hamh)
|
||||
|
|
@ -251,7 +247,7 @@ SUBROUTINE plot_wannier_bands(ek)
|
|||
! reproduses original bands structure. To check just type 'gnuplot wannier_bands.plot'
|
||||
! in your terminal window. Of course one can use another ploting software for that purpose,
|
||||
! for example 'xmgrace original_bands.dat wannier_bands.dat'
|
||||
|
||||
|
||||
USE constants, ONLY: rytoev
|
||||
use io_global, only: stdout, ionode, ionode_id
|
||||
use io_files
|
||||
|
|
@ -267,7 +263,7 @@ SUBROUTINE plot_wannier_bands(ek)
|
|||
|
||||
INTEGER :: i,j,k,ik,ios
|
||||
REAL(DP) :: x, emax, emin
|
||||
|
||||
|
||||
open (unit = 113, file = 'wannier_bands.dat', status = 'unknown', form = 'formatted', err = 400, iostat = ios)
|
||||
open (unit = 114, file = 'original_bands.dat', status = 'unknown', form = 'formatted', err = 401, iostat = ios)
|
||||
open (unit = 115, file = 'wannier_bands.plot', status = 'unknown', form = 'formatted', err = 402, iostat = ios)
|
||||
|
|
@ -278,58 +274,58 @@ SUBROUTINE plot_wannier_bands(ek)
|
|||
emax = ek(1,1)
|
||||
emin = ek(1,1)
|
||||
|
||||
do i=1, nwan
|
||||
x = 0.d0
|
||||
do ik=1, nks/nspin
|
||||
! find limits for pretty plotting
|
||||
if (emax.lt.ek(i,ik)*rytoev) emax = ek(i,ik)*rytoev
|
||||
if (emin.gt.ek(i,ik)*rytoev) emin = ek(i,ik)*rytoev
|
||||
!
|
||||
write(113,'(2f15.9)') x, ek(i,ik)*rytoev
|
||||
if (ik.ne.nks) then
|
||||
x = x + SQRT((xk(1,ik)-xk(1,ik+1))**2+(xk(2,ik)-xk(2,ik+1))**2+(xk(3,ik)-xk(3,ik+1))**2)
|
||||
end if
|
||||
end do
|
||||
write(113, '(2a)') ' '
|
||||
end do
|
||||
do i=1, nbnd
|
||||
x = 0.d0
|
||||
do ik=1, nks/nspin
|
||||
write(114,'(2f15.9)') x, et(i,ik)*rytoev
|
||||
if (ik.ne.nks) then
|
||||
x = x + SQRT((xk(1,ik)-xk(1,ik+1))**2+(xk(2,ik)-xk(2,ik+1))**2+(xk(3,ik)-xk(3,ik+1))**2)
|
||||
end if
|
||||
end do
|
||||
write(114, '(2a)') ' '
|
||||
end do
|
||||
|
||||
do i=1, nwan
|
||||
x = 0.d0
|
||||
do ik=1, nks/nspin
|
||||
! find limits for pretty plotting
|
||||
if (emax.lt.ek(i,ik)*rytoev) emax = ek(i,ik)*rytoev
|
||||
if (emin.gt.ek(i,ik)*rytoev) emin = ek(i,ik)*rytoev
|
||||
!
|
||||
write(113,'(2f15.9)') x, ek(i,ik)*rytoev
|
||||
if (ik.ne.nks) then
|
||||
x = x + SQRT((xk(1,ik)-xk(1,ik+1))**2+(xk(2,ik)-xk(2,ik+1))**2+(xk(3,ik)-xk(3,ik+1))**2)
|
||||
end if
|
||||
end do
|
||||
write(113, '(2a)') ' '
|
||||
end do
|
||||
do i=1, nbnd
|
||||
x = 0.d0
|
||||
do ik=1, nks/nspin
|
||||
write(114,'(2f15.9)') x, et(i,ik)*rytoev
|
||||
if (ik.ne.nks) then
|
||||
x = x + SQRT((xk(1,ik)-xk(1,ik+1))**2+(xk(2,ik)-xk(2,ik+1))**2+(xk(3,ik)-xk(3,ik+1))**2)
|
||||
end if
|
||||
end do
|
||||
write(114, '(2a)') ' '
|
||||
end do
|
||||
|
||||
if (nspin.eq.2) then
|
||||
do i=1, nwan
|
||||
x = 0.d0
|
||||
do ik=nks/2+1, nks
|
||||
! find limits for pretty plotting
|
||||
if (emax.lt.ek(i,ik)*rytoev) emax = ek(i,ik)*rytoev
|
||||
if (emin.gt.ek(i,ik)*rytoev) emin = ek(i,ik)*rytoev
|
||||
!
|
||||
write(113,'(2f15.9)') x, ek(i,ik)*rytoev
|
||||
if (ik.ne.nks) then
|
||||
x = x + SQRT((xk(1,ik)-xk(1,ik+1))**2+(xk(2,ik)-xk(2,ik+1))**2+(xk(3,ik)-xk(3,ik+1))**2)
|
||||
end if
|
||||
end do
|
||||
write(113, '(2a)') ' '
|
||||
end do
|
||||
do i=1, nbnd
|
||||
x = 0.d0
|
||||
do ik=nks/2+1, nks
|
||||
write(114,'(2f15.9)') x, et(i,ik)*rytoev
|
||||
if (ik.ne.nks) then
|
||||
x = x + SQRT((xk(1,ik)-xk(1,ik+1))**2+(xk(2,ik)-xk(2,ik+1))**2+(xk(3,ik)-xk(3,ik+1))**2)
|
||||
end if
|
||||
end do
|
||||
write(114, '(2a)') ' '
|
||||
end do
|
||||
end if
|
||||
|
||||
do i=1, nwan
|
||||
x = 0.d0
|
||||
do ik=nks/2+1, nks
|
||||
! find limits for pretty plotting
|
||||
if (emax.lt.ek(i,ik)*rytoev) emax = ek(i,ik)*rytoev
|
||||
if (emin.gt.ek(i,ik)*rytoev) emin = ek(i,ik)*rytoev
|
||||
!
|
||||
write(113,'(2f15.9)') x, ek(i,ik)*rytoev
|
||||
if (ik.ne.nks) then
|
||||
x = x + SQRT((xk(1,ik)-xk(1,ik+1))**2+(xk(2,ik)-xk(2,ik+1))**2+(xk(3,ik)-xk(3,ik+1))**2)
|
||||
end if
|
||||
end do
|
||||
write(113, '(2a)') ' '
|
||||
end do
|
||||
do i=1, nbnd
|
||||
x = 0.d0
|
||||
do ik=nks/2+1, nks
|
||||
write(114,'(2f15.9)') x, et(i,ik)*rytoev
|
||||
if (ik.ne.nks) then
|
||||
x = x + SQRT((xk(1,ik)-xk(1,ik+1))**2+(xk(2,ik)-xk(2,ik+1))**2+(xk(3,ik)-xk(3,ik+1))**2)
|
||||
end if
|
||||
end do
|
||||
write(114, '(2a)') ' '
|
||||
end do
|
||||
end if
|
||||
|
||||
write(115,*)'reset'
|
||||
write(115,*)'set term post eps'
|
||||
write(115,*)'set output "wannier_bands.eps"'
|
||||
|
|
|
|||
|
|
@ -20,7 +20,7 @@ SUBROUTINE wannier_hamiltonian_JK(nwan,hamk,outfile)
|
|||
implicit none
|
||||
integer, intent(in) :: nwan, outfile
|
||||
complex(DP) :: hamk(nwan,nwan,nks)
|
||||
|
||||
|
||||
integer :: i,j, ik
|
||||
complex(DP), allocatable :: hamk2(:,:)
|
||||
real(DP) :: eps = 1.d-8, hr,hi
|
||||
|
|
@ -32,81 +32,81 @@ SUBROUTINE wannier_hamiltonian_JK(nwan,hamk,outfile)
|
|||
|
||||
write(outfile,*) nks,nwan
|
||||
do ik = 1, nks
|
||||
|
||||
! if(ik.eq.43) then
|
||||
! write(stdout,*) 'Omitting point', ik
|
||||
! CYCLE
|
||||
! end if
|
||||
|
||||
! if(ik.eq.43) then
|
||||
! write(stdout,*) 'Omitting point', ik
|
||||
! CYCLE
|
||||
! end if
|
||||
write(outfile,'(f15.12)') wk(ik)
|
||||
|
||||
write(outfile,'(f15.12)') wk(ik)
|
||||
|
||||
! eg-orbitals should be the first
|
||||
hamk2 = ZERO
|
||||
! hamk2(1,:) = hamk(1,:,ik)
|
||||
! hamk2(2,:) = hamk(4,:,ik)
|
||||
! hamk2(3,:) = hamk(2,:,ik)
|
||||
! hamk2(4,:) = hamk(3,:,ik)
|
||||
! hamk2(5:nwan,:) = hamk(5:nwan,:,ik)
|
||||
! hamk(:,:,ik) = hamk2
|
||||
! hamk2(:,1) = hamk(:,1,ik)
|
||||
! hamk2(:,2) = hamk(:,4,ik)
|
||||
! hamk2(:,3) = hamk(:,2,ik)
|
||||
! hamk2(:,4) = hamk(:,3,ik)
|
||||
! hamk2(:,5:nwan) = hamk(:,5:nwan,ik)
|
||||
! eg-orbitals should be the first
|
||||
hamk2 = ZERO
|
||||
!hamk2(1,:) = hamk(1,:,ik)
|
||||
!hamk2(2,:) = hamk(4,:,ik)
|
||||
!hamk2(3,:) = hamk(2,:,ik)
|
||||
!hamk2(4,:) = hamk(3,:,ik)
|
||||
!hamk2(5:nwan,:) = hamk(5:nwan,:,ik)
|
||||
!hamk(:,:,ik) = hamk2
|
||||
!hamk2(:,1) = hamk(:,1,ik)
|
||||
!hamk2(:,2) = hamk(:,4,ik)
|
||||
!hamk2(:,3) = hamk(:,2,ik)
|
||||
!hamk2(:,4) = hamk(:,3,ik)
|
||||
!hamk2(:,5:nwan) = hamk(:,5:nwan,ik)
|
||||
|
||||
!rearrange
|
||||
! hamk2(1,:) = hamk(5,:,ik)
|
||||
! hamk2(2,:) = hamk(3,:,ik)
|
||||
! hamk2(3,:) = hamk(1,:,ik)
|
||||
! hamk2(4,:) = hamk(2,:,ik)
|
||||
! hamk2(5,:) = hamk(4,:,ik)
|
||||
! hamk2(6,:) = hamk(10,:,ik)
|
||||
! hamk2(7,:) = hamk(8,:,ik)
|
||||
! hamk2(8,:) = hamk(6,:,ik)
|
||||
! hamk2(9,:) = hamk(7,:,ik)
|
||||
! hamk2(10,:) = hamk(9,:,ik)
|
||||
! hamk2(11:nwan,:) = hamk(11:nwan,:,ik)
|
||||
! hamk(:,:,ik) = hamk2
|
||||
! hamk2(:,1) = hamk(:,5,ik)
|
||||
! hamk2(:,2) = hamk(:,3,ik)
|
||||
! hamk2(:,3) = hamk(:,1,ik)
|
||||
! hamk2(:,4) = hamk(:,2,ik)
|
||||
! hamk2(:,5) = hamk(:,4,ik)
|
||||
! hamk2(:,6) = hamk(:,10,ik)
|
||||
! hamk2(:,7) = hamk(:,8,ik)
|
||||
! hamk2(:,8) = hamk(:,6,ik)
|
||||
! hamk2(:,9) = hamk(:,7,ik)
|
||||
! hamk2(:,10) = hamk(:,9,ik)
|
||||
! hamk2(:,11:nwan) = hamk(:,11:nwan,ik)
|
||||
!hamk2(1,:) = hamk(5,:,ik)
|
||||
!hamk2(2,:) = hamk(3,:,ik)
|
||||
!hamk2(3,:) = hamk(1,:,ik)
|
||||
!hamk2(4,:) = hamk(2,:,ik)
|
||||
!hamk2(5,:) = hamk(4,:,ik)
|
||||
!hamk2(6,:) = hamk(10,:,ik)
|
||||
!hamk2(7,:) = hamk(8,:,ik)
|
||||
!hamk2(8,:) = hamk(6,:,ik)
|
||||
!hamk2(9,:) = hamk(7,:,ik)
|
||||
!hamk2(10,:) = hamk(9,:,ik)
|
||||
!hamk2(11:nwan,:) = hamk(11:nwan,:,ik)
|
||||
!hamk(:,:,ik) = hamk2
|
||||
!hamk2(:,1) = hamk(:,5,ik)
|
||||
!hamk2(:,2) = hamk(:,3,ik)
|
||||
!hamk2(:,3) = hamk(:,1,ik)
|
||||
!hamk2(:,4) = hamk(:,2,ik)
|
||||
!hamk2(:,5) = hamk(:,4,ik)
|
||||
!hamk2(:,6) = hamk(:,10,ik)
|
||||
!hamk2(:,7) = hamk(:,8,ik)
|
||||
!hamk2(:,8) = hamk(:,6,ik)
|
||||
!hamk2(:,9) = hamk(:,7,ik)
|
||||
!hamk2(:,10) = hamk(:,9,ik)
|
||||
!hamk2(:,11:nwan) = hamk(:,11:nwan,ik)
|
||||
|
||||
hamk2 = hamk2 * rytoev
|
||||
|
||||
hamk2 = hamk(:,:,ik) * rytoev
|
||||
do i=1, nwan
|
||||
do j=1, nwan
|
||||
hr = ABS(dreal(hamk2(i,j)))
|
||||
hi = ABS(aimag(hamk2(i,j)))
|
||||
if((hr.ge.eps).AND.(hi.ge.eps)) write(outfile,'(2f12.8)') dreal(hamk2(i,j)), aimag(hamk2(i,j))
|
||||
if ((hr.lt.eps).AND.(hi.ge.eps)) write(outfile,'(f3.0,f12.8)') 0., aimag(hamk2(i,j))
|
||||
if ((hr.ge.eps).AND.(hi.lt.eps)) write(outfile,'(f12.8,f3.0)') dreal(hamk2(i,j)), 0.
|
||||
if ((hr.lt.eps).AND.(hi.lt.eps)) write(outfile,'(2f3.0)') 0., 0.
|
||||
end do
|
||||
end do
|
||||
hamk2 = hamk2 * rytoev
|
||||
|
||||
end do
|
||||
hamk2 = hamk(:,:,ik) * rytoev
|
||||
do i=1, nwan
|
||||
do j=1, nwan
|
||||
hr = ABS(dreal(hamk2(i,j)))
|
||||
hi = ABS(aimag(hamk2(i,j)))
|
||||
if((hr.ge.eps).AND.(hi.ge.eps)) write(outfile,'(2f12.8)') dreal(hamk2(i,j)), aimag(hamk2(i,j))
|
||||
if ((hr.lt.eps).AND.(hi.ge.eps)) write(outfile,'(f3.0,f12.8)') 0., aimag(hamk2(i,j))
|
||||
if ((hr.ge.eps).AND.(hi.lt.eps)) write(outfile,'(f12.8,f3.0)') dreal(hamk2(i,j)), 0.
|
||||
if ((hr.lt.eps).AND.(hi.lt.eps)) write(outfile,'(2f3.0)') 0., 0.
|
||||
end do
|
||||
end do
|
||||
|
||||
end do
|
||||
|
||||
!for debug
|
||||
! write(stdout,*) 'Real part of first 5x5 block in Gamma'
|
||||
! do i=1,5
|
||||
! write(stdout,'(5f17.12)') (dreal(hamk2(i,j,1)), j=1,5)
|
||||
! end do
|
||||
! write(stdout,*) 'Imag part of first 5x5 block in Gamma'
|
||||
! do i=1,5
|
||||
! write(stdout,'(5f17.12)') (aimag(hamk2(i,j,1)), j=1,5)
|
||||
! end do
|
||||
!end for debug
|
||||
!for debug
|
||||
! write(stdout,*) 'Real part of first 5x5 block in Gamma'
|
||||
! do i=1,5
|
||||
! write(stdout,'(5f17.12)') (dreal(hamk2(i,j,1)), j=1,5)
|
||||
! end do
|
||||
! write(stdout,*) 'Imag part of first 5x5 block in Gamma'
|
||||
! do i=1,5
|
||||
! write(stdout,'(5f17.12)') (aimag(hamk2(i,j,1)), j=1,5)
|
||||
! end do
|
||||
!end for debug
|
||||
|
||||
deallocate(hamk2)
|
||||
deallocate(hamk2)
|
||||
|
||||
END SUBROUTINE wannier_hamiltonian_JK
|
||||
|
||||
|
|
@ -117,18 +117,18 @@ SUBROUTINE wannier_hamiltonian_IL(nwan,hamk,outfile)
|
|||
use io_global, only: stdout
|
||||
use kinds, only: DP
|
||||
use constants, ONLY : rytoev
|
||||
use klist, only: nks
|
||||
use ktetra
|
||||
use klist, only: nks
|
||||
use ktetra
|
||||
use klist, only: xk, wk
|
||||
use lsda_mod, only: nspin
|
||||
use lsda_mod, only: nspin
|
||||
|
||||
implicit none
|
||||
integer, intent(in) :: nwan, outfile
|
||||
complex(DP) :: hamk(nwan,nwan,nks)
|
||||
|
||||
implicit none
|
||||
integer, intent(in) :: nwan, outfile
|
||||
complex(DP) :: hamk(nwan,nwan,nks)
|
||||
integer :: i,j, ik
|
||||
|
||||
integer :: i,j, ik
|
||||
|
||||
write(stdout,*) 'Hamiltonian is in the IL format,', nks, 'k-points'
|
||||
write(stdout,*) 'Hamiltonian is in the IL format,', nks, 'k-points'
|
||||
|
||||
write(outfile,*) nks, ntetra
|
||||
write(outfile,*) nspin, nwan
|
||||
|
|
@ -136,9 +136,9 @@ SUBROUTINE wannier_hamiltonian_IL(nwan,hamk,outfile)
|
|||
write(outfile,*) ((xk(i,ik), i=1,3), ik=1,nks)
|
||||
write(outfile,*) (1, (tetra(i,j), i=1,4), j=1,ntetra)
|
||||
|
||||
do ik = 1, nks
|
||||
write(outfile,*) ((dreal(hamk(i,j,ik)),j=i,nwan),i=1,nwan)
|
||||
write(outfile,*) ((dimag(hamk(i,j,ik)),j=i,nwan),i=1,nwan)
|
||||
end do
|
||||
do ik = 1, nks
|
||||
write(outfile,*) ((dreal(hamk(i,j,ik)),j=i,nwan),i=1,nwan)
|
||||
write(outfile,*) ((dimag(hamk(i,j,ik)),j=i,nwan),i=1,nwan)
|
||||
end do
|
||||
|
||||
END SUBROUTINE wannier_hamiltonian_IL
|
||||
|
|
|
|||
|
|
@ -25,54 +25,53 @@ PROGRAM wannier_composition
|
|||
CHARACTER(len=256) :: outdir
|
||||
integer :: ios,nc(3),n0(3)
|
||||
namelist /inputpp/ outdir, prefix, nwan, plot_wan_num, plot_wan_spin, nc, n0
|
||||
|
||||
|
||||
call start_postproc (nd_nmbr)
|
||||
!
|
||||
ios = 0
|
||||
!
|
||||
IF ( ionode ) THEN
|
||||
!
|
||||
! set default values for variables in namelist
|
||||
!
|
||||
CALL get_env( 'ESPRESSO_TMPDIR', outdir )
|
||||
IF ( TRIM( outdir ) == ' ' ) outdir = './'
|
||||
prefix ='pwscf'
|
||||
nwan = 0
|
||||
plot_wan_spin=1
|
||||
|
||||
nc(1) = 3
|
||||
nc(2) = 3
|
||||
nc(3) = 3
|
||||
n0(1) = -1
|
||||
n0(2) = -1
|
||||
n0(3) = -1
|
||||
!
|
||||
CALL input_from_file ( )
|
||||
!
|
||||
READ (5, inputpp, iostat=ios )
|
||||
!
|
||||
tmp_dir = trimcheck (outdir)
|
||||
!
|
||||
! set default values for variables in namelist
|
||||
!
|
||||
CALL get_env( 'ESPRESSO_TMPDIR', outdir )
|
||||
IF ( TRIM( outdir ) == ' ' ) outdir = './'
|
||||
prefix ='pwscf'
|
||||
nwan = 0
|
||||
plot_wan_spin=1
|
||||
|
||||
nc(1) = 3
|
||||
nc(2) = 3
|
||||
nc(3) = 3
|
||||
n0(1) = -1
|
||||
n0(2) = -1
|
||||
n0(3) = -1
|
||||
!
|
||||
CALL input_from_file ( )
|
||||
!
|
||||
READ (5, inputpp, iostat=ios )
|
||||
!
|
||||
tmp_dir = trimcheck (outdir)
|
||||
END IF
|
||||
!
|
||||
CALL mp_bcast( ios, ionode_id )
|
||||
IF ( ios /= 0 ) CALL errore('wannier_ham','reading inputpp namelist',ABS(ios))
|
||||
|
||||
call read_file
|
||||
call openfil_pp
|
||||
|
||||
call wannier_init(.true.)
|
||||
|
||||
!debug
|
||||
write(stdout,'(5x,"Calling plot_wannier for wannier",i3)') plot_wan_num
|
||||
!end of debug
|
||||
call plot_wannier(nc,n0)
|
||||
!debug
|
||||
write(stdout,'(5x,"Calling plot_atoms")')
|
||||
!end of debug
|
||||
call plot_atoms()
|
||||
|
||||
!debug
|
||||
write(stdout,'(5x,"Calling plot_wannier for wannier",i3)') plot_wan_num
|
||||
!end of debug
|
||||
call plot_wannier(nc,n0)
|
||||
!debug
|
||||
write(stdout,'(5x,"Calling plot_atoms")')
|
||||
!end of debug
|
||||
call plot_atoms()
|
||||
|
||||
call stop_pp
|
||||
|
||||
|
||||
call wannier_clean()
|
||||
|
||||
END PROGRAM wannier_composition
|
||||
|
|
@ -104,9 +103,9 @@ SUBROUTINE plot_wannier(nc,n0)
|
|||
COMPLEX(DP), allocatable :: wan_func(:,:), pp_ort(:,:), psic(:), psic3(:,:,:), psic3_0(:,:,:), psic_sum(:,:,:,:), paux(:,:)
|
||||
real(DP), allocatable :: rho(:,:,:,:), raux(:)
|
||||
real(DP) :: r(3)
|
||||
|
||||
|
||||
IF (nsym.GT.1) THEN
|
||||
call errore('wannier_cmptn','k-points set is in the irreducible brillouin zone - not implemented',1)
|
||||
call errore('wannier_cmptn','k-points set is in the irreducible brillouin zone - not implemented',1)
|
||||
END IF
|
||||
|
||||
allocate(wan_func(npwx,nwan))
|
||||
|
|
@ -120,81 +119,79 @@ SUBROUTINE plot_wannier(nc,n0)
|
|||
call init_at_1
|
||||
|
||||
CALL struc_fact (nat, tau, ntyp, ityp, ngm, g, bg, nr1, nr2, nr3, &
|
||||
strf, eigts1, eigts2, eigts3)
|
||||
strf, eigts1, eigts2, eigts3)
|
||||
|
||||
current_spin = 1
|
||||
wan_func = ZERO
|
||||
psic3 = ZERO
|
||||
psic3_0 = ZERO
|
||||
psic_sum = ZERO
|
||||
|
||||
|
||||
do ik = 1, nks
|
||||
CALL gk_sort (xk (1, ik), ngm, g, ecutwfc / tpiba2, npw, igk, g2kin)
|
||||
if (lsda) current_spin = isk(ik)
|
||||
|
||||
wan_func = ZERO
|
||||
call get_buffer( wan_func, nwordwf, iunwf, ik)
|
||||
|
||||
psic(1:nrxxs) = ZERO
|
||||
rho = ZERO
|
||||
do j = 1, npw
|
||||
psic (nls (igk (j) ) ) = wan_func (j, plot_wan_num)
|
||||
end do
|
||||
|
||||
call cft3s (psic, nr1s, nr2s, nr3s, nrx1s, nrx2s, nrx3s, 2)
|
||||
|
||||
do k=1, nrx3s
|
||||
do j=1,nrx2s
|
||||
do i=1,nrx1s
|
||||
n = i + (j-1)*nrx1s + (k-1)*nrx2s*nrx1s
|
||||
psic3_0(i,j,k) = psic(n)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
|
||||
do k=1, (nrx3s-1)*nc(3)
|
||||
do j=1, (nrx2s-1)*nc(2)
|
||||
do i=1, (nrx1s-1)*nc(1)
|
||||
! r = n0(1)*at(1,:)+n0(2)*at(2,:)+n0(3)*at(3,:)
|
||||
! r = r + DBLE(i-1)*at(1,:)/DBLE(nrx1s-1)+DBLE(j-1)*at(2,:)/DBLE(nrx2s-1)+DBLE(k-1)*at(3,:)/DBLE(nrx3s-1)
|
||||
r = n0(1)*at(:,1)+n0(2)*at(:,2)+n0(3)*at(:,3)
|
||||
r = r + DBLE(i-1)*at(:,1)/DBLE(nrx1s-1)+DBLE(j-1)*at(:,2)/DBLE(nrx2s-1)+DBLE(k-1)*at(:,3)/DBLE(nrx3s-1)
|
||||
phase = dcos(tpi*(xk(1,ik)*r(1)+xk(2,ik)*r(2)+xk(3,ik)*r(3))) + dcmplx(0.d0,1.d0)*dsin(tpi*(xk(1,ik)*r(1)+xk(2,ik)*r(2)+xk(3,ik)*r(3)))
|
||||
|
||||
i1 = i - FLOOR(DBLE(i-0.01)/DBLE(nrx1s-1))*(nrx1s-1)
|
||||
j1 = j - FLOOR(DBLE(j-0.01)/DBLE(nrx2s-1))*(nrx2s-1)
|
||||
k1 = k - FLOOR(DBLE(k-0.01)/DBLE(nrx3s-1))*(nrx3s-1)
|
||||
psic_sum(i,j,k,current_spin) = psic_sum(i,j,k,current_spin)+ &
|
||||
dcmplx(wk(ik),0.d0)*psic3_0(i1,j1,k1)*phase
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
|
||||
|
||||
CALL gk_sort (xk (1, ik), ngm, g, ecutwfc / tpiba2, npw, igk, g2kin)
|
||||
if (lsda) current_spin = isk(ik)
|
||||
|
||||
wan_func = ZERO
|
||||
call get_buffer( wan_func, nwordwf, iunwf, ik)
|
||||
|
||||
psic(1:nrxxs) = ZERO
|
||||
rho = ZERO
|
||||
do j = 1, npw
|
||||
psic (nls (igk (j) ) ) = wan_func (j, plot_wan_num)
|
||||
end do
|
||||
|
||||
call cft3s (psic, nr1s, nr2s, nr3s, nrx1s, nrx2s, nrx3s, 2)
|
||||
|
||||
do k=1, nrx3s
|
||||
do j=1,nrx2s
|
||||
do i=1,nrx1s
|
||||
n = i + (j-1)*nrx1s + (k-1)*nrx2s*nrx1s
|
||||
psic3_0(i,j,k) = psic(n)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
|
||||
do k=1, (nrx3s-1)*nc(3)
|
||||
do j=1, (nrx2s-1)*nc(2)
|
||||
do i=1, (nrx1s-1)*nc(1)
|
||||
! r = n0(1)*at(1,:)+n0(2)*at(2,:)+n0(3)*at(3,:)
|
||||
! r = r + DBLE(i-1)*at(1,:)/DBLE(nrx1s-1)+DBLE(j-1)*at(2,:)/DBLE(nrx2s-1)+DBLE(k-1)*at(3,:)/DBLE(nrx3s-1)
|
||||
r = n0(1)*at(:,1)+n0(2)*at(:,2)+n0(3)*at(:,3)
|
||||
r = r + DBLE(i-1)*at(:,1)/DBLE(nrx1s-1)+DBLE(j-1)*at(:,2)/DBLE(nrx2s-1)+DBLE(k-1)*at(:,3)/DBLE(nrx3s-1)
|
||||
phase = dcos(tpi*(xk(1,ik)*r(1)+xk(2,ik)*r(2)+xk(3,ik)*r(3))) + dcmplx(0.d0,1.d0)*dsin(tpi*(xk(1,ik)*r(1)+xk(2,ik)*r(2)+xk(3,ik)*r(3)))
|
||||
|
||||
i1 = i - FLOOR(DBLE(i-0.01)/DBLE(nrx1s-1))*(nrx1s-1)
|
||||
j1 = j - FLOOR(DBLE(j-0.01)/DBLE(nrx2s-1))*(nrx2s-1)
|
||||
k1 = k - FLOOR(DBLE(k-0.01)/DBLE(nrx3s-1))*(nrx3s-1)
|
||||
psic_sum(i,j,k,current_spin) = psic_sum(i,j,k,current_spin)+ &
|
||||
dcmplx(wk(ik),0.d0)*psic3_0(i1,j1,k1)*phase
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
|
||||
end do !ik
|
||||
|
||||
|
||||
rho = 0.d0
|
||||
|
||||
do n=1, nspin
|
||||
do i=1, nrx1s*nc(1)
|
||||
do j=1, nrx2s*nc(2)
|
||||
do k=1,nrx3s*nc(3)
|
||||
rho(i,j,k,n) = dreal(psic_sum(i,j,k,n))**2+aimag(psic_sum(i,j,k,n))**2
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
do i=1, nrx1s*nc(1)
|
||||
do j=1, nrx2s*nc(2)
|
||||
do k=1,nrx3s*nc(3)
|
||||
rho(i,j,k,n) = dreal(psic_sum(i,j,k,n))**2+aimag(psic_sum(i,j,k,n))**2
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
|
||||
|
||||
open (10, file='wannier.plot.dx', err = 100, iostat = ios)
|
||||
100 call errore ('plot_wannier', 'Opening out file', abs (ios) )
|
||||
100 call errore ('plot_wannier', 'Opening out file', abs (ios) )
|
||||
|
||||
! I want to write .dx file for dataexplorer
|
||||
write(10,'(a36,3i6)') 'object 1 class gridpositions counts ', nrx3s*nc(3), nrx2s*nc(2), nrx1s*nc(1)
|
||||
write(10,*) 'origin', n0(1)*at(:,1)+n0(2)*at(:,2)+n0(3)*at(:,3)
|
||||
! write(10,'(a5, 3f9.5)') 'delta', (at(3,i)/(1.d0*(nrx3s-1)),i=1,3)
|
||||
! write(10,'(a5, 3f9.5)') 'delta', (at(2,i)/(1.d0*(nrx2s-1)),i=1,3)
|
||||
! write(10,'(a5, 3f9.5)') 'delta', (at(1,i)/(1.d0*(nrx1s-1)),i=1,3)
|
||||
! write(10,'(a5, 3f9.5)') 'delta', (at(3,i)/(1.d0*(nrx3s-1)),i=1,3)
|
||||
! write(10,'(a5, 3f9.5)') 'delta', (at(2,i)/(1.d0*(nrx2s-1)),i=1,3)
|
||||
! write(10,'(a5, 3f9.5)') 'delta', (at(1,i)/(1.d0*(nrx1s-1)),i=1,3)
|
||||
write(10,'(a5, 3f9.5)') 'delta', (at(i,1)/(1.d0*(nrx3s-1)),i=1,3)
|
||||
write(10,'(a5, 3f9.5)') 'delta', (at(i,2)/(1.d0*(nrx2s-1)),i=1,3)
|
||||
write(10,'(a5, 3f9.5)') 'delta', (at(i,3)/(1.d0*(nrx1s-1)),i=1,3)
|
||||
|
|
@ -202,25 +199,23 @@ SUBROUTINE plot_wannier(nc,n0)
|
|||
write(10,*) 'attribute "element type" string "cubes"'
|
||||
write(10,*) 'attribute "ref" string "positions"'
|
||||
write(10,'(a44,i10,a13)') 'object 3 class array type float rank 0 items', nrx3s*nc(3)*nrx2s*nc(2)*nrx1s*nc(1), 'data follows'
|
||||
|
||||
|
||||
do i=1, nrx3s*nc(3)
|
||||
do j=1,nrx2s*nc(2)
|
||||
do k=1,nrx1s*nc(1)
|
||||
write(10,'(f13.7)') rho(k,j,i,plot_wan_spin)
|
||||
! write(10,'(f13.7)') aimag(psic_sum(k,j,i,plot_wan_spin))
|
||||
end do
|
||||
end do
|
||||
do j=1,nrx2s*nc(2)
|
||||
do k=1,nrx1s*nc(1)
|
||||
write(10,'(f13.7)') rho(k,j,i,plot_wan_spin)
|
||||
! write(10,'(f13.7)') aimag(psic_sum(k,j,i,plot_wan_spin))
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
|
||||
|
||||
|
||||
write(10,'(a34)') 'attribute "dep" string "positions"'
|
||||
write(10,*) 'object "regular positions regular connections" class field'
|
||||
write(10,*) 'component "positions" value 1'
|
||||
write(10,*) 'component "connections" value 2'
|
||||
write(10,*) 'component "data" value 3'
|
||||
write(10,*) 'end'
|
||||
|
||||
|
||||
close(10)
|
||||
|
||||
deallocate(wan_func)
|
||||
|
|
@ -237,25 +232,25 @@ END SUBROUTINE plot_wannier
|
|||
SUBROUTINE plot_atoms
|
||||
use io_global, only: stdout
|
||||
use kinds, only: DP
|
||||
use ions_base, only: tau, nat, ityp, zv
|
||||
implicit none
|
||||
integer :: i,na, ios
|
||||
|
||||
open (20, file='atoms.plot.dx', err = 200, iostat = ios)
|
||||
200 call errore ('plot_wannier', 'Opening out atoms file', abs (ios) )
|
||||
|
||||
write(20,*) 'object 1 class array type float rank 1 shape 3 items', nat,' data follows'
|
||||
use ions_base, only: tau, nat, ityp, zv
|
||||
implicit none
|
||||
integer :: i,na, ios
|
||||
|
||||
open (20, file='atoms.plot.dx', err = 200, iostat = ios)
|
||||
200 call errore ('plot_wannier', 'Opening out atoms file', abs (ios) )
|
||||
|
||||
write(20,*) 'object 1 class array type float rank 1 shape 3 items', nat,' data follows'
|
||||
do na = 1, nat
|
||||
write(20,'(3f9.5)') (tau(i,na),i=1,3)
|
||||
write(20,'(3f9.5)') (tau(i,na),i=1,3)
|
||||
enddo
|
||||
write(20,*) 'object 2 class array type float rank 0 items', nat,' data follows'
|
||||
write(20,*) 'object 2 class array type float rank 0 items', nat,' data follows'
|
||||
do na = 1, nat
|
||||
write(20,*) zv(ityp(na))
|
||||
write(20,*) zv(ityp(na))
|
||||
enddo
|
||||
write(20,*) 'attribute "dep" string "positions"'
|
||||
write(20,*) 'object "irregular positions" class field'
|
||||
write(20,*) 'component "positions" value 1'
|
||||
write(20,*) 'component "data" value 2'
|
||||
write(20,*) 'end'
|
||||
close(20)
|
||||
write(20,*) 'attribute "dep" string "positions"'
|
||||
write(20,*) 'object "irregular positions" class field'
|
||||
write(20,*) 'component "positions" value 1'
|
||||
write(20,*) 'component "data" value 2'
|
||||
write(20,*) 'end'
|
||||
close(20)
|
||||
END SUBROUTINE plot_atoms
|
||||
|
|
|
|||
|
|
@ -23,63 +23,62 @@ SUBROUTINE wannier_u_matrix(U,hJ)
|
|||
rotm = 0.d0
|
||||
c = 0
|
||||
do iwan=1, nwan
|
||||
do j=1,wan_in(iwan,1)%ning
|
||||
if(wan_in(iwan,1)%ing(j)%l.eq.2) then
|
||||
c = c+1
|
||||
SELECT CASE(wan_in(iwan,1)%ing(j)%m)
|
||||
CASE(1)
|
||||
rotm(c,3) = wan_in(iwan,1)%ing(j)%c
|
||||
CASE(2)
|
||||
rotm(c,4) = wan_in(iwan,1)%ing(j)%c
|
||||
CASE(3)
|
||||
rotm(c,2) = wan_in(iwan,1)%ing(j)%c
|
||||
CASE(4)
|
||||
rotm(c,5) = wan_in(iwan,1)%ing(j)%c
|
||||
CASE(5)
|
||||
rotm(c,1) = wan_in(iwan,1)%ing(j)%c
|
||||
END SELECT
|
||||
end if
|
||||
end do
|
||||
do j=1,wan_in(iwan,1)%ning
|
||||
if(wan_in(iwan,1)%ing(j)%l.eq.2) then
|
||||
c = c+1
|
||||
SELECT CASE(wan_in(iwan,1)%ing(j)%m)
|
||||
CASE(1)
|
||||
rotm(c,3) = wan_in(iwan,1)%ing(j)%c
|
||||
CASE(2)
|
||||
rotm(c,4) = wan_in(iwan,1)%ing(j)%c
|
||||
CASE(3)
|
||||
rotm(c,2) = wan_in(iwan,1)%ing(j)%c
|
||||
CASE(4)
|
||||
rotm(c,5) = wan_in(iwan,1)%ing(j)%c
|
||||
CASE(5)
|
||||
rotm(c,1) = wan_in(iwan,1)%ing(j)%c
|
||||
END SELECT
|
||||
end if
|
||||
end do
|
||||
end do
|
||||
|
||||
if(c.gt.5) call errore('Too many interactiong atoms - cant construct U matrix',c)
|
||||
|
||||
do i=1,5
|
||||
do j=1,5
|
||||
rotm(i+5,j+5) = rotm(i,j)
|
||||
end do
|
||||
do j=1,5
|
||||
rotm(i+5,j+5) = rotm(i,j)
|
||||
end do
|
||||
end do
|
||||
|
||||
do i = 1,10
|
||||
do j = 1, 10
|
||||
tmp = 0.d0
|
||||
do k=1,10
|
||||
do l=1,10
|
||||
tmp=tmp+rotm(i,k)*u2(k,l)*rotm(j,l)
|
||||
enddo
|
||||
enddo
|
||||
unew(i,j)=tmp
|
||||
enddo
|
||||
do j = 1, 10
|
||||
tmp = 0.d0
|
||||
do k=1,10
|
||||
do l=1,10
|
||||
tmp=tmp+rotm(i,k)*u2(k,l)*rotm(j,l)
|
||||
enddo
|
||||
enddo
|
||||
unew(i,j)=tmp
|
||||
enddo
|
||||
enddo
|
||||
|
||||
!output
|
||||
do i=1,c
|
||||
write(stdout,'(5x,10f5.2)') (unew(i,j),j=1,c), (unew(i,j+5),j=1,c)
|
||||
end do
|
||||
do i=6,5+c
|
||||
write(stdout,'(5x,10f5.2)') (unew(i,j),j=1,c), (unew(i,j+5),j=1,c)
|
||||
end do
|
||||
write(stdout,*)
|
||||
|
||||
open(70,file='umatrix',status='unknown',form='formatted')
|
||||
do i=1,c
|
||||
write(70,'(10f5.2)') (unew(i,j),j=1,c), (unew(i,j+5),j=1,c)
|
||||
end do
|
||||
do i=6,5+c
|
||||
write(70,'(10f5.2)') (unew(i,j),j=1,c), (unew(i,j+5),j=1,c)
|
||||
end do
|
||||
write(70,*)
|
||||
close(70)
|
||||
|
||||
do i=1,c
|
||||
write(stdout,'(5x,10f5.2)') (unew(i,j),j=1,c), (unew(i,j+5),j=1,c)
|
||||
end do
|
||||
do i=6,5+c
|
||||
write(stdout,'(5x,10f5.2)') (unew(i,j),j=1,c), (unew(i,j+5),j=1,c)
|
||||
end do
|
||||
write(stdout,*)
|
||||
|
||||
open(70,file='umatrix',status='unknown',form='formatted')
|
||||
do i=1,c
|
||||
write(70,'(10f5.2)') (unew(i,j),j=1,c), (unew(i,j+5),j=1,c)
|
||||
end do
|
||||
do i=6,5+c
|
||||
write(70,'(10f5.2)') (unew(i,j),j=1,c), (unew(i,j+5),j=1,c)
|
||||
end do
|
||||
write(70,*)
|
||||
close(70)
|
||||
|
||||
END SUBROUTINE wannier_u_matrix
|
||||
|
|
|
|||
|
|
@ -94,7 +94,7 @@ SUBROUTINE save_buffer( vect, nword, unit, nrec )
|
|||
!
|
||||
IF ( nword /= SIZE ( buffer1, 1) ) &
|
||||
CALL errore ('save_buffer', 'record length mismatch', ABS(nword))
|
||||
!
|
||||
!
|
||||
buffer1(:,nrec) = vect(:)
|
||||
!
|
||||
ELSE
|
||||
|
|
@ -139,7 +139,7 @@ SUBROUTINE get_buffer( vect, nword, unit, nrec )
|
|||
!
|
||||
IF ( nword /= SIZE ( buffer1, 1) ) &
|
||||
CALL errore ('get_buffer', 'record length mismatch', ABS(nword))
|
||||
!
|
||||
!
|
||||
vect(:) = buffer1(:,nrec)
|
||||
!
|
||||
ELSE
|
||||
|
|
|
|||
|
|
@ -452,7 +452,7 @@ SUBROUTINE electrons()
|
|||
IF (lgauss) THEN
|
||||
CALL errore( 'electrons', 'charge is wrong: smearing is needed', 1 )
|
||||
ELSE
|
||||
CALL errore( 'electrons', 'charge is wrong', 1 )
|
||||
CALL errore( 'electrons', 'charge is wrong', 1 )
|
||||
END IF
|
||||
END IF
|
||||
END IF
|
||||
|
|
|
|||
|
|
@ -632,14 +632,9 @@ h_epsi_her_set.o : buffers.o
|
|||
h_epsi_her_set.o : pwcom.o
|
||||
h_epsi_her_set.o : scf_mod.o
|
||||
h_psi.o : ../Modules/control_flags.o
|
||||
h_psi.o : ../Modules/fft_base.o
|
||||
h_psi.o : ../Modules/fft_parallel.o
|
||||
h_psi.o : ../Modules/functionals.o
|
||||
h_psi.o : ../Modules/kind.o
|
||||
h_psi.o : ../Modules/mp_global.o
|
||||
h_psi.o : ../Modules/task_groups.o
|
||||
h_psi.o : ../Modules/uspp.o
|
||||
h_psi.o : ../Modules/wavefunctions.o
|
||||
h_psi.o : becmod.o
|
||||
h_psi.o : exx.o
|
||||
h_psi.o : noncol.o
|
||||
|
|
@ -1484,14 +1479,6 @@ vhpsi.o : ../Modules/mp_global.o
|
|||
vhpsi.o : ../Modules/uspp.o
|
||||
vhpsi.o : pwcom.o
|
||||
vhpsi.o : scf_mod.o
|
||||
vhpsi_nc.o : ../Modules/control_flags.o
|
||||
vhpsi_nc.o : ../Modules/ions_base.o
|
||||
vhpsi_nc.o : ../Modules/kind.o
|
||||
vhpsi_nc.o : ../Modules/mp.o
|
||||
vhpsi_nc.o : ../Modules/mp_global.o
|
||||
vhpsi_nc.o : ../Modules/uspp.o
|
||||
vhpsi_nc.o : pwcom.o
|
||||
vhpsi_nc.o : scf_mod.o
|
||||
vloc_of_g.o : ../Modules/constants.o
|
||||
vloc_of_g.o : ../Modules/kind.o
|
||||
vloc_psi.o : ../Modules/control_flags.o
|
||||
|
|
@ -1502,6 +1489,7 @@ vloc_psi.o : ../Modules/mp_global.o
|
|||
vloc_psi.o : ../Modules/parallel_include.o
|
||||
vloc_psi.o : ../Modules/task_groups.o
|
||||
vloc_psi.o : ../Modules/wavefunctions.o
|
||||
vloc_psi.o : noncol.o
|
||||
vloc_psi.o : pwcom.o
|
||||
w0gauss.o : ../Modules/constants.o
|
||||
w0gauss.o : ../Modules/kind.o
|
||||
|
|
@ -1715,7 +1703,6 @@ trnvecc.o : ../include/f_defs.h
|
|||
update_pot.o : ../include/f_defs.h
|
||||
vcsubs.o : ../include/f_defs.h
|
||||
vhpsi.o : ../include/f_defs.h
|
||||
vhpsi_nc.o : ../include/f_defs.h
|
||||
vloc_of_g.o : ../include/f_defs.h
|
||||
vloc_psi.o : ../include/f_defs.h
|
||||
wannier_check.o : ../include/f_defs.h
|
||||
|
|
|
|||
|
|
@ -28,7 +28,7 @@ SUBROUTINE ortho_wfc(lda,ldb,wfc,ierr)
|
|||
REAL(DP) , ALLOCATABLE :: e (:)
|
||||
|
||||
ierr = 0
|
||||
|
||||
|
||||
ALLOCATE (overlap( lda , lda))
|
||||
ALLOCATE (work ( lda , lda))
|
||||
ALLOCATE (e ( lda))
|
||||
|
|
@ -41,7 +41,7 @@ SUBROUTINE ortho_wfc(lda,ldb,wfc,ierr)
|
|||
e = 0.d0
|
||||
|
||||
CALL ZGEMM ('n', 'c', lda, lda, ldb, (1.d0, 0.d0), &
|
||||
wfc, lda, wfc, lda, (0.d0, 0.d0), overlap, lda)
|
||||
wfc, lda, wfc, lda, (0.d0, 0.d0), overlap, lda)
|
||||
|
||||
#ifdef __PARA
|
||||
CALL mp_sum( overlap, intra_pool_comm )
|
||||
|
|
@ -51,19 +51,19 @@ SUBROUTINE ortho_wfc(lda,ldb,wfc,ierr)
|
|||
!
|
||||
CALL cdiagh (lda, overlap, lda, e, work)
|
||||
DO i = 1, lda
|
||||
IF(ABS(e(i)).lt.1.d-10) THEN
|
||||
ierr = 1
|
||||
RETURN
|
||||
ELSE
|
||||
e (i) = 1.d0/dsqrt(e(i))
|
||||
END IF
|
||||
IF(ABS(e(i)).lt.1.d-10) THEN
|
||||
ierr = 1
|
||||
RETURN
|
||||
ELSE
|
||||
e (i) = 1.d0/dsqrt(e(i))
|
||||
END IF
|
||||
ENDDO
|
||||
|
||||
overlap = ZERO
|
||||
|
||||
DO i = 1, lda
|
||||
DO j = 1, lda
|
||||
overlap (i, j) = ZERO
|
||||
overlap (i, j) = ZERO
|
||||
DO k = 1, lda
|
||||
overlap (i, j) = overlap (i, j) + e(k)*work(i, k)*DCONJG(work (j, k) )
|
||||
ENDDO
|
||||
|
|
@ -74,7 +74,7 @@ SUBROUTINE ortho_wfc(lda,ldb,wfc,ierr)
|
|||
!
|
||||
wfc_ortho(:,:) = ZERO
|
||||
call ZGEMM('N', 'N', lda, ldb, lda, ONE, overlap, lda, &
|
||||
wfc, lda, ZERO, wfc_ortho, lda)
|
||||
wfc, lda, ZERO, wfc_ortho, lda)
|
||||
|
||||
wfc(:,:) = wfc_ortho(:,:)
|
||||
|
||||
|
|
@ -111,11 +111,11 @@ SUBROUTINE check_ortho(lda,ldb,wfc)
|
|||
! calculate overlap matrix
|
||||
!
|
||||
CALL ZGEMM ('n', 'c', lda, lda, ldb, ONE, &
|
||||
wfc, lda, wfc, lda, ZERO, overlap, lda)
|
||||
wfc, lda, wfc, lda, ZERO, overlap, lda)
|
||||
|
||||
write(stdout,'(5x,a45,2i5)') 'check_ortho for wavefunction with dimentions ', lda,ldb
|
||||
do i=1,lda
|
||||
write(stdout,'(5x,8f8.4)') (dreal(overlap(i,j)),j=1,lda)
|
||||
write(stdout,'(5x,8f8.4)') (dreal(overlap(i,j)),j=1,lda)
|
||||
end do
|
||||
write(stdout,'(5x,a18)') 'end of check_ortho'
|
||||
|
||||
|
|
|
|||
|
|
@ -31,57 +31,55 @@ subroutine wannier_check()
|
|||
|
||||
! here we will write to stdout source of wannier functions (atomic functions from which wannier are generated)
|
||||
do ispin=1, nspin
|
||||
!
|
||||
write(stdout,'(5x,a4,i2)') 'Spin',ispin
|
||||
do iwan=1,nwan
|
||||
write(stdout,'(7x,"Wannier #",i3," centered on atom ",a3," (position ",3f8.5," )")') &
|
||||
iwan, atm(ityp(wan_in(iwan,ispin)%iatom)), (tau(i,wan_in(iwan,ispin)%iatom),i=1,3)
|
||||
|
||||
if( use_energy_int) then
|
||||
write(stdout,'(9x,"Bands for generation: from",f6.3," to",f6.3)') &
|
||||
wan_in(iwan,ispin)%bands_from,wan_in(iwan,ispin)%bands_to
|
||||
else
|
||||
write(stdout,'(9x,"Bands for generation: from",i4," to",i4)') &
|
||||
INT(wan_in(iwan,ispin)%bands_from),INT(wan_in(iwan,ispin)%bands_to)
|
||||
end if
|
||||
|
||||
write(stdout,'(9x,a31)') 'Trial wavefunction ingredients:'
|
||||
do i=1,wan_in(iwan,ispin)%ning
|
||||
nwfc=0
|
||||
lmax_wfc = 0
|
||||
write(stdout,'(10x,f12.10," of l=",i1,", m=",i1)') &
|
||||
wan_in(iwan,ispin)%ing(i)%c, wan_in(iwan,ispin)%ing(i)%l, wan_in(iwan,ispin)%ing(i)%m
|
||||
|
||||
! now we shoud associate every ingridient of trial wavefunction with atomic orbital
|
||||
! it will be done only once - for future using in wannier_proj
|
||||
DO na = 1, nat
|
||||
nt = ityp (na)
|
||||
DO n = 1, upf(nt)%nwfc
|
||||
IF (upf(nt)%oc (n) >= 0.d0) THEN
|
||||
l = upf(nt)%lchi (n)
|
||||
lmax_wfc = max (lmax_wfc, l )
|
||||
DO m=1, 2*l+1
|
||||
nwfc=nwfc+1
|
||||
! the most important part
|
||||
if ( &
|
||||
(na == wan_in(iwan,ispin)%iatom) .AND. &
|
||||
(l == wan_in(iwan,ispin)%ing(i)%l) .AND. &
|
||||
(m == wan_in(iwan,ispin)%ing(i)%m) ) &
|
||||
wan_in(iwan,ispin)%ing(i)%iatomwfc = nwfc
|
||||
enddo
|
||||
endif
|
||||
enddo
|
||||
enddo
|
||||
|
||||
|
||||
|
||||
end do ! ingredients
|
||||
end do ! iwannier
|
||||
!
|
||||
write(stdout,'(5x,a4,i2)') 'Spin',ispin
|
||||
do iwan=1,nwan
|
||||
write(stdout,'(7x,"Wannier #",i3," centered on atom ",a3," (position ",3f8.5," )")') &
|
||||
iwan, atm(ityp(wan_in(iwan,ispin)%iatom)), (tau(i,wan_in(iwan,ispin)%iatom),i=1,3)
|
||||
|
||||
if( use_energy_int) then
|
||||
write(stdout,'(9x,"Bands for generation: from",f6.3," to",f6.3)') &
|
||||
wan_in(iwan,ispin)%bands_from,wan_in(iwan,ispin)%bands_to
|
||||
else
|
||||
write(stdout,'(9x,"Bands for generation: from",i4," to",i4)') &
|
||||
INT(wan_in(iwan,ispin)%bands_from),INT(wan_in(iwan,ispin)%bands_to)
|
||||
end if
|
||||
|
||||
write(stdout,'(9x,a31)') 'Trial wavefunction ingredients:'
|
||||
do i=1,wan_in(iwan,ispin)%ning
|
||||
nwfc=0
|
||||
lmax_wfc = 0
|
||||
write(stdout,'(10x,f12.10," of l=",i1,", m=",i1)') &
|
||||
wan_in(iwan,ispin)%ing(i)%c, wan_in(iwan,ispin)%ing(i)%l, wan_in(iwan,ispin)%ing(i)%m
|
||||
|
||||
! now we shoud associate every ingridient of trial wavefunction with atomic orbital
|
||||
! it will be done only once - for future using in wannier_proj
|
||||
DO na = 1, nat
|
||||
nt = ityp (na)
|
||||
DO n = 1, upf(nt)%nwfc
|
||||
IF (upf(nt)%oc (n) >= 0.d0) THEN
|
||||
l = upf(nt)%lchi (n)
|
||||
lmax_wfc = max (lmax_wfc, l )
|
||||
DO m=1, 2*l+1
|
||||
nwfc=nwfc+1
|
||||
! the most important part
|
||||
if ( &
|
||||
(na == wan_in(iwan,ispin)%iatom) .AND. &
|
||||
(l == wan_in(iwan,ispin)%ing(i)%l) .AND. &
|
||||
(m == wan_in(iwan,ispin)%ing(i)%m) ) &
|
||||
wan_in(iwan,ispin)%ing(i)%iatomwfc = nwfc
|
||||
enddo
|
||||
endif
|
||||
enddo
|
||||
enddo
|
||||
|
||||
end do ! ingredients
|
||||
end do ! iwannier
|
||||
end do !ispin
|
||||
|
||||
! do iwan=1,nwan
|
||||
! write(stdout,'(7x,"Wannier #",i3," atomic wavefunction", i3)') iwan, wan_in(iwan,1)%ing(1)%iatomwfc
|
||||
! end do ! iwannier
|
||||
! do iwan=1,nwan
|
||||
! write(stdout,'(7x,"Wannier #",i3," atomic wavefunction", i3)') iwan, wan_in(iwan,1)%ing(1)%iatomwfc
|
||||
! end do ! iwannier
|
||||
|
||||
if (lmax_wfc > 3) call errore ('wannier_check', 'l > 3 not yet implemented', 1)
|
||||
if (nwfc /= natomwfc) call errore ('wannier_check', 'wrong # of atomic wfcs?', 1)
|
||||
|
|
|
|||
|
|
@ -30,17 +30,17 @@ subroutine wannier_enrg(enrg)
|
|||
|
||||
enrg = ZERO
|
||||
current_spin = 1
|
||||
|
||||
|
||||
DO ik=1, nks
|
||||
IF (lsda) current_spin = isk(ik)
|
||||
CALL get_buffer( pp, nwordwpp, iunwpp, ik)
|
||||
DO i=1, nwan
|
||||
DO j=1, nbnd
|
||||
enrg(i,current_spin) = enrg(i,current_spin) + pp(i,j)*conjg(pp(i,j))*wk(ik)*et(j,ik)
|
||||
END DO
|
||||
END DO
|
||||
IF (lsda) current_spin = isk(ik)
|
||||
CALL get_buffer( pp, nwordwpp, iunwpp, ik)
|
||||
DO i=1, nwan
|
||||
DO j=1, nbnd
|
||||
enrg(i,current_spin) = enrg(i,current_spin) + pp(i,j)*conjg(pp(i,j))*wk(ik)*et(j,ik)
|
||||
END DO
|
||||
END DO
|
||||
END DO
|
||||
|
||||
|
||||
IF(nspin.eq.1) enrg=enrg*0.5D0
|
||||
|
||||
return
|
||||
|
|
|
|||
|
|
@ -41,22 +41,21 @@ SUBROUTINE wannier_init(hwwa)
|
|||
|
||||
coef = ZERO
|
||||
wannier_energy = ZERO
|
||||
wannier_occ = ZERO
|
||||
wannier_occ = ZERO
|
||||
|
||||
wan_in(1:nwan,1:nspin) = wan_data(1:nwan,1:nspin)
|
||||
|
||||
IF(.NOT. hwwa) THEN
|
||||
|
||||
IF(use_energy_int) THEN
|
||||
do i=1,nwan
|
||||
wan_in(i,:)%bands_from = (1.d0/rytoev)*wan_in(i,:)%bands_from
|
||||
wan_in(i,:)%bands_to = (1.d0/rytoev)*wan_in(i,:)%bands_to
|
||||
end do
|
||||
END IF
|
||||
|
||||
CALL wannier_check()
|
||||
|
||||
end if
|
||||
IF(use_energy_int) THEN
|
||||
do i=1,nwan
|
||||
wan_in(i,:)%bands_from = (1.d0/rytoev)*wan_in(i,:)%bands_from
|
||||
wan_in(i,:)%bands_to = (1.d0/rytoev)*wan_in(i,:)%bands_to
|
||||
end do
|
||||
END IF
|
||||
|
||||
CALL wannier_check()
|
||||
end if
|
||||
|
||||
ALLOCATE(wan_pot(nwan,nspin))
|
||||
wan_pot(1:nwan,1:nspin) = constrain_pot(1:nwan,1:nspin)
|
||||
|
|
@ -66,11 +65,11 @@ SUBROUTINE wannier_init(hwwa)
|
|||
nwordwf = nwan*npwx*npol
|
||||
CALL open_buffer( iunwpp, 'wproj', nwordwpp, nks, exst )
|
||||
CALL open_buffer( iunwf, 'wwf', nwordwf, nks, exst )
|
||||
|
||||
|
||||
! For atomic wavefunctions
|
||||
INQUIRE( UNIT = iunigk, OPENED = opnd )
|
||||
IF(.NOT. opnd) CALL seqopn( iunigk, 'igk', 'UNFORMATTED', exst )
|
||||
|
||||
|
||||
IF(.NOT. ALLOCATED(swfcatom)) ALLOCATE( swfcatom( npwx, natomwfc))
|
||||
U_projection = 'ortho-atomic'
|
||||
|
||||
|
|
|
|||
|
|
@ -30,20 +30,20 @@ subroutine wannier_occupancies(occ)
|
|||
|
||||
occ = ZERO
|
||||
current_spin = 1
|
||||
|
||||
DO ik=1, nks
|
||||
IF (lsda) current_spin = isk(ik)
|
||||
CALL get_buffer( pp, nwordwpp, iunwpp, ik)
|
||||
DO i=1, nwan
|
||||
DO j=1,nwan
|
||||
DO k=1, nbnd
|
||||
occ(i,j,current_spin) = occ(i,j,current_spin) + pp(i,k)*conjg(pp(j,k))*wg(k,ik)
|
||||
END DO
|
||||
END DO
|
||||
END DO
|
||||
END DO
|
||||
|
||||
IF(nspin.eq.1) occ=occ*0.5D0
|
||||
|
||||
DO ik=1, nks
|
||||
IF (lsda) current_spin = isk(ik)
|
||||
CALL get_buffer( pp, nwordwpp, iunwpp, ik)
|
||||
DO i=1, nwan
|
||||
DO j=1,nwan
|
||||
DO k=1, nbnd
|
||||
occ(i,j,current_spin) = occ(i,j,current_spin) + pp(i,k)*conjg(pp(j,k))*wg(k,ik)
|
||||
END DO
|
||||
END DO
|
||||
END DO
|
||||
END DO
|
||||
|
||||
IF(nspin.eq.1) occ=occ*0.5D0
|
||||
|
||||
return
|
||||
end subroutine wannier_occupancies
|
||||
|
|
|
|||
|
|
@ -52,7 +52,7 @@ subroutine wannier_proj(ik, wan_func)
|
|||
!Read current wavefunctions
|
||||
evc = ZERO
|
||||
call davcio( evc, nwordwfc, iunwfc, ik, -1 )
|
||||
! Reads ortho-atomic wfc
|
||||
! Reads ortho-atomic wfc
|
||||
! You should prepare data using orthoatwfc.f90
|
||||
swfcatom = ZERO
|
||||
CALL davcio (swfcatom, nwordatwfc, iunsat, ik, -1)
|
||||
|
|
@ -60,43 +60,43 @@ subroutine wannier_proj(ik, wan_func)
|
|||
! generates trial wavefunctions as a summ of ingridients
|
||||
trialwf = ZERO
|
||||
do iwan=1, nwan
|
||||
do j=1,wan_in(iwan,current_spin)%ning
|
||||
do k=1,npwx
|
||||
trialwf(k,iwan) = trialwf(k,iwan) + &
|
||||
dcmplx(wan_in(iwan,current_spin)%ing(j)%c,0.d0) * swfcatom(k,wan_in(iwan,current_spin)%ing(j)%iatomwfc)
|
||||
end do
|
||||
end do
|
||||
do j=1,wan_in(iwan,current_spin)%ning
|
||||
do k=1,npwx
|
||||
trialwf(k,iwan) = trialwf(k,iwan) + &
|
||||
dcmplx(wan_in(iwan,current_spin)%ing(j)%c,0.d0) * swfcatom(k,wan_in(iwan,current_spin)%ing(j)%iatomwfc)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
|
||||
! copmputes <\Psi|\hat S|\phi> for all \Psi and \phi
|
||||
! later one should select only few columns
|
||||
pp = ZERO
|
||||
DO ibnd = 1, nbnd
|
||||
DO iwan = 1, nwan
|
||||
pp (iwan, ibnd) = ZDOTC (npwx, trialwf (1, iwan), 1, evc (1, ibnd), 1)
|
||||
ENDDO
|
||||
DO iwan = 1, nwan
|
||||
pp (iwan, ibnd) = ZDOTC (npwx, trialwf (1, iwan), 1, evc (1, ibnd), 1)
|
||||
ENDDO
|
||||
ENDDO
|
||||
|
||||
|
||||
! And now we should nullify few elements
|
||||
do iwan=1, nwan
|
||||
do ibnd=1, nbnd
|
||||
if(use_energy_int) then
|
||||
if( et(ibnd,ik) < wan_in(iwan,current_spin)%bands_from ) pp(iwan,ibnd) = ZERO
|
||||
if( et(ibnd,ik) > wan_in(iwan,current_spin)%bands_to ) pp(iwan,ibnd) = ZERO
|
||||
else
|
||||
if( (ibnd < INT(wan_in(iwan,current_spin)%bands_from)) &
|
||||
.OR. ( ibnd > INT(wan_in(iwan,current_spin)%bands_to) ) ) then
|
||||
pp(iwan,ibnd) = ZERO
|
||||
! write(stdout,'(5x,"nullify component for band",i3," of wannier",i3)') ibnd,iwan
|
||||
end if
|
||||
end if
|
||||
end do
|
||||
do ibnd=1, nbnd
|
||||
if(use_energy_int) then
|
||||
if( et(ibnd,ik) < wan_in(iwan,current_spin)%bands_from ) pp(iwan,ibnd) = ZERO
|
||||
if( et(ibnd,ik) > wan_in(iwan,current_spin)%bands_to ) pp(iwan,ibnd) = ZERO
|
||||
else
|
||||
if( (ibnd < INT(wan_in(iwan,current_spin)%bands_from)) &
|
||||
.OR. ( ibnd > INT(wan_in(iwan,current_spin)%bands_to) )) then
|
||||
pp(iwan,ibnd) = ZERO
|
||||
! write(stdout,'(5x,"nullify component for band",i3," of wannier",i3)') ibnd,iwan
|
||||
end if
|
||||
end if
|
||||
end do
|
||||
end do
|
||||
|
||||
|
||||
! Orthogonalize pp
|
||||
CALL ortho_wfc(nwan,nbnd,pp,ierr)
|
||||
IF (ierr .EQ. 1) call errore('wannier_proj', 'wrong orthogonalization on k-point', ik)
|
||||
|
||||
|
||||
!And write ortho-pp to file
|
||||
call save_buffer( pp, nwordwpp, iunwpp, ik)
|
||||
|
||||
|
|
|
|||
|
|
@ -1797,8 +1797,8 @@ function continued_fraction(a,b,e,gamma,m, term)
|
|||
aa=0.0
|
||||
bb=0.0
|
||||
do p=1, q
|
||||
aa=aa+a(m-p)
|
||||
bb=bb+b(m-p)
|
||||
aa=aa+a(m-p)
|
||||
bb=bb+b(m-p)
|
||||
enddo
|
||||
aa=aa/q
|
||||
bb=bb/q
|
||||
|
|
@ -2629,8 +2629,8 @@ function green(a,b,e,m, term)
|
|||
aa=0.0
|
||||
bb=0.0
|
||||
do p=1, q
|
||||
aa=aa+a(m-p)
|
||||
bb=bb+b(m-p)
|
||||
aa=aa+a(m-p)
|
||||
bb=bb+b(m-p)
|
||||
enddo
|
||||
aa=aa/q
|
||||
bb=bb/q
|
||||
|
|
|
|||
|
|
@ -62,7 +62,7 @@
|
|||
|
||||
!
|
||||
Magnetic=' Starting magnetic'
|
||||
lsda=.false.
|
||||
lsda=.false.
|
||||
|
||||
!
|
||||
! Read input information
|
||||
|
|
@ -82,27 +82,27 @@
|
|||
y0=0.
|
||||
z0=0.
|
||||
|
||||
close(12)
|
||||
|
||||
close(12)
|
||||
|
||||
do while( .true. )
|
||||
read(5,'(a)',end=110) line
|
||||
if(line(1:22).eq.Magnetic) then
|
||||
read(5,'(a)',end=110) line
|
||||
if(line(1:22).eq.Magnetic) then
|
||||
lsda=.true.
|
||||
print*, line(1:22)
|
||||
goto 110
|
||||
endif
|
||||
enddo
|
||||
110 continue
|
||||
|
||||
print*, 'LSDA====', lsda
|
||||
print*, line(1:22)
|
||||
goto 110
|
||||
endif
|
||||
enddo
|
||||
110 continue
|
||||
|
||||
print*, 'LSDA====', lsda
|
||||
|
||||
rewind(5)
|
||||
|
||||
do while( .true. )
|
||||
rewind(5)
|
||||
|
||||
do while( .true. )
|
||||
read(5,'(a)') line
|
||||
print*, line
|
||||
if(line(1:24).eq.nkpt) then
|
||||
backspace(5)
|
||||
backspace(5)
|
||||
read(line,'(24x,i5)') n_kpoints
|
||||
goto 101
|
||||
endif
|
||||
|
|
@ -113,7 +113,7 @@
|
|||
|
||||
! End of band structure calculation
|
||||
|
||||
do while( .true. )
|
||||
do while( .true. )
|
||||
read(5,'(a)',end=102) line
|
||||
if(line(1:38).eq.Band_Structure) then
|
||||
! print*,line
|
||||
|
|
@ -122,107 +122,107 @@
|
|||
enddo
|
||||
102 continue
|
||||
|
||||
print*, ' lsda==', lsda
|
||||
print*, ' lsda==', lsda
|
||||
|
||||
! Find bands number, nbands
|
||||
!
|
||||
|
||||
read(5,*)
|
||||
read(5,*)
|
||||
read(5,*)
|
||||
|
||||
if(lsda.eqv..true.) then
|
||||
|
||||
read(5,*)
|
||||
read(5,*)
|
||||
read(5,*)
|
||||
|
||||
endif
|
||||
|
||||
nlines=0
|
||||
3 read(5,'(a)',end=4) line
|
||||
print*,'black_line==',line(1:11)
|
||||
if(line(1:11).ne.blank) then
|
||||
nlines=nlines+1
|
||||
goto 3
|
||||
|
||||
else
|
||||
|
||||
goto 4
|
||||
endif
|
||||
4 continue
|
||||
|
||||
print*,'nlines==', nlines
|
||||
|
||||
do k=1,nlines+1
|
||||
backspace(5)
|
||||
enddo
|
||||
|
||||
nbands=0
|
||||
do k=1,nlines
|
||||
read(5,'(a)') line
|
||||
do j=1,8
|
||||
!
|
||||
! 9 is due to output format for e(n,k): 2X, 8f9.4
|
||||
!
|
||||
if(line((3+9*(j-1)):(3+9*j)).ne.blank) then
|
||||
nbands=nbands+1
|
||||
endif
|
||||
enddo
|
||||
|
||||
enddo
|
||||
|
||||
print*, 'nbands==', nbands
|
||||
|
||||
if(lsda.eqv..true.) then ! begin for lsda calculations
|
||||
read(5,*)
|
||||
read(5,*)
|
||||
read(5,*)
|
||||
|
||||
n_kpoints=n_kpoints/2
|
||||
if(lsda.eqv..true.) then
|
||||
|
||||
print*, 'kpoints=', n_kpoints
|
||||
read(5,*)
|
||||
read(5,*)
|
||||
read(5,*)
|
||||
|
||||
allocate (e_up(n_kpoints,nbands))
|
||||
allocate (e_down(n_kpoints,nbands))
|
||||
endif
|
||||
|
||||
nlines=0
|
||||
3 read(5,'(a)',end=4) line
|
||||
print*,'black_line==',line(1:11)
|
||||
if(line(1:11).ne.blank) then
|
||||
nlines=nlines+1
|
||||
goto 3
|
||||
|
||||
else
|
||||
|
||||
goto 4
|
||||
endif
|
||||
4 continue
|
||||
|
||||
print*,'nlines==', nlines
|
||||
|
||||
do k=1,nlines+1
|
||||
backspace(5)
|
||||
enddo
|
||||
|
||||
nbands=0
|
||||
do k=1,nlines
|
||||
read(5,'(a)') line
|
||||
do j=1,8
|
||||
!
|
||||
! 9 is due to output format for e(n,k): 2X, 8f9.4
|
||||
!
|
||||
if(line((3+9*(j-1)):(3+9*j)).ne.blank) then
|
||||
nbands=nbands+1
|
||||
endif
|
||||
enddo
|
||||
|
||||
enddo
|
||||
|
||||
print*, 'nbands==', nbands
|
||||
|
||||
if(lsda.eqv..true.) then ! begin for lsda calculations
|
||||
|
||||
n_kpoints=n_kpoints/2
|
||||
|
||||
print*, 'kpoints=', n_kpoints
|
||||
|
||||
allocate (e_up(n_kpoints,nbands))
|
||||
allocate (e_down(n_kpoints,nbands))
|
||||
|
||||
! back nlines+1 positions (number of eigenvalues lines plus one blank line)
|
||||
!
|
||||
do k=1,nlines+1
|
||||
backspace(5)
|
||||
enddo
|
||||
do k=1,nlines+1
|
||||
backspace(5)
|
||||
enddo
|
||||
!
|
||||
! back 3 positions for k-points
|
||||
!
|
||||
backspace(5)
|
||||
backspace(5)
|
||||
backspace(5)
|
||||
backspace(5)
|
||||
backspace(5)
|
||||
backspace(5)
|
||||
|
||||
! Now ready to start
|
||||
!
|
||||
read(5,*)
|
||||
read(5,*)
|
||||
!
|
||||
! Reading spin-up energies
|
||||
!
|
||||
do k1=1,n_kpoints
|
||||
!
|
||||
do k1=1,n_kpoints
|
||||
|
||||
read(5,*)
|
||||
read(5,*)
|
||||
read(5,*)
|
||||
read(5,*)
|
||||
|
||||
read(5,*,end=99) (e_up(k1,j),j=1,nbands)
|
||||
enddo
|
||||
read(5,*,end=99) (e_up(k1,j),j=1,nbands)
|
||||
enddo
|
||||
99 continue
|
||||
|
||||
read(5,*)
|
||||
read(5,*)
|
||||
read(5,*)
|
||||
read(5,*)
|
||||
read(5,*)
|
||||
read(5,*)
|
||||
|
||||
! Reading Spin-down bands
|
||||
|
||||
do k1=1,n_kpoints
|
||||
do k1=1,n_kpoints
|
||||
read(5,*)
|
||||
read(5,*)
|
||||
read(5,*)
|
||||
read(5,*,end=96) (e_down(k1,j),j=1,nbands)
|
||||
enddo
|
||||
read(5,*)
|
||||
read(5,*)
|
||||
read(5,*,end=96) (e_down(k1,j),j=1,nbands)
|
||||
enddo
|
||||
96 continue
|
||||
open(11,file='Bands_FS_up.bxsf',form='formatted')
|
||||
|
||||
|
|
@ -296,33 +296,33 @@
|
|||
|
||||
close(11)
|
||||
|
||||
deallocate (e_up)
|
||||
deallocate (e_down)
|
||||
deallocate (e_up)
|
||||
deallocate (e_down)
|
||||
|
||||
print*,'LSDA FINISHED!!!!'
|
||||
print*,'LSDA FINISHED!!!!'
|
||||
|
||||
!!! end for LSDA calculations
|
||||
|
||||
else ! end of lsda section
|
||||
!
|
||||
allocate (e_up(n_kpoints,nbands))
|
||||
else ! end of lsda section
|
||||
!
|
||||
allocate (e_up(n_kpoints,nbands))
|
||||
! back nlines+1 positions (number of eigenvalues lines plus one blank line)
|
||||
do k=1,nlines+1
|
||||
backspace(5)
|
||||
enddo
|
||||
|
||||
print*, 'n_kpoints===', n_kpoints
|
||||
print*, 'n_kpoints===', n_kpoints
|
||||
|
||||
backspace(5)
|
||||
backspace(5)
|
||||
backspace(5)
|
||||
|
||||
|
||||
backspace(5)
|
||||
backspace(5)
|
||||
backspace(5)
|
||||
|
||||
|
||||
do k1=1,n_kpoints
|
||||
|
||||
read(5,*)
|
||||
read(5,*)
|
||||
read(5,*)
|
||||
read(5,*)
|
||||
read(5,*)
|
||||
read(5,*)
|
||||
|
||||
read(5,*,end=98) (e_up(k1,j),j=1,nbands)
|
||||
! read(5,'(2x,8f9.4)',end=98) (e_up(k1,j),j=1,nbands)
|
||||
|
|
@ -365,10 +365,10 @@
|
|||
|
||||
close(11)
|
||||
|
||||
deallocate (e_up)
|
||||
deallocate (e_up)
|
||||
|
||||
endif
|
||||
|
||||
endif
|
||||
|
||||
stop
|
||||
end
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue