subroutine aptocta (vx, vy, vz, nv1, nv2)
ccbeg.
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c SUBROUTINE APTOCTA
c
c call aptocta (vx, vy, vz, nv1, nv2)
c
c Version: aptocta Updated 1990 March 12 13:10.
c aptocta Originated 1989 November 2 14:10.
c
c Author: Arthur L. Edwards, LLNL, L-298, Telephone (925) 422-4123.
c
c
c Purpose: To generate a regular octahedron inscribed in a unit sphere.
c An octahedron has 6 vertices, 12 edges, and 8 triangular faces.
c Edges join vertex pairs 1-2, 1-3, 1-4, 1-5, 2-3, 2-5, 2-6,
c 3-4, 3-6, 4-5, 4-6 and 5-6.
c The face with vertices 1, 2 and 3 is parallel to the xy plane,
c with positive z, with vertices 1, 2 and 3 in counterclockwise
c order viewed from large positive z.
c The face with vertices 4, 5 and 6 is parallel to the xy plane.
c Edge 1-3 is parallel to the y axis.
c The orientation is symmetric with the cube generated by
c subroutine aptcube.
c
c Input: None
c
c Output: (vx(nv), vy(nv), vz(nv), nv = 1, 6),
c (nv1(ne), nv2(ne), ne = 1, 12).
c
c Note: See aptdode to generate a regular dodecahedron.
c See apticos to generate a regular icosahedron.
c See aptcube to generate a cube with the same symmetry.
c See apttetr to generate a regular tetrahedron.
c
c Glossary:
c
c nv1 Output Index of first vertex of edge ne. Size 12.
c
c nv2 Output Index of second vertex of edge ne. Size 12.
c
c vx,vy,vz Output The x, y, z coordinates of a vertex of a regular
c octahedron. Size 6.
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
ccend.
c.... Dimensioned arguments.
c---- Index of first vertex of edge.
dimension nv1 (12)
c---- Index of second vertex of edge.
dimension nv2 (12)
c---- Coordinate x of octahedron vertex.
dimension vx (6)
c---- Coordinate y of octahedron vertex.
dimension vy (6)
c---- Coordinate z of octahedron vertex.
dimension vz (6)
c.... Local variables.
c---- Index of edge.
common /laptocta/ ne
c---- Index of first vertex of edge.
dimension nver1 (12)
c---- Index of second vertex of edge.
dimension nver2 (12)
data (nver1(n), n = 1, 12) /1, 1, 1, 1, 2, 2, 2, 3, 3, 4, 4, 5/
data (nver2(n), n = 1, 12) /2, 3, 4, 5, 3, 5, 6, 4, 6, 5, 6, 6/
cbugc***DEBUG begins.
cbugc---- Dihedral angle.
cbug common /laptocta/ alpha
cbugc---- Face area.
cbug common /laptocta/ area
cbugc---- Total face area.
cbug common /laptocta/ areatot
cbugc---- Edge length.
cbug common /laptocta/ dl1
cbugc---- Edge length squared.
cbug common /laptocta/ dl2
cbugc---- Edge length cubed.
cbug common /laptocta/ dl3
cbugc---- Index in vx, vy, vz.
cbug common /laptocta/ n
cbugc---- Error flag from rotax.
cbug common /laptocta/ nerr
cbugc---- Central angle of edge.
cbug common /laptocta/ phi
cbugc---- Mathematical constant, pi.
cbug common /laptocta/ pi
cbugc---- Mathematical constant, pi.
cbug data pi /3.14159265358979323/
cbugc---- Rotation matrix.
cbug common /laptocta/ rotm (3,3)
cbugc---- Inscribed sphere radius.
cbug common /laptocta/ rs1
cbugc---- Inscibed sphere radius squared.
cbug common /laptocta/ rs2
cbugc---- Inscribed sphere radius cubed.
cbug common /laptocta/ rs3
cbugc---- Volume.
cbug common /laptocta/ volume
cbugc***DEBUG ends.
c.... Generate the 6 vertices of a regular octahedron.
c.... Orientation is symmetric with the cube generated by aptcube.
vx(1) = 1.0 / sqrt (6.0)
vy(1) = 1.0 / sqrt (2.0)
vz(1) = 1.0 / sqrt (3.0)
vx(2) = -2.0 * vx(1)
vy(2) = 0.0
vz(2) = vz(1)
vx(3) = vx(1)
vy(3) = -vy(1)
vz(3) = vz(1)
vx(4) = 2.0 * vx(1)
vy(4) = vy(2)
vz(4) = -vz(1)
vx(5) = -vx(1)
vy(5) = vy(1)
vz(5) = -vz(1)
vx(6) = -vx(1)
vy(6) = -vy(1)
vz(6) = -vz(1)
c.... Generate the indices of the vertices bounding each edge.
do 110 ne = 1, 12
nv1(ne) = nver1(ne)
nv2(ne) = nver2(ne)
110 continue
cbugc***DEBUG begins.
cbug 9901 format (// 'octahedron vertices.' //
cbug & ' n x',15x,'y',15x,'z')
cbug 9902 format (i3,3f16.12)
cbug 9903 format (/ 'Edges:' /
cbug & (2i3))
cbug write ( 3, 9901)
cbug write ( 3, 9902) (n, vx(n), vy(n), vz(n), n = 1, 6)
cbug write ( 3, 9903) (nv1(n), nv2(n), n = 1, 12)
cbug write ( 3, '(//)')
cbug
cbugc____ call plotpoly (6, vx, vy, vz, 12, nv1, nv2)
cbugc____ call rotax (6, vx, vy, vz, 1.0, 1.0, 1.0, 0, 30.0, rotm, nerr)
cbugc____ call plotpoly (6, vx, vy, vz, 12, nv1, nv2)
cbug
cbug dl1 = sqrt (2.0)
cbug dl2 = dl1**2
cbug dl3 = dl1 * dl2
cbug rs1 = 1.0 / sqrt (3.0)
cbug rs2 = rs1**2
cbug rs3 = rs1 * rs2
cbug area = sqrt (3.0) / 2.0
cbug areatot = 8.0 * area
cbug volume = 4.0 / 3.0
cbug alpha = acos (-1.0 / 3.0) * 180.0 / pi
cbug phi = acos (0.0) * 180.0 / pi
cbug 9904 format (' dl, dl**2, dl**3=',1p3e20.12 /
cbug & ' r, r**2, r**3=',1p3e20.12 /
cbug & ' area=',1pe20.12,' areatot=',1pe20.12 /
cbug & ' volume=',1pe20.12 /
cbug & ' alpha=',1pe20.12,' phi=',1pe20.12)
cbug write ( 3, 9904) dl1, dl2, dl3, rs1, rs2, rs3, area, areatot,
cbug & volume, alpha, phi
cbugc***DEBUG ends.
return
c.... End of subroutine aptocta. (+1 line.)
end
UCRL-WEB-209832