home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power Programming
/
powerprogramming1994.iso
/
progtool
/
surfmodl
/
surfm203.arc
/
SURFSRC.ARC
/
SHELSURF.INC
< prev
next >
Wrap
Text File
|
1987-01-05
|
2KB
|
66 lines
procedure SHELSURF (var Surfmin, Surfmax: surfaces; Nsurf: integer);
{ Shell sort the surface data, using Surfavg as the primary sorting
criterion and Surfmin as the secondary (tie-breaking) sorting
criterion. Procedure as published in Tanenbaum, "Structured
Computer Organization", Prentice-Hall, Englewood Cliffs, NJ, 1976.
}
var Dist: integer; { sorting distance }
K, I: integer; { genl sorting indexes }
Vert: integer; { vertex number }
Vert1, Vert2: integer; { vertices to swap }
begin
{$ifdef BIGMEM}
with ptrg^ do with ptrh^ do with ptri^ do
begin
{$endif}
{ Determine the initial value of Dist by finding the largest power
of 2 less than Nsurf, and subtracting 1 from it. The final step in
this calculation is performed inside the main sorting loop.
}
Dist := 4;
while (Dist < Nsurf) do
Dist := Dist + Dist;
Dist := Dist - 1;
{ Main sorting loop. The outer loop is executed once per pass. }
while (Dist > 1) do begin
Dist := Dist div 2;
for K := 1 to (Nsurf - Dist) do begin
I := K;
while (I > 0) do begin
{ This stmt. is the comparison. It also controls moving values
upward after an exchange. }
if (Surfmax[I] > Surfmax[I+Dist]) or
((Surfmax[I] = Surfmax[I+Dist]) and (Surfmin[I] > Surfmin[I+Dist]))
then begin
{ The next 6 stmts. perform the exchange }
swapreal (Surfmax[I], Surfmax[I+Dist]);
swapreal (Surfmin[I], Surfmin[I+Dist]);
swapint (Matl[I], Matl[I+Dist]);
swapint (Nvert[I], Nvert[I+Dist]);
{ Swap all the vertices }
Vert1 := (I-1)*Maxvert + 1;
Vert2 := (I+Dist-1)*Maxvert + 1;
for Vert := 1 to Maxvert do begin
swapint (Connect[Vert1], Connect[Vert2]);
Vert1 := Vert1 + 1;
Vert2 := Vert2 + 1;
end;
(* for Vert := 1 to Maxvert do
swapint (Connect[(I-1)*Maxvert + Vert],
Connect[(I+Dist-1)*Maxvert + Vert]);
*)
end else
I := 0; { stop the while loop! }
I := I - Dist;
end; { while }
end; { for K }
end; { while Dist }
{$ifdef BIGMEM}
end; {with}
{$endif}
end; { procedure SHELSURF }