subroutine apticos (vx, vy, vz, nv1, nv2)
ccbeg.
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c SUBROUTINE APTICOS
c
c call apticos (vx, vy, vz, nv1, nv2)
c
c Version: apticos Updated 1990 March 12 13:10.
c apticos 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 icosahedron inscribed in a unit sphere.
c An icosahedron has 12 vertices, 30 edges, and 20 triangular
c faces. Edges join vertex pairs 1-2, 1-3, 1-4, 1-5, 1-6, 2-3,
c 2-6, 2-7, 2-11, 3-4, 3-7, 3-8, 4-5, 4-8, 4-9, 5-6, 5-9, 5-10,
c 6-10, 6-11, 7-8, 7-11, 7-12, 8-9, 8-12, 9-10, 9-12, 10-11,
c 10-12 and 11-12. Vertices 1 and 12 are on the z axis.
c The orientation is symmetric with the regular dodecahedron
c generated by subroutine aptdode. Two opposite vertices are
c on the z axis, and a vertex adjacent to the upper vertex
c is in the xz plane, with positive x.
c Edge 1-2 is from (0, 0, 1) to (2/sqrt(5), 0, 1/sqrt(5)).
c
c Input: None
c
c Output: (vx(nv), vy(nv), vz(nv), nv = 1, 12),
c (nv1(ne), nv2(ne), ne = 1, 30).
c
c Note: See aptdode to generate a dodecahedron 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 icosahedron. Size 12.
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 icosahedron vertex.
dimension vx (12)
c---- Coordinate y of icosahedron vertex.
dimension vy (12)
c---- Coordinate z of icosahedron vertex.
dimension vz (12)
c.... Local variables.
c---- Cosine of angle from z axis.
common /lapticos/ cosph
c---- Index of edge.
common /lapticos/ 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, 1, 1, 1, 1, 2, 2, 2, 2, 3,
& 3, 3, 4, 4, 4, 5, 5, 5, 6, 6,
& 7, 7, 7, 8, 8, 9, 9, 10, 10, 11/
data (nver2(n), n = 1, 30) /2, 3, 4, 5, 6, 3, 6, 7, 11, 4,
& 7, 8, 5, 8, 9, 6, 9, 10, 10, 11,
& 8, 11, 12, 9, 12, 10, 12, 11, 12, 12/
c---- Mathematical constant, pi.
common /lapticos/ pi
c---- Sine of angle from z axis.
common /lapticos/ sinph
cbugc***DEBUG begins.
cbugc---- Dihedral angle.
cbug common /lapticos/ alpha
cbugc---- Face area.
cbug common /lapticos/ area
cbugc---- Total face area.
cbug common /lapticos/ areatot
cbugc---- Edge length.
cbug common /lapticos/ dl1
cbugc---- Edge length squared.
cbug common /lapticos/ dl2
cbugc---- Edge length cubed.
cbug common /lapticos/ dl3
cbugc---- Index in vx, vy, vz.
cbug common /lapticos/ n
cbugc---- Error flag from rotax.
cbug common /lapticos/ nerr
cbugc---- Central angle of edge.
cbug common /lapticos/ phi
cbugc---- Rotation matrix.
cbug common /lapticos/ rotm (3,3)
cbugc---- Inscribed sphere radius.
cbug common /lapticos/ rs1
cbugc---- Inscibed sphere radius squared.
cbug common /lapticos/ rs2
cbugc---- Inscribed sphere radius cubed.
cbug common /lapticos/ rs3
cbugc---- Volume.
cbug common /lapticos/ volume
cbugc***DEBUG ends.
c.... Initialize.
c---- Mathematical constant, pi.
pi = 3.14159265358979323
c.... Generate the 12 vertices of a regular icosahedron, on a unit sphere.
c.... Orientation is symmetric with regular dodecahedron (see aptdode).
sinph = 2.0 / sqrt (5.0)
cosph = 0.5 * sinph
vx( 1) = 0.0
vy( 1) = 0.0
vz( 1) = 1.0
vx( 2) = sinph
vy( 2) = 0.0
vz( 2) = cosph
vx( 3) = sinph * cos (0.4 * pi)
vy( 3) = sinph * sin (0.4 * pi)
vz( 3) = cosph
vx( 4) = sinph * cos (0.8 * pi)
vy( 4) = sinph * sin (0.8 * pi)
vz( 4) = cosph
vx( 5) = vx(4)
vy( 5) = -vy(4)
vz( 5) = cosph
vx( 6) = vx(3)
vy( 6) = -vy(3)
vz( 6) = cosph
vx( 7) = -vx(4)
vy( 7) = vy(4)
vz( 7) = -cosph
vx( 8) = -vx(3)
vy( 8) = vy(3)
vz( 8) = -cosph
vx( 9) = -vx(2)
vy( 9) = 0.0
vz( 9) = -cosph
vx(10) = -vx(3)
vy(10) = -vy(3)
vz(10) = -cosph
vx(11) = -vx(4)
vy(11) = -vy(4)
vz(11) = -cosph
vx(12) = 0.0
vy(12) = 0.0
vz(12) = -1.0
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 (// 'icosahedron 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, 12)
cbug write ( 3, 9903) (nv1(n), nv2(n), n = 1, 30)
cbug write ( 3, '(//)')
cbug
cbugc____ call plotpoly (12, vx, vy, vz, 30, nv1, nv2)
cbugc____ call rotax (12, vx, vy, vz, 1.0, 1.0, 1.0, 0, 30.0, rotm, nerr)
cbugc____ call plotpoly (12, vx, vy, vz, 30, nv1, nv2)
cbug
cbug dl1 = 4.0 / sqrt (10.0 + 2.0 * sqrt (5.0))
cbug dl2 = dl1**2
cbug dl3 = dl1 * dl2
cbug rs1 = sqrt (42.0 + 18.0 * sqrt (5.0)) * dl1 / 12.0
cbug rs2 = rs1**2
cbug rs3 = rs1 * rs2
cbug area = 0.25 * sqrt (3.0) * dl2
cbug areatot = 20.0 * area
cbug volume = 5.0 * (3.0 + sqrt (5.0)) * dl3 / 12.0
cbug alpha = acos (-sqrt (5.0) / 3.0) * 180.0 / pi
cbug phi = acos (1.0 / sqrt (5.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 apticos. (+1 line.)
end
UCRL-WEB-209832