<< Miscellaneous`RealOnly`
<< Graphics`Colors`
<< Graphics`Legend`
Off[General::"spell1"];
Off[General::"spell"];

Enter the Data:

data = {{0, 0}, {2.0, 0.000}, {4.0, 0.12}, {6.0, 1.42}, {8.0, 
            42.3}, {9.0, 205}, {10.0, 690}, {10.5, 1010}, {11.0, 
            1030}, {11.5, 830}, {12.0, 0.000}};

Plot the data to see what it looks like:

p1 = 
        ListPlot[data, PlotStyle -> {PointSize[0.01], Blue}, 
          ImageSize -> {800, 500}];

Define the model:

model[x_, a_, b_] = 
        a*(12 - x)^2*E^(-b*(12 - x));

We will optimize the model by minimizing the total distance between the data and the model, using the (Subscript[V, 2]) distance function:

V2[a_, 
        b_] = ((0 - model[0, a, b])^2 + (0 - 
                  model[2, a, b])^2
 + (0.12 - 
                  model[4, a, b])^2 + (1.42 - 
                  model[6, a, b])^2
 + (42.3 - 
                  model[8, a, b])^2 + (205 - 
                  model[9, a, b])^2
 + (690 - 
                  model[10, a, b])^2 + (1010 - 
                  model[10.5, a, b])^2
 + (1030 - 
                  model[11, a, b])^2 + (830 - 
                  model[11.5, a, b])^2
 + (0 - 
                  model[12, a, b])^2)^(1/2)

We wish to plot this, but have no idea what range of values of use for a and b. So we find the values of a and b that force the model to be an exact fit for two points (if the model had had three parameters we would have found an exact fit for three points):

Solve[{model[8, a, b] == 42.3, 
        model[11, a, b] == 1030}, {a, b}]

Check that these values give a reasonable fit:

estOfA=;
estOfB=;
F[x_] = model[x, estOfA, estOfB];
p1 = 
        ListPlot[data, PlotStyle -> {PointSize[0.01], Blue}, 
          DisplayFunction -> Identity];
p2 = 
        Plot[F[x], {x, 0, 12}, PlotStyle -> {Red}, 
          DisplayFunction -> Identity];
Show[{p1, p2}, DisplayFunction -> $DisplayFunction, 
        ImageSize -> {800, 500}];

So we plot values of a around 8000 and values of b around 2:

Plot3D[{V2[a, b], Hue[V2[a, b]/10000]}, 
(* The number that divides V2 in the Hue command should be:
 increased until only a single color shows, 
	then  gradually  reduced  again  until  
                      the  region  of  minimal  height  can  be  
                      identified *)
{a, 6000, 10000},{b, 0, 4},
ImageSize -> {800, 500},
PlotPoints -> 40,
ViewPoint -> {1, -1, 1}  
];

From the plot focus on the minimal area with a contour plot. The objective should be to see a black area surrounded by dark gray; this gives a strong indication that the region is indeed minimal

ContourPlot[V2[a, b],
{a, 6000, 10000},{b, 1, 3},   
ImageSize -> {800, 500},
PlotPoints -> 20,   
Contours -> 10  
];

To find the exact location of the local minimum we solve (∂_a) (Subscript[V, 2])(a, b) = 0 and (∂_b) (Subscript[V, 2])(a, b) = 0. Before using the Solve or FindRoot commnads it can help Mathematica if we do the differentiation first:
(Ignore the blue warnings about spelling errors)

dxV2[a_, b_] = D[V2[a, b], a];
dyV2[a_, b_] = D[V2[a, b], b];

We try to use Solve first:

Solve[{dxV2[a, b] == 0, dyV2[a, b] == 0}, {a, b}]   (* If this takes a long time,  
          or starts spitting out blue error messages,  
          go to Kernal -> Abort Evaluation *)

If you had to abort the Solve command, then use FindRoot using the 'exact fit values' above as your first guess:

FindRoot[{dxV2[a, b] == 0, 
        dyV2[a, b] == 0}, 
{a, 7500.0}, {b, 
        1.9}, 
MaxIterations -> 15   
]

If this version of FindRoot didn't work then use the one below. Use the boundary of the minimal area you found using ContourPlot as the values for a and b. (You could also use this as a check on the answer from the previous FindRoot command)

FindRoot[{dxV2[a, b] == 0, dyV2[a, b] == 0},
{a, {7000, 8500}},{b, {1.85, 2}},  
MaxIterations -> 15    
]

Now we plot the data together with the optimal model, this is to give a visual check on the validity of the model.

Clear[F];
bestA=;
bestB=;
F[x_] = model[x, bestA, bestB];
p1 = 
        ListPlot[data, PlotStyle -> {PointSize[0.01], Red}, 
          DisplayFunction -> Identity];
p2 = 
        Plot[F[x], {x, 0, 12}, PlotStyle -> {Blue}, 
          DisplayFunction -> Identity];
Show[{p1, p2}, DisplayFunction -> $DisplayFunction, 
        ImageSize -> {800, 500}];

Notice that this function has regions that would give misleading results when using both vertical and horizontal residuals, so we should, ideally use perpendicular residuals, Mathematica, however has difficulties calculating these to a sufficient level of accuracy.