subroutine aptcube (vx, vy, vz, nv1, nv2)
ccbeg.
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c SUBROUTINE APTCUBE
c
c call aptcube (vx, vy, vz, nv1, nv2)
c
c Version: aptcube Updated 1990 March 12 13:10.
c aptcube 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 cube inscribed in a unit sphere.
c A cube has 8 vertices, 12 edges, and 6 square faces.
c Edges join vertex pairs 1-2, 1-4, 1-5, 2-3, 2-6, 3-4, 3-7,
c 4-8, 5-6, 5-8, 6-7, 7-8.
c Vertices 1 and 7 are on the z axis.
c Edge 1-2 is from (0, 0, 1) to (2*sqrt(2)/3, 0, 1/3).
c
c Input: None
c
c Output: (vx(nv), vy(nv), vz(nv), nv = 1, 8),
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 apttetr to generate a regular tetrahedron.
c See aptocta to generate an octahedron with the same symmetry.
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 cube.
c (A regular hexahedron.) Size 8.
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 cube vertex.
dimension vx (8)
c---- Coordinate y of cube vertex.
dimension vy (8)
c---- Coordinate z of cube vertex.
dimension vz (8)
c.... Local variables.
c---- Index of edge.
common /laptcube/ 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, 2, 2, 3, 3, 4, 5, 5, 6, 7/
data (nver2(n), n = 1, 12) /2, 4, 5, 3, 6, 4, 7, 8, 6, 8, 7, 8/
cbugc***DEBUG begins.
cbugc---- Dihedral angle.
cbug common /laptcube/ alpha
cbugc---- Face area.
cbug common /laptcube/ area
cbugc---- Total face area.
cbug common /laptcube/ areatot
cbugc---- Edge length.
cbug common /laptcube/ dl1
cbugc---- Edge length squared.
cbug common /laptcube/ dl2
cbugc---- Edge length cubed.
cbug common /laptcube/ dl3
cbugc---- Index in vx, vy, vz.
cbug common /laptcube/ n
cbugc---- Error flag from rotax.
cbug common /laptcube/ nerr
cbugc---- Central angle of edge.
cbug common /laptcube/ phi
cbugc---- Mathematical constant, pi.
cbug common /laptcube/ pi
cbugc---- Mathematical constant, pi.
cbug data pi /3.14159265358979323/
cbugc---- Rotation matrix.
cbug common /laptcube/ rotm (3,3)
cbugc---- Inscribed sphere radius.
cbug common /laptcube/ rs1
cbugc---- Inscibed sphere radius squared.
cbug common /laptcube/ rs2
cbugc---- Inscribed sphere radius cubed.
cbug common /laptcube/ rs3
cbugc---- Volume.
cbug common /laptcube/ volume
cbugc***DEBUG ends.
c.... Generate the 8 vertices of a regular cube.
c.... Orientation is symmetric with the regular tetrahedron
c.... generated by apttetr. Vertices 1 and 7 on z axis.
c.... Orientation is symmetric with the octahedron generated by aptocta.
vx(1) = 0.0
vy(1) = 0.0
vz(1) = 1.0
vx(2) = 2.0 * sqrt (2.0) / 3.0
vy(2) = vy(1)
vz(2) = 1.0 / 3.0
vx(3) = sqrt (2.0) / 3.0
vy(3) = sqrt (6.0) / 3.0
vz(3) = -vz(2)
vx(4) = -vx(3)
vy(4) = vy(3)
vz(4) = vz(2)
vx(5) = -vx(3)
vy(5) = -vy(3)
vz(5) = vz(2)
vx(6) = vx(3)
vy(6) = -vy(3)
vz(6) = -vz(2)
vx(7) = vx(1)
vy(7) = vy(1)
vz(7) = -vz(1)
vx(8) = -vx(2)
vy(8) = vy(1)
vz(8) = -vz(2)
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 (// 'cube 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, 8)
cbug write ( 3, 9903) (nv1(n), nv2(n), n = 1, 12)
cbug write ( 3, '(//)')
cbug
cbugc____ call plotpoly (8, vx, vy, vz, 12, nv1, nv2)
cbugc____ call rotax (8, vx, vy, vz, 1.0, 1.0, 1.0, 0, 30.0, rotm, nerr)
cbugc____ call plotpoly (8, vx, vy, vz, 12, nv1, nv2)
cbug
cbug dl1 = 2.0 / sqrt (3.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 = 4.0 / 3.0
cbug areatot = 6.0 * area
cbug volume = 8.0 * sqrt (3.0) / 9.0
cbug alpha = acos (0.0) * 180.0 / pi
cbug phi = acos (1.0 / 3.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 aptcube. (+1 line.)
end
UCRL-WEB-209832