subroutine aptdode (vx, vy, vz, nv1, nv2)
ccbeg.
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c SUBROUTINE APTDODE
c
c call aptdode (vx, vy, vz, nv1, nv2)
c
c Version: aptdode Updated 1990 March 12 13:10.
c aptdode 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 dodecahedron inscribed in a unit sphere.
c The orientation is symmetric with the regular icosahedron
c generated by subroutine apticos.
c A dodecahedron has 20 vertices, 30 edges, and 12 pentagonal
c faces. Edges join vertex pairs 1-2, 2-3, 3-4, 4-5, 1-5, 1-6,
c 2-8, 3-10, 4-12, 5-14, 6-7, 7-8, 8-9, 9-10, 10-11, 11-12, 12-13,
c 13-14, 14-15, 6-15, 7-16, 9-17, 11-18, 13-19, 15-20, 16-17,
c 17-18, 18-19, 19-20 and 16-20.
c The face with vertices 1, 2, 3, 4 and 5 is parallel to the
c xy plane, with positive z, with edge 1-2 parallel to the y axis,
c and with vertices 1 to 5 counterclockwise, as seen from
c large positive z.
c
c Input: None
c
c Output: (vx(nv), vy(nv), vz(nv), nv = 1, 20),
c (nv1(ne), nv2(ne), ne = 1, 30).
c
c Note: See apticos to generate an icosahedron with same symmetry.
c See apttetr to generate a regular tetrahedron.
c See aptcube to generate a cube.
c See aptocta to generate a regular octahedron.
c
c Glossary:
c
c nv1 Output Index of first vertex of edge ne. Size 30.
c
c nv2 Output Index of second vertex of edge ne. Size 30.
c
c vx,vy,vz Output The x, y, z coordinates of a vertex of a regular
c dodecahedron. Size 20.
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
ccend.
c.... Dimensioned arguments.
c---- Index of first vertex of edge.
dimension nv1 (30)
c---- Index of second vertex of edge.
dimension nv2 (30)
c---- Coordinate x of dodecahedron vertex.
dimension vx (20)
c---- Coordinate y of dodecahedron vertex.
dimension vy (20)
c---- Coordinate z of dodecahedron vertex.
dimension vz (20)
c.... Local variables.
c---- Cosine of angle from z axis.
common /laptdode/ cosph1
c---- Cosine of angle from z axis.
common /laptdode/ cosph2
c---- Index of edge.
common /laptdode/ ne
c---- Index of first vertex of edge.
dimension nver1 (30)
c---- Index of second vertex of edge.
dimension nver2 (30)
data (nver1(n), n = 1, 30) /1, 2, 3, 4, 1, 1, 2, 3, 4, 5,
& 6, 7, 8, 9, 10, 11, 12, 13, 14, 6,
& 7, 9, 11, 13, 15, 16, 17, 18,
& 19, 16/
data (nver2(n), n = 1, 30) /2, 3, 4, 5, 5, 6, 8, 10, 12, 14,
& 7, 8, 9, 10, 11, 12, 13, 14, 15, 15,
& 16, 17, 18, 19, 20, 17, 18, 19,
& 20, 20/
c---- Mathematical constant, pi.
common /laptdode/ pi
c---- Sine of angle from z axis.
common /laptdode/ sinph1
c---- Sine of angle from z axis.
common /laptdode/ sinph2
cbugc***DEBUG begins.
cbugc---- Dihedral angle.
cbug common /laptdode/ alpha
cbugc---- Face area.
cbug common /laptdode/ area
cbugc---- Total face area.
cbug common /laptdode/ areatot
cbugc---- Cosine of ph1x.
cbug common /laptdode/ cosph1x
cbugc---- Cosine of ph2x.
cbug common /laptdode/ cosph2x
cbugc---- Edge length.
cbug common /laptdode/ dl1
cbugc---- Edge length squared.
cbug common /laptdode/ dl2
cbugc---- Edge length cubed.
cbug common /laptdode/ dl3
cbugc---- Index in vx, vy, vz.
cbug common /laptdode/ n
cbugc---- Error flag from rotax.
cbug common /laptdode/ nerr
cbugc---- Angle of a vertex from z axis.
cbug common /laptdode/ ph1x
cbugc---- Angle of a vertex from z axis.
cbug common /laptdode/ ph2x
cbugc---- Central angle of edge.
cbug common /laptdode/ phi
cbugc---- Rotation matrix.
cbug common /laptdode/ rotm (3,3)
cbugc---- Inscribed sphere radius.
cbug common /laptdode/ rs1
cbugc---- Inscibed sphere radius squared.
cbug common /laptdode/ rs2
cbugc---- Inscribed sphere radius cubed.
cbug common /laptdode/ rs3
cbugc---- Sine of ph1x.
cbug common /laptdode/ sinph1x
cbugc---- Sine of ph2x.
cbug common /laptdode/ sinph2x
cbugc---- Volume.
cbug common /laptdode/ volume
cbugc***DEBUG ends.
c---- Mathematical constant, pi.
pi = 3.14159265358979323
c.... Generate the 20 vertices of a regular dodecahedron, on a unit sphere.
c.... Orientation is symmetric with regular icosahedron (see apticos).
c.... sin (ph1) = 2 / ((sqrt(3) + sqrt(15)) * sin (pi / 5)).
c.... sin (ph2) = 4 * cos (pi / 5) / ((sqrt(3) + sqrt(15)) * sin (pi / 5)).
cosph1 = 0.79465447229176622
sinph1 = 0.60706199820668616
vx( 1) = cos (0.2 * pi) * sinph1
vy( 1) = sin (0.2 * pi) * sinph1
vz( 1) = cosph1
vx( 2) = cos (0.6 * pi) * sinph1
vy( 2) = sin (0.6 * pi) * sinph1
vz( 2) = vz(1)
vx( 3) = -sinph1
vy( 3) = 0.0
vz( 3) = vz(1)
vx( 4) = vx(2)
vy( 4) = -vy(2)
vz( 4) = vz(1)
vx( 5) = vx(1)
vy( 5) = -vy(1)
vz( 5) = vz(1)
cosph2 = 0.18759247408508012
sinph2 = 0.98224694637684595
vx( 6) = cosph1
vy( 6) = vy(2)
vz( 6) = cosph2
vx( 7) = -0.5 * vx(3)
vy( 7) = sin (0.4 * pi) * sinph2
vz( 7) = -cosph2
vx( 8) = 0.5 * vx(3)
vy( 8) = vy(7)
vz( 8) = cosph2
vx( 9) = -vx(6)
vy( 9) = vy(2)
vz( 9) = -cosph2
vx(10) = -sinph2
vy(10) = vy(3)
vz(10) = cosph2
vx(11) = -vx(6)
vy(11) = -vy(2)
vz(11) = -cosph2
vx(12) = 0.5 * vx(3)
vy(12) = -vy(7)
vz(12) = cosph2
vx(13) = -0.5 * vx(3)
vy(13) = -vy(7)
vz(13) = -cosph2
vx(14) = vx(6)
vy(14) = -vy(2)
vz(14) = cosph2
vx(15) = -vx(10)
vy(15) = vy(3)
vz(15) = -cosph2
vx(16) = -vx(2)
vy(16) = vy(2)
vz(16) = -vz(1)
vx(17) = -vx(1)
vy(17) = vy(1)
vz(17) = -vz(1)
vx(18) = -vx(1)
vy(18) = -vy(1)
vz(18) = -vz(1)
vx(19) = -vx(2)
vy(19) = -vy(2)
vz(19) = -vz(1)
vx(20) = -vx(3)
vy(20) = vy(3)
vz(20) = -vz(1)
c.... Generate the indices of the vertices bounding each edge.
do 110 ne = 1, 30
nv1(ne) = nver1(ne)
nv2(ne) = nver2(ne)
110 continue
cbugc***DEBUG begins.
cbug 9901 format (// 'dodecahedron 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, 20)
cbug write ( 3, 9903) (nv1(n), nv2(n), n = 1, 30)
cbug write ( 3, '(//)')
cbug
cbugc____ call plotpoly (20, vx, vy, vz, 30, nv1, nv2)
cbugc____ call rotax (20, vx, vy, vz, 1.0, 1.0, 1.0, 0, 30.0, rotm, nerr)
cbugc____ call plotpoly (20, vx, vy, vz, 30, nv1, nv2)
cbug
cbug dl1 = 4.0 / (sqrt (3.0) + sqrt (15.0))
cbug dl2 = dl1**2
cbug dl3 = dl1 * dl2
cbug rs1 = 0.05 * sqrt (250.0 + 110.0 * sqrt (5.0)) * dl1
cbug rs2 = rs1**2
cbug rs3 = rs1 * rs2
cbug area = 0.25 * sqrt (25.0 + 10.0 * sqrt (5.0)) * dl2
cbug areatot = 12.0 * area
cbug volume = 0.25 * (15.0 + 7.0 * sqrt (5.0)) * dl3
cbug alpha = acos (-1.0 / sqrt (5.0)) * 180.0 / pi
cbug phi = acos (sqrt (5.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
cbug sinph1x = 2.0 * sqrt (2.0 + 2.0 / sqrt (5.0)) /
cbug & (sqrt (3.0) + sqrt (15.0))
cbug cosph1x = sqrt ((1.0 - sinph1x) * (1.0 + sinph1x))
cbug ph1x = asin (sinph1x) * 180 / pi
cbug sinph2x = 4.0 * sqrt (1.0 + 2.0 / sqrt (5.0)) /
cbug & (sqrt (3.0) + sqrt (15.0))
cbug cosph2x = sqrt ((1.0 - sinph2x) * (1.0 + sinph2x))
cbug ph2x = asin (sinph2x) * 180 / pi
cbug 9905 format (' ph1=',1p3e20.12 / ' ph2=',1p3e20.12)
cbug write ( 3, 9905) ph1x, sinph1x, cosph1x,
cbug & ph2x, sinph2x, cosph2x
cbugc***DEBUG ends.
return
c.... End of subroutine aptdode. (+1 line.)
end
UCRL-WEB-209832