Category : Science and Education
Archive   : SURF1311.ZIP
Filename : REVOLVE.PAS
{ construct a solid of revolution }
const
MAXOUTLN = 500; { maximum # of coords to revolve }
var Firstnode, Lastnode: integer; { first & last node in solid }
R, Z: array[1..MAXOUTLN] of real; { R & Z coords of outline}
Node: integer; { node # }
Surf: integer; { surface # }
Noutln: integer; { # of outline nodes }
i: integer; { genl. index }
Realvar: vartype; { genl. input array }
Num: integer; { #vbls. read in }
Comment: text80; { comment on input line }
Outln: integer; { outline node number }
Material: integer; { material number of solid }
Orient: integer; { orientation code (1 = X axis, }
{ 2 = Y axis, 3 = Z axis) }
d1, d2, d3: integer; { degree nos. for each axis }
Nslice: integer; { # angular slices }
Lastrzero: boolean; { flag if last R=0 }
Slice: real; { angle for one slice (radians) }
Firstnodelastrow: integer; { node # }
Firstnodethisrow: integer; { node # }
Scale: vector; { scale factor X, Y, Z directions }
Shift: vector; { shift vector X, Y, Z directions }
Rotate: vector; { rotation about X, Y, Z axes }
begin
Line_num := Line_num + 1;
Num := inreal (Infile, Realvar, Comment, Line_num, FALSE);
if (Num <> 4) or (Realvar[1] < 1) or (Realvar[1] > MAXOUTLN) or
(Realvar[2] < 3) or (Realvar[3] < 1) or (Realvar[3] > Nmatl) or
(Realvar[4] < 1) or (Realvar[4] > 3) then begin
writeln ('Bad input for solid of revolution (line ', Line_num, ')');
if (Num <> 3) then
writeln ('Expecting 3 numeric entries.');
if (Realvar[1] < 1) or (Realvar[1] > MAXOUTLN) then
writeln ('Noutln must be between 1 and ', MAXOUTLN);
if (Realvar[2] < 3) then
writeln ('Must have at least 3 slices!');
if (Realvar[3] < 1) or (Realvar[3] > Nmatl) then
writeln ('Matl must be between 1 and ',Nmatl);
if (Realvar[4] < 1) or (Realvar[4] > 3) then
writeln ('Orientation code must be 1, 2 or 3.');
close (Infile);
halt;
end;
Noutln := round(Realvar[1]);
Nslice := round(Realvar[2]);
Material := round(Realvar[3]);
Orient := round(Realvar[4]);
Line_num := Line_num + 1;
Num := inreal (Infile, Realvar, Comment, Line_num, FALSE);
if (Num <> 6) then begin
writeln ('Bad input: expecting 6 numeric entries for scale & shift (line ',
Line_num,')');
close (Infile);
halt;
end;
Scale[1] := Realvar[1];
Scale[2] := Realvar[2];
Scale[3] := Realvar[3];
Shift[1] := Realvar[4];
Shift[2] := Realvar[5];
Shift[3] := Realvar[6];
Line_num := Line_num + 1;
Num := inreal (Infile, Realvar, Comment, Line_num, FALSE);
if (Num <> 3) then begin
writeln ('Bad input: expecting 3 numeric entries for rotation (line ',
Line_num,')');
close (Infile);
halt;
end;
Rotate[1] := Realvar[1];
Rotate[2] := Realvar[2];
Rotate[3] := Realvar[3];
for Outln := 1 to Noutln do begin
Line_num := Line_num + 1;
Num := inreal (Infile, Realvar, Comment, Line_num, FALSE);
if (Num <> 2) then begin
writeln ('Bad input: expecting 2 numeric entries for outline point #',
Outln, '(line', Line_num,')');
close (Infile);
halt;
end;
R[Outln] := Realvar[1];
Z[Outln] := Realvar[2];
end; { for Outln }
{ set the DOF numbers depending on major axis }
case Orient of
1: begin { X major axis }
d1 := 2;
d2 := 3;
d3 := 1;
end;
2: begin { Y major axis }
d1 := 3;
d2 := 1;
d3 := 2;
end;
3: begin { Z major axis }
d1 := 1;
d2 := 2;
d3 := 3;
end;
end; { case }
Firstnode := Nnodes + 1;
Slice := 6.2832 / Nslice;
Node := Nnodes;
Surf := Nsurf;
{ Do the top row first }
if (R[1] = 0.0) then begin
Node := Node + 1;
if (Node > MAXNODES) then begin
writeln ('Exceeded MAXNODES=',MAXNODES,' in surface of revolution ',
'(line ',Line_num,' of input).');
close (Infile);
halt;
end;
World[Node][d1] := 0.0;
World[Node][d2] := 0.0;
World[Node][d3] := Z[1];
Lastrzero := TRUE;
end else begin
for i := 1 to Nslice do begin
Node := Node + 1;
if (Node > MAXNODES) then begin
writeln ('Exceeded MAXNODES=',MAXNODES,' in surface of revolution ',
'(line ',Line_num,' of input).');
close (Infile);
halt;
end;
World[Node][d1] := R[1] * cos(Slice * (i-1));
World[Node][d2] := R[1] * sin(Slice * (i-1));
World[Node][d3] := Z[1];
end;
Lastrzero := FALSE;
end;
Firstnodelastrow := Firstnode;
for Outln := 2 to Noutln do begin
Firstnodethisrow := Node + 1;
if (R[Outln] = 0.0) then begin
Node := Node + 1;
if (Node > MAXNODES) then begin
writeln ('Exceeded MAXNODES=',MAXNODES,' in surface of revolution ',
'(line ',Line_num,' of input).');
close (Infile);
halt;
end;
if (Lastrzero) then begin
writeln ('Error: Cannot have two outline points in a row with zero ',
'radius! (points ', Outln-1, ' and ', Outln, ')');
halt;
end;
World[Node][d1] := 0.0;
World[Node][d2] := 0.0;
World[Node][d3] := Z[Outln];
Lastrzero := TRUE;
{ This node at R=0, so surfaces are triangles }
for i := 1 to Nslice do begin
Surf := Surf + 1;
if (Surf > Realmaxsurf) then begin
writeln ('Exceeded MAXSURF=',Realmaxsurf,' in surface of revolution',
' (line ',Line_num,' of input).');
close (Infile);
halt;
end;
Matl[Surf] := Material;
Connect[(Surf-1)*Maxvert+1] := Firstnodelastrow + i - 1;
Connect[(Surf-1)*Maxvert+2] := Firstnodethisrow;
if (i = Nslice) then
Connect[(Surf-1)*Maxvert+3] := Firstnodelastrow
else
Connect[(Surf-1)*Maxvert+3] := Firstnodelastrow + i;
Connect[(Surf-1)*Maxvert+4] := 0;
end; { for i }
end else begin
for i := 1 to Nslice do begin
Node := Node + 1;
if (Node > MAXNODES) then begin
writeln ('Exceeded MAXNODES=',MAXNODES,' in surface of revolution ',
'(line ',Line_num,' of input).');
close (Infile);
halt;
end;
World[Node][d1] := R[Outln] * cos(Slice * (i-1));
World[Node][d2] := R[Outln] * sin(Slice * (i-1));
World[Node][d3] := Z[Outln];
end;
if (Lastrzero) then begin
Lastrzero := FALSE;
{ Last node at R=0, so surfaces are triangles }
for i := 1 to Nslice do begin
Surf := Surf + 1;
if (Surf > Realmaxsurf) then begin
writeln ('Exceeded MAXSURF=',Realmaxsurf,' in surface of ',
'revolution (line ',Line_num,' of input).');
close (Infile);
halt;
end;
Matl[Surf] := Material;
Connect[(Surf-1)*Maxvert+1] := Firstnodelastrow;
Connect[(Surf-1)*Maxvert+2] := Firstnodethisrow + i - 1;
if (i = Nslice) then
Connect[(Surf-1)*Maxvert+3] := Firstnodethisrow
else
Connect[(Surf-1)*Maxvert+3] := Firstnodethisrow + i;
Connect[(Surf-1)*Maxvert+4] := 0;
end; { for i }
end else begin
{ Neither node at R=0, so use quads }
Lastrzero := FALSE;
for i := 1 to Nslice do begin
Surf := Surf + 1;
if (Surf > Realmaxsurf) then begin
writeln ('Exceeded MAXSURF=',Realmaxsurf,' in surface of ',
'revolution (line ',Line_num,' of input).');
close (Infile);
halt;
end;
Matl[Surf] := Material;
Connect[(Surf-1)*Maxvert+1] := Firstnodelastrow + i - 1;
Connect[(Surf-1)*Maxvert+2] := Firstnodethisrow + i - 1;
if (i = Nslice) then begin
Connect[(Surf-1)*Maxvert+3] := Firstnodethisrow;
Connect[(Surf-1)*Maxvert+4] := Firstnodelastrow;
end else begin
Connect[(Surf-1)*Maxvert+3] := Firstnodethisrow + i;
Connect[(Surf-1)*Maxvert+4] := Firstnodelastrow + i;
end;
if (Maxvert > 4) then
Connect[(Surf-1)*Maxvert+5] := 0;
end; { for i }
end; { if Lastrzero }
end; { if R[Outln] = 0.0 }
Firstnodelastrow := Firstnodethisrow;
end; { for Outln }
Lastnode := Node;
Nnodes := Node;
Nsurf := Surf;
rotatenodes (Firstnode, Lastnode, Rotate);
shiftnodes (Firstnode, Lastnode, Shift);
scalenodes (Firstnode, Lastnode, Scale);
end; { procedure REVOLVE }
Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!
This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.
But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/