module particles ! Number of carriers, and node integer, parameter :: DIM = 3 ! dimension ! For each particle real ( kind = 8 ), dimension(:,:), allocatable :: Par_pos, Par_wvk, Par_vel, PreRun_Par_wvk, PreRun_Par_vel ! carrier position and wave vector k integer, dimension(:), allocatable :: Par_valley, Par_use, PreRun_Par_valley, Par_Al ! 1 is used 0 is not/ Add 08/2013 for Al Content Var real ( kind = 8 ), dimension(:), allocatable :: Par_ene, Par_tau, PreRun_Par_ene, PreRun_Par_tau real ( kind = 8 ) :: ParCharge ! charge of sampled particles ! for fixed potential integer :: num_Bins, num_boundBin, num_BarTros, num_FieldSec, InitialPosDist, num_InitBin, PropertyNode ! InitialPosDist- Algorithm for initial position distribution real ( kind = 8 ) :: BinSize ! Tro_Depth, real ( kind = 8 ), dimension(2) :: FieldAppRegion real ( kind = 8 ), dimension(2, DIM) :: box_coor ! box coordinate, (Lx_min, Lx_max, Ly_min, Ly_max, Lz_min, Lz_max) real ( kind = 8 ), dimension(DIM) :: box_len ! box length, (Lx, Ly, Lz) y and z is periodic .. , real ( kind = 8 ), dimension(:), allocatable :: loc_Bar, Bar_Height,loc_Start_Field,loc_End_Field,Field_Sec ! 1D, loc_Tro real ( kind = 8 ), dimension(:), allocatable :: loc_bin ! 1D ! position/ Properties real ( kind = 8 ) :: SysCurrent, EneBoundL, EneBoundR, EneBound, AccumEneBoundL, AccumEneBoundR, AccumEneBound,AccumSysCurrent integer :: ParInNumBoundL,AccumParInNumBoundL,ParInNumBoundR,AccumParInNumBoundR,ParOutNumBoundL, ParOutNumBoundR, ParNumBoundPlus, AccumParOutNumBoundL, AccumParOutNumBoundR, AccumParNumBoundPlus ! 1D real ( kind = 8 ), dimension(:,:), allocatable :: binhist_ParNumDen, TA_binhist_ParNumDen, TA_binhist_ParNumber, bin_ParVal, TA_bin_ParVal integer, dimension(:,:), allocatable :: binhist_ParNumber real ( kind = 8 ), dimension(:), allocatable :: initbin_ParAveEne, bin_ParNumDen, bin_ParAveEne, bin_ParAveEneV, bin_ParDrftVel, TA_bin_ParNumDen, TA_bin_ParAveEne, TA_bin_ParNumber, TA_bin_ParDrftVel ! 1D integer, dimension(:), allocatable :: bin_ParNumber end module scattering ! for valley - integer, parameter :: num_Valley = 3 ! G - 1, L - 2, X - 3 integer, parameter :: num_ScatMech = 15 ! max for each ... G 1~10, L 11~, X polar_ab 1, real ( kind = 8 ), dimension(num_Valley) :: nonParaParameter, rel_eff_mass ! default.. nonParabolPara2, nonParabolPara4 real ( kind = 8 ), dimension(:,:), allocatable :: nonParabolPara,nonParabolPara2, nonParabolPara4,eff_mass,semh,hhem,tau_max,Energy_debye,DebyeEps real ( kind = 8 ), dimension(:), allocatable :: nBin_eps_high,nBin_eps_low,Debye_length !dielectric constant integer, dimension(num_Valley) :: max_scatt_mech integer:: num_EnergyLevel ! total # of energy level real ( kind = 8 ) :: MaxE_eV, StepE_eV integer:: PrintoutPhonon, PrintoutPartProp, PrintoutXYZ, PrintoutHist, PrintoutScatRate ! Fileout setting 0709 integer:: PolarOpticalTest,polar_L,polar_X,IonImpurity_Scat_G,IonImpurity_Scat_L,IonImpurity_Scat_X,Alloy_Scat_G,Alloy_Scat_L,Alloy_Scat_X integer:: acoustic_G,acoustic_L,acoustic_X,intervalley_G_L,intervalley_G_X,intervalley_L_G,intervalley_L_L,intervalley_L_X,intervalley_X_G,intervalley_X_L,intervalley_X_X ! Scattering Parameters integer :: AlContVary,num_BinsForAl ! Al Content Variation Add 08/2013 real ( kind = 8 ) :: BinLengthForAl,loc_Start_Al,loc_End_Al,DefaultAlContent,Default_rho_GaAs,Default_u_sound,Default_primV real ( kind = 8 ) :: Default_split_L_G,Default_split_X_G,Default_eps_high,Default_eps_low ! dielectric constant real (kind = 8), dimension(:), allocatable :: Al_Dist_Content,Al_rho_GaAs,Al_eps_high,Al_eps_low,Al_split_L_G,Al_split_X_G,Al_rel_eff_massG,Al_rel_eff_massL,Al_rel_eff_massX,Al_nonPara_G, Al_u_sound, Al_primV real ( kind = 8 ) :: acou_sigma_G,acou_sigma_L,acou_sigma_X, polar_Ep_G,polar_Ep_L,polar_Ep_X ! Acoustic Coupling Const[eV] G/L/X = 7.01/9.2/9.0 ! phonon energy for Polaroptical /eV/ 0.03536, 0.03536, 0.03536 real ( kind = 8 ) :: DefPot_G_L,DefPot_G_X,DefPot_L_G,DefPot_L_L,DefPot_L_X,DefPot_X_G,DefPot_X_L,DefPot_X_X ! GL1.8E10 GX10.E10 LG 1.8E10 LL 5.E10 LX 1.E10 XG 10.E10 XL 1.E10 XX 10.E10 Intervalley Deformation Potential [eV/m] real ( kind = 8 ) :: IntVal_Ep_G_L,IntVal_Ep_G_X,IntVal_Ep_L_G,IntVal_Ep_L_L, IntVal_Ep_L_X,IntVal_Ep_X_G,IntVal_Ep_X_L,IntVal_Ep_X_X ! phonon energy for IV /eV/ 0.0278, 0.0299, 0.0278, 0.029, 0.0293, 0.0299, 0.0293, 0.0299 real ( kind = 8 ) :: eq_valleys_G,eq_valleys_L,eq_valleys_X, AlloyPotDiff ! Ee level diff (0.29,0.48), # of eq valleys 1/4/3 !!! later need to consider change real ( kind = 8 ), dimension(:,:,:,:), allocatable :: scatt_table, ren_scatt_table ! Add Al bin integer:: num_BinsComb integer, dimension(:), allocatable :: AlBinFromCB,TBinFromCB integer, dimension(:,:), allocatable :: CombBin real ( kind = 8 ), dimension(:,:), allocatable :: TempVar_tau_max real ( kind = 8 ), dimension(:,:,:), allocatable :: acou_constTemp,polarAb_constTemp,polarEm_constTemp,alloy_constTemp,impurity_constTemp real ( kind = 8 ), dimension(:,:,:,:), allocatable :: ivAb_constTemp,ivEm_constTemp,TempVar_scat_table,TempVar_renscat_table ! phonon 0709 integer, dimension(num_ScatMech,num_Valley):: AllScatCount ! Phonon Counting 0709 integer, dimension(:,:,:), allocatable:: BinScatCount, TempVar_BinScatCount ! Phonon Counting 0709 Phonon simulation 11/2012 integer, dimension(:), allocatable:: TA_bin_PhononNum ! Phonon Counting 0709 real ( kind = 8 ), dimension(:), allocatable:: TA_bin_PhononEne, TA_bin_PhononEneWm ! Phonon Counting 0709 ! Additional Phonon related parameters 11/2012 real(kind = 8 ) :: ConstForEneOp, ExternalResAP,ExternalResOP, T_room ! Defined in problem ConstForEneOp-calculated real(kind = 8 ) :: qsupply, qsupplyA, qsupplyO, TpA_Hot, TpA_Cold, TpO_Hot, TpO_Cold, k_pA, k_pO, MatElement, RepresentEpLO ! from Input real(kind = 8),dimension(:),allocatable:: Bin_TemperOP,Bin_OccupOP,Bin_TemperAP,TABin_TemperOP,TABin_TemperAP ! Additional Phonon Tracking 11/2012 real(kind = 8),dimension(:),allocatable:: BinQsupO, BinQsupA, BinQsupTotal, TABinQsupO, TABinQsupA, TABinQsupTotal ! Additional Phonon Tracking 11/2012 real(kind = 8),dimension(:),allocatable:: epInterEneWm2, ppInterEneWm2, BinOPEne, BinAPEne, TAepInterEneWm2, TAppInterEneWm2 ! Additional Phonon Tracking 11/2012 real(kind = 8),dimension(:),allocatable:: fave_bin_TpA, fave_bin_TpO, fave_bin_qsupA, fave_bin_qsupO, fave_bin_qsupT, fave_bin_epWm2, fave_bin_ppWm2 ! Additional Phonon Tracking 11/2012 real(kind = 8),dimension(:),allocatable:: Tfave_bin_TpA, Tfave_bin_TpO, Tfave_bin_qsupA, Tfave_bin_qsupO, Tfave_bin_qsupT, Tfave_bin_epWm2, Tfave_bin_ppWm2 real( kind = 8 ) :: RightBoundTempAP, RightBoundTempOP, APTableTempLow,APTableTempHigh,APParaCapRT, APParaCapZ,APParaBeta, step_APTemp integer:: BoundQSetting, num_APTable, num_APmidCheck real (kind = 8), dimension(:), allocatable :: APTableTemper, APTableHeatCp, APTableEnergy integer, dimension(:), allocatable :: SelectedIdx integer:: TotalP_Num,TotalScatCount,TotalopScatCount,polar_G_Num,polar_L_Num,polar_X_Num,IntVal_G_L_Num,IntVal_G_X_Num,IntVal_L_G_Num integer:: IntVal_L_L_Num,IntVal_L_X_Num,IntVal_X_G_Num,IntVal_X_L_Num,IntVal_X_X_Num real ( kind = 8 ) :: TotalP_EneWm, TotalP_Ene,polar_G_Ene,polar_L_Ene,polar_X_Ene,IntVal_G_L_Ene,IntVal_G_X_Ene,IntVal_L_G_Ene real ( kind = 8 ) :: IntVal_L_L_Ene,IntVal_L_X_Ene,IntVal_X_G_Ene,IntVal_X_L_Ene,IntVal_X_X_Ene integer, dimension(num_ScatMech,num_Valley):: flag_mech real ( kind = 8 ), dimension(num_ScatMech,num_Valley):: E_change integer, dimension(num_ScatMech,num_Valley):: i_valley integer, dimension(num_ScatMech,num_Valley):: ScatMechFreq real ( kind = 8 ) :: max_scat ! MaxScattering Rate real ( kind = 8 ), dimension(:,:), allocatable :: RelCumFreqDist, FreqDist, CumFreqDist ! distribution function end module simulation ! Basic Parameters real ( kind = 8 ), parameter :: pi = 3.141592653589793239 real ( kind = 8 ), parameter :: kB = 1.3806503D-23 ! J/K real ( kind = 8 ), parameter :: r_o = 1.0D-10 ! Angstrom real ( kind = 8 ), parameter :: m_o = 1.675D-27 !neutron mass %kg real ( kind = 8 ), parameter :: m_e = 9.10938188D-31 !electron mass real ( kind = 8 ), parameter :: e_c = 1.60217646D-19 real ( kind = 8 ), parameter :: eps_o = 8.8541878176D-12 ! dielectric C^2/N-m^2 real ( kind = 8 ), parameter :: N_a = 6.0221415D26 ! Avogadro real ( kind = 8 ), parameter :: hbar = 1.05457148D-34 ! J-s real ( kind = 8 ) :: echbar ! J-s ! Simulation Condition integer:: num_Carriers, num_maxCarriers,Initialnum_Carriers,BothSideCheck, num_bcCheckBin, step_output1, step_output2 ! total sampled # of carriers ! FinalSimulation 0720 real ( kind = 8 ) :: Initial_je,DerivedCellV, TimePreLMax ! initially calculate 0720 real ( kind = 8 ) :: time_fave,time_fave_period, fave_PhonEWm,fave_PhonEWm_eb,fave_eNum,fave_eNum_eb,fave_vel,fave_vel_eb,fave_je,fave_je_eb real ( kind = 8 ) :: fave_TotEne, fave_InOut_B,fave_InOut_LB,fave_InOut_RB,fave_G_ratio, fave_jeA_eb, fave_jeA real ( kind = 8 ), dimension(:), allocatable:: fave_bin_eNum, fave_bin_vel, fave_bin_PhonEWm, fave_bin_PoiPot, fave_bin_AllPot, fave_bin_Eneev real ( kind = 8 ) :: Tfave_PhonEWm,Tfave_PhonEWm_eb,Tfave_eNum,Tfave_eNum_eb,Tfave_vel,Tfave_vel_eb,Tfave_TotEne,Tfave_InOut_B,Tfave_InOut_LB,Tfave_InOut_RB,Tfave_G_ratio real ( kind = 8 ), dimension(:), allocatable:: Tfave_bin_eNum, Tfave_bin_vel, Tfave_bin_PhonEWm, Tfave_bin_PoiPot, Tfave_bin_AllPot, Tfave_bin_Eneev !!!!!!!!! Preloop !11/2012 - Pre real(kind=8),dimension(:),allocatable::PreLoop_Bin_OccupAP,PreLoop_Bin_OccupOP,PreLoop_A_Bin_vel,PreLoop_A_Bin_eNum real(kind=8),dimension(:),allocatable::PreLoop_Bin_EpLO,PreLoop_Bin_EpLOWm3,PreLoop_Bin_EpLOWm2,PreLoop_Bin_EpTO,PreLoop_Bin_EpTOWm3,PreLoop_Bin_EpTOWm2,PreLoop_Bin_EpO,PreLoop_Bin_EpOWm3,PreLoop_Bin_EpOWm2 real(kind=8)::PreLoop_eNum,PreLoop_eNum_eb,PreLoop_vel,PreLoop_vel_eb,PreLoop_je,PreLoop_jeA,PreLoop_je_eb,PreLoop_jeA_eb real(kind=8)::PreLoop_TP_EneWm2_eb,PreLoop_TP_EneWm2,PreLoop_TPLO_EneWm2,PreLoop_TPLO_EneWm2_eb,PreLoop_TPTO_EneWm2,PreLoop_TPTO_EneWm2_eb !!!!!!!!! Quasi Steady !11/2012 - Pre real ( kind = 8 ),dimension(:),allocatable::Quasi_peLOWm2,Quasi_peTOWm2,Quasi_peOWm2,Quasi_ppUpWm2 integer:: ChangeHPABField, QuasiSdotMode, QuasiBoundConsid, GivenQsupply, PreLoopSpeed real(kind=8)::HotPhononFactor,Target_jeA,Target_Speed ! input real(kind=8)::QuasiTimeStep,QuasiTimeMax,MaxTempChange integer:: Algo_bcCheck, num_CheckFreq, BCoption, TempUpdateFreq ! add Temperature check Freq 11/2012 real ( kind = 8 ) :: num_InjLB, num_InjRB, BCPos_factor, BCEne_factor real ( kind = 8 ) :: time, time_max, time_step, time_early ! time step fs real ( kind = 8 ) :: Te, Tp, Tsys, Te_eV, Tp_eV, Tsys_eV ! in K, in eV real ( kind = 8 ), dimension(3) :: EFieldBg ! electric field V/m velcity initial bias ! Pre-run parameters integer:: Use_prerun, PRParNum real ( kind = 8 ) :: PRtime_max, PRtime_early, PRtime ! time step fs real ( kind = 8 ), dimension(:), allocatable :: PRValley ! Poisson Setting/Check, BarrierCLM, PhononSim, ! add 11/2012 integer:: BarrierCLM, PhononSim, LOmodeOccPhonSim, PoissonSetting, Algo_AssignCharge, Step_FreqFieldUpdate, num_Nodes, num_InitNode, Algo_PoiFieldAssign, UpdatePoiField real ( kind = 8 ) :: time_Poisson, NodeSize, ChargeForPoisson real ( kind = 8 ), dimension(:), allocatable :: loc_Node, pot_Node, InitPot_Node, charge_Node, num_Node, field_Node ! real ( kind = 8 ), dimension(:), allocatable :: TA_Node_Potential, TA_Node_PoiPot, TA_Node_Charge, TA_Node_EField ! Properties Check ! energy - all valley, for each valley, real ( kind = 8 ) :: TotParEne, AveParEne, TimeAveParEne, PotentialGain ! energy real ( kind = 8 ), dimension(:), allocatable :: TotEneValley, AveEneValley, TimeAveEneValley ! ! freq - valley, integer, dimension(:), allocatable :: FreqValley ! How many particles in the whole area in each valley real ( kind = 8 ), dimension(:), allocatable :: RelFreqValley, TimeFreqValley, TimeRelFreqValley ! How many particles in the whole area in each valley - time average ! velocity - all valleys, each valley real ( kind = 8 ), dimension(3) :: AveParVel, TimeAveParVel ! average particle velocity for x,y,z direction real ( kind = 8 ), dimension(:,:), allocatable :: AveParValleyVel, TimeAveParValleyVel ! Energy Histogram - for all energy valleys, for each valley integer, dimension(:), allocatable :: EneLevelHist, Deficiency_bin integer :: StepParOutL, StepParOutR real ( kind = 8 ) :: InjParPerStep, AccumInjParL, AccumInjParR, vel_InitBias real ( kind = 8 ), dimension(:), allocatable :: RelEneLevelHist, TimeRelEneLevelHist ! EneLevelHist-number integer, dimension(:,:), allocatable :: EneLevelValleyHist real ( kind = 8 ), dimension(:,:), allocatable :: RelEneLevelValleyHist, TimeRelEneLevelValleyHist ! EneLevelHist-number real ( kind = 8 ) :: E_F, n_d, n_i real ( kind = 16 ) :: RandomNum ! Generated Random number end