1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
|
unit StatThdsUtil;
interface
uses
ComCtrls,Classes, Graphics, ExtCtrls, define_types,stats,dialogs;
const
kMaxThreads = 16;
kSh = 10; //bits to shift
kMaxImages = 1024;
kMaxPermute = 4000;
kPlankMB : integer = 512;
var
gnCPUThreads, gThreadsRunning: Integer;
kPlankSz : integer;// =1024 {bytes/kb} * 1024 {bytes/mb} * kPlankMB; //e.g. 512 MB
gDataTypeRA: array [0..kMaxImages] of integer;
gOffsetRA,gScaleRA,gInterceptRA: array [0..kMaxImages] of single;
gnVoxTestedRA : array [0..kMaxThreads] of integer;
gPermuteMinT,gPermuteMaxT,gPermuteMinBM,gPermuteMaxBM : array [0..kMaxThreads,0..kMaxPermute ] of double;
procedure ClearThreadData(lnThreads,lnPermute: integer);
function SumThreadDataLite (lnThreads: integer): integer;
function SumThreadData (lnThreads,lnPermute: integer;lPermuteMaxT, lPermuteMinT,lPermuteMaxBM, lPermuteMinBM: singleP): integer;
procedure ClearThreadDataPvals (lnThreads,lnPermute: integer);
implementation
procedure ClearThreadDataPvals (lnThreads,lnPermute: integer);
var lT,lP: integer;
begin
if lnThreads < 1 then exit;
if lnPermute > kMaxPermute then
showmessage('Error: recompile with larger kMaxPermute');
for lT := 1 to lnThreads do
gnVoxTestedRA[lT] := 0;
if lnPermute < 1 then exit;
for lT := 1 to lnThreads do begin
for lP := 1 to lnPermute do begin
gPermuteMinT[lT,lP] := 10;
gPermuteMaxT[lT,lP] := -10;
gPermuteMinBM[lT,lP] := 10;
gPermuteMaxBM[lT,lP] := -10;
end;
end;
end;
procedure ClearThreadData (lnThreads,lnPermute: integer);
var lT,lP: integer;
begin
if lnThreads < 1 then exit;
if lnPermute > kMaxPermute then
showmessage('Error: recompile with larger kMaxPermute');
for lT := 1 to lnThreads do
gnVoxTestedRA[lT] := 0;
if lnPermute < 1 then exit;
for lT := 1 to lnThreads do begin
for lP := 1 to lnPermute do begin
gPermuteMinT[lT,lP] := 0;
gPermuteMaxT[lT,lP] := 0;
gPermuteMinBM[lT,lP] := 0;
gPermuteMaxBM[lT,lP] := 0;
end;
end;
end;
function SumThreadDataLite (lnThreads: integer): integer;
var lT: integer;
begin
result := 0;
if lnThreads < 1 then exit;
for lT := 1 to lnThreads do
result := result + gnVoxTestedRA[lT];
end;
function SumThreadData (lnThreads,lnPermute: integer;lPermuteMaxT, lPermuteMinT,lPermuteMaxBM, lPermuteMinBM: singleP): integer;
var lT,lP: integer;
begin
result := 0;
if lnThreads < 1 then exit;
for lT := 1 to lnThreads do
result := result + gnVoxTestedRA[lT];
if lnPermute < 1 then exit;
for lP := 1 to lnPermute do begin
lPermuteMinT^[lP] := gPermuteMinT[1,lP];
lPermuteMaxT^[lP] := gPermuteMaxT[1,lP];
lPermuteMinBM^[lP] := gPermuteMinBM[1,lP];
lPermuteMaxBM^[lP] := gPermuteMaxBM[1,lP];
end;
if lnThreads < 2 then exit;
for lT := 2 to lnThreads do begin
for lP := 1 to lnPermute do begin
if lPermuteMinT^[lP] > gPermuteMinT[lT,lP] then
lPermuteMinT^[lP] := gPermuteMinT[lT,lP];
if lPermuteMinBM^[lP] > gPermuteMinBM[lT,lP] then
lPermuteMinBM^[lP] := gPermuteMinBM[lT,lP];
if lPermuteMaxT^[lP] < gPermuteMaxT[lT,lP] then
lPermuteMaxT^[lP] := gPermuteMaxT[lT,lP];
if lPermuteMaxBM^[lP] < gPermuteMaxBM[lT,lP] then
lPermuteMaxBM^[lP] := gPermuteMaxBM[lT,lP];
end;
end;
end; //SumThreadData
end.
|