Finding intersection points of two graphics

Using your data

plot1 = ListLinePlot[data, PlotStyle -> {Thick, Black}];
f = Function[t, a*t^n] /. FindFit[data, a*t^n, {a, n}, t, MaxIterations -> 1000]
plot2 = Plot[f[t], {t, 2, 60}, PlotStyle -> Red];

and then

Show[
 plot1,
 plot2,
 ImageSize -> 400
 ]

Mathematica graphics

The same technique used here can be applied to this problem:

pts=Graphics`Mesh`FindIntersections@Show[
  plot1,
  plot2
  ]
(* {{26.3239, 0.487639}, {49.5794, 1.23106}} *)

So that

Show[
 plot1,
 plot2,
 Graphics[{
   RGBColor[0, 0.7, 0],
   PointSize -> 0.025,
   Point[pts]
   }],
 ImageSize -> 400
 ]

Mathematica graphics


To find exect numbers (using a picture), start with data from OP. enter image description here

Difine

f[t_] = a Power[t, n] /. 
  FindFit[data, a Power[t, n], {a, n}, t, MaxIterations -> 1000]

Then

g = Interpolation[data];
FindRoot[f[t] == g[t], {t, #}] & /@ {26, 50};
pts = Thread[{t /. s, f[t /. s]}]

{{26.2896, 0.486623}, {49.6013, 1.23181}}

You may also try without any picture

z = Quiet@FindRoot[f[t] == g[t], {t, #}] & /@ data[[All, 1]];
u = Sort@Select[DeleteDuplicates[Round[(t /. z), 0.001]], (# > 0) &]
pts4 = Thread[{u, f[u]}]

to get all four (!) points automatically

{{0.021, 0.0000143076}, {26.29, 0.486633}, {49.601, 1.2318}, {60.291, 1.63887}}

Show plots with points: enter image description here


A numerical approach

fit = a*t^n /. FindFit[data, a*t^n, {a, n}, t, MaxIterations -> 1000]

0.00407473 t^1.46296

Get fitted data

tab = Table[fit, {t, data[[1, 1]], data[[-1, 1]], (data[[-1, 1]] - data[[1, 1]])/(Length@data - 1)}];

Crossing positions

pos = Flatten@Position[Partition[Last /@ data - tab, 2, 1], {a_, b_} /; Sign@a != Sign@b];

Crossing at points

data[[pos]]

{{26.0395, 0.477391}, {49.06, 1.22164}}

Show[
 Plot[fit, {t, 0, 60}, PlotStyle -> Orange],
 ListPlot[data],
 Graphics[{Red, PointSize[0.02], Point@data[[pos]]}]]

enter image description here