Find permutation with highest organization number (OEIS A047838)

This answer just shows how to improve the speed of orgNumber:

orgNumber2[p_] := Total @ Abs @ Differences @ p

Comparison:

t0 = Table[RandomSample[Range[44]],{i,1,100000}];

t1 = Max[Map[orgNumber,t0]]; //AbsoluteTiming
t2 = Max[Map[orgNumber2, t0]]; //AbsoluteTiming

t1==t2

{6.94362, Null}

{0.4978, Null}

True

Another almost order of magnitude increase in speed can be obtained by writing a version that works with multiple lists:

orgNumber3[p:{__List}] := Total[Abs @ Transpose @ Differences[Transpose@p], {2}]

Timing:

t3 = Max @ orgNumber3[t0]; //AbsoluteTiming
t1 == t2 == t3

{0.070115, Null}

True

Addendum

Using ciao's comment, producing the desired permutation is simple:

maxPerm[n_] := Ordering @ Join[
    Range[2, 2 Floor[n/2], 2],
    {1},
    Range[2 Ceiling[n/2] - 1, 3, -2]
]

For $n=44$:

r = maxPerm[44]; //AbsoluteTiming
r
orgNumber2[r]

{0.000045, Null}

{23, 1, 44, 2, 43, 3, 42, 4, 41, 5, 40, 6, 39, 7, 38, 8, 37, 9, 36, \ 10, 35, 11, 34, 12, 33, 13, 32, 14, 31, 15, 30, 16, 29, 17, 28, 18, \ 27, 19, 26, 20, 25, 21, 24, 22}

967

For $n = 10^6$ :

n = 10^6;
r = maxPerm[n]; //AbsoluteTiming
orgNumber2[r]
Floor[n^2/2] - 1

{0.019479, Null}

499999999999

499999999999

...and we are done!
Solution for k=44 in 10 seconds

k=44;
r=Last@Select[Flatten[Table[Select[Riffle[#,-Last@IntegerPartitions[Floor[(Floor[k^2/2]-1)/2],{Floor[(k-1)/2]},b=Range[s=Floor[Floor[(Floor[k^2/2]-1)/2]/Floor[k/2]],s+2]]]&/@Reverse/@IntegerPartitions[Floor[(Floor[k^2/2]-1)/2]+1,{Ceiling[(k-1)/2]},Range[s=Floor[Floor[(Floor[k^2/2] - 1)/2]/Floor[k/2]],s+k-8]],Union[FoldList[Total[{##}]&,p,#]]==Range@k&],{p,k}],1],Union@Differences@Union[FoldList[Total[{##}]&,#[[1]],#]]=={1}&];w=FoldList[Total[{##}]&,1,r];
f=w+k-Max@w
Total@Abs@Differences@f
Floor[k^2/2]-1    

k=44

{22,44,21,43,20,42,19,41,18,40,17,39,16,38,15,37,14,36,13,35,12,34,11,33,10,32,9,31,8,30,7,29,6,28,5,27,4,26,3,25,2,24,1,23}
967
967

This algorithm tries to find the differences-list of the result.

By examining the differences we can see that half of them are positive and half negative. Also sum of positives is equal to sum of negatives +1 and they are riffled. So we are trying to produce those two sets using IntegerPartition but we must choose as less results as possible in order for this to terminate. In order to make this work we have to "fine-tune" the variable c of the following algorithm (otherwise it will throw errors). The goal of this answer was to reach k=44 which seemed impossible by testing permutations...
Here are the correct values in order to hit k=50

k=50;
c=15;
r=Last@Select[Flatten[Table[Select[Riffle[#,-Last@IntegerPartitions[Floor[(Floor[k^2/2]-1)/2],{Floor[(k-1)/2]},b=Range[s=Floor[Floor[(Floor[k^2/2]-1)/2]/Floor[k/2]],s+2]]]&/@Reverse/@IntegerPartitions[Floor[(Floor[k^2/2]-1)/2]+1,{Ceiling[(k-1)/2]},Range[s=Floor[Floor[(Floor[k^2/2] - 1)/2]/Floor[k/2]],s+c]],Union[FoldList[Total[{##}]&,p,#]]==Range@k&],{p,k}],1],Union@Differences@Union[FoldList[Total[{##}]&,#[[1]],#]]=={1}&];w=FoldList[Total[{##}]&,1,r];
f=w+k-Max@w
Total@Abs@Differences@f
Floor[k^2/2]-1     

k=50
{25,50,24,49,23,48,22,47,21,46,20,45,19,44,18,43,17,42,16,41,15,40,14,39,13,38,12,37,11,36,10,35,9,34,8,33,7,32,6,31,5,30,4,29,3,28,2,27,1,26}
1249
1249