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

269 lines
8.1 KiB
Fortran
Raw Blame History

! Copyright (C) 2006-2008 Dmitry Korotin dmitry@korotin.name
! 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 .
!
#define ZERO (0.d0,0.d0)
#define ONE (1.d0,0.d0)
!-----------------------------------------------------------------------
PROGRAM wannier_plot
!-----------------------------------------------------------------------
!
! This program plots charge density of selected wannier function in
! IBM Data Explorer format
USE io_global, ONLY: stdout, ionode, ionode_id
USE kinds, ONLY : DP
USE io_files, ONLY : prefix, tmp_dir, trimcheck
USE wannier_new, ONLY : nwan, plot_wan_num, plot_wan_spin
USE mp, ONLY : mp_bcast
USE io_global, ONLY : ionode, stdout
USE mp_global, ONLY : mp_startup
USE environment, ONLY : environment_start
IMPLICIT NONE
CHARACTER(len=256) :: outdir
INTEGER :: ios,nc(3),n0(3)
NAMELIST /inputpp/ outdir, prefix, nwan, plot_wan_num, plot_wan_spin, nc, n0
!
! initialise environment
!
#ifdef __PARA
CALL mp_startup ( )
#endif
CALL environment_start ( 'WANNIER_PLOT' )
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)
ENDIF
!
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()
CALL stop_pp
CALL wannier_clean()
END PROGRAM wannier_plot
SUBROUTINE plot_wannier(nc,n0)
USE io_global, ONLY: stdout, ionode, ionode_id
USE io_files
USE kinds, ONLY: DP
USE wannier_new, ONLY: nwan,plot_wan_num,plot_wan_spin
USE klist, ONLY: nks, xk, wk
USE lsda_mod, ONLY: isk, current_spin, lsda, nspin
USE wvfct, ONLY: nbnd, npwx, igk, npw, g2kin
USE constants, ONLY : rytoev , tpi
USE buffers
USE symm_base, ONLY : nsym
USE ldaU, ONLY : swfcatom
USE fft_base, ONLY: dffts
USE fft_interfaces, ONLY : invfft
USE gvect
USE gsmooth
USE cell_base
USE ions_base, ONLY : nat, ntyp=>nsp, ityp, tau, atm, zv
USE vlocal, ONLY : strf
IMPLICIT NONE
INTEGER, INTENT(in) :: nc(3), n0(3)
INTEGER :: i,j, k, ik, n, ir, ios, n1, n2, n3,i1,j1,k1
COMPLEX(DP) :: phase
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>1) THEN
CALL errore('wannier_cmptn','k-points set is in the irreducible brillouin zone - not implemented',1)
ENDIF
ALLOCATE(wan_func(npwx,nwan))
ALLOCATE(psic(nrxxs))
ALLOCATE(psic3(nrx1s,nrx2s,nrx3s))
ALLOCATE(psic3_0(nrx1s,nrx2s,nrx3s))
ALLOCATE(psic_sum(nc(1)*nrx1s,nc(2)*nrx2s,nc(3)*nrx3s,nspin))
ALLOCATE(rho(nc(1)*nrx1s,nc(2)*nrx2s,nc(3)*nrx3s,nspin))
CALL init_us_1
CALL init_at_1
CALL struc_fact (nat, tau, ntyp, ityp, ngm, g, bg, nr1, nr2, nr3, &
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)
ENDDO
CALL invfft ('Wave', psic, dffts)
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)
ENDDO
ENDDO
ENDDO
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 = cos(tpi*(xk(1,ik)*r(1)+xk(2,ik)*r(2)+xk(3,ik)*r(3))) + &
(0.d0,1.d0)*sin(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)+ &
cmplx(wk(ik),0.d0,kind=DP)*psic3_0(i1,j1,k1)*phase
ENDDO
ENDDO
ENDDO
ENDDO !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
ENDDO
ENDDO
ENDDO
ENDDO
OPEN (10, file='wannier.plot.dx', err = 100, iostat = 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(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)
WRITE(10,'(a38,3i6)') 'object 2 class gridconnections counts ', nrx3s*nc(3), nrx2s*nc(2), nrx1s*nc(1)
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))
ENDDO
ENDDO
ENDDO
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)
DEALLOCATE(psic)
DEALLOCATE(psic3)
DEALLOCATE(psic3_0)
DEALLOCATE(psic_sum)
DEALLOCATE(rho)
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'
DO na = 1, nat
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'
DO na = 1, nat
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)
END SUBROUTINE plot_atoms
Reference in New Issue View Git Blame Copy Permalink