! SUBROUTINE THAT CREATES THE SCATTERING TABLE/flag_mech = 1 ==> isotropic scattering process, 2 ==> polar optical phonons subroutine sc_table() ! subroutine intervalley_rate(i_count,valley_i,valley_f,nFinalValleys,coupling_const,delta_Efi_eV,EpIntact_eV,out_file_1,out_file_2) use simulation use scattering character*30 out_file_1, out_file_2 ! local variable integer i_count, valley_i, valley_f, nFinalValleys ! initial and final valley real ( kind = 8 ) :: sigma, EpIntact_eV, coupling_const,delta_Efi_eV ! local !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! CREATE TABLE FOR THE GAMMA VALLEY, Scattering mechanism: ! 1: acoustic phonons, 2-3: polar optical phonons 4-5: G-L iv 6-7: G-X iv !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! valley_i = 1 i_count = 0 ! Acoustic phonons scattering rate if(acoustic_G.eq.1)then sigma = acou_sigma_G out_file_1 = 'acoustic_G.txt' call acoustic_rate(i_count,valley_i,sigma,out_file_1) endif ! Coulomb scattering rate - Brooks-Herring approach ! if(Coulomb_scattering.eq.1)then ! out_file_1 = 'Coulomb_G' ! call Coulomb_BH(i_count,valley,num_EnergyLevel,out_file_1) ! endif ! Polar optical phonons scattering rate if(polar_G.eq.1)then ! polar_rate(i_count,valley,EpIntact_eV,out_file_1,out_file_2) ! EpIntact_eV = polar_Ep_G out_file_1 = 'polar_G_ab.txt' out_file_2 = 'polar_G_em.txt' call polar_rate(i_count,valley_i,EpIntact_eV,out_file_1,out_file_2) endif ! Intervalley scattering: G to L if(intervalley_G_L.eq.1)then EpIntact_eV = IntVal_Ep_G_L coupling_const = DefPot_G_L delta_Efi_eV = split_L_G ! energy difference eV nFinalValleys = eq_valleys_L ! # of valleys valley_f = 2 ! final_valley number to L (2) out_file_1 = 'intervalley_G_L_ab.txt' out_file_2 = 'intervalley_G_L_em.txt' call intervalley_rate(i_count,valley_i,valley_f,nFinalValleys,coupling_const,delta_Efi_eV,EpIntact_eV,out_file_1,out_file_2) endif ! Intervalley scattering: G to X valley if(intervalley_G_X.eq.1)then EpIntact_eV = IntVal_Ep_G_X coupling_const = DefPot_G_X delta_Efi_eV = split_X_G ! energy difference eV nFinalValleys = eq_valleys_X ! # of valleys valley_f = 3 ! final_valley number to L (2) out_file_1 = 'intervalley_G_X_ab.txt' out_file_2 = 'intervalley_G_X_em.txt' call intervalley_rate(i_count,valley_i,valley_f,nFinalValleys,coupling_const,delta_Efi_eV,EpIntact_eV,out_file_1,out_file_2) endif call renormalize_table(valley_i,i_count) ! renormalize print*,'Mechanisms in the G valley = ',i_count print*,' ' if(i_count.gt.0)then open(unit=31,file='G_table_renormalized.txt',status='unknown') do i = 1,num_EnergyLevel tempEe_eV = real(i,kind = 8)*StepE_eV write(31,32),tempEe_eV,(ren_scatt_table(i,k,1),k=1,10) !(i,i_count,valley_i) 32 format(2X,11(F8.4,2X)) enddo endif close(31) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! CREATE TABLE FOR THE L VALLEY Scattering mechanism: ! 1. acoustic phonons 2-3 polar optical phonons, 4-5: L-G 6-7: L-L 8-9: L-X intervalley !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! valley_i = 2 i_count = 0 ! Acoustic phonons scattering rate if(acoustic_L.eq.1)then sigma = acou_sigma_L out_file_1 = 'acoustic_L.txt' call acoustic_rate(i_count,valley_i,sigma,out_file_1) endif ! Coulomb scattering rate - Brooks-Herring approach ! if(Coulomb_scattering.eq.1)then ! out_file_1 = 'Coulomb_L' ! call Coulomb_BH(i_count,valley,num_EnergyLevel,out_file_1) ! endif ! Polar optical phonons scattering rate if(polar_L.eq.1)then EpIntact_eV = polar_Ep_L out_file_1 = 'polar_L_ab.txt' out_file_2 = 'polar_L_em.txt' call polar_rate(i_count,valley_i,EpIntact_eV,out_file_1,out_file_2) endif ! Intervalley scattering: L to G valley if(intervalley_L_G.eq.1)then EpIntact_eV = IntVal_Ep_L_G coupling_const = DefPot_L_G delta_Efi_eV = -split_L_G ! energy difference eV nFinalValleys = eq_valleys_G ! # of valleys valley_f = 1 ! final_valley number to G (1) out_file_1 = 'intervalley_L_G_ab.txt' out_file_2 = 'intervalley_L_G_em.txt' call intervalley_rate(i_count,valley_i,valley_f,nFinalValleys,coupling_const,delta_Efi_eV,EpIntact_eV,out_file_1,out_file_2) endif ! Intervalley scattering: L to L valley if(intervalley_L_L.eq.1)then EpIntact_eV = IntVal_Ep_L_L coupling_const = DefPot_L_L delta_Efi_eV = 0. ! energy difference eV nFinalValleys = eq_valleys_L - 1. ! # of valleys valley_f = 2 ! final_valley number to L (2) out_file_1 = 'intervalley_L_L_ab.txt' out_file_2 = 'intervalley_L_L_em.txt' call intervalley_rate(i_count,valley_i,valley_f,nFinalValleys,coupling_const,delta_Efi_eV,EpIntact_eV,out_file_1,out_file_2) endif ! Intervalley scattering: L to X valley if(intervalley_L_X.eq.1)then EpIntact_eV = IntVal_Ep_L_X coupling_const = DefPot_L_X delta_Efi_eV = split_X_G - split_L_G ! energy difference eV nFinalValleys = eq_valleys_X ! # of valleys valley_f = 3 ! final_valley number to X (3) out_file_1 = 'intervalley_L_X_ab.txt' out_file_2 = 'intervalley_L_X_em.txt' call intervalley_rate(i_count,valley_i,valley_f,nFinalValleys,coupling_const,delta_Efi_eV,EpIntact_eV,out_file_1,out_file_2) endif call renormalize_table(valley_i,i_count) ! renormalize print*,'Mechanisms in the L valley = ',i_count print*,' ' if(i_count.gt.0)then open(unit=31,file='L_table_renormalized.txt',status='unknown') do i = 1,num_EnergyLevel tempEe_eV = real(i,kind = 8)*StepE_eV write(31,33), tempEe_eV,(ren_scatt_table(i,k,2),k=1,10) ! 2 - from L 33 format(2X,11(F8.4,2X)) enddo endif close(31) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! CREATE TABLE FOR THE X VALLEY Scattering mechanism: ! 1- acoustic phonons, 2-3: polar optical phonons, 4-5: X-G, 6-7: X-L, 8-9: X-X !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! valley_i = 3 i_count = 0 ! Acoustic phonons scattering rate if(acoustic_X.eq.1)then sigma = acou_sigma_X out_file_1 = 'acoustic_X.txt' call acoustic_rate(i_count,valley_i,sigma,out_file_1) endif ! Coulomb scattering rate - Brooks-Herring approach ! if(Coulomb_scattering.eq.1)then ! out_file_1 = 'Coulomb_X' ! call Coulomb_BH(i_count,valley,num_EnergyLevel,out_file_1) ! endif ! Polar optical phonons scattering rate if(polar_X.eq.1)then EpIntact_eV = polar_Ep_X out_file_1 = 'polar_X_ab.txt' out_file_2 = 'polar_X_em.txt' call polar_rate(i_count,valley_i,EpIntact_eV,out_file_1,out_file_2) endif ! Intervalley scattering: X to G valley if(intervalley_X_G.eq.1)then EpIntact_eV = IntVal_Ep_X_G coupling_const = DefPot_X_G delta_Efi_eV = -split_X_G ! energy difference eV nFinalValleys = eq_valleys_G ! # of valleys valley_f = 1 ! final_valley number to G (1) out_file_1 = 'intervalley_X_G_ab.txt' out_file_2 = 'intervalley_X_G_em.txt' call intervalley_rate(i_count,valley_i,valley_f,nFinalValleys,coupling_const,delta_Efi_eV,EpIntact_eV,out_file_1,out_file_2) endif ! Intervalley scattering: X to L valley if(intervalley_X_L.eq.1)then EpIntact_eV = IntVal_Ep_X_L coupling_const = DefPot_X_L delta_Efi_eV = split_L_G - split_X_G ! energy difference eV nFinalValleys = eq_valleys_L ! # of valleys valley_f = 2 ! final_valley number to L (2) out_file_1 = 'intervalley_X_L_ab.txt' out_file_2 = 'intervalley_X_L_em.txt' call intervalley_rate(i_count,valley_i,valley_f,nFinalValleys,coupling_const,delta_Efi_eV,EpIntact_eV,out_file_1,out_file_2) endif ! Intervalley scattering: X to X valley if(intervalley_X_X.eq.1)then EpIntact_eV = IntVal_Ep_X_X coupling_const = DefPot_X_X delta_Efi_eV = 0. ! energy difference eV nFinalValleys = eq_valleys_X - 1. ! # of valleys valley_f = 3 ! final_valley number to X (3) out_file_1 = 'intervalley_X_X_ab.txt' out_file_2 = 'intervalley_X_X_em.txt' call intervalley_rate(i_count,valley_i,valley_f,nFinalValleys,coupling_const,delta_Efi_eV,EpIntact_eV,out_file_1,out_file_2) endif call renormalize_table(valley_i,i_count) ! renormalize print*,'Mechanisms in the X valley = ',i_count print*,' ' if(i_count.gt.0)then open(unit=31,file='X_table_renormalized.txt',status='unknown') do i = 1,num_EnergyLevel tempEe_eV = real(i,kind = 8)*StepE_eV write(31,34),tempEe_eV,(ren_scatt_table(i,k,3),k=1,10) 34 format(2X,11(F8.4,2X)) enddo endif close(31) return end