Wave Propagation in Linear Media | re-examined

PhiFro::usage =
"PhiFro[x,t,w,k,n,l,(opts)] returns the left-going part in the barrier.
For further information see Phi"
PhiTun::usage =
"PhiTun[x,t,w,k,n,l,(opts)] returns the wave inside the barrier. For
further information see Phi"
Begin["`Private`"]
(*-- Functions independent of the waveform --*)
RefCoeffPos[xi_,l_] := -I Sin[l Sqrt[xi^2-1]]/
(2 xi Sqrt[xi^2-1] Cos[l Sqrt[xi^2-1]] - I (2 xi^2-1) Sin[l Sqrt[xi^2-1]]);
RefCoeffNeg[xi_,l_] := I Sin[l Sqrt[xi^2-1]]/
(2 xi Sqrt[xi^2-1] Cos[l Sqrt[xi^2-1]] + I (2 xi^2-1) Sin[l Sqrt[xi^2-1]]);
ToCoeffPos[xi_,l_] := (xi Sqrt[xi^2-1] + xi^2)/
(2 xi Sqrt[xi^2-1] Cos[l Sqrt[xi^2-1]] - I (2 xi^2-1) Sin[l Sqrt[xi^2-1]])
ToCoeffNeg[xi_,l_] := (xi Sqrt[xi^2-1] + xi^2)/
(2 xi Sqrt[xi^2-1] Cos[l Sqrt[xi^2-1]] + I (2 xi^2-1) Sin[l Sqrt[xi^2-1]])
FroCoeffPos[xi_,l_] := (xi Sqrt[xi^2-1] - xi^2)/
(2 xi Sqrt[xi^2-1] Cos[l Sqrt[xi^2-1]] - I (2 xi^2-1) Sin[l Sqrt[xi^2-1]])
FroCoeffNeg[xi_,l_] := (xi Sqrt[xi^2-1] - xi^2)/
(2 xi Sqrt[xi^2-1] Cos[l Sqrt[xi^2-1]] + I (2 xi^2-1) Sin[l Sqrt[xi^2-1]])
TransCoeffPos[xi_,l_] := 2 xi Sqrt[xi^2-1]/
(2 xi Sqrt[xi^2-1] Cos[l Sqrt[xi^2-1]] - I (2 xi^2-1) Sin[l Sqrt[xi^2-1]])
TransCoeffNeg[xi_,l_] := 2 xi Sqrt[xi^2-1]/
(2 xi Sqrt[xi^2-1] Cos[l Sqrt[xi^2-1]] + I (2 xi^2-1) Sin[l Sqrt[xi^2-1]])
TunOsc[a_,b_,c_,d_,xi_] := Exp[I (a xi^2 + b xi + c Sqrt[xi^2 - 1] + d)];
OutOsc[a_,b_,c_,d_,xi_] := Exp[I (a xi^2 + (b+c) xi + d)];
GaussTruncLims[w_,k_,n_,wp_] :=
{N[Sqrt[w] (1-n/(Pi k) *
Sqrt[Log[Sqrt[2 Pi] k/Sqrt[n w Sqrt[2 Pi]]/10^-(wp+1)]]), wp+2],
N[Sqrt[w] (1+n/(Pi k) *
Sqrt[Log[Sqrt[2 Pi] k/Sqrt[n w Sqrt[2 Pi]]/10^-(wp+1)]]), wp+2]};
(*-- Wave packet shape --*)
GaussConst[w_,k_,n_] := k Sqrt[2 Pi / (w n Sqrt[2 Pi])];
GaussShapePos[w_,k_,n_,xi_] := Exp[-(Pi k (xi/Sqrt[w] - 1)/n)^2];
GaussShapeNeg[w_,k_,n_,xi_] := Exp[-(Pi k (-xi/Sqrt[w] - 1)/n)^2];
GaussIncPos[a_,b_,c_,d_,w_,k_,n_,l_][xi_] :=
GaussShapePos[w,k,n,xi] * OutOsc[a,b,c,d,xi];
GaussIncNeg[a_,b_,c_,d_,w_,k_,n_,l_][xi_] :=
GaussShapeNeg[w,k,n,xi] * OutOsc[a,b,c,d,xi];
GaussRefPos[a_,b_,c_,d_,w_,k_,n_,l_][xi_] :=
RefCoeffPos[xi,l] * GaussShapePos[w,k,n,xi] * OutOsc[a,b,c,d,xi];
GaussRefNeg[a_,b_,c_,d_,w_,k_,n_,l_][xi_] :=
RefCoeffNeg[xi,l] * GaussShapeNeg[w,k,n,xi] * OutOsc[a,b,c,d,xi];
GaussToPos[a_,b_,c_,d_,w_,k_,n_,l_][xi_] :=
ToCoeffPos[xi,l] * GaussShapePos[w,k,n,xi] * TunOsc[a,b,c,d,xi];
GaussToNeg[a_,b_,c_,d_,w_,k_,n_,l_][xi_] :=
ToCoeffNeg[xi,l] * GaussShapeNeg[w,k,n,xi] * TunOsc[a,b,c,d,xi];
GaussFroPos[a_,b_,c_,d_,w_,k_,n_,l_][xi_] :=
FroCoeffPos[xi,l] * GaussShapePos[w,k,n,xi] * TunOsc[a,b,c,d,xi];
GaussFroNeg[a_,b_,c_,d_,w_,k_,n_,l_][xi_] :=
FroCoeffNeg[xi,l] * GaussShapeNeg[w,k,n,xi] * TunOsc[a,b,c,d,xi];
GaussTransPos[a_,b_,c_,d_,w_,k_,n_,l_][xi_] :=
TransCoeffPos[xi,l] * GaussShapePos[w,k,n,xi] * OutOsc[a,b,c,d,xi];
GaussTransNeg[a_,b_,c_,d_,w_,k_,n_,l_][xi_] :=
TransCoeffNeg[xi,l] * GaussShapeNeg[w,k,n,xi] * OutOsc[a,b,c,d,xi];
(*-- Templates for wave computations --*)
GaussPassTruncTemp[fpos_, fneg_, x_, t_, w_, k_, n_, l_, opts___Rule] :=
Module[{wp = WorkingPrecision/.{opts}/.Options[OscInt],
ag = AccuracyGoal/. {opts}/.Options[OscInt],
pg = PrecisionGoal/. {opts}/.Options[OscInt],
mi = MinRecursion/. {opts}/.Options[OscInt],
230
A Mathematica packages