Set-Up

Begin with the constants, in reduced variables to make things simple. Also, set the barrier height to 1 and offset V by 1e-3 for convenience.

hbar := 1
me := 1
V0 := 1
En =.

Enter the values for the wavenumber, following CTDL pg. 84

k1 =. 
k2 =.

K0 := (Sqrt[((2*me*V0)/((hbar^2)))])
k1[k_] := k
k2[k_] := (Sqrt[(k^2) - (K0^2)])

The coefficients for reflection have already been calculated for this problem - set them up as recommended in CTDL. Notice that this makes A1 and A2 functions of k.

A1 =. 
A2 =.

A1[k_] := (((k1[k] - k2[k]))/((k1[k] + k2[k])))
A2[k_] := ((2*k1[k])/((k1[k] + k2[k])))

Define Δk, from the problem set. From this, construct g(k). Also throw in ω(k) - this will be convenient later on.

deltak := (Sqrt[0.1*V0])
a := (Sqrt[2])/deltak
g[k_] := 
      Exp[-((a^2)/
                4)*((k - k0)^2)]
ω[k_] := ((hbar*(k^2))/(2*me))

Define the last parameters, k0, x0, and the location of the step.

k0 := (Sqrt[2.1])
x0 := -10
steploc := 0

Wave functions

Now: the wavefunctions. I separated the incident wave from the reflected and transmitted waves (maybe it's inappropriate to call it the 'initial' wave, but that's what I started with). Mathematica starts making some inconvenient assumptions when the 'Conj' function is called, so it is usually more convenient to flip the signs in front of the i's manually and name a new function. Let me know if you have an easier way to do this.

Ψinitial[x_, t_, k_] := 
      (1/(Sqrt[2*π]))*g[k]*
        Exp[I*((k*x) - ω[k]*t)]*
        Exp[-I*(k - k0)*x0]
Ψinitialconj[x_, t_, k_] := 
      (1/(Sqrt[2*π]))*g[k]*
        Exp[-I*((k*x - ω[k]*t))]*
        Exp[I*(k - k0)*x0]
Ψreflected[x_, t_, k_] := 
      (1/(Sqrt[2*π]))*g[k]*A1[k]*
        Exp[-I*((k*x) + ω[k]*t)]*
        Exp[-I*(k - k0)*x0]
Ψreflectedconj[x_, t_, k_] := 
      (1/(Sqrt[2*π]))*g[k]*A1[k]*
        Exp[I*((k*x) + ω[k]*t)]*
        Exp[I*(k - k0)*x0]
Ψtransmitted[x_, t_, k_] := 
      (1/(Sqrt[2*π]))*g[k]*A2[k]*
        Exp[I*(((Sqrt[(k^2) - (K0^2)])*x) - ω[k]*t)]*
        Exp[-I*(k - k0)*x0]
Ψtransmittedconj[x_, t_, k_] := 
      (1/(Sqrt[2*π]))*g[k]*A2[k]*
        Exp[-I*(((Sqrt[(k^2) - (K0^2)])*x) - ω[k]*
                  t)]*Exp[I*(k - k0)*x0]

I ended up summing k over nine locations because this made for better pictures. Again, it looks cluttered due to manual complex conjugate-ing. The function names are long, but I wanted to make them clear.

Ψinitial[x_, t_] := 
      UnitStep[-(x)]*(Ψinitial[x, t, 
              k0]
 + Ψinitial[x, t, 
              k0 + deltak/2]
 + Ψinitial[x, t, 
              k0 - deltak/2]
 + Ψinitial[x, t, 
              k0 + deltak]
 + Ψinitial[x, t, 
              k0 - deltak]
 + Ψinitial[x, t, 
              k0 + 3*deltak/2]
 + Ψinitial[x, 
              t, k0 - 3*deltak/2]
 + Ψinitial[
              x, t, k0 + 2*deltak]
 + Ψinitial[
              x, t, k0 - 2*deltak])
Ψinitialconj[x_, t_] := 
      UnitStep[-(x)]*(Ψinitialconj[x, t, 
              k0]
 + Ψinitialconj[x, t, 
              k0 + deltak/2]
 + Ψinitialconj[x, 
              t, k0 - deltak/2]
 + Ψinitialconj[
              x, t, k0 + 
                deltak]
 + Ψinitialconj[x, t, 
              k0 - deltak]
 + Ψinitialconj[x, 
              t, k0 + 3*
                  deltak/2]
 + Ψinitialconj[x, 
              t, k0 - 3*
                  deltak/2]
 + Ψinitialconj[x, 
              t, k0 + 2*deltak]
 + Ψinitialconj[
              x, t, k0 - 2*deltak])
Ψreflected[x_, t_] := 
      UnitStep[-(x)]*(Ψreflected[x, t, 
              k0]
 + Ψreflected[x, t, 
              k0 + deltak/2]
 + Ψreflected[x, 
              t, k0 - deltak/2]
 + Ψreflected[
              x, t, k0 + deltak]
 + Ψreflected[
              x, t, k0 - deltak]
 + Ψreflected[
              x, t, k0 + 
                3*deltak/2]
 + Ψreflected[x, t, 
              k0 - 3*deltak/2]
 + Ψreflected[x, 
              t, k0 + 2*deltak]
 + Ψreflected[
              x, t, k0 - 2*deltak])
Ψreflectedconj[x_, t_] := 
      UnitStep[-(x)]*(Ψreflectedconj[x, t, 
              k0]
 + Ψreflectedconj[x, t, 
              k0 + deltak/2]
 + Ψreflectedconj[
              x, t, k0 - 
                deltak/2]
 + Ψreflectedconj[x, 
              t, k0 + deltak]
 + Ψreflectedconj[
              x, t, k0 - 
                deltak]
 + Ψreflectedconj[x, t, 
              k0 + 3*deltak/
                    2]
 + Ψreflectedconj[x, t, 
              k0 - 3*deltak/
                    2]
 + Ψreflectedconj[x, t, 
              k0 + 2*deltak]
 + Ψreflectedconj[
              x, t, k0 - 2*deltak])
Ψtransmitted[x_, t_] := 
      UnitStep[(x)]*
(Ψtransmitted[x, t, 
              k0] + 
Ψtransmitted[x, t, 
              k0 + deltak/2] + 
Ψtransmitted[x, 
              t, k0 - deltak/2] + 
Ψtransmitted[
              x, t, k0 + 
                deltak] + 
Ψtransmitted[x, t, 
              k0 - deltak] + 
Ψtransmitted[x, 
              t, k0 + 3*
                  deltak/2] + 
Ψtransmitted[x, 
              t, k0 - 3*
                  deltak/2] + 
Ψtransmitted[x, 
              t, k0 + 2*deltak] + 
Ψtransmitted[
              x, t, k0 - 2*deltak])
Ψtransmittedconj[x_, t_] := 
      UnitStep[(x)]*(Ψtransmittedconj[x, t, 
              k0]
 + Ψtransmittedconj[x, t, 
              k0 + deltak/
                  2]
 + Ψtransmittedconj[x, t, 
              k0 - deltak/
                  2]
 + Ψtransmittedconj[x, t, 
              k0 + deltak]
 + Ψtransmittedconj[
              x, t, k0 - 
                deltak]
 + Ψtransmittedconj[x, 
              t, 
              k0 + 3*deltak/
                    2]
 + Ψtransmittedconj[x, 
              t, k0 - 3*
                  deltak/2]
 + Ψtransmittedconj[
              x, t, k0 + 
                2*deltak]
 + Ψtransmittedconj[
              x, t, k0 - 2*deltak])

Test to see how the transmission and reflection coefficients (or their precursors) look.

A1[k0]
A2[k0]

Movies

A movie of the incident wave and its reflection.

For[time = 0, 
      time < 15, time++, 
Plot[
Re[(Ψinitial[x, 
                  time] + Ψreflected[x, 
                  time])*(Ψinitialconj[x, 
                  time] + Ψreflectedconj[x, 
                  time])], 
{x, -20, 
          0}, 
PlotRange -> {0, 4}]]

CTDL makes a nice approximation for the characteristics of the transmitted wave. Below is a movie of that approximation vs. the incedent wave in the absence of a barrier. Notice the periodicity in the transmitted wave because we approximated the integration with a sum.

Ψinitialnostep[x_, 
        t_] := (Ψinitial[x, t, 
            k0]
 + Ψinitial[x, t, 
            k0 + deltak/2]
 + Ψinitial[x, t, 
            k0 - deltak/2]
 + Ψinitial[x, t, 
            k0 + deltak]
 + Ψinitial[x, t, 
            k0 - deltak]
 + Ψinitial[x, t, 
            k0 + 3*deltak/2]
 + Ψinitial[x, t, 
            k0 - 3*deltak/2]
 + Ψinitial[x, t, 
            k0 + 2*deltak]
 + Ψinitial[x, t, 
            k0 - 2*deltak])
Ψinitialnostepconj[x_, 
        t_] := (Ψinitialconj[x, t, 
            k0]
 + Ψinitialconj[x, t, 
            k0 + deltak/2]
 + Ψinitialconj[x, 
            t, k0 - deltak/2]
 + Ψinitialconj[
            x, t, k0 + deltak]
 + Ψinitialconj[
            x, t, k0 - deltak]
 + Ψinitialconj[
            x, t, k0 + 
              3*deltak/2]
 + Ψinitialconj[x, t, 
            k0 - 3*deltak/2]
 + Ψinitialconj[x, 
            t, k0 + 2*deltak]
 + Ψinitialconj[
            x, t, k0 - 2*deltak])

The approximate width of the transmitted wave, and its reciporical: the coefficient of x in the wave equations.

deltatransmit = (Sqrt[(k0^2) - (K0^2)])/k0
1/deltatransmit

For[time = 10, 
      time < 18, time++, 
Plot[
{Re[
            A2[k0]^2*Ψinitialnostep[x*4.5, 
                time]*Ψinitialnostepconj[x*4.5, 
                time]], 
Ψinitialnostep[x, 
              time]*Ψinitialnostepconj[x, 
              time]}, 
{x, 0, 
          20}
]
]