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