Skip to content
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
362 changes: 229 additions & 133 deletions src/ome_ex.f90
Original file line number Diff line number Diff line change
Expand Up @@ -37,150 +37,167 @@ module ome_ex

contains
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine get_ome_ex(iflag_norder)
implicit none

!here
subroutine get_ome_ex(iflag_norder)
implicit none

integer iflag_norder
integer :: ibz
integer :: nn,nnp
integer :: nj
integer, intent(in) :: iflag_norder
integer :: ibz
integer :: nn, nnp
integer :: nj

! For k-resolved excitonic linear output
integer :: u_exk
logical :: do_write_exk
complex*16, allocatable :: vme_ex_k(:,:) ! (3, norb_ex_cut)

! auxiliary arrays used to evaluate ex-ome
dimension ek(npointstotal,nband_ex)
dimension xme_ex_band(npointstotal,3,nband_ex,nband_ex) ! only here! provisional
dimension vme_ex_band(npointstotal,3,nband_ex,nband_ex)
dimension berry_eigen_ex_band(npointstotal,3,nband_ex,nband_ex)
dimension gen_der_ex_band(npointstotal,3,3,nband_ex,nband_ex)
dimension shift_vector_ex_band(npointstotal,3,3,nband_ex,nband_ex)

real*8 :: ek
real*8 :: shift_vector_ex_band
complex*16 :: xme_ex_band
complex*16 :: vme_ex_band
complex*16 :: berry_eigen_ex_band
complex*16 :: gen_der_ex_band

!auxiliary arrays used to evaluate ex-ome
dimension ek(npointstotal,nband_ex)
dimension xme_ex_band(npointstotal,3,nband_ex,nband_ex) !only here! provisional
dimension vme_ex_band(npointstotal,3,nband_ex,nband_ex)
dimension berry_eigen_ex_band(npointstotal,3,nband_ex,nband_ex)
dimension gen_der_ex_band(npointstotal,3,3,nband_ex,nband_ex)
dimension shift_vector_ex_band(npointstotal,3,3,nband_ex,nband_ex)

real*8 :: ek
real*8 :: shift_vector_ex_band
complex*16 :: xme_ex_band
complex*16 vme_ex_band
complex*16 berry_eigen_ex_band
complex*16 gen_der_ex_band
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
write(*,*) '6. Entering ome_ex'

!read SP optical matrix elements from file
write(*,*) ' Reading optical matrix elements (sp)...'
if (iflag_norder.eq.1) then
vme_ex_band=0.0d0
ek=0.0d0
call read_ome_sp_linear(iflag_norder,npointstotal,nband_ex,vme_ex_band,ek)
write(*,*) '6. Entering ome_ex'

! Decide whether to write the k-resolved file:
! Only makes sense for linear (iflag_norder == 1)
do_write_exk = (iflag_norder .eq. 1)

! read SP optical matrix elements from file
write(*,*) ' Reading optical matrix elements (sp)...'
if (iflag_norder .eq. 1) then
vme_ex_band = 0.0d0
ek = 0.0d0
call read_ome_sp_linear(iflag_norder, npointstotal, nband_ex, vme_ex_band, ek)
end if

if (iflag_norder .eq. 2) then
ek = 0.0d0
vme_ex_band = 0.0d0
berry_eigen_ex_band = 0.0d0
gen_der_ex_band = 0.0d0
shift_vector_ex_band = 0.0d0
call read_ome_sp_nonlinear(iflag_norder, npointstotal, nband_ex, berry_eigen_ex_band, &
gen_der_ex_band, shift_vector_ex_band, vme_ex_band, ek)

! Provisional (19/07/2025): we evaluate here xme_ex_band at a given k-point
xme_ex_band = 0.0d0
call get_ome_sp_xme_ex_band(ek, vme_ex_band, xme_ex_band)
end if

! allocate arrays for ex-ome
! linear conductivity
if (iflag_norder .eq. 1 .or. iflag_norder .eq. 2) then
allocate(vme_ex(3, norb_ex_cut))
allocate(xme_ex(3, norb_ex_cut))
vme_ex = 0.0d0
xme_ex = 0.0d0
end if

! allocate k-resolved buffer + open file (linear only)
if (do_write_exk) then
allocate(vme_ex_k(3, norb_ex_cut))
vme_ex_k = 0.0d0
u_exk = 77
call write_ome_ex_linear_kresolved_init(u_exk, material_name, norb_ex_cut)
end if

! second order ones
if (iflag_norder .eq. 2) then
allocate(qme_ex_inter1(3, norb_ex_cut, norb_ex_cut))
allocate(qme_ex_inter2(3, norb_ex_cut, norb_ex_cut))
allocate(qme_ex_inter(3, norb_ex_cut, norb_ex_cut))
allocate(yme_ex_inter1(3, norb_ex_cut, norb_ex_cut))
allocate(yme_ex_inter2(3, norb_ex_cut, norb_ex_cut))
allocate(yme_ex_inter(3, norb_ex_cut, norb_ex_cut))
allocate(xme_ex_inter(3, norb_ex_cut, norb_ex_cut))
allocate(vme_ex_inter1(3, norb_ex_cut, norb_ex_cut))
allocate(vme_ex_inter2(3, norb_ex_cut, norb_ex_cut))
allocate(vme_ex_inter(3, norb_ex_cut, norb_ex_cut))

qme_ex_inter1 = 0.0d0
qme_ex_inter2 = 0.0d0
qme_ex_inter = 0.0d0
yme_ex_inter1 = 0.0d0
yme_ex_inter2 = 0.0d0
yme_ex_inter = 0.0d0
xme_ex_inter = 0.0d0
vme_ex_inter1 = 0.0d0
vme_ex_inter2 = 0.0d0
vme_ex_inter = 0.0d0

! allocate and get derivative of exciton envelope function with respect to k
allocate(fk_ex_der(3, norb_ex, norb_ex_cut))
call get_fk_ex_der_k()
end if

if (iflag_norder .eq. 1) then
write(*,*) ' Evaluating excitonic optical matrix elements for linear conductivity...'
end if
if (iflag_norder .eq. 2) then
write(*,*) ' Evaluating excitonic optical matrix elements for nonlinear conductivity...'
end if

! k-space integration of excitonic optical matrix elements
do ibz = 1, npointstotal
write(*,*) ' Optical matrix elements (ex): k-point', ibz, '/', npointstotal

! Fill V_{0N} and X_{0N} (summed over k) for linear conductivity
if (iflag_norder .eq. 1 .or. iflag_norder .eq. 2) then
call get_ome_gs_ex_sum_k(ibz, ek, xme_ex_band, vme_ex_band)
end if

if (iflag_norder.eq.2) then
ek=0.0d0
vme_ex_band=0.0d0
berry_eigen_ex_band=0.0d0
gen_der_ex_band=0.0d0
shift_vector_ex_band=0.0d0
call read_ome_sp_nonlinear(iflag_norder,npointstotal,nband_ex,berry_eigen_ex_band, &
gen_der_ex_band,shift_vector_ex_band,vme_ex_band,ek)


!Provisional (19/07/2025): we evaluate hete xme_ex_band at a given k-point
!Better to implement in ome_sp later
xme_ex_band=0.0d0
call get_ome_sp_xme_ex_band(ek,vme_ex_band,xme_ex_band)
end if

!allocate arrays for ex-ome
!linear conductivity
if (iflag_norder.eq.1 .or. iflag_norder.eq.2) then
allocate(vme_ex(3,norb_ex_cut))
allocate(xme_ex(3,norb_ex_cut))
vme_ex=0.0d0
xme_ex=0.0d0
end if
!second order ones
if (iflag_norder.eq.2) then
allocate(qme_ex_inter1(3,norb_ex_cut,norb_ex_cut))
allocate(qme_ex_inter2(3,norb_ex_cut,norb_ex_cut))
allocate(qme_ex_inter(3,norb_ex_cut,norb_ex_cut))
allocate(yme_ex_inter1(3,norb_ex_cut,norb_ex_cut))
allocate(yme_ex_inter2(3,norb_ex_cut,norb_ex_cut))
allocate(yme_ex_inter(3,norb_ex_cut,norb_ex_cut))
allocate(xme_ex_inter(3,norb_ex_cut,norb_ex_cut))
allocate(vme_ex_inter1(3,norb_ex_cut,norb_ex_cut))
allocate(vme_ex_inter2(3,norb_ex_cut,norb_ex_cut))
allocate(vme_ex_inter(3,norb_ex_cut,norb_ex_cut))
qme_ex_inter1=0.0d0
qme_ex_inter2=0.0d0
qme_ex_inter=0.0d0
yme_ex_inter1=0.0d0
yme_ex_inter2=0.0d0
yme_ex_inter=0.0d0
xme_ex_inter=0.0d0
vme_ex_inter1=0.0d0
vme_ex_inter2=0.0d0
vme_ex_inter=0.0d0
!allocate and getderivative of exciton envelope function with respect to k
allocate (fk_ex_der(3,norb_ex,norb_ex_cut))
!get exciton envelope function derivative with respect to k
call get_fk_ex_der_k() !get derivative of exciton envelope function with respect to k
end if

if (iflag_norder.eq.1) then
write(*,*) ' Evaluating excitonic optical matrix elements for linear conductivity...'
! Also write k-resolved contribution for linear case:
if (do_write_exk) then
call get_ome_gs_ex_kresolved(ibz, ek, vme_ex_band, vme_ex_k)
call write_ome_ex_linear_kresolved_point(u_exk, rkxvector(ibz), rkyvector(ibz), rkzvector(ibz), &
norb_ex_cut, vme_ex_k)
end if
if (iflag_norder.eq.2) then
write(*,*) ' Evaluating excitonic optical matrix elements for nonlinear conductivity...'
end if

!k-space integration of excitonic optical marix elements
do ibz=1,npointstotal
write(*,*) ' Optical matrix elements (ex): k-point',ibz,'/',npointstotal
!fill V_{0N} and X_{0N} for linear conductivity
if (iflag_norder.eq.1 .or. iflag_norder.eq.2) then
call get_ome_gs_ex_sum_k(ibz,ek,xme_ex_band,vme_ex_band) !sum over k points
end if
if (iflag_norder.eq.2) then
!fill Q_{NN'} (1,2), Y_{NN'} (1,2) and V_{NN'} (1,2)
call get_ome_inter_ex_sum_k(ibz,ek,xme_ex_band,vme_ex_band,berry_eigen_ex_band) !sum over k points
end if
end do

if (iflag_norder.eq.2) then
!Sum all terms together for matrix elements
!fill Q_{NN'} (total), Y_{NN'} (total), X_{NN'} (total) and V_{NN'} (total)
do nn=1,norb_ex_cut
do nnp=1,norb_ex_cut
do nj=1,3
qme_ex_inter(nj,nn,nnp)=qme_ex_inter1(nj,nn,nnp)+qme_ex_inter2(nj,nn,nnp)
yme_ex_inter(nj,nn,nnp)=yme_ex_inter1(nj,nn,nnp)+yme_ex_inter2(nj,nn,nnp)
xme_ex_inter(nj,nn,nnp)=yme_ex_inter(nj,nn,nnp)+qme_ex_inter(nj,nn,nnp)
vme_ex_inter(nj,nn,nnp)=vme_ex_inter1(nj,nn,nnp)+vme_ex_inter2(nj,nn,nnp)
end do
end do
end do

!do nn=1,10
!write(*,*) nn,e_ex(nn)*27.211386,qme_ex_inter(1,nn,nn),qme_ex_inter1(1,nn,nn),qme_ex_inter2(1,nn,nn)
!end do
!pause
if (iflag_norder .eq. 2) then
call get_ome_inter_ex_sum_k(ibz, ek, xme_ex_band, vme_ex_band, berry_eigen_ex_band)
end if
end do

if (do_write_exk) then
call write_ome_ex_linear_kresolved_close(u_exk)
deallocate(vme_ex_k)
write(*,*) ' k-resolved linear excitonic matrix elements written (omeexk)'
end if

if (iflag_norder .eq. 2) then
! Sum all terms together for matrix elements (N,N')
do nn = 1, norb_ex_cut
do nnp = 1, norb_ex_cut
do nj = 1, 3
qme_ex_inter(nj, nn, nnp) = qme_ex_inter1(nj, nn, nnp) + qme_ex_inter2(nj, nn, nnp)
yme_ex_inter(nj, nn, nnp) = yme_ex_inter1(nj, nn, nnp) + yme_ex_inter2(nj, nn, nnp)
xme_ex_inter(nj, nn, nnp) = yme_ex_inter(nj, nn, nnp) + qme_ex_inter(nj, nn, nnp)
vme_ex_inter(nj, nn, nnp) = vme_ex_inter1(nj, nn, nnp) + vme_ex_inter2(nj, nn, nnp)
end do
end do
end do
end if

!do ibz=1,npointstotal
!write(*,*) ibz,fk_ex(ibz,1),fk_ex_der(1,ibz,1)
!end do
write(*,*) ' Optical matrix elements (ex) have been evaluated'

!do nn=1,norb_ex_cut
!write(*,*) nn,abs(qme_ex_inter1(1,1,nn)),abs(qme_ex_inter2(1,1,nn))
!end do
!pause
! writing excitonic optical matrix elements (summed over k)
if (iflag_norder .eq. 1) then
call write_ome_ex_linear(vme_ex)
end if
write(*,*) ' Optical matrix elements (ex, N -> GS) have been written in file'
write(*,*) ' Optical matrix elements (ex, N -> N^prime) will not be printed in this version'

write(*,*) ' Optical matrix elements (ex) have been evaluated'
!writing excitonic optical matrix elements
if (iflag_norder.eq.1) then
call write_ome_ex_linear(vme_ex)
end if
write(*,*) ' Optical matrix elements (ex, N -> GS) have been written in file'
write(*,*) ' Optical matrix elements (ex, N -> N^prime) will not be printed in this version'
end subroutine get_ome_ex
end subroutine get_ome_ex

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine get_ome_sp_xme_ex_band(ek,vme_ex_band,xme_ex_band)
Expand Down Expand Up @@ -251,6 +268,41 @@ subroutine get_ome_gs_ex_sum_k(ibz,ek,xme_ex_band,vme_ex_band)
end do
end subroutine get_ome_gs_ex_sum_k

!-----------------------------------------------------------------
! Compute k-resolved contribution to V_{0N} for a single k-point
! This fills vme_ex_k(:,nn) with the contributions coming from
! the given k-point `ibz`, using the same index mapping as
! get_ome_gs_ex_sum_k but without summing over k-points.
!-----------------------------------------------------------------
subroutine get_ome_gs_ex_kresolved(ibz,ek,vme_ex_band,vme_ex_k)
implicit none
integer :: ibz

integer :: nn,ic,iv,nj
integer :: i_ex_nn

dimension ek(npointstotal,nband_ex)
dimension vme_ex_band(npointstotal,3,nband_ex,nband_ex)
complex*16 :: vme_ex_band
complex*16 :: vme_ex_k(3,norb_ex_cut)
real*8 :: ek

! initialize
vme_ex_k = 0.0d0

do nn = 1, norb_ex_cut
do ic = 1, nc_ex
do iv = 1, nv_ex
call get_ex_index_first(nf, nv_ex, nc_ex, 0, ibz, i_ex_nn, ic, iv)
do nj = 1, 3
vme_ex_k(nj, nn) = vme_ex_k(nj, nn) + fk_ex(i_ex_nn, nn) * vme_ex_band(ibz, nj, iv, nv_ex+ic)
end do
end do
end do
end do

end subroutine get_ome_gs_ex_kresolved

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine get_ome_inter_ex_sum_k(ibz,ek,xme_ex_band,vme_ex_band,berry_eigen_ex_band)
implicit none
Expand Down Expand Up @@ -361,6 +413,47 @@ subroutine write_ome_ex_linear(vme_ex)
end subroutine write_ome_ex_linear
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

subroutine write_ome_ex_linear_kresolved_init(unitno, material_name, norb_ex_cut)
implicit none
integer, intent(in) :: unitno, norb_ex_cut
character(len=*), intent(in) :: material_name

open(unitno, file='ome_linear_ex_k_'//trim(material_name)//'.omeexk', status='replace')
! Simple header:
! line 1: tag
! line 2: norb_ex_cut
write(unitno,*) 1
write(unitno,*) norb_ex_cut
end subroutine write_ome_ex_linear_kresolved_init


subroutine write_ome_ex_linear_kresolved_point(unitno, kx, ky, kz, norb_ex_cut, vme_ex_k)
implicit none
integer, intent(in) :: unitno, norb_ex_cut
real*8, intent(in) :: kx, ky, kz
complex*16, intent(in) :: vme_ex_k(3, norb_ex_cut)

integer :: nn
! For each k-point:
! line: kx ky kz
! then norb_ex_cut lines:
! nn Re(Vx) Im(Vx) Re(Vy) Im(Vy) Re(Vz) Im(Vz)
write(unitno,*) kx, ky, kz
do nn = 1, norb_ex_cut
write(unitno,*) nn, dble(vme_ex_k(1,nn)), dimag(vme_ex_k(1,nn)), &
dble(vme_ex_k(2,nn)), dimag(vme_ex_k(2,nn)), &
dble(vme_ex_k(3,nn)), dimag(vme_ex_k(3,nn))
end do
end subroutine write_ome_ex_linear_kresolved_point


subroutine write_ome_ex_linear_kresolved_close(unitno)
implicit none
integer, intent(in) :: unitno
close(unitno)
end subroutine write_ome_ex_linear_kresolved_close


!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine read_ome_sp_linear(iflag_norder,npointstotal,nband_ex,vme_ex_band,ek)
implicit none
Expand Down Expand Up @@ -450,4 +543,7 @@ subroutine read_ome_sp_nonlinear(iflag_norder,npointstotal,nband_ex,berry_eigen_

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
end subroutine read_ome_sp_nonlinear



end module ome_ex
Loading