home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / GRAPHICS / PLOT / SURFUTI3.ZIP / REVOLVE.INC < prev    next >
Encoding:
Text File  |  1990-09-03  |  9.2 KB  |  265 lines
  1. procedure REVOLVE;
  2. { construct a solid of revolution }
  3.  
  4.  
  5. var Firstnode, Lastnode: integer;           { first & last node in solid }
  6.     R, Z:                array[1..MAXOUTLN] of real; { R & Z coords of outline}
  7.     Node:                integer;           { node # }
  8.     Surf:                integer;           { surface # }
  9.     Noutln:              integer;           { # of outline nodes }
  10.     i:                   integer;           { genl. index }
  11.     Realvar:             vartype;           { genl. input array }
  12.     Num:                 integer;           { #vbls. read in }
  13.     Comment:             text80;            { comment on input line }
  14.     Outln:               integer;           { outline node number }
  15.     Material:            integer;           { material number of solid }
  16.     Orient:              integer;           { orientation code (1 = X axis, }
  17.                                             { 2 = Y axis, 3 = Z axis) }
  18.     d1, d2, d3:          integer;           { degree nos. for each axis }
  19.     Nslice:              integer;           { # angular slices }
  20.     Lastrzero:           boolean;           { flag if last R=0 }
  21.     Slice:               real;              { angle for one slice (radians) }
  22.     Firstnodelastrow:    integer;           { node # }
  23.     Firstnodethisrow:    integer;           { node # }
  24.     Scale:               vector;            { scale factor X, Y, Z directions }
  25.     Shift:               vector;            { shift vector X, Y, Z directions }
  26.     Rotate:              vector;            { rotation about X, Y, Z axes }
  27.  
  28.  
  29. begin
  30. {$ifdef BIGMEM}
  31. with ptra^ do with ptrb^ do with ptrc^ do
  32. begin
  33. {$endif}
  34.   Line_num := Line_num + 1;
  35.   Num := inreal (Infile, Realvar, Comment, Line_num, FALSE);
  36.   if (Num <> 4) or (Realvar[1] < 1) or (Realvar[1] > MAXOUTLN) or
  37.      (Realvar[2] < 3) or (Realvar[3] < 1) or (Realvar[3] > Nmatl) or
  38.      (Realvar[4] < 1) or (Realvar[4] > 3) then begin
  39.     writeln ('Bad input for solid of revolution (line ', Line_num, ')');
  40.     if (Num <> 3) then
  41.       writeln ('Expecting 3 numeric entries.');
  42.     if (Realvar[1] < 1) or (Realvar[1] > MAXOUTLN) then
  43.       writeln ('Noutln must be between 1 and ', MAXOUTLN);
  44.     if (Realvar[2] < 3) then
  45.       writeln ('Must have at least 3 slices!');
  46.     if (Realvar[3] < 1) or (Realvar[3] > Nmatl) then
  47.       writeln ('Matl must be between 1 and ',Nmatl);
  48.     if (Realvar[4] < 1) or (Realvar[4] > 3) then
  49.       writeln ('Orientation code must be 1, 2 or 3.');
  50.     close (Infile);
  51.     halt;
  52.   end;
  53.   Noutln := round(Realvar[1]);
  54.   Nslice := round(Realvar[2]);
  55.   Material := round(Realvar[3]);
  56.   Orient := round(Realvar[4]);
  57.  
  58.   Line_num := Line_num + 1;
  59.   Num := inreal (Infile, Realvar, Comment, Line_num, FALSE);
  60.   if (Num <> 6) then begin
  61.     writeln ('Bad input: expecting 6 numeric entries for scale & shift (line ',
  62.       Line_num,')');
  63.     close (Infile);
  64.     halt;
  65.   end;
  66.   Scale[1] := Realvar[1];
  67.   Scale[2] := Realvar[2];
  68.   Scale[3] := Realvar[3];
  69.   Shift[1] := Realvar[4];
  70.   Shift[2] := Realvar[5];
  71.   Shift[3] := Realvar[6];
  72.  
  73.   Line_num := Line_num + 1;
  74.   Num := inreal (Infile, Realvar, Comment, Line_num, FALSE);
  75.   if (Num <> 3) then begin
  76.     writeln ('Bad input: expecting 3 numeric entries for rotation (line ',
  77.       Line_num,')');
  78.     close (Infile);
  79.     halt;
  80.   end;
  81.   Rotate[1] := Realvar[1];
  82.   Rotate[2] := Realvar[2];
  83.   Rotate[3] := Realvar[3];
  84.  
  85.   for Outln := 1 to Noutln do begin
  86.     Line_num := Line_num + 1;
  87.     Num := inreal (Infile, Realvar, Comment, Line_num, FALSE);
  88.     if (Num <> 2) then begin
  89.       writeln ('Bad input: expecting 2 numeric entries for outline point #',
  90.         Outln, '(line', Line_num,')');
  91.       close (Infile);
  92.       halt;
  93.     end;
  94.     R[Outln] := Realvar[1];
  95.     Z[Outln] := Realvar[2];
  96.   end; { for Outln }
  97.  
  98. { set the DOF numbers depending on major axis }
  99.   case Orient of
  100.     1: begin   { X major axis }
  101.       d1 := 2;
  102.       d2 := 3;
  103.       d3 := 1;
  104.     end;
  105.     2: begin   { Y major axis }
  106.       d1 := 3;
  107.       d2 := 1;
  108.       d3 := 2;
  109.     end;
  110.     3: begin   { Z major axis }
  111.       d1 := 1;
  112.       d2 := 2;
  113.       d3 := 3;
  114.     end;
  115.   end; { case }
  116.  
  117.   Firstnode := Nnodes + 1;
  118.   Slice := 6.2832 / Nslice;
  119.   Node := Nnodes;
  120.   Surf := Nsurf;
  121.  
  122. { Do the top row first }
  123.   if (R[1] = 0.0) then begin
  124.     Node := Node + 1;
  125.     if (Node > MAXNODES) then begin
  126.       writeln ('Exceeded MAXNODES=',MAXNODES,' in surface of revolution ',
  127.         '(line ',Line_num,' of input).');
  128.       close (Infile);
  129.       halt;
  130.     end;
  131.     World[Node][d1] := 0.0;
  132.     World[Node][d2] := 0.0;
  133.     World[Node][d3] := Z[1];
  134.     Lastrzero := TRUE;
  135.   end else begin
  136.     for i := 1 to Nslice do begin
  137.       Node := Node + 1;
  138.       if (Node > MAXNODES) then begin
  139.         writeln ('Exceeded MAXNODES=',MAXNODES,' in surface of revolution ',
  140.           '(line ',Line_num,' of input).');
  141.         close (Infile);
  142.         halt;
  143.       end;
  144.       World[Node][d1] := R[1] * cos(Slice * (i-1));
  145.       World[Node][d2] := R[1] * sin(Slice * (i-1));
  146.       World[Node][d3] := Z[1];
  147.     end;
  148.     Lastrzero := FALSE;
  149.   end;
  150.   Firstnodelastrow := Firstnode;
  151.  
  152.   for Outln := 2 to Noutln do begin
  153.     Firstnodethisrow := Node + 1;
  154.     if (R[Outln] = 0.0) then begin
  155.       Node := Node + 1;
  156.       if (Node > MAXNODES) then begin
  157.         writeln ('Exceeded MAXNODES=',MAXNODES,' in surface of revolution ',
  158.           '(line ',Line_num,' of input).');
  159.         close (Infile);
  160.         halt;
  161.       end;
  162.       if (Lastrzero) then begin
  163.         writeln ('Error: Cannot have two outline points in a row with zero ',
  164.           'radius! (points ', Outln-1, ' and ', Outln, ')');
  165.         halt;
  166.       end;
  167.       World[Node][d1] := 0.0;
  168.       World[Node][d2] := 0.0;
  169.       World[Node][d3] := Z[Outln];
  170.       Lastrzero := TRUE;
  171.  
  172.       { This node at R=0, so surfaces are triangles }
  173.       for i := 1 to Nslice do begin
  174.         Surf := Surf + 1;
  175.         if (Surf > Realmaxsurf) then begin
  176.           writeln ('Exceeded MAXSURF=',Realmaxsurf,' in surface of revolution',
  177.             ' (line ',Line_num,' of input).');
  178.           close (Infile);
  179.           halt;
  180.         end;
  181.         Matl[Surf] := Material;
  182.         Connect[(Surf-1)*Maxvert+1] := Firstnodelastrow + i - 1;
  183.         Connect[(Surf-1)*Maxvert+2] := Firstnodethisrow;
  184.         if (i = Nslice) then
  185.           Connect[(Surf-1)*Maxvert+3] := Firstnodelastrow
  186.         else
  187.           Connect[(Surf-1)*Maxvert+3] := Firstnodelastrow + i;
  188.         Connect[(Surf-1)*Maxvert+4] := 0;
  189.       end; { for i }
  190.  
  191.     end else begin
  192.       for i := 1 to Nslice do begin
  193.         Node := Node + 1;
  194.         if (Node > MAXNODES) then begin
  195.           writeln ('Exceeded MAXNODES=',MAXNODES,' in surface of revolution ',
  196.             '(line ',Line_num,' of input).');
  197.           close (Infile);
  198.           halt;
  199.         end;
  200.         World[Node][d1] := R[Outln] * cos(Slice * (i-1));
  201.         World[Node][d2] := R[Outln] * sin(Slice * (i-1));
  202.         World[Node][d3] := Z[Outln];
  203.       end;
  204.  
  205.       if (Lastrzero) then begin
  206.         Lastrzero := FALSE;
  207.         { Last node at R=0, so surfaces are triangles }
  208.         for i := 1 to Nslice do begin
  209.           Surf := Surf + 1;
  210.           if (Surf > Realmaxsurf) then begin
  211.             writeln ('Exceeded MAXSURF=',Realmaxsurf,' in surface of ',
  212.               'revolution (line ',Line_num,' of input).');
  213.             close (Infile);
  214.             halt;
  215.           end;
  216.           Matl[Surf] := Material;
  217.           Connect[(Surf-1)*Maxvert+1] := Firstnodelastrow;
  218.           Connect[(Surf-1)*Maxvert+2] := Firstnodethisrow + i - 1;
  219.           if (i = Nslice) then
  220.             Connect[(Surf-1)*Maxvert+3] := Firstnodethisrow
  221.           else
  222.             Connect[(Surf-1)*Maxvert+3] := Firstnodethisrow + i;
  223.           Connect[(Surf-1)*Maxvert+4] := 0;
  224.         end; { for i }
  225.  
  226.       end else begin
  227.         { Neither node at R=0, so use quads }
  228.         Lastrzero := FALSE;
  229.         for i := 1 to Nslice do begin
  230.           Surf := Surf + 1;
  231.           if (Surf > Realmaxsurf) then begin
  232.             writeln ('Exceeded MAXSURF=',Realmaxsurf,' in surface of ',
  233.               'revolution (line ',Line_num,' of input).');
  234.             close (Infile);
  235.             halt;
  236.           end;
  237.           Matl[Surf] := Material;
  238.           Connect[(Surf-1)*Maxvert+1] := Firstnodelastrow + i - 1;
  239.           Connect[(Surf-1)*Maxvert+2] := Firstnodethisrow + i - 1;
  240.           if (i = Nslice) then begin
  241.             Connect[(Surf-1)*Maxvert+3] := Firstnodethisrow;
  242.             Connect[(Surf-1)*Maxvert+4] := Firstnodelastrow;
  243.           end else begin
  244.             Connect[(Surf-1)*Maxvert+3] := Firstnodethisrow + i;
  245.             Connect[(Surf-1)*Maxvert+4] := Firstnodelastrow + i;
  246.           end;
  247.           if (Maxvert > 4) then
  248.             Connect[(Surf-1)*Maxvert+5] := 0;
  249.         end; { for i }
  250.       end; { if Lastrzero }
  251.     end; { if R[Outln] = 0.0 }
  252.     Firstnodelastrow := Firstnodethisrow;
  253.   end; { for Outln }
  254.   Lastnode := Node;
  255.   Nnodes := Node;
  256.   Nsurf := Surf;
  257.  
  258.   rotatenodes (Firstnode, Lastnode, Rotate);
  259.   shiftnodes (Firstnode, Lastnode, Shift);
  260.   scalenodes (Firstnode, Lastnode, Scale);
  261. {$ifdef BIGMEM}
  262. end; {with}
  263. {$endif}
  264. end; { procedure REVOLVE }
  265.