Efficient upsampling of multidimensional array

Using method that Guess who it is suggested I managed to get around 75% faster result.

Unsample[x_] := Nest[Riffle[#, #]\[Transpose] &, x, 2]

ans = Map[Unsample, arr, {2}]; // AbsoluteTiming

Your suggested solution evaluates in 1 to 1.2 sec on my machine, while this one evaluates in 0.63 s. I suspect that this method can be further improved.

Note by Mr.Wizard: code mildly refactored.

arr=RandomReal[1,{5000,5,12,12}];

r1=Map[ArrayFlatten,Map[{{#,#},{#,#}}&,arr,{4}],{2}];//AbsoluteTiming
r2=Flatten[Map[{{#,#},{#,#}}&,arr,{4}],{{1},{2},{3,5},{4,6}}];//AbsoluteTiming
r3=Map[With[{t=Transpose@Riffle[#,#]},Transpose@Riffle[t,t]]&,arr,{2}];//AbsoluteTiming

cf = With[{code = 
     ArrayFlatten@
      Map[{{#, #}, {#, #}} &, 
       Array[Quiet @ \[FormalA][[##]] &, {12, 12}], {2}]}, 
   Compile[{{\[FormalA], _Real, 2}}, code, RuntimeAttributes -> Listable]];

r4=cf[arr];//AbsoluteTiming

I propose using Part itself to complete this transformation. In miniature:

m = {{a, b}, {c, d}};

m[[{1, 1, 2, 2}, {1, 1, 2, 2}]] // MatrixForm

$\left( \begin{array}{cccc} a & a & b & b \\ a & a & b & b \\ c & c & d & d \\ c & c & d & d \\ \end{array} \right)$

A function specific to your tensor dimensions:

fn1[m_] := m[[All, All, #, #]] & @ ⌈Range[24]/2⌉

This is about four times faster than the presently Accepted answer and competitive with chyaong's compiled function.

arr = RandomReal[1, {5000, 5, 12, 12}];

fn1[arr] // Dimensions // RepeatedTiming

{0.0324, {5000, 5, 24, 24}}

Generalization

This function may be generalized as follows:

upsample[a_?TensorQ, lev_] := a[[##]] & @@
  Replace[_Integer :> All] /@
    MapAt[⌈Range[2 #]/2⌉ &, Dimensions[a], List /@ lev]

Applied to your case:

upsample[arr, {3, 4}] // Dimensions // RepeatedTiming

{0.032, {5000, 5, 24, 24}}

But also:

t = ArrayReshape[Alphabet[], {2, 2, 2, 2}];

upsample[t, 1] // MatrixForm

upsample[t, 3] // MatrixForm

upsample[t, {2, 4}] // MatrixForm