2006-06-29 19:02:00 +08:00
|
|
|
|
2010-06-14 21:45:31 +08:00
|
|
|
! Copyright (C) 2004-2009 Andrea Benassi and Quantum ESPRESSO group
|
|
|
|
! This file is distributed under the terms of the
|
|
|
|
! GNU General Public License. See the file `License'
|
|
|
|
! in the root directory of the present distribution,
|
|
|
|
! or http://www.gnu.org/copyleft/gpl.txt .
|
2006-06-29 19:02:00 +08:00
|
|
|
|
2007-02-06 01:01:54 +08:00
|
|
|
!------------------------------
|
|
|
|
MODULE grid_module
|
|
|
|
!------------------------------
|
|
|
|
USE kinds, ONLY : DP
|
|
|
|
IMPLICIT NONE
|
|
|
|
PRIVATE
|
|
|
|
|
|
|
|
!
|
2010-06-14 21:45:31 +08:00
|
|
|
! general purpose vars
|
2007-02-06 01:01:54 +08:00
|
|
|
!
|
|
|
|
REAL(DP), ALLOCATABLE :: focc(:,:), wgrid(:)
|
2010-06-14 21:45:31 +08:00
|
|
|
REAL(DP) :: alpha
|
2007-02-06 01:01:54 +08:00
|
|
|
!
|
|
|
|
!
|
|
|
|
PUBLIC :: grid_build, grid_destroy
|
|
|
|
PUBLIC :: focc, wgrid, alpha
|
|
|
|
|
|
|
|
CONTAINS
|
|
|
|
|
2007-02-27 18:00:57 +08:00
|
|
|
!---------------------------------------------
|
|
|
|
SUBROUTINE grid_build(nw, wmax, wmin)
|
|
|
|
!-------------------------------------------
|
2007-02-06 01:01:54 +08:00
|
|
|
!
|
2007-02-27 18:00:57 +08:00
|
|
|
USE kinds, ONLY : DP
|
|
|
|
USE wvfct, ONLY : nbnd, wg
|
|
|
|
USE klist, ONLY : nks, wk, nelec
|
|
|
|
USE lsda_mod, ONLY : nspin
|
|
|
|
USE uspp, ONLY : okvan
|
2007-02-06 01:01:54 +08:00
|
|
|
!
|
|
|
|
IMPLICIT NONE
|
|
|
|
!
|
|
|
|
! input vars
|
2010-06-14 21:45:31 +08:00
|
|
|
INTEGER, INTENT(in) :: nw
|
|
|
|
REAL(DP), INTENT(in) :: wmax ,wmin
|
2007-02-06 01:01:54 +08:00
|
|
|
!
|
|
|
|
! local vars
|
2007-02-27 18:00:57 +08:00
|
|
|
INTEGER :: iw,ik,i,ierr
|
2010-06-14 21:45:31 +08:00
|
|
|
|
2007-02-06 01:01:54 +08:00
|
|
|
!
|
|
|
|
! check on the number of bands: we need to include empty bands in order to allow
|
|
|
|
! to write the transitions
|
|
|
|
!
|
|
|
|
IF ( REAL(nbnd, DP) <= nelec / 2.0_DP ) CALL errore('epsilon', 'ban band number', 1)
|
|
|
|
|
|
|
|
!
|
|
|
|
! spin is not implemented
|
|
|
|
!
|
2007-09-04 16:22:35 +08:00
|
|
|
IF( nspin > 2 ) CALL errore('grid_build','Non collinear spin calculation not implemented',1)
|
2007-02-06 01:01:54 +08:00
|
|
|
|
|
|
|
!
|
|
|
|
! USPP are not implemented (dipole matrix elements are not trivial at all)
|
|
|
|
!
|
2007-02-09 17:23:17 +08:00
|
|
|
IF ( okvan ) CALL errore('grid_build','USPP are not implemented',1)
|
2007-02-06 01:01:54 +08:00
|
|
|
|
2007-02-09 17:23:17 +08:00
|
|
|
ALLOCATE ( focc( nbnd, nks), STAT=ierr )
|
2010-06-14 21:45:31 +08:00
|
|
|
IF (ierr/=0) CALL errore('grid_build','allocating focc', abs(ierr))
|
2007-02-06 01:01:54 +08:00
|
|
|
!
|
2007-02-09 17:23:17 +08:00
|
|
|
ALLOCATE( wgrid( nw ), STAT=ierr )
|
2010-06-14 21:45:31 +08:00
|
|
|
IF (ierr/=0) CALL errore('grid_build','allocating wgrid', abs(ierr))
|
2007-02-06 01:01:54 +08:00
|
|
|
|
2007-02-09 17:23:17 +08:00
|
|
|
!
|
2010-06-14 21:45:31 +08:00
|
|
|
! check on k point weights, no symmetry operations are allowed
|
2007-02-09 17:23:17 +08:00
|
|
|
!
|
|
|
|
DO ik = 2, nks
|
|
|
|
!
|
2010-06-14 21:45:31 +08:00
|
|
|
IF ( abs( wk(1) - wk(ik) ) > 1.0d-8 ) &
|
2007-02-09 17:23:17 +08:00
|
|
|
CALL errore('grid_build','non unifrom kpt grid', ik )
|
|
|
|
!
|
|
|
|
ENDDO
|
2007-02-06 01:01:54 +08:00
|
|
|
!
|
2010-06-14 21:45:31 +08:00
|
|
|
! occupation numbers, to be normalized differently
|
2007-09-04 16:22:35 +08:00
|
|
|
! whether we are spin resolved or not
|
|
|
|
!
|
|
|
|
IF(nspin==1) THEN
|
|
|
|
DO ik = 1,nks
|
|
|
|
DO i = 1,nbnd
|
|
|
|
focc(i,ik)= wg(i, ik ) * 2.0_DP / wk( ik )
|
|
|
|
ENDDO
|
|
|
|
ENDDO
|
2010-06-14 21:45:31 +08:00
|
|
|
ELSEIF(nspin==2) THEN
|
2007-09-04 16:22:35 +08:00
|
|
|
DO ik = 1,nks
|
|
|
|
DO i = 1,nbnd
|
|
|
|
focc(i,ik)= wg(i, ik ) * 1.0_DP / wk( ik )
|
|
|
|
ENDDO
|
|
|
|
ENDDO
|
|
|
|
ENDIF
|
2007-02-06 01:01:54 +08:00
|
|
|
!
|
|
|
|
! set the energy grid
|
|
|
|
!
|
|
|
|
alpha = (wmax - wmin) / REAL(nw, DP)
|
|
|
|
!
|
2010-06-14 21:45:31 +08:00
|
|
|
DO iw = 1, nw
|
2007-02-06 01:01:54 +08:00
|
|
|
wgrid(iw) = wmin + iw * alpha
|
|
|
|
ENDDO
|
|
|
|
!
|
|
|
|
END SUBROUTINE grid_build
|
|
|
|
!
|
|
|
|
!
|
|
|
|
!----------------------------------
|
|
|
|
SUBROUTINE grid_destroy
|
|
|
|
!----------------------------------
|
|
|
|
IMPLICIT NONE
|
|
|
|
INTEGER :: ierr
|
|
|
|
!
|
2010-06-14 21:45:31 +08:00
|
|
|
IF ( allocated( focc) ) THEN
|
2007-02-09 17:23:17 +08:00
|
|
|
!
|
|
|
|
DEALLOCATE ( focc, wgrid, STAT=ierr)
|
2010-06-14 21:45:31 +08:00
|
|
|
CALL errore('grid_destroy','deallocating grid stuff',abs(ierr))
|
2007-02-09 17:23:17 +08:00
|
|
|
!
|
|
|
|
ENDIF
|
2007-02-06 01:01:54 +08:00
|
|
|
!
|
|
|
|
END SUBROUTINE grid_destroy
|
|
|
|
|
|
|
|
END MODULE grid_module
|
|
|
|
|
|
|
|
|
2006-06-29 19:02:00 +08:00
|
|
|
!------------------------------
|
|
|
|
PROGRAM epsilon
|
2006-11-23 00:09:55 +08:00
|
|
|
!------------------------------
|
2006-06-29 19:02:00 +08:00
|
|
|
!
|
|
|
|
! Compute the complex macroscopic dielectric function,
|
|
|
|
! at the RPA level, neglecting local field effects.
|
|
|
|
! Eps is computed both on the real or immaginary axis
|
|
|
|
!
|
2007-02-06 01:01:54 +08:00
|
|
|
! Authors: Andrea Benassi, Andrea Ferretti, Carlo Cavazzoni
|
2006-06-29 19:02:00 +08:00
|
|
|
!
|
|
|
|
! NOTE: Part of the basic implementation is taken from pw2gw.f90;
|
|
|
|
!
|
|
|
|
!
|
2007-02-06 01:01:54 +08:00
|
|
|
USE kinds, ONLY : DP
|
|
|
|
USE io_global, ONLY : stdout, ionode, ionode_id
|
|
|
|
USE mp, ONLY : mp_bcast
|
|
|
|
USE iotk_module
|
|
|
|
USE xml_io_base
|
2009-11-08 18:11:24 +08:00
|
|
|
USE io_files, ONLY : tmp_dir, prefix, outdir, trimcheck
|
2007-02-06 01:01:54 +08:00
|
|
|
USE constants, ONLY : RYTOEV
|
|
|
|
USE ener, ONLY : ef
|
2010-06-14 21:45:31 +08:00
|
|
|
USE klist, ONLY : lgauss
|
2007-02-06 01:01:54 +08:00
|
|
|
USE ktetra, ONLY : ltetra
|
2007-09-04 16:22:35 +08:00
|
|
|
USE wvfct, ONLY : nbnd
|
|
|
|
USE lsda_mod, ONLY : nspin
|
2009-11-08 18:11:24 +08:00
|
|
|
USE mp_global, ONLY : mp_startup
|
2009-11-10 00:07:19 +08:00
|
|
|
USE environment, ONLY : environment_start
|
2010-06-14 21:45:31 +08:00
|
|
|
!
|
2006-06-29 19:02:00 +08:00
|
|
|
IMPLICIT NONE
|
|
|
|
!
|
|
|
|
! input variables
|
|
|
|
!
|
2007-09-04 16:22:35 +08:00
|
|
|
INTEGER :: nw,nbndmin,nbndmax
|
2007-02-06 01:01:54 +08:00
|
|
|
REAL(DP) :: intersmear,intrasmear,wmax,wmin,shift
|
2006-06-29 19:02:00 +08:00
|
|
|
CHARACTER(10) :: calculation,smeartype
|
2007-02-06 01:01:54 +08:00
|
|
|
LOGICAL :: metalcalc
|
2006-06-29 19:02:00 +08:00
|
|
|
!
|
|
|
|
NAMELIST / inputpp / prefix, outdir, calculation
|
2010-06-14 21:45:31 +08:00
|
|
|
NAMELIST / energy_grid / smeartype,intersmear,intrasmear,wmax,wmin,nbndmin,nbndmax,nw,shift
|
2006-06-29 19:02:00 +08:00
|
|
|
!
|
|
|
|
! local variables
|
|
|
|
!
|
|
|
|
INTEGER :: ios
|
|
|
|
|
2010-06-14 21:45:31 +08:00
|
|
|
!---------------------------------------------
|
2006-06-29 19:02:00 +08:00
|
|
|
! program body
|
2010-06-14 21:45:31 +08:00
|
|
|
!---------------------------------------------
|
2006-06-29 19:02:00 +08:00
|
|
|
!
|
2009-11-08 18:11:24 +08:00
|
|
|
! initialise environment
|
2007-02-06 01:01:54 +08:00
|
|
|
!
|
2009-11-08 18:11:24 +08:00
|
|
|
#ifdef __PARA
|
2009-11-10 00:07:19 +08:00
|
|
|
CALL mp_startup ( )
|
2009-11-08 18:11:24 +08:00
|
|
|
#endif
|
|
|
|
CALL environment_start ( 'epsilon' )
|
2006-06-29 19:02:00 +08:00
|
|
|
!
|
2010-06-14 21:45:31 +08:00
|
|
|
! Set default values for variables in namelist
|
2006-06-29 19:02:00 +08:00
|
|
|
!
|
|
|
|
calculation = 'eps'
|
|
|
|
prefix = 'pwscf'
|
|
|
|
shift = 0.0d0
|
2006-11-23 00:09:55 +08:00
|
|
|
outdir = './'
|
2007-02-09 17:23:17 +08:00
|
|
|
intersmear = 0.136
|
2007-02-06 01:01:54 +08:00
|
|
|
wmin = 0.0d0
|
2006-06-29 19:02:00 +08:00
|
|
|
wmax = 30.0d0
|
2007-09-04 16:22:35 +08:00
|
|
|
nbndmin = 1
|
2010-06-14 21:45:31 +08:00
|
|
|
nbndmax = 0
|
2006-06-29 19:02:00 +08:00
|
|
|
nw = 600
|
2007-02-06 01:01:54 +08:00
|
|
|
smeartype = 'gauss'
|
2010-06-14 21:45:31 +08:00
|
|
|
intrasmear = 0.0d0
|
|
|
|
metalcalc = .false.
|
|
|
|
|
2006-06-29 19:02:00 +08:00
|
|
|
!
|
2010-06-14 21:45:31 +08:00
|
|
|
! this routine allows the user to redirect the input using -input
|
|
|
|
! instead of <
|
2006-06-29 19:02:00 +08:00
|
|
|
!
|
|
|
|
CALL input_from_file( )
|
2007-02-06 01:01:54 +08:00
|
|
|
|
|
|
|
!
|
|
|
|
! read input file
|
|
|
|
!
|
|
|
|
IF (ionode) WRITE( stdout, "( 2/, 5x, 'Reading input file...' ) " )
|
2010-06-14 21:45:31 +08:00
|
|
|
ios = 0
|
2007-10-16 00:33:28 +08:00
|
|
|
!
|
|
|
|
IF ( ionode ) READ (5, inputpp, IOSTAT=ios)
|
|
|
|
!
|
2010-06-14 21:45:31 +08:00
|
|
|
CALL mp_bcast ( ios, ionode_id )
|
|
|
|
IF (ios/=0) CALL errore('epsilon', 'reading namelist INPUTPP', abs(ios))
|
2007-10-16 00:33:28 +08:00
|
|
|
!
|
2010-06-14 21:45:31 +08:00
|
|
|
IF ( ionode ) THEN
|
2006-06-29 19:02:00 +08:00
|
|
|
!
|
|
|
|
READ (5, energy_grid, IOSTAT=ios)
|
|
|
|
!
|
2007-02-06 01:01:54 +08:00
|
|
|
tmp_dir = trimcheck(outdir)
|
2007-02-27 18:00:57 +08:00
|
|
|
!
|
2006-06-29 19:02:00 +08:00
|
|
|
ENDIF
|
2007-10-16 00:33:28 +08:00
|
|
|
!
|
2010-06-14 21:45:31 +08:00
|
|
|
CALL mp_bcast ( ios, ionode_id )
|
|
|
|
IF (ios/=0) CALL errore('epsilon', 'reading namelist ENERGY_GRID', abs(ios))
|
|
|
|
!
|
|
|
|
! ... Broadcast variables
|
2006-06-29 19:02:00 +08:00
|
|
|
!
|
2007-02-06 01:01:54 +08:00
|
|
|
IF (ionode) WRITE( stdout, "( 5x, 'Broadcasting variables...' ) " )
|
|
|
|
|
2010-06-14 21:45:31 +08:00
|
|
|
CALL mp_bcast( smeartype, ionode_id )
|
2006-06-29 19:02:00 +08:00
|
|
|
CALL mp_bcast( calculation, ionode_id )
|
2010-06-14 21:45:31 +08:00
|
|
|
CALL mp_bcast( prefix, ionode_id )
|
|
|
|
CALL mp_bcast( tmp_dir, ionode_id )
|
|
|
|
CALL mp_bcast( shift, ionode_id )
|
|
|
|
CALL mp_bcast( outdir, ionode_id )
|
2007-02-06 01:01:54 +08:00
|
|
|
CALL mp_bcast( intrasmear, ionode_id )
|
2010-06-14 21:45:31 +08:00
|
|
|
CALL mp_bcast( intersmear, ionode_id)
|
|
|
|
CALL mp_bcast( wmax, ionode_id )
|
|
|
|
CALL mp_bcast( wmin, ionode_id )
|
|
|
|
CALL mp_bcast( nw, ionode_id )
|
|
|
|
CALL mp_bcast( nbndmin, ionode_id )
|
|
|
|
CALL mp_bcast( nbndmax, ionode_id )
|
2007-02-06 01:01:54 +08:00
|
|
|
|
2006-06-29 19:02:00 +08:00
|
|
|
!
|
2010-06-14 21:45:31 +08:00
|
|
|
! read PW simulation parameters from prefix.save/data-file.xml
|
2006-06-29 19:02:00 +08:00
|
|
|
!
|
2007-02-06 01:01:54 +08:00
|
|
|
IF (ionode) WRITE( stdout, "( 5x, 'Reading PW restart file...' ) " )
|
2010-06-14 21:45:31 +08:00
|
|
|
|
2006-06-29 19:02:00 +08:00
|
|
|
CALL read_file
|
|
|
|
CALL openfil_pp
|
|
|
|
|
|
|
|
!
|
2007-02-06 01:01:54 +08:00
|
|
|
! few conversions
|
2006-06-29 19:02:00 +08:00
|
|
|
!
|
2010-06-14 21:45:31 +08:00
|
|
|
|
2007-02-09 17:23:17 +08:00
|
|
|
IF (ionode) WRITE(stdout,"(2/, 5x, 'Fermi energy [eV] is: ',f8.5)") ef *RYTOEV
|
2006-06-29 19:02:00 +08:00
|
|
|
|
2010-06-14 21:45:31 +08:00
|
|
|
IF (lgauss .or. ltetra) THEN
|
|
|
|
metalcalc=.true.
|
2007-02-06 01:01:54 +08:00
|
|
|
IF (ionode) WRITE( stdout, "( 5x, 'The system is a metal...' ) " )
|
|
|
|
ELSE
|
|
|
|
IF (ionode) WRITE( stdout, "( 5x, 'The system is a dielectric...' ) " )
|
|
|
|
ENDIF
|
2006-06-29 19:02:00 +08:00
|
|
|
|
2007-09-04 16:22:35 +08:00
|
|
|
IF (nbndmax == 0) nbndmax = nbnd
|
|
|
|
|
2006-06-29 19:02:00 +08:00
|
|
|
!
|
2007-02-06 01:01:54 +08:00
|
|
|
! ... run the specific pp calculation
|
2006-06-29 19:02:00 +08:00
|
|
|
!
|
2010-06-14 21:45:31 +08:00
|
|
|
IF (ionode) WRITE(stdout,"(/, 5x, 'Performing ',a,' calculation...')") trim(calculation)
|
2006-06-29 19:02:00 +08:00
|
|
|
|
2007-02-06 01:01:54 +08:00
|
|
|
CALL start_clock( 'calculation' )
|
2006-06-29 19:02:00 +08:00
|
|
|
!
|
2010-06-14 21:45:31 +08:00
|
|
|
SELECT CASE ( trim(calculation) )
|
2006-06-29 19:02:00 +08:00
|
|
|
!
|
2007-02-06 01:01:54 +08:00
|
|
|
CASE ( 'eps' )
|
|
|
|
!
|
2007-09-04 16:22:35 +08:00
|
|
|
CALL eps_calc ( intersmear,intrasmear,nw,wmax,wmin,nbndmin,nbndmax,shift,metalcalc,nspin )
|
2007-02-06 01:01:54 +08:00
|
|
|
!
|
|
|
|
CASE ( 'jdos' )
|
|
|
|
!
|
2007-09-04 16:22:35 +08:00
|
|
|
CALL jdos_calc ( smeartype,intersmear,nw,wmax,wmin,nbndmin,nbndmax,shift,nspin )
|
2007-02-06 01:01:54 +08:00
|
|
|
!
|
|
|
|
CASE ( 'offdiag' )
|
|
|
|
!
|
2007-09-04 16:22:35 +08:00
|
|
|
CALL offdiag_calc ( intersmear,intrasmear,nw,wmax,wmin,nbndmin,nbndmax,shift,metalcalc,nspin )
|
2007-02-06 01:01:54 +08:00
|
|
|
!
|
2007-02-27 18:00:57 +08:00
|
|
|
CASE ( 'occ' )
|
|
|
|
!
|
|
|
|
CALL occ_calc ()
|
|
|
|
!
|
2007-02-06 01:01:54 +08:00
|
|
|
CASE DEFAULT
|
|
|
|
!
|
2010-06-14 21:45:31 +08:00
|
|
|
CALL errore('epsilon','invalid CALCULATION = '//trim(calculation),1)
|
2007-02-06 01:01:54 +08:00
|
|
|
!
|
|
|
|
END SELECT
|
2006-06-29 19:02:00 +08:00
|
|
|
!
|
2007-02-06 01:01:54 +08:00
|
|
|
CALL stop_clock( 'calculation' )
|
2010-06-14 21:45:31 +08:00
|
|
|
|
2006-06-29 19:02:00 +08:00
|
|
|
!
|
2007-02-06 01:01:54 +08:00
|
|
|
! few info about timing
|
2006-06-29 19:02:00 +08:00
|
|
|
!
|
2007-02-06 01:01:54 +08:00
|
|
|
CALL stop_clock( 'epsilon' )
|
2006-06-29 19:02:00 +08:00
|
|
|
!
|
2007-02-06 01:01:54 +08:00
|
|
|
IF ( ionode ) WRITE( stdout , "(/)" )
|
2006-06-29 19:02:00 +08:00
|
|
|
!
|
2007-02-06 01:01:54 +08:00
|
|
|
CALL print_clock( 'epsilon' )
|
|
|
|
CALL print_clock( 'calculation' )
|
|
|
|
CALL print_clock( 'dipole_calc' )
|
2006-06-29 19:02:00 +08:00
|
|
|
!
|
2007-02-06 01:01:54 +08:00
|
|
|
IF ( ionode ) WRITE( stdout, * )
|
2006-06-29 19:02:00 +08:00
|
|
|
|
|
|
|
!
|
|
|
|
!
|
2007-02-06 01:01:54 +08:00
|
|
|
CALL stop_pp ()
|
2006-06-29 19:02:00 +08:00
|
|
|
|
2010-06-14 21:45:31 +08:00
|
|
|
END PROGRAM epsilon
|
2006-06-29 19:02:00 +08:00
|
|
|
|
|
|
|
|
2007-02-06 01:01:54 +08:00
|
|
|
!-----------------------------------------------------------------------------
|
2007-09-04 16:22:35 +08:00
|
|
|
SUBROUTINE eps_calc ( intersmear,intrasmear, nw, wmax, wmin, nbndmin, nbndmax, shift, &
|
|
|
|
metalcalc , nspin)
|
2007-02-06 01:01:54 +08:00
|
|
|
!-----------------------------------------------------------------------------
|
2006-06-29 19:02:00 +08:00
|
|
|
!
|
2007-02-06 01:01:54 +08:00
|
|
|
USE kinds, ONLY : DP
|
|
|
|
USE constants, ONLY : PI, RYTOEV
|
|
|
|
USE cell_base, ONLY : tpiba2, omega
|
2007-02-27 18:00:57 +08:00
|
|
|
USE wvfct, ONLY : nbnd, et
|
2007-02-06 01:01:54 +08:00
|
|
|
USE ener, ONLY : efermi => ef
|
2007-02-27 18:00:57 +08:00
|
|
|
USE klist, ONLY : nks, nkstot, degauss
|
|
|
|
USE io_global, ONLY : ionode, stdout
|
2007-02-09 17:23:17 +08:00
|
|
|
!
|
2010-06-14 21:45:31 +08:00
|
|
|
USE grid_module, ONLY : alpha, focc, wgrid, grid_build, grid_destroy
|
2008-01-24 01:10:45 +08:00
|
|
|
USE mp_global, ONLY : inter_pool_comm, intra_pool_comm
|
|
|
|
USE mp, ONLY : mp_sum
|
2010-06-14 21:45:31 +08:00
|
|
|
!
|
2007-02-06 01:01:54 +08:00
|
|
|
IMPLICIT NONE
|
2006-06-29 19:02:00 +08:00
|
|
|
|
|
|
|
!
|
2007-02-06 01:01:54 +08:00
|
|
|
! input variables
|
2006-06-29 19:02:00 +08:00
|
|
|
!
|
2010-06-14 21:45:31 +08:00
|
|
|
INTEGER, INTENT(in) :: nw,nbndmin,nbndmax,nspin
|
|
|
|
REAL(DP), INTENT(in) :: wmax, wmin, intersmear,intrasmear, shift
|
|
|
|
LOGICAL, INTENT(in) :: metalcalc
|
2006-06-29 19:02:00 +08:00
|
|
|
!
|
2007-02-06 01:01:54 +08:00
|
|
|
! local variables
|
2006-06-29 19:02:00 +08:00
|
|
|
!
|
2010-06-14 21:45:31 +08:00
|
|
|
INTEGER :: i, ik, iband1, iband2,is
|
2007-02-06 01:01:54 +08:00
|
|
|
INTEGER :: iw, iwp, ierr
|
|
|
|
REAL(DP) :: etrans, const, w, renorm(3)
|
|
|
|
!
|
2007-09-04 16:22:35 +08:00
|
|
|
REAL(DP), ALLOCATABLE :: epsr(:,:), epsi(:,:), epsrc(:,:,:), epsic(:,:,:)
|
|
|
|
REAL(DP), ALLOCATABLE :: ieps(:,:), eels(:,:), iepsc(:,:,:), eelsc(:,:,:)
|
2007-02-06 01:01:54 +08:00
|
|
|
REAL(DP), ALLOCATABLE :: dipole(:,:,:)
|
|
|
|
COMPLEX(DP),ALLOCATABLE :: dipole_aux(:,:,:)
|
2006-06-29 19:02:00 +08:00
|
|
|
!
|
2007-02-06 01:01:54 +08:00
|
|
|
!--------------------------
|
|
|
|
! main routine body
|
|
|
|
!--------------------------
|
2006-06-29 19:02:00 +08:00
|
|
|
!
|
|
|
|
!
|
2007-02-06 01:01:54 +08:00
|
|
|
! perform some consistency checks, calculate occupation numbers and setup w grid
|
|
|
|
!
|
2007-09-04 16:22:35 +08:00
|
|
|
CALL grid_build(nw, wmax, wmin)
|
2010-06-14 21:45:31 +08:00
|
|
|
!
|
|
|
|
! allocate main spectral and auxiliary quantities
|
|
|
|
!
|
2007-02-06 01:01:54 +08:00
|
|
|
ALLOCATE( dipole(3, nbnd, nbnd), STAT=ierr )
|
2010-06-14 21:45:31 +08:00
|
|
|
IF (ierr/=0) CALL errore('epsilon','allocating dipole', abs(ierr) )
|
2007-02-06 01:01:54 +08:00
|
|
|
!
|
|
|
|
ALLOCATE( dipole_aux(3, nbnd, nbnd), STAT=ierr )
|
2010-06-14 21:45:31 +08:00
|
|
|
IF (ierr/=0) CALL errore('epsilon','allocating dipole_aux', abs(ierr) )
|
2007-09-04 16:22:35 +08:00
|
|
|
|
|
|
|
!
|
|
|
|
! spin unresolved calculation
|
|
|
|
!
|
2010-06-14 21:45:31 +08:00
|
|
|
IF (nspin == 1) THEN
|
2007-02-06 01:01:54 +08:00
|
|
|
!
|
|
|
|
ALLOCATE( epsr( 3, nw), epsi( 3, nw), eels( 3, nw), ieps(3,nw ), STAT=ierr )
|
2010-06-14 21:45:31 +08:00
|
|
|
IF (ierr/=0) CALL errore('epsilon','allocating eps', abs(ierr))
|
2007-02-06 01:01:54 +08:00
|
|
|
|
|
|
|
!
|
|
|
|
! initialize response functions
|
|
|
|
!
|
|
|
|
epsr(:,:) = 0.0_DP
|
|
|
|
epsi(:,:) = 0.0_DP
|
|
|
|
ieps(:,:) = 0.0_DP
|
2006-06-29 19:02:00 +08:00
|
|
|
|
2007-02-06 01:01:54 +08:00
|
|
|
!
|
|
|
|
! main kpt loop
|
|
|
|
!
|
|
|
|
kpt_loop: &
|
2007-02-09 17:23:17 +08:00
|
|
|
DO ik = 1, nks
|
2006-06-29 19:02:00 +08:00
|
|
|
!
|
2007-02-06 01:01:54 +08:00
|
|
|
! For every single k-point: order k+G for
|
|
|
|
! read and distribute wavefunctions
|
2010-06-14 21:45:31 +08:00
|
|
|
! compute dipole matrix 3 x nbnd x nbnd parallel over g
|
2007-02-06 01:01:54 +08:00
|
|
|
! recover g parallelism getting the total dipole matrix
|
2010-06-14 21:45:31 +08:00
|
|
|
!
|
2007-09-04 16:22:35 +08:00
|
|
|
CALL dipole_calc( ik, dipole_aux, metalcalc , nbndmin, nbndmax)
|
2006-06-29 19:02:00 +08:00
|
|
|
!
|
2010-06-14 21:45:31 +08:00
|
|
|
dipole(:,:,:)= tpiba2 * REAL( dipole_aux(:,:,:) * conjg(dipole_aux(:,:,:)), DP )
|
|
|
|
|
2007-02-27 18:00:57 +08:00
|
|
|
!
|
2010-06-14 21:45:31 +08:00
|
|
|
! Calculation of real and immaginary parts
|
2006-06-29 19:02:00 +08:00
|
|
|
! of the macroscopic dielettric function from dipole
|
2010-06-14 21:45:31 +08:00
|
|
|
! approximation.
|
|
|
|
! 'intersmear' is the brodening parameter
|
2007-02-06 01:01:54 +08:00
|
|
|
!
|
|
|
|
!Interband
|
2010-06-14 21:45:31 +08:00
|
|
|
!
|
2007-09-04 16:22:35 +08:00
|
|
|
DO iband2 = nbndmin,nbndmax
|
2006-06-29 19:02:00 +08:00
|
|
|
!
|
2007-02-06 01:01:54 +08:00
|
|
|
IF ( focc(iband2,ik) < 2.0d0) THEN
|
2010-06-14 21:45:31 +08:00
|
|
|
DO iband1 = nbndmin,nbndmax
|
2007-09-04 16:22:35 +08:00
|
|
|
!
|
|
|
|
IF (iband1==iband2) CYCLE
|
2006-06-29 19:02:00 +08:00
|
|
|
IF ( focc(iband1,ik) >= 1e-4 ) THEN
|
2010-06-14 21:45:31 +08:00
|
|
|
IF (abs(focc(iband2,ik)-focc(iband1,ik))< 1e-3) CYCLE
|
2006-06-29 19:02:00 +08:00
|
|
|
!
|
|
|
|
! transition energy
|
|
|
|
!
|
|
|
|
etrans = ( et(iband2,ik) -et(iband1,ik) ) * RYTOEV + shift
|
|
|
|
!
|
|
|
|
! loop over frequencies
|
|
|
|
!
|
2010-06-14 21:45:31 +08:00
|
|
|
DO iw = 1, nw
|
2006-06-29 19:02:00 +08:00
|
|
|
!
|
|
|
|
w = wgrid(iw)
|
|
|
|
!
|
2007-02-06 01:01:54 +08:00
|
|
|
epsi(:,iw) = epsi(:,iw) + dipole(:,iband1,iband2) * intersmear * w* &
|
2007-09-04 16:22:35 +08:00
|
|
|
RYTOEV**3 * (focc(iband1,ik))/ &
|
2010-06-14 21:45:31 +08:00
|
|
|
(( (etrans**2 -w**2 )**2 + intersmear**2 * w**2 )* etrans )
|
|
|
|
|
2006-06-29 19:02:00 +08:00
|
|
|
epsr(:,iw) = epsr(:,iw) + dipole(:,iband1,iband2) * RYTOEV**3 * &
|
2007-09-04 16:22:35 +08:00
|
|
|
(focc(iband1,ik)) * &
|
2006-06-29 19:02:00 +08:00
|
|
|
(etrans**2 - w**2 ) / &
|
2010-06-14 21:45:31 +08:00
|
|
|
(( (etrans**2 -w**2 )**2 + intersmear**2 * w**2 )* etrans )
|
2006-06-29 19:02:00 +08:00
|
|
|
ENDDO
|
|
|
|
|
|
|
|
ENDIF
|
|
|
|
ENDDO
|
2007-09-04 16:22:35 +08:00
|
|
|
ENDIF
|
2006-06-29 19:02:00 +08:00
|
|
|
ENDDO
|
2007-02-06 01:01:54 +08:00
|
|
|
!
|
2007-02-09 17:23:17 +08:00
|
|
|
!Intraband (only if metalcalc is true)
|
2007-02-06 01:01:54 +08:00
|
|
|
!
|
|
|
|
IF (metalcalc) THEN
|
2007-09-04 16:22:35 +08:00
|
|
|
DO iband1 = nbndmin,nbndmax
|
2007-02-06 01:01:54 +08:00
|
|
|
!
|
|
|
|
IF ( focc(iband1,ik) < 2.0d0) THEN
|
|
|
|
IF ( focc(iband1,ik) >= 1e-4 ) THEN
|
|
|
|
!
|
|
|
|
! loop over frequencies
|
|
|
|
!
|
2010-06-14 21:45:31 +08:00
|
|
|
DO iw = 1, nw
|
2007-02-06 01:01:54 +08:00
|
|
|
!
|
|
|
|
w = wgrid(iw)
|
|
|
|
!
|
2007-09-04 16:22:35 +08:00
|
|
|
epsi(:,iw) = epsi(:,iw) + dipole(:,iband1,iband1) * intrasmear * w* &
|
2010-06-14 21:45:31 +08:00
|
|
|
RYTOEV**2 * (exp((et(iband1,ik)-efermi)/degauss ))/ &
|
|
|
|
(( w**4 + intrasmear**2 * w**2 )*(1+exp((et(iband1,ik)-efermi)/ &
|
|
|
|
degauss))**2*degauss )
|
|
|
|
|
2007-09-04 16:22:35 +08:00
|
|
|
epsr(:,iw) = epsr(:,iw) - dipole(:,iband1,iband1) * RYTOEV**2 * &
|
2010-06-14 21:45:31 +08:00
|
|
|
(exp((et(iband1,ik)-efermi)/degauss )) * w**2 / &
|
|
|
|
(( w**4 + intrasmear**2 * w**2 )*(1+exp((et(iband1,ik)-efermi)/ &
|
2007-02-27 18:00:57 +08:00
|
|
|
degauss))**2*degauss )
|
2007-02-06 01:01:54 +08:00
|
|
|
ENDDO
|
|
|
|
|
|
|
|
ENDIF
|
|
|
|
ENDIF
|
|
|
|
|
|
|
|
ENDDO
|
|
|
|
ENDIF
|
|
|
|
ENDDO kpt_loop
|
2006-06-29 19:02:00 +08:00
|
|
|
|
2007-02-06 01:01:54 +08:00
|
|
|
!
|
|
|
|
! recover over kpt parallelization (inter_pool)
|
|
|
|
!
|
2008-01-24 01:10:45 +08:00
|
|
|
CALL mp_sum( epsr, inter_pool_comm )
|
|
|
|
CALL mp_sum( epsi, inter_pool_comm )
|
2010-06-14 21:45:31 +08:00
|
|
|
|
2006-06-29 19:02:00 +08:00
|
|
|
!
|
|
|
|
! impose the correct normalization
|
|
|
|
!
|
2006-11-23 18:47:12 +08:00
|
|
|
const = 64.0d0 * PI / ( omega * REAL(nkstot, DP) )
|
2010-06-14 21:45:31 +08:00
|
|
|
epsr(:,:) = 1.0_DP + epsr(:,:) * const
|
|
|
|
epsi(:,:) = epsi(:,:) * const
|
2007-02-06 01:01:54 +08:00
|
|
|
|
2006-06-29 19:02:00 +08:00
|
|
|
!
|
2010-06-14 21:45:31 +08:00
|
|
|
! Calculation of eels spectrum
|
2006-06-29 19:02:00 +08:00
|
|
|
!
|
2007-02-06 01:01:54 +08:00
|
|
|
DO iw = 1, nw
|
|
|
|
!
|
|
|
|
eels(:,iw) = epsi(:,iw) / ( epsr(:,iw)**2 + epsi(:,iw)**2 )
|
|
|
|
!
|
2006-06-29 19:02:00 +08:00
|
|
|
ENDDO
|
2010-06-14 21:45:31 +08:00
|
|
|
|
2006-06-29 19:02:00 +08:00
|
|
|
!
|
|
|
|
! calculation of dielectric function on the immaginary frequency axe
|
2010-06-14 21:45:31 +08:00
|
|
|
!
|
2006-06-29 19:02:00 +08:00
|
|
|
|
2007-02-06 01:01:54 +08:00
|
|
|
DO iw = 1, nw
|
2010-06-14 21:45:31 +08:00
|
|
|
DO iwp = 2, nw
|
2007-02-06 01:01:54 +08:00
|
|
|
!
|
2010-06-14 21:45:31 +08:00
|
|
|
ieps(:,iw) = ieps(:,iw) + wgrid(iwp) * epsi(:,iwp) / ( wgrid(iwp)**2 + wgrid(iw)**2)
|
2007-02-06 01:01:54 +08:00
|
|
|
!
|
|
|
|
ENDDO
|
2010-06-14 21:45:31 +08:00
|
|
|
ENDDO
|
2006-06-29 19:02:00 +08:00
|
|
|
|
2010-06-14 21:45:31 +08:00
|
|
|
ieps(:,:) = 1.0d0 + 2 / PI * ieps(:,:) * alpha
|
2006-06-29 19:02:00 +08:00
|
|
|
|
|
|
|
!
|
2010-06-14 21:45:31 +08:00
|
|
|
! check dielectric function normalizzation via sumrule
|
2006-06-29 19:02:00 +08:00
|
|
|
!
|
2010-06-14 21:45:31 +08:00
|
|
|
DO i=1,3
|
|
|
|
renorm(i) = alpha * sum( epsi(i,:) * wgrid(:) )
|
2007-02-06 01:01:54 +08:00
|
|
|
ENDDO
|
2006-06-29 19:02:00 +08:00
|
|
|
!
|
|
|
|
IF ( ionode ) THEN
|
2007-02-06 01:01:54 +08:00
|
|
|
!
|
2010-06-14 21:45:31 +08:00
|
|
|
WRITE(stdout,"(/,5x, 'The bulk xx plasmon frequency [eV] is: ',f15.9 )") sqrt(renorm(1) * 2.0d0 / PI)
|
|
|
|
WRITE(stdout,"(5x, 'The bulk yy plasmon frequency [eV] is: ',f15.9 )") sqrt(renorm(2) * 2.0d0 / PI)
|
|
|
|
WRITE(stdout,"(5x, 'The bulk zz plasmon frequency [eV] is: ',f15.9 )") sqrt(renorm(3) * 2.0d0 / PI)
|
2007-02-06 01:01:54 +08:00
|
|
|
WRITE(stdout,"(/,5x, 'Writing output on file...' )")
|
|
|
|
!
|
|
|
|
! write results on data files
|
|
|
|
!
|
2006-06-29 19:02:00 +08:00
|
|
|
|
|
|
|
OPEN (30, FILE='epsr.dat', FORM='FORMATTED' )
|
|
|
|
OPEN (40, FILE='epsi.dat', FORM='FORMATTED' )
|
|
|
|
OPEN (41, FILE='eels.dat', FORM='FORMATTED' )
|
|
|
|
OPEN (42, FILE='ieps.dat', FORM='FORMATTED' )
|
|
|
|
!
|
|
|
|
WRITE(30, "(2x,'# energy grid [eV] epsr_x epsr_y epsr_z')" )
|
|
|
|
WRITE(40, "(2x,'# energy grid [eV] epsi_x epsi_y epsi_z')" )
|
|
|
|
WRITE(41, "(2x,'# energy grid [eV] eels components [arbitrary units]')" )
|
|
|
|
WRITE(42, "(2x,'# energy grid [eV] ieps_x ieps_y ieps_z ')" )
|
|
|
|
!
|
2007-02-06 01:01:54 +08:00
|
|
|
DO iw =1, nw
|
2006-06-29 19:02:00 +08:00
|
|
|
!
|
|
|
|
WRITE(30,"(4f15.6)") wgrid(iw), epsr(1:3, iw)
|
|
|
|
WRITE(40,"(4f15.6)") wgrid(iw), epsi(1:3, iw)
|
|
|
|
WRITE(41,"(4f15.6)") wgrid(iw), eels(1:3, iw)
|
|
|
|
WRITE(42,"(4f15.6)") wgrid(iw), ieps(1:3, iw)
|
|
|
|
!
|
|
|
|
ENDDO
|
|
|
|
!
|
|
|
|
CLOSE(30)
|
|
|
|
CLOSE(40)
|
|
|
|
CLOSE(41)
|
|
|
|
CLOSE(42)
|
|
|
|
!
|
|
|
|
ENDIF
|
|
|
|
|
2007-09-04 16:22:35 +08:00
|
|
|
DEALLOCATE ( epsr, epsi, eels, ieps)
|
|
|
|
!
|
|
|
|
! collinear spin calculation
|
|
|
|
!
|
2010-06-14 21:45:31 +08:00
|
|
|
ELSEIF (nspin == 2 ) THEN
|
2007-09-04 16:22:35 +08:00
|
|
|
!
|
|
|
|
ALLOCATE( epsrc( 0:1, 3, nw), epsic( 0:1,3, nw), eelsc( 0:1,3, nw), iepsc(0:1,3,nw ), STAT=ierr )
|
2010-06-14 21:45:31 +08:00
|
|
|
IF (ierr/=0) CALL errore('epsilon','allocating eps', abs(ierr))
|
2007-09-04 16:22:35 +08:00
|
|
|
|
|
|
|
!
|
|
|
|
! initialize response functions
|
|
|
|
!
|
|
|
|
epsrc(:,:,:) = 0.0_DP
|
|
|
|
epsic(:,:,:) = 0.0_DP
|
|
|
|
iepsc(:,:,:) = 0.0_DP
|
|
|
|
|
|
|
|
!
|
|
|
|
! main kpt loop
|
|
|
|
!
|
|
|
|
|
|
|
|
spin_loop: &
|
|
|
|
DO is=0,1
|
|
|
|
kpt_loopspin: &
|
2010-06-14 21:45:31 +08:00
|
|
|
! if nspin=2 the number of nks must be even (even if the calculation
|
2007-09-04 16:22:35 +08:00
|
|
|
! is performed at gamma point only), so nks must be always a multiple of 2
|
2010-06-14 21:45:31 +08:00
|
|
|
DO ik = 1 + is * int(nks/2), int(nks/2) + is * int(nks/2)
|
2007-09-04 16:22:35 +08:00
|
|
|
!
|
|
|
|
! For every single k-point: order k+G for
|
|
|
|
! read and distribute wavefunctions
|
2010-06-14 21:45:31 +08:00
|
|
|
! compute dipole matrix 3 x nbnd x nbnd parallel over g
|
2007-09-04 16:22:35 +08:00
|
|
|
! recover g parallelism getting the total dipole matrix
|
2010-06-14 21:45:31 +08:00
|
|
|
!
|
2007-09-04 16:22:35 +08:00
|
|
|
CALL dipole_calc( ik, dipole_aux, metalcalc , nbndmin, nbndmax)
|
|
|
|
!
|
2010-06-14 21:45:31 +08:00
|
|
|
dipole(:,:,:)= tpiba2 * REAL( dipole_aux(:,:,:) * conjg(dipole_aux(:,:,:)), DP )
|
|
|
|
|
2007-09-04 16:22:35 +08:00
|
|
|
!
|
2010-06-14 21:45:31 +08:00
|
|
|
! Calculation of real and immaginary parts
|
2007-09-04 16:22:35 +08:00
|
|
|
! of the macroscopic dielettric function from dipole
|
2010-06-14 21:45:31 +08:00
|
|
|
! approximation.
|
|
|
|
! 'intersmear' is the brodening parameter
|
2007-09-04 16:22:35 +08:00
|
|
|
!
|
|
|
|
!Interband
|
2010-06-14 21:45:31 +08:00
|
|
|
!
|
2007-09-04 16:22:35 +08:00
|
|
|
DO iband2 = nbndmin,nbndmax
|
|
|
|
!
|
|
|
|
IF ( focc(iband2,ik) < 1.0d0) THEN
|
2010-06-14 21:45:31 +08:00
|
|
|
DO iband1 = nbndmin,nbndmax
|
2007-09-04 16:22:35 +08:00
|
|
|
!
|
|
|
|
IF (iband1==iband2) CYCLE
|
|
|
|
IF ( focc(iband1,ik) >= 1e-4 ) THEN
|
2010-06-14 21:45:31 +08:00
|
|
|
IF (abs(focc(iband2,ik)-focc(iband1,ik))< 1e-3) CYCLE
|
2007-09-04 16:22:35 +08:00
|
|
|
!
|
|
|
|
! transition energy
|
|
|
|
!
|
|
|
|
etrans = ( et(iband2,ik) -et(iband1,ik) ) * RYTOEV + shift
|
|
|
|
!
|
|
|
|
! loop over frequencies
|
|
|
|
!
|
2010-06-14 21:45:31 +08:00
|
|
|
DO iw = 1, nw
|
2007-09-04 16:22:35 +08:00
|
|
|
!
|
|
|
|
w = wgrid(iw)
|
|
|
|
!
|
|
|
|
epsic(is,:,iw) = epsic(is,:,iw) + dipole(:,iband1,iband2) * intersmear * w* &
|
|
|
|
RYTOEV**3 * (focc(iband1,ik))/ &
|
2010-06-14 21:45:31 +08:00
|
|
|
(( (etrans**2 -w**2 )**2 + intersmear**2 * w**2 )* etrans )
|
|
|
|
|
2007-09-04 16:22:35 +08:00
|
|
|
epsrc(is,:,iw) = epsrc(is,:,iw) + dipole(:,iband1,iband2) * RYTOEV**3 * &
|
|
|
|
(focc(iband1,ik)) * &
|
|
|
|
(etrans**2 - w**2 ) / &
|
2010-06-14 21:45:31 +08:00
|
|
|
(( (etrans**2 -w**2 )**2 + intersmear**2 * w**2 )* etrans )
|
2007-09-04 16:22:35 +08:00
|
|
|
ENDDO
|
|
|
|
|
|
|
|
ENDIF
|
|
|
|
ENDDO
|
|
|
|
ENDIF
|
|
|
|
ENDDO
|
|
|
|
!
|
|
|
|
!Intraband (only if metalcalc is true)
|
|
|
|
!
|
|
|
|
IF (metalcalc) THEN
|
|
|
|
DO iband1 = nbndmin,nbndmax
|
|
|
|
!
|
|
|
|
IF ( focc(iband1,ik) < 1.0d0) THEN
|
|
|
|
IF ( focc(iband1,ik) >= 1e-4 ) THEN
|
|
|
|
!
|
|
|
|
! loop over frequencies
|
|
|
|
!
|
2010-06-14 21:45:31 +08:00
|
|
|
DO iw = 1, nw
|
2007-09-04 16:22:35 +08:00
|
|
|
!
|
|
|
|
w = wgrid(iw)
|
|
|
|
!
|
|
|
|
epsic(is,:,iw) = epsic(is,:,iw) + dipole(:,iband1,iband1) * intrasmear * w* &
|
2010-06-14 21:45:31 +08:00
|
|
|
RYTOEV**2 * (exp((et(iband1,ik)-efermi)/degauss ))/ &
|
|
|
|
(( w**4 + intrasmear**2 * w**2 )*(1+exp((et(iband1,ik)-efermi)/ &
|
|
|
|
degauss))**2*degauss )
|
|
|
|
|
2007-09-04 16:22:35 +08:00
|
|
|
epsrc(is,:,iw) = epsrc(is,:,iw) - dipole(:,iband1,iband1) * RYTOEV**2 * &
|
2010-06-14 21:45:31 +08:00
|
|
|
(exp((et(iband1,ik)-efermi)/degauss )) * w**2 / &
|
|
|
|
(( w**4 + intrasmear**2 * w**2 )*(1+exp((et(iband1,ik)-efermi)/ &
|
2007-09-04 16:22:35 +08:00
|
|
|
degauss))**2*degauss )
|
|
|
|
ENDDO
|
|
|
|
|
|
|
|
ENDIF
|
|
|
|
ENDIF
|
|
|
|
|
|
|
|
ENDDO
|
|
|
|
ENDIF
|
|
|
|
ENDDO kpt_loopspin
|
|
|
|
ENDDO spin_loop
|
|
|
|
!
|
|
|
|
! recover over kpt parallelization (inter_pool)
|
|
|
|
!
|
2008-01-24 01:10:45 +08:00
|
|
|
CALL mp_sum( epsr, inter_pool_comm )
|
|
|
|
CALL mp_sum( epsi, inter_pool_comm )
|
2010-06-14 21:45:31 +08:00
|
|
|
|
2007-09-04 16:22:35 +08:00
|
|
|
!
|
|
|
|
! impose the correct normalization
|
|
|
|
!
|
|
|
|
const = 128.0d0 * PI / ( omega * REAL(nkstot, DP) )
|
2010-06-14 21:45:31 +08:00
|
|
|
epsrc(:,:,:) = 1.0_DP + epsrc(:,:,:) * const
|
|
|
|
epsic(:,:,:) = epsic(:,:,:) * const
|
2007-09-04 16:22:35 +08:00
|
|
|
|
|
|
|
!
|
2010-06-14 21:45:31 +08:00
|
|
|
! Calculation of eels spectrum
|
2007-09-04 16:22:35 +08:00
|
|
|
!
|
|
|
|
DO iw = 1, nw
|
|
|
|
!
|
|
|
|
eelsc(:,:,iw) = epsic(:,:,iw) / ( epsrc(:,:,iw)**2 + epsic(:,:,iw)**2 )
|
|
|
|
!
|
|
|
|
ENDDO
|
2010-06-14 21:45:31 +08:00
|
|
|
|
2007-09-04 16:22:35 +08:00
|
|
|
!
|
|
|
|
! calculation of dielectric function on the immaginary frequency axe
|
2010-06-14 21:45:31 +08:00
|
|
|
!
|
2007-09-04 16:22:35 +08:00
|
|
|
|
|
|
|
DO iw = 1, nw
|
2010-06-14 21:45:31 +08:00
|
|
|
DO iwp = 2, nw
|
2007-09-04 16:22:35 +08:00
|
|
|
!
|
2010-06-14 21:45:31 +08:00
|
|
|
iepsc(:,:,iw) = iepsc(:,:,iw) + wgrid(iwp) * epsic(:,:,iwp) / ( wgrid(iwp)**2 + wgrid(iw)**2)
|
2007-09-04 16:22:35 +08:00
|
|
|
!
|
|
|
|
ENDDO
|
2010-06-14 21:45:31 +08:00
|
|
|
ENDDO
|
2007-09-04 16:22:35 +08:00
|
|
|
|
2010-06-14 21:45:31 +08:00
|
|
|
iepsc(:,:,:) = 1.0d0 + 2.0_DP / PI * iepsc(:,:,:) * alpha
|
2007-09-04 16:22:35 +08:00
|
|
|
|
|
|
|
IF (ionode) THEN
|
|
|
|
WRITE(stdout,"(/,5x, 'Writing output on file...' )")
|
|
|
|
!
|
|
|
|
! write results on data files
|
|
|
|
!
|
|
|
|
|
|
|
|
OPEN (30, FILE='uepsr.dat', FORM='FORMATTED' )
|
|
|
|
OPEN (40, FILE='uepsi.dat', FORM='FORMATTED' )
|
|
|
|
OPEN (41, FILE='ueels.dat', FORM='FORMATTED' )
|
|
|
|
OPEN (42, FILE='uieps.dat', FORM='FORMATTED' )
|
|
|
|
OPEN (43, FILE='depsr.dat', FORM='FORMATTED' )
|
|
|
|
OPEN (44, FILE='depsi.dat', FORM='FORMATTED' )
|
|
|
|
OPEN (45, FILE='deels.dat', FORM='FORMATTED' )
|
|
|
|
OPEN (46, FILE='dieps.dat', FORM='FORMATTED' )
|
|
|
|
OPEN (47, FILE='epsr.dat', FORM='FORMATTED' )
|
|
|
|
OPEN (48, FILE='epsi.dat', FORM='FORMATTED' )
|
|
|
|
OPEN (49, FILE='eels.dat', FORM='FORMATTED' )
|
|
|
|
OPEN (50, FILE='ieps.dat', FORM='FORMATTED' )
|
|
|
|
!
|
|
|
|
WRITE(30, "(2x,'# energy grid [eV] epsr_x epsr_y epsr_z')" )
|
|
|
|
WRITE(40, "(2x,'# energy grid [eV] epsi_x epsi_y epsi_z')" )
|
|
|
|
WRITE(41, "(2x,'# energy grid [eV] eels components [arbitrary units]')" )
|
|
|
|
WRITE(42, "(2x,'# energy grid [eV] ieps_x ieps_y ieps_z ')" )
|
|
|
|
WRITE(43, "(2x,'# energy grid [eV] epsr_x epsr_y epsr_z')" )
|
|
|
|
WRITE(44, "(2x,'# energy grid [eV] epsi_x epsi_y epsi_z')" )
|
|
|
|
WRITE(45, "(2x,'# energy grid [eV] eels components [arbitrary units]')" )
|
|
|
|
WRITE(46, "(2x,'# energy grid [eV] ieps_x ieps_y ieps_z ')" )
|
|
|
|
WRITE(47, "(2x,'# energy grid [eV] epsr_x epsr_y epsr_z')" )
|
|
|
|
WRITE(48, "(2x,'# energy grid [eV] epsi_x epsi_y epsi_z')" )
|
|
|
|
WRITE(49, "(2x,'# energy grid [eV] eels components [arbitrary units]')" )
|
|
|
|
WRITE(50, "(2x,'# energy grid [eV] ieps_x ieps_y ieps_z ')" )
|
|
|
|
!
|
|
|
|
DO iw =1, nw
|
|
|
|
!
|
|
|
|
WRITE(30,"(4f15.6)") wgrid(iw), epsrc(0,1:3, iw)
|
|
|
|
WRITE(40,"(4f15.6)") wgrid(iw), epsic(0,1:3, iw)
|
|
|
|
WRITE(41,"(4f15.6)") wgrid(iw), eelsc(0,1:3, iw)
|
|
|
|
WRITE(42,"(4f15.6)") wgrid(iw), iepsc(0,1:3, iw)
|
|
|
|
WRITE(43,"(4f15.6)") wgrid(iw), epsrc(1,1:3, iw)
|
|
|
|
WRITE(44,"(4f15.6)") wgrid(iw), epsic(1,1:3, iw)
|
|
|
|
WRITE(45,"(4f15.6)") wgrid(iw), eelsc(1,1:3, iw)
|
|
|
|
WRITE(46,"(4f15.6)") wgrid(iw), iepsc(1,1:3, iw)
|
|
|
|
WRITE(47,"(4f15.6)") wgrid(iw), epsrc(1,1:3, iw)+epsrc(0,1:3, iw)
|
|
|
|
WRITE(48,"(4f15.6)") wgrid(iw), epsic(1,1:3, iw)+epsic(0,1:3, iw)
|
|
|
|
WRITE(49,"(4f15.6)") wgrid(iw), eelsc(1,1:3, iw)+eelsc(0,1:3, iw)
|
|
|
|
WRITE(50,"(4f15.6)") wgrid(iw), iepsc(1,1:3, iw)+iepsc(0,1:3, iw)
|
|
|
|
!
|
|
|
|
ENDDO
|
|
|
|
!
|
|
|
|
CLOSE(30)
|
|
|
|
CLOSE(40)
|
|
|
|
CLOSE(41)
|
|
|
|
CLOSE(42)
|
|
|
|
CLOSE(43)
|
|
|
|
CLOSE(44)
|
|
|
|
CLOSE(45)
|
|
|
|
CLOSE(46)
|
|
|
|
CLOSE(47)
|
|
|
|
CLOSE(48)
|
|
|
|
CLOSE(49)
|
|
|
|
CLOSE(50)
|
|
|
|
!
|
|
|
|
ENDIF
|
|
|
|
DEALLOCATE ( epsrc, epsic, eelsc, iepsc)
|
|
|
|
ENDIF
|
2006-06-29 19:02:00 +08:00
|
|
|
!
|
|
|
|
! local cleaning
|
|
|
|
!
|
2007-02-06 01:01:54 +08:00
|
|
|
CALL grid_destroy()
|
|
|
|
!
|
|
|
|
DEALLOCATE ( dipole, dipole_aux )
|
2006-11-23 00:09:55 +08:00
|
|
|
|
2007-02-06 01:01:54 +08:00
|
|
|
END SUBROUTINE eps_calc
|
2010-06-14 21:45:31 +08:00
|
|
|
|
2007-02-27 18:00:57 +08:00
|
|
|
!----------------------------------------------------------------------------------------
|
2007-09-04 16:22:35 +08:00
|
|
|
SUBROUTINE jdos_calc ( smeartype,intersmear,nw,wmax,wmin,nbndmin,nbndmax,shift,nspin )
|
2007-02-27 18:00:57 +08:00
|
|
|
!--------------------------------------------------------------------------------------
|
2007-02-06 01:01:54 +08:00
|
|
|
!
|
|
|
|
USE kinds, ONLY : DP
|
|
|
|
USE constants, ONLY : PI, RYTOEV
|
|
|
|
USE wvfct, ONLY : nbnd, et
|
2007-02-27 18:00:57 +08:00
|
|
|
USE klist, ONLY : nks
|
|
|
|
USE io_global, ONLY : ionode, stdout
|
2010-06-14 21:45:31 +08:00
|
|
|
USE grid_module, ONLY : alpha, focc, wgrid, grid_build, grid_destroy
|
|
|
|
!
|
2007-02-06 01:01:54 +08:00
|
|
|
IMPLICIT NONE
|
|
|
|
|
|
|
|
!
|
|
|
|
! input variables
|
|
|
|
!
|
2010-06-14 21:45:31 +08:00
|
|
|
INTEGER, INTENT(in) :: nw,nbndmin,nbndmax,nspin
|
|
|
|
REAL(DP), INTENT(in) :: wmax, wmin, intersmear, shift
|
|
|
|
CHARACTER(*), INTENT(in) :: smeartype
|
2007-02-06 01:01:54 +08:00
|
|
|
!
|
|
|
|
! local variables
|
|
|
|
!
|
2010-06-14 21:45:31 +08:00
|
|
|
INTEGER :: ik, is, iband1, iband2
|
2007-02-27 18:00:57 +08:00
|
|
|
INTEGER :: iw, ierr
|
2007-09-04 16:22:35 +08:00
|
|
|
REAL(DP) :: etrans, w, renorm, count, srcount(0:1), renormzero,renormuno
|
2007-02-06 01:01:54 +08:00
|
|
|
!
|
2007-09-04 16:22:35 +08:00
|
|
|
REAL(DP), ALLOCATABLE :: jdos(:),srjdos(:,:)
|
2006-11-23 00:09:55 +08:00
|
|
|
!
|
2007-02-06 01:01:54 +08:00
|
|
|
!--------------------------
|
|
|
|
! main routine body
|
|
|
|
!--------------------------
|
2006-11-23 00:09:55 +08:00
|
|
|
!
|
2010-06-14 21:45:31 +08:00
|
|
|
! No wavefunctions are needed in order to compute jdos, only eigenvalues,
|
2007-02-06 01:01:54 +08:00
|
|
|
! they are distributed to each task so
|
|
|
|
! no mpi calls are necessary in this routine
|
2006-11-23 00:09:55 +08:00
|
|
|
!
|
2007-02-06 01:01:54 +08:00
|
|
|
! perform some consistency checks, calculate occupation numbers and setup w grid
|
|
|
|
!
|
2007-02-27 18:00:57 +08:00
|
|
|
CALL grid_build(nw, wmax, wmin )
|
2007-09-04 16:22:35 +08:00
|
|
|
|
|
|
|
!
|
|
|
|
! spin unresolved calculation
|
|
|
|
!
|
2010-06-14 21:45:31 +08:00
|
|
|
IF (nspin == 1) THEN
|
2007-02-06 01:01:54 +08:00
|
|
|
!
|
|
|
|
! allocate main spectral and auxiliary quantities
|
|
|
|
!
|
|
|
|
ALLOCATE( jdos(nw), STAT=ierr )
|
2010-06-14 21:45:31 +08:00
|
|
|
IF (ierr/=0) CALL errore('epsilon','allocating jdos',abs(ierr))
|
2006-11-23 00:09:55 +08:00
|
|
|
!
|
2007-02-06 01:01:54 +08:00
|
|
|
! initialize jdos
|
|
|
|
!
|
|
|
|
jdos(:)=0.0_DP
|
2006-11-23 00:09:55 +08:00
|
|
|
|
2007-02-06 01:01:54 +08:00
|
|
|
! Initialising a counter for the number of transition
|
2007-02-27 18:00:57 +08:00
|
|
|
count=0.0_DP
|
2006-11-23 00:09:55 +08:00
|
|
|
|
2007-02-06 01:01:54 +08:00
|
|
|
!
|
|
|
|
! main kpt loop
|
|
|
|
!
|
2006-11-23 00:09:55 +08:00
|
|
|
|
2007-02-06 01:01:54 +08:00
|
|
|
IF (smeartype=='lorentz') THEN
|
|
|
|
|
|
|
|
kpt_lor: &
|
|
|
|
DO ik = 1, nks
|
|
|
|
!
|
|
|
|
! Calculation of joint density of states
|
|
|
|
! 'intersmear' is the brodening parameter
|
|
|
|
!
|
|
|
|
DO iband2 = 1,nbnd
|
2007-09-04 16:22:35 +08:00
|
|
|
IF ( focc(iband2,ik) < 2.0d0) THEN
|
2007-02-06 01:01:54 +08:00
|
|
|
DO iband1 = 1,nbnd
|
|
|
|
!
|
|
|
|
IF ( focc(iband1,ik) >= 1.0d-4 ) THEN
|
|
|
|
!
|
|
|
|
! transition energy
|
|
|
|
!
|
2007-02-27 18:00:57 +08:00
|
|
|
etrans = ( et(iband2,ik) -et(iband1,ik) ) * RYTOEV + shift
|
2007-02-06 01:01:54 +08:00
|
|
|
!
|
|
|
|
IF( etrans < 1.0d-10 ) CYCLE
|
2006-11-23 00:09:55 +08:00
|
|
|
|
2007-09-04 16:22:35 +08:00
|
|
|
count = count + (focc(iband1,ik)-focc(iband2,ik))
|
|
|
|
!
|
2007-02-06 01:01:54 +08:00
|
|
|
! loop over frequencies
|
|
|
|
!
|
|
|
|
DO iw = 1, nw
|
|
|
|
!
|
|
|
|
w = wgrid(iw)
|
|
|
|
!
|
|
|
|
jdos(iw) = jdos(iw) + intersmear * (focc(iband1,ik)-focc(iband2,ik)) &
|
|
|
|
/ ( PI * ( (etrans -w )**2 + (intersmear)**2 ) )
|
2006-11-23 00:09:55 +08:00
|
|
|
|
|
|
|
ENDDO
|
2007-02-06 01:01:54 +08:00
|
|
|
|
|
|
|
ENDIF
|
|
|
|
ENDDO
|
2007-09-04 16:22:35 +08:00
|
|
|
ENDIF
|
2007-02-06 01:01:54 +08:00
|
|
|
ENDDO
|
|
|
|
|
|
|
|
ENDDO kpt_lor
|
|
|
|
|
2010-06-14 21:45:31 +08:00
|
|
|
ELSEIF (smeartype=='gauss') THEN
|
2007-02-06 01:01:54 +08:00
|
|
|
|
|
|
|
kpt_gauss: &
|
|
|
|
DO ik = 1, nks
|
|
|
|
|
|
|
|
!
|
|
|
|
! Calculation of joint density of states
|
|
|
|
! 'intersmear' is the brodening parameter
|
|
|
|
!
|
|
|
|
DO iband2 = 1,nbnd
|
|
|
|
DO iband1 = 1,nbnd
|
|
|
|
!
|
|
|
|
IF ( focc(iband2,ik) < 2.0d0) THEN
|
|
|
|
IF ( focc(iband1,ik) >= 1.0d-4 ) THEN
|
2006-11-23 00:09:55 +08:00
|
|
|
!
|
2007-02-06 01:01:54 +08:00
|
|
|
! transition energy
|
2006-11-23 00:09:55 +08:00
|
|
|
!
|
2007-02-27 18:00:57 +08:00
|
|
|
etrans = ( et(iband2,ik) -et(iband1,ik) ) * RYTOEV + shift
|
2006-11-23 00:09:55 +08:00
|
|
|
!
|
2007-02-06 01:01:54 +08:00
|
|
|
IF( etrans < 1.0d-10 ) CYCLE
|
|
|
|
|
|
|
|
! loop over frequencies
|
|
|
|
!
|
|
|
|
|
|
|
|
count=count+ (focc(iband1,ik)-focc(iband2,ik))
|
|
|
|
|
|
|
|
DO iw = 1, nw
|
|
|
|
!
|
|
|
|
w = wgrid(iw)
|
|
|
|
!
|
|
|
|
jdos(iw) = jdos(iw) + (focc(iband1,ik)-focc(iband2,ik)) * &
|
2010-06-14 21:45:31 +08:00
|
|
|
exp(-(etrans-w)**2/intersmear**2) &
|
|
|
|
/ (intersmear * sqrt(PI))
|
2007-02-06 01:01:54 +08:00
|
|
|
|
|
|
|
ENDDO
|
|
|
|
|
|
|
|
ENDIF
|
|
|
|
ENDIF
|
|
|
|
ENDDO
|
|
|
|
ENDDO
|
|
|
|
|
|
|
|
ENDDO kpt_gauss
|
|
|
|
|
|
|
|
ELSE
|
|
|
|
|
2010-06-14 21:45:31 +08:00
|
|
|
CALL errore('epsilon', 'invalid SMEARTYPE = '//trim(smeartype), 1)
|
2007-02-06 01:01:54 +08:00
|
|
|
|
|
|
|
ENDIF
|
|
|
|
|
|
|
|
!
|
|
|
|
! jdos normalizzation
|
|
|
|
!
|
|
|
|
|
|
|
|
jdos(:)=jdos(:)/count
|
|
|
|
|
|
|
|
!
|
|
|
|
! check jdos normalization
|
|
|
|
!
|
|
|
|
|
2010-06-14 21:45:31 +08:00
|
|
|
renorm = alpha * sum( jdos(:) )
|
2007-02-06 01:01:54 +08:00
|
|
|
!
|
|
|
|
! write results on data files
|
|
|
|
!
|
|
|
|
IF (ionode) THEN
|
|
|
|
WRITE(stdout,"(/,5x, 'Integration over JDOS gives: ',f15.9,' instead of 1.0d0' )") renorm
|
|
|
|
WRITE(stdout,"(/,5x, 'Writing output on file...' )")
|
2010-06-14 21:45:31 +08:00
|
|
|
|
2007-02-06 01:01:54 +08:00
|
|
|
OPEN (30, FILE='jdos.dat', FORM='FORMATTED' )
|
|
|
|
!
|
|
|
|
WRITE(30, "(2x,'# energy grid [eV] JDOS [1/eV] ')" )
|
|
|
|
!
|
|
|
|
DO iw =1, nw
|
|
|
|
!
|
|
|
|
WRITE(30,"(4f15.6)") wgrid(iw), jdos(iw)
|
|
|
|
!
|
2006-11-23 00:09:55 +08:00
|
|
|
ENDDO
|
|
|
|
!
|
2007-02-06 01:01:54 +08:00
|
|
|
CLOSE(30)
|
|
|
|
ENDIF
|
|
|
|
!
|
|
|
|
! local cleaning
|
|
|
|
!
|
|
|
|
DEALLOCATE ( jdos )
|
|
|
|
|
2007-09-04 16:22:35 +08:00
|
|
|
!
|
|
|
|
! collinear spin calculation
|
|
|
|
!
|
2010-06-14 21:45:31 +08:00
|
|
|
ELSEIF(nspin==2) THEN
|
2007-09-04 16:22:35 +08:00
|
|
|
!
|
|
|
|
! allocate main spectral and auxiliary quantities
|
|
|
|
!
|
|
|
|
ALLOCATE( srjdos(0:1,nw), STAT=ierr )
|
2010-06-14 21:45:31 +08:00
|
|
|
IF (ierr/=0) CALL errore('epsilon','allocating spin resolved jdos',abs(ierr))
|
2007-09-04 16:22:35 +08:00
|
|
|
!
|
|
|
|
! initialize jdos
|
|
|
|
!
|
|
|
|
srjdos(:,:)=0.0_DP
|
|
|
|
|
|
|
|
! Initialising a counter for the number of transition
|
|
|
|
srcount(:)=0.0_DP
|
|
|
|
|
|
|
|
!
|
|
|
|
! main kpt loop
|
|
|
|
!
|
|
|
|
|
|
|
|
IF (smeartype=='lorentz') THEN
|
|
|
|
|
|
|
|
DO is=0,1
|
2010-06-14 21:45:31 +08:00
|
|
|
! if nspin=2 the number of nks must be even (even if the calculation
|
2007-09-04 16:22:35 +08:00
|
|
|
! is performed at gamma point only), so nks must be always a multiple of 2
|
2010-06-14 21:45:31 +08:00
|
|
|
DO ik = 1 + is * int(nks/2), int(nks/2) + is * int(nks/2)
|
2007-09-04 16:22:35 +08:00
|
|
|
!
|
|
|
|
! Calculation of joint density of states
|
|
|
|
! 'intersmear' is the brodening parameter
|
|
|
|
!
|
|
|
|
DO iband2 = 1,nbnd
|
|
|
|
IF ( focc(iband2,ik) < 2.0d0) THEN
|
|
|
|
DO iband1 = 1,nbnd
|
|
|
|
!
|
|
|
|
IF ( focc(iband1,ik) >= 1.0d-4 ) THEN
|
|
|
|
!
|
|
|
|
! transition energy
|
|
|
|
!
|
|
|
|
etrans = ( et(iband2,ik) -et(iband1,ik) ) * RYTOEV + shift
|
|
|
|
!
|
|
|
|
IF( etrans < 1.0d-10 ) CYCLE
|
|
|
|
|
|
|
|
! loop over frequencies
|
|
|
|
!
|
|
|
|
srcount(is)=srcount(is)+ (focc(iband1,ik)-focc(iband2,ik))
|
|
|
|
|
|
|
|
DO iw = 1, nw
|
|
|
|
!
|
|
|
|
w = wgrid(iw)
|
|
|
|
!
|
|
|
|
srjdos(is,iw) = srjdos(is,iw) + intersmear * (focc(iband1,ik)-focc(iband2,ik)) &
|
|
|
|
/ ( PI * ( (etrans -w )**2 + (intersmear)**2 ) )
|
|
|
|
|
|
|
|
ENDDO
|
|
|
|
|
|
|
|
ENDIF
|
|
|
|
ENDDO
|
|
|
|
ENDIF
|
|
|
|
ENDDO
|
|
|
|
|
2010-06-14 21:45:31 +08:00
|
|
|
ENDDO
|
2007-09-04 16:22:35 +08:00
|
|
|
ENDDO
|
|
|
|
|
2010-06-14 21:45:31 +08:00
|
|
|
ELSEIF (smeartype=='gauss') THEN
|
2007-09-04 16:22:35 +08:00
|
|
|
|
|
|
|
DO is=0,1
|
2010-06-14 21:45:31 +08:00
|
|
|
! if nspin=2 the number of nks must be even (even if the calculation
|
2007-09-04 16:22:35 +08:00
|
|
|
! is performed at gamma point only), so nks must be always a multiple of 2
|
2010-06-14 21:45:31 +08:00
|
|
|
DO ik = 1 + is * int(nks/2), int(nks/2) + is * int(nks/2)
|
2007-09-04 16:22:35 +08:00
|
|
|
!
|
|
|
|
! Calculation of joint density of states
|
|
|
|
! 'intersmear' is the brodening parameter
|
|
|
|
!
|
|
|
|
DO iband2 = 1,nbnd
|
|
|
|
DO iband1 = 1,nbnd
|
|
|
|
!
|
|
|
|
IF ( focc(iband2,ik) < 2.0d0) THEN
|
|
|
|
IF ( focc(iband1,ik) >= 1.0d-4 ) THEN
|
|
|
|
!
|
|
|
|
! transition energy
|
|
|
|
!
|
|
|
|
etrans = ( et(iband2,ik) -et(iband1,ik) ) * RYTOEV + shift
|
|
|
|
!
|
|
|
|
IF( etrans < 1.0d-10 ) CYCLE
|
|
|
|
|
|
|
|
! loop over frequencies
|
|
|
|
!
|
|
|
|
|
|
|
|
srcount(is)=srcount(is)+ (focc(iband1,ik)-focc(iband2,ik))
|
|
|
|
|
|
|
|
DO iw = 1, nw
|
|
|
|
!
|
|
|
|
w = wgrid(iw)
|
|
|
|
!
|
|
|
|
srjdos(is,iw) = srjdos(is,iw) + (focc(iband1,ik)-focc(iband2,ik)) * &
|
2010-06-14 21:45:31 +08:00
|
|
|
exp(-(etrans-w)**2/intersmear**2) &
|
|
|
|
/ (intersmear * sqrt(PI))
|
2007-09-04 16:22:35 +08:00
|
|
|
|
|
|
|
ENDDO
|
|
|
|
|
|
|
|
ENDIF
|
|
|
|
ENDIF
|
|
|
|
ENDDO
|
|
|
|
ENDDO
|
|
|
|
|
2010-06-14 21:45:31 +08:00
|
|
|
ENDDO
|
2007-09-04 16:22:35 +08:00
|
|
|
ENDDO
|
|
|
|
|
|
|
|
ELSE
|
|
|
|
|
2010-06-14 21:45:31 +08:00
|
|
|
CALL errore('epsilon', 'invalid SMEARTYPE = '//trim(smeartype), 1)
|
2007-09-04 16:22:35 +08:00
|
|
|
|
|
|
|
ENDIF
|
|
|
|
|
|
|
|
!
|
|
|
|
! jdos normalizzation
|
|
|
|
!
|
|
|
|
DO is = 0,1
|
|
|
|
srjdos(is,:)=srjdos(is,:)/srcount(is)
|
|
|
|
ENDDO
|
|
|
|
!
|
|
|
|
! check jdos normalization
|
|
|
|
!
|
|
|
|
|
2010-06-14 21:45:31 +08:00
|
|
|
renormzero = alpha * sum( srjdos(0,:) )
|
|
|
|
renormuno = alpha * sum( srjdos(1,:) )
|
2007-09-04 16:22:35 +08:00
|
|
|
!
|
|
|
|
! write results on data files
|
|
|
|
!
|
|
|
|
IF (ionode) THEN
|
|
|
|
WRITE(stdout,"(/,5x, 'Integration over spin UP JDOS gives: ',f15.9,' instead of 1.0d0' )") renormzero
|
|
|
|
WRITE(stdout,"(/,5x, 'Integration over spin DOWN JDOS gives: ',f15.9,' instead of 1.0d0' )") renormuno
|
|
|
|
WRITE(stdout,"(/,5x, 'Writing output on file...' )")
|
2010-06-14 21:45:31 +08:00
|
|
|
|
2007-09-04 16:22:35 +08:00
|
|
|
OPEN (30, FILE='jdos.dat', FORM='FORMATTED' )
|
|
|
|
!
|
|
|
|
WRITE(30, "(2x,'# energy grid [eV] UJDOS [1/eV] DJDOS[1:eV]')" )
|
|
|
|
!
|
|
|
|
DO iw =1, nw
|
|
|
|
!
|
|
|
|
WRITE(30,"(4f15.6)") wgrid(iw), srjdos(0,iw), srjdos(1,iw)
|
|
|
|
!
|
|
|
|
ENDDO
|
|
|
|
!
|
|
|
|
CLOSE(30)
|
|
|
|
ENDIF
|
|
|
|
|
|
|
|
DEALLOCATE ( srjdos )
|
|
|
|
ENDIF
|
|
|
|
!
|
|
|
|
! local cleaning
|
|
|
|
!
|
|
|
|
CALL grid_destroy()
|
|
|
|
|
2007-02-06 01:01:54 +08:00
|
|
|
END SUBROUTINE jdos_calc
|
|
|
|
|
|
|
|
!-----------------------------------------------------------------------------
|
2007-09-04 16:22:35 +08:00
|
|
|
SUBROUTINE offdiag_calc ( intersmear,intrasmear, nw, wmax, wmin, nbndmin, nbndmax,&
|
|
|
|
shift, metalcalc, nspin )
|
2007-02-06 01:01:54 +08:00
|
|
|
!-----------------------------------------------------------------------------
|
|
|
|
!
|
|
|
|
USE kinds, ONLY : DP
|
|
|
|
USE constants, ONLY : PI, RYTOEV
|
|
|
|
USE cell_base, ONLY : tpiba2, omega
|
|
|
|
USE wvfct, ONLY : nbnd, et
|
|
|
|
USE ener, ONLY : efermi => ef
|
2007-02-27 18:00:57 +08:00
|
|
|
USE klist, ONLY : nks, nkstot, degauss
|
|
|
|
USE grid_module, ONLY : focc, wgrid, grid_build, grid_destroy
|
|
|
|
USE io_global, ONLY : ionode, stdout
|
2008-01-24 01:10:45 +08:00
|
|
|
USE mp_global, ONLY : inter_pool_comm, intra_pool_comm
|
|
|
|
USE mp, ONLY : mp_sum
|
|
|
|
|
2010-06-14 21:45:31 +08:00
|
|
|
!
|
2007-02-06 01:01:54 +08:00
|
|
|
IMPLICIT NONE
|
|
|
|
|
|
|
|
!
|
|
|
|
! input variables
|
|
|
|
!
|
2010-06-14 21:45:31 +08:00
|
|
|
INTEGER, INTENT(in) :: nw,nbndmin,nbndmax,nspin
|
|
|
|
REAL(DP), INTENT(in) :: wmax, wmin, intersmear,intrasmear, shift
|
|
|
|
LOGICAL, INTENT(in) :: metalcalc
|
2007-02-06 01:01:54 +08:00
|
|
|
!
|
|
|
|
! local variables
|
|
|
|
!
|
2010-06-14 21:45:31 +08:00
|
|
|
INTEGER :: ik, iband1, iband2
|
2007-02-27 18:00:57 +08:00
|
|
|
INTEGER :: iw, ierr, it1, it2
|
|
|
|
REAL(DP) :: etrans, const, w
|
2007-02-06 01:01:54 +08:00
|
|
|
!
|
|
|
|
COMPLEX(DP), ALLOCATABLE :: dipole_aux(:,:,:)
|
|
|
|
COMPLEX(DP), ALLOCATABLE :: epstot(:,:,:),dipoletot(:,:,:,:)
|
|
|
|
!
|
|
|
|
!--------------------------
|
|
|
|
! main routine body
|
|
|
|
!--------------------------
|
|
|
|
!
|
|
|
|
! perform some consistency checks, calculate occupation numbers and setup w grid
|
|
|
|
!
|
2007-02-27 18:00:57 +08:00
|
|
|
CALL grid_build(nw, wmax, wmin )
|
2007-02-06 01:01:54 +08:00
|
|
|
!
|
|
|
|
! allocate main spectral and auxiliary quantities
|
|
|
|
!
|
|
|
|
ALLOCATE( dipoletot(3,3, nbnd, nbnd), STAT=ierr )
|
2010-06-14 21:45:31 +08:00
|
|
|
IF (ierr/=0) CALL errore('epsilon','allocating dipoletot', abs(ierr) )
|
2007-02-06 01:01:54 +08:00
|
|
|
!
|
|
|
|
ALLOCATE( dipole_aux(3, nbnd, nbnd), STAT=ierr )
|
2010-06-14 21:45:31 +08:00
|
|
|
IF (ierr/=0) CALL errore('epsilon','allocating dipole_aux', abs(ierr) )
|
2007-02-06 01:01:54 +08:00
|
|
|
!
|
|
|
|
ALLOCATE(epstot( 3,3, nw),STAT=ierr )
|
2010-06-14 21:45:31 +08:00
|
|
|
IF (ierr/=0) CALL errore('epsilon','allocating epstot', abs(ierr))
|
2007-02-06 01:01:54 +08:00
|
|
|
|
|
|
|
!
|
|
|
|
! initialize response functions
|
|
|
|
!
|
|
|
|
epstot = (0.0_DP,0.0_DP)
|
|
|
|
!
|
|
|
|
! main kpt loop
|
|
|
|
!
|
|
|
|
DO ik = 1, nks
|
|
|
|
!
|
|
|
|
! For every single k-point: order k+G for
|
|
|
|
! read and distribute wavefunctions
|
2010-06-14 21:45:31 +08:00
|
|
|
! compute dipole matrix 3 x nbnd x nbnd parallel over g
|
2007-02-06 01:01:54 +08:00
|
|
|
! recover g parallelism getting the total dipole matrix
|
2010-06-14 21:45:31 +08:00
|
|
|
!
|
2007-09-04 16:22:35 +08:00
|
|
|
CALL dipole_calc( ik, dipole_aux, metalcalc, nbndmin, nbndmax)
|
2006-11-23 00:09:55 +08:00
|
|
|
!
|
2007-02-06 01:01:54 +08:00
|
|
|
DO it2 = 1, 3
|
|
|
|
DO it1 = 1, 3
|
2010-06-14 21:45:31 +08:00
|
|
|
dipoletot(it1,it2,:,:) = tpiba2 * dipole_aux(it1,:,:) * conjg( dipole_aux(it2,:,:) )
|
2007-02-06 01:01:54 +08:00
|
|
|
ENDDO
|
|
|
|
ENDDO
|
2006-11-23 00:09:55 +08:00
|
|
|
!
|
|
|
|
! Calculation of real and immaginary parts
|
|
|
|
! of the macroscopic dielettric function from dipole
|
|
|
|
! approximation.
|
2007-02-06 01:01:54 +08:00
|
|
|
! 'intersmear' is the brodening parameter
|
2006-11-23 00:09:55 +08:00
|
|
|
!
|
|
|
|
DO iband2 = 1,nbnd
|
2007-09-04 16:22:35 +08:00
|
|
|
IF ( focc(iband2,ik) < 2.0d0) THEN
|
2006-11-23 00:09:55 +08:00
|
|
|
DO iband1 = 1,nbnd
|
|
|
|
!
|
|
|
|
IF ( focc(iband1,ik) >= 1e-4 ) THEN
|
2007-02-06 01:01:54 +08:00
|
|
|
!
|
|
|
|
! transition energy
|
|
|
|
!
|
|
|
|
etrans = ( et(iband2,ik) -et(iband1,ik) ) * RYTOEV + shift
|
|
|
|
!
|
2010-06-14 21:45:31 +08:00
|
|
|
IF (abs(focc(iband2,ik)-focc(iband1,ik))< 1e-4) CYCLE
|
2007-02-06 01:01:54 +08:00
|
|
|
!
|
|
|
|
! loop over frequencies
|
|
|
|
!
|
|
|
|
DO iw = 1, nw
|
|
|
|
!
|
|
|
|
w = wgrid(iw)
|
|
|
|
!
|
|
|
|
epstot(:,:,iw) = epstot(:,:,iw) + dipoletot(:,:,iband1,iband2)*RYTOEV**3/(etrans) *&
|
|
|
|
focc(iband1,ik)/(etrans**2 - w**2 - (0,1)*intersmear*w)
|
|
|
|
ENDDO
|
|
|
|
!
|
|
|
|
ENDIF
|
|
|
|
ENDDO
|
2007-09-04 16:22:35 +08:00
|
|
|
ENDIF
|
2007-02-06 01:01:54 +08:00
|
|
|
ENDDO
|
|
|
|
!
|
2007-02-09 17:23:17 +08:00
|
|
|
!Intraband (only if metalcalc is true)
|
2007-02-06 01:01:54 +08:00
|
|
|
!
|
|
|
|
IF (metalcalc) THEN
|
|
|
|
DO iband1 = 1,nbnd
|
|
|
|
!
|
|
|
|
IF ( focc(iband1,ik) < 2.0d0) THEN
|
|
|
|
IF ( focc(iband1,ik) >= 1e-4 ) THEN
|
2006-11-23 00:09:55 +08:00
|
|
|
!
|
|
|
|
! loop over frequencies
|
|
|
|
!
|
2007-02-06 01:01:54 +08:00
|
|
|
DO iw = 1, nw
|
2006-11-23 00:09:55 +08:00
|
|
|
!
|
|
|
|
w = wgrid(iw)
|
|
|
|
!
|
2007-09-04 16:22:35 +08:00
|
|
|
epstot(:,:,iw) = epstot(:,:,iw) - dipoletot(:,:,iband1,iband1)* &
|
2010-06-14 21:45:31 +08:00
|
|
|
RYTOEV**2 * (exp((et(iband1,ik)-efermi)/degauss ))/ &
|
|
|
|
(( w**2 + (0,1)*intrasmear*w)*(1+exp((et(iband1,ik)-efermi)/ &
|
|
|
|
degauss))**2*degauss )
|
2007-02-06 01:01:54 +08:00
|
|
|
ENDDO
|
2006-11-23 00:09:55 +08:00
|
|
|
|
|
|
|
ENDIF
|
|
|
|
ENDIF
|
|
|
|
|
|
|
|
ENDDO
|
2007-02-06 01:01:54 +08:00
|
|
|
ENDIF
|
|
|
|
ENDDO
|
|
|
|
|
|
|
|
!
|
|
|
|
! recover over kpt parallelization (inter_pool)
|
|
|
|
!
|
2008-01-24 01:10:45 +08:00
|
|
|
CALL mp_sum( epstot, inter_pool_comm )
|
2006-11-23 00:09:55 +08:00
|
|
|
|
|
|
|
!
|
|
|
|
! impose the correct normalization
|
|
|
|
!
|
2006-11-23 18:47:12 +08:00
|
|
|
const = 64.0d0 * PI / ( omega * REAL(nkstot, DP) )
|
2007-02-06 01:01:54 +08:00
|
|
|
!
|
2006-11-23 18:47:12 +08:00
|
|
|
epstot(:,:,:) = 1.0_DP + epstot(:,:,:) * const
|
2006-11-23 00:09:55 +08:00
|
|
|
!
|
|
|
|
! write results on data files
|
|
|
|
!
|
2007-02-06 01:01:54 +08:00
|
|
|
IF (ionode) THEN
|
|
|
|
!
|
|
|
|
WRITE(stdout,"(/,5x, 'Writing output on file...' )")
|
|
|
|
!
|
2006-11-23 00:09:55 +08:00
|
|
|
OPEN (41, FILE='epsxx.dat', FORM='FORMATTED' )
|
|
|
|
OPEN (42, FILE='epsxy.dat', FORM='FORMATTED' )
|
|
|
|
OPEN (43, FILE='epsxz.dat', FORM='FORMATTED' )
|
|
|
|
OPEN (44, FILE='epsyx.dat', FORM='FORMATTED' )
|
|
|
|
OPEN (45, FILE='epsyy.dat', FORM='FORMATTED' )
|
|
|
|
OPEN (46, FILE='epsyz.dat', FORM='FORMATTED' )
|
|
|
|
OPEN (47, FILE='epszx.dat', FORM='FORMATTED' )
|
|
|
|
OPEN (48, FILE='epszy.dat', FORM='FORMATTED' )
|
|
|
|
OPEN (49, FILE='epszz.dat', FORM='FORMATTED' )
|
2010-06-14 21:45:31 +08:00
|
|
|
!
|
2007-02-06 01:01:54 +08:00
|
|
|
WRITE(41, "(2x,'# energy grid [eV] epsr epsi')" )
|
|
|
|
WRITE(42, "(2x,'# energy grid [eV] epsr epsi')" )
|
|
|
|
WRITE(43, "(2x,'# energy grid [eV] epsr epsi')" )
|
|
|
|
WRITE(44, "(2x,'# energy grid [eV] epsr epsi')" )
|
|
|
|
WRITE(45, "(2x,'# energy grid [eV] epsr epsi')" )
|
|
|
|
WRITE(46, "(2x,'# energy grid [eV] epsr epsi')" )
|
|
|
|
WRITE(47, "(2x,'# energy grid [eV] epsr epsi')" )
|
|
|
|
WRITE(48, "(2x,'# energy grid [eV] epsr epsi')" )
|
|
|
|
WRITE(49, "(2x,'# energy grid [eV] epsr epsi')" )
|
2006-11-23 00:09:55 +08:00
|
|
|
!
|
2007-02-06 01:01:54 +08:00
|
|
|
DO iw =1, nw
|
|
|
|
!
|
2010-06-14 21:45:31 +08:00
|
|
|
WRITE(41,"(4f15.6)") wgrid(iw), REAL(epstot(1,1, iw)), aimag(epstot(1,1, iw))
|
|
|
|
WRITE(42,"(4f15.6)") wgrid(iw), REAL(epstot(1,2, iw)), aimag(epstot(1,2, iw))
|
|
|
|
WRITE(43,"(4f15.6)") wgrid(iw), REAL(epstot(1,3, iw)), aimag(epstot(1,3, iw))
|
|
|
|
WRITE(44,"(4f15.6)") wgrid(iw), REAL(epstot(2,1, iw)), aimag(epstot(2,1, iw))
|
|
|
|
WRITE(45,"(4f15.6)") wgrid(iw), REAL(epstot(2,2, iw)), aimag(epstot(2,2, iw))
|
|
|
|
WRITE(46,"(4f15.6)") wgrid(iw), REAL(epstot(2,3, iw)), aimag(epstot(2,3, iw))
|
|
|
|
WRITE(47,"(4f15.6)") wgrid(iw), REAL(epstot(3,1, iw)), aimag(epstot(3,1, iw))
|
|
|
|
WRITE(48,"(4f15.6)") wgrid(iw), REAL(epstot(3,2, iw)), aimag(epstot(3,2, iw))
|
|
|
|
WRITE(49,"(4f15.6)") wgrid(iw), REAL(epstot(3,3, iw)), aimag(epstot(3,3, iw))
|
2007-02-06 01:01:54 +08:00
|
|
|
!
|
2006-11-23 00:09:55 +08:00
|
|
|
ENDDO
|
|
|
|
!
|
|
|
|
CLOSE(30)
|
|
|
|
CLOSE(40)
|
|
|
|
CLOSE(41)
|
|
|
|
CLOSE(42)
|
2007-02-06 01:01:54 +08:00
|
|
|
!
|
|
|
|
ENDIF
|
|
|
|
|
2006-11-23 00:09:55 +08:00
|
|
|
!
|
|
|
|
! local cleaning
|
|
|
|
!
|
2007-02-06 01:01:54 +08:00
|
|
|
CALL grid_destroy()
|
|
|
|
DEALLOCATE ( dipoletot, dipole_aux, epstot )
|
2006-11-23 00:09:55 +08:00
|
|
|
|
2007-02-06 01:01:54 +08:00
|
|
|
END SUBROUTINE offdiag_calc
|
2006-06-29 19:02:00 +08:00
|
|
|
|
|
|
|
|
2007-09-04 16:22:35 +08:00
|
|
|
!--------------------------------------------------------------------
|
|
|
|
SUBROUTINE dipole_calc( ik, dipole_aux, metalcalc, nbndmin, nbndmax )
|
|
|
|
!------------------------------------------------------------------
|
2007-02-06 01:01:54 +08:00
|
|
|
USE kinds, ONLY : DP
|
2010-12-23 05:45:34 +08:00
|
|
|
USE wvfct, ONLY : npw, nbnd, igk, g2kin, ecutwfc
|
2007-02-06 01:01:54 +08:00
|
|
|
USE wavefunctions_module, ONLY : evc
|
|
|
|
USE klist, ONLY : xk
|
|
|
|
USE cell_base, ONLY : tpiba2
|
2010-12-23 05:45:34 +08:00
|
|
|
USE gvect, ONLY : ngm, g
|
2007-02-06 01:01:54 +08:00
|
|
|
USE io_files, ONLY : nwordwfc, iunwfc
|
|
|
|
USE grid_module, ONLY : focc
|
2008-04-20 00:28:45 +08:00
|
|
|
USE mp_global, ONLY : intra_pool_comm
|
|
|
|
USE mp, ONLY : mp_sum
|
2007-02-06 01:01:54 +08:00
|
|
|
|
|
|
|
IMPLICIT NONE
|
|
|
|
!
|
|
|
|
! global variables
|
2010-06-14 21:45:31 +08:00
|
|
|
INTEGER, INTENT(in) :: ik,nbndmin,nbndmax
|
|
|
|
COMPLEX(DP), INTENT(inout) :: dipole_aux(3,nbnd,nbnd)
|
|
|
|
LOGICAL, INTENT(in) :: metalcalc
|
2007-02-06 01:01:54 +08:00
|
|
|
!
|
|
|
|
! local variables
|
|
|
|
INTEGER :: iband1,iband2,ig
|
2010-06-14 21:45:31 +08:00
|
|
|
COMPLEX(DP) :: caux
|
2007-02-06 01:01:54 +08:00
|
|
|
|
|
|
|
!
|
|
|
|
! Routine Body
|
2010-06-14 21:45:31 +08:00
|
|
|
!
|
2007-02-06 01:01:54 +08:00
|
|
|
CALL start_clock( 'dipole_calc' )
|
2006-06-29 19:02:00 +08:00
|
|
|
|
2007-02-06 01:01:54 +08:00
|
|
|
!
|
|
|
|
! setup k+G grids for each kpt
|
|
|
|
!
|
2010-06-14 21:45:31 +08:00
|
|
|
CALL gk_sort (xk (1, ik), ngm, g, ecutwfc / tpiba2, npw, igk, g2kin)
|
|
|
|
!
|
2007-02-06 01:01:54 +08:00
|
|
|
! read wfc for the given kpt
|
|
|
|
!
|
2010-06-14 21:45:31 +08:00
|
|
|
CALL davcio (evc, nwordwfc, iunwfc, ik, - 1)
|
2007-02-06 01:01:54 +08:00
|
|
|
!
|
|
|
|
! compute matrix elements
|
|
|
|
!
|
|
|
|
dipole_aux(:,:,:) = (0.0_DP,0.0_DP)
|
|
|
|
!
|
2007-09-04 16:22:35 +08:00
|
|
|
DO iband2 = nbndmin,nbndmax
|
2007-02-06 01:01:54 +08:00
|
|
|
IF ( focc(iband2,ik) < 2.0d0) THEN
|
2010-06-14 21:45:31 +08:00
|
|
|
DO iband1 = nbndmin,nbndmax
|
2007-09-04 16:22:35 +08:00
|
|
|
!
|
2010-06-14 21:45:31 +08:00
|
|
|
IF ( iband1==iband2 ) CYCLE
|
2007-02-06 01:01:54 +08:00
|
|
|
IF ( focc(iband1,ik) >= 1e-4 ) THEN
|
|
|
|
!
|
|
|
|
DO ig=1,npw
|
|
|
|
!
|
2010-06-14 21:45:31 +08:00
|
|
|
caux= conjg(evc(ig,iband1))*evc(ig,iband2)
|
2007-02-06 01:01:54 +08:00
|
|
|
!
|
|
|
|
dipole_aux(:,iband1,iband2) = dipole_aux(:,iband1,iband2) + &
|
|
|
|
( g(:,igk(ig)) ) * caux
|
|
|
|
!
|
|
|
|
ENDDO
|
|
|
|
ENDIF
|
|
|
|
!
|
|
|
|
ENDDO
|
2007-09-04 16:22:35 +08:00
|
|
|
ENDIF
|
2007-02-06 01:01:54 +08:00
|
|
|
ENDDO
|
|
|
|
!
|
2007-02-27 18:00:57 +08:00
|
|
|
! The diagonal terms are taken into account only if the system is treated like a metal, not
|
2010-06-14 21:45:31 +08:00
|
|
|
! in the intraband therm. Because of this we can recalculate the diagonal component of the dipole
|
2007-02-27 18:00:57 +08:00
|
|
|
! tensor directly as we need it for the intraband therm, without interference with interband one.
|
|
|
|
!
|
|
|
|
IF (metalcalc) THEN
|
|
|
|
!
|
2007-09-04 16:22:35 +08:00
|
|
|
DO iband1 = nbndmin,nbndmax
|
2007-02-27 18:00:57 +08:00
|
|
|
DO ig=1,npw
|
|
|
|
!
|
2010-06-14 21:45:31 +08:00
|
|
|
caux= conjg(evc(ig,iband1))*evc(ig,iband1)
|
2007-02-27 18:00:57 +08:00
|
|
|
!
|
|
|
|
dipole_aux(:,iband1,iband1) = dipole_aux(:,iband1,iband1) + &
|
|
|
|
( g(:,igk(ig))+ xk(:,ik) ) * caux
|
|
|
|
!
|
|
|
|
ENDDO
|
|
|
|
ENDDO
|
|
|
|
!
|
|
|
|
ENDIF
|
|
|
|
!
|
2007-02-06 01:01:54 +08:00
|
|
|
! recover over G parallelization (intra_pool)
|
|
|
|
!
|
2010-06-14 21:45:31 +08:00
|
|
|
CALL mp_sum( dipole_aux, intra_pool_comm )
|
2007-02-06 01:01:54 +08:00
|
|
|
!
|
|
|
|
CALL stop_clock( 'dipole_calc' )
|
|
|
|
!
|
|
|
|
END SUBROUTINE dipole_calc
|
2007-02-27 18:00:57 +08:00
|
|
|
|
|
|
|
|
|
|
|
!-------------------------------------------------
|
|
|
|
SUBROUTINE occ_calc ()
|
|
|
|
!-------------------------------------------------
|
|
|
|
!
|
|
|
|
USE kinds, ONLY : DP
|
2007-09-04 16:22:35 +08:00
|
|
|
USE klist, ONLY : nkstot, wk, degauss
|
2007-02-27 18:00:57 +08:00
|
|
|
USE wvfct, ONLY : nbnd, wg, et
|
|
|
|
USE ener, ONLY : ef
|
|
|
|
USE mp_global, ONLY : me_pool
|
|
|
|
!
|
|
|
|
IMPLICIT NONE
|
|
|
|
!
|
|
|
|
REAL(DP), ALLOCATABLE :: focc(:,:),foccp(:,:)
|
2010-06-14 21:45:31 +08:00
|
|
|
CHARACTER(25) :: filename
|
2007-02-27 18:00:57 +08:00
|
|
|
INTEGER :: ierr, i, ik
|
2010-06-14 21:45:31 +08:00
|
|
|
!
|
2007-09-04 16:22:35 +08:00
|
|
|
ALLOCATE ( focc( nbnd, nkstot), STAT=ierr )
|
2010-06-14 21:45:31 +08:00
|
|
|
IF (ierr/=0) CALL errore('grid_build','allocating focc', abs(ierr))
|
2007-02-27 18:00:57 +08:00
|
|
|
!
|
2007-09-04 16:22:35 +08:00
|
|
|
ALLOCATE ( foccp( nbnd, nkstot), STAT=ierr )
|
2010-06-14 21:45:31 +08:00
|
|
|
IF (ierr/=0) CALL errore('grid_build','allocating foccp', abs(ierr))
|
2007-02-27 18:00:57 +08:00
|
|
|
|
|
|
|
IF (me_pool==0) THEN
|
|
|
|
!
|
2007-09-04 16:22:35 +08:00
|
|
|
filename = 'occupations.dat'
|
|
|
|
! WRITE(filename,"(I3,'.occupation.dat')")me_pool
|
2010-06-14 21:45:31 +08:00
|
|
|
OPEN (unit=50, file=trim(filename))
|
2007-02-27 18:00:57 +08:00
|
|
|
WRITE(50,*) '#energy (Ry) occupation factor derivative'
|
2010-06-14 21:45:31 +08:00
|
|
|
|
2007-09-04 16:22:35 +08:00
|
|
|
DO ik = 1,nkstot
|
2007-02-27 18:00:57 +08:00
|
|
|
DO i = 1,nbnd
|
|
|
|
focc(i,ik)= wg(i, ik ) * 2.0_DP/wk( ik )
|
2010-06-14 21:45:31 +08:00
|
|
|
foccp(i,ik)= 2* exp((et(i,ik)-ef)/degauss)/((1+exp((et(i,ik)-ef)/degauss))**2*degauss)
|
|
|
|
WRITE(50,*)et(i,ik),focc(i,ik),foccp(i,ik)
|
2007-02-27 18:00:57 +08:00
|
|
|
ENDDO
|
|
|
|
ENDDO
|
2010-06-14 21:45:31 +08:00
|
|
|
|
|
|
|
CLOSE (50)
|
2007-02-27 18:00:57 +08:00
|
|
|
!
|
|
|
|
ENDIF
|
|
|
|
!
|
|
|
|
DEALLOCATE ( focc, STAT=ierr)
|
2010-06-14 21:45:31 +08:00
|
|
|
CALL errore('grid_destroy','deallocating grid stuff',abs(ierr))
|
2007-02-27 18:00:57 +08:00
|
|
|
!
|
|
|
|
DEALLOCATE ( foccp, STAT=ierr)
|
2010-06-14 21:45:31 +08:00
|
|
|
CALL errore('grid_destroy','deallocating grid stuff',abs(ierr))
|
2007-02-27 18:00:57 +08:00
|
|
|
|
|
|
|
END SUBROUTINE occ_calc
|