subroutine apttetr (vx, vy, vz, nv1, nv2)

ccbeg.
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c                             SUBROUTINE APTTETR
c
c     call apttetr (vx, vy, vz, nv1, nv2)
c
c     Version:  apttetr  Updated    1990 March 12 13:10.
c               apttetr  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 tetrahedron inscribed in a unit sphere.
c               A tetrahedron has 4 vertices, 6 edges, and 4 triangular faces.
c               Vertex 1 is on the z axis, and the face with vertices 2, 3
c               and 4 is parallel to the xy plane.
c               Edges join vertex pairs 1-2, 1-3, 1-4, 2-3, 2-4, 3-4.
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, 4),
c               (nv1(ne), nv2(ne), ne = 1, 6).
c
c     Note:     See aptcube to generate a cube with shared symmetry.
c               See aptocta to generate a regular octahedron.
c               See aptdode to generate a regular dodecahedron.
c               See apticos to generate a regular icosahedron.
c
c     Glossary:
c
c     nv1       Output   Index of first vertex of edge ne.  Size 6.
c
c     nv2       Output   Index of second vertex of edge ne.  Size 6.
c
c     vx,vy,vz  Output   The x, y, z coordinates of a vertex of a regular
c                          tetrahedron.  Size 4.
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
ccend.

c.... Dimensioned arguments.

c---- Index of first vertex of edge.
      dimension nv1     (6)
c---- Index of second vertex of edge.
      dimension nv2     (6)

c---- Coordinate x of tetrahedron vertex.
      dimension vx      (4)
c---- Coordinate y of tetrahedron vertex.
      dimension vy      (4)
c---- Coordinate z of tetrahedron vertex.
      dimension vz      (4)

c.... Local variables.

c---- Index of edge.
      common /lapttetr/ ne
c---- Index of first vertex of edge.
      dimension nver1   (6)
c---- Index of second vertex of edge.
      dimension nver2   (6)
cbugc***DEBUG begins.
cbugc---- Dihedral angle.
cbug      common /lapttetr/ alpha
cbugc---- Face area.
cbug      common /lapttetr/ area
cbugc---- Total face area.
cbug      common /lapttetr/ areatot
cbugc---- Edge length.
cbug      common /lapttetr/ dl1
cbugc---- Edge length squared.
cbug      common /lapttetr/ dl2
cbugc---- Edge length cubed.
cbug      common /lapttetr/ dl3
cbugc---- Index in vx, vy, vz.
cbug      common /lapttetr/ n
cbugc---- Error flag from rotax.
cbug      common /lapttetr/ nerr
cbugc---- Central angle of edge.
cbug      common /lapttetr/ phi
cbugc---- Mathematical constant, pi.
cbug      common /lapttetr/ pi
cbugc---- Mathematical constant, pi.
cbug      data pi /3.14159265358979323/
cbugc---- Rotation matrix.
cbug      common /lapttetr/ rotm   (3,3)
cbugc---- Inscribed sphere radius.
cbug      common /lapttetr/ rs1
cbugc---- Inscibed sphere radius squared.
cbug      common /lapttetr/ rs2
cbugc---- Inscribed sphere radius cubed.
cbug      common /lapttetr/ rs3
cbugc---- Volume.
cbug      common /lapttetr/ volume
cbugc***DEBUG ends.

      data (nver1(n), n = 1, 6) /1, 1, 1, 2, 2, 3/
      data (nver2(n), n = 1, 6) /2, 3, 4, 3, 4, 4/

c.... Generate the 4 vertices of a regular tetrahedron.

      vx(1) = 0.0
      vy(1) = 0.0
      vz(1) = 1.0

      vx(2) =  2.0 * sqrt (2.0) / 3.0
      vy(2) =  0.0
      vz(2) = -1.0 / 3.0

      vx(3) = -0.5 * vx(2)
      vy(3) =  sqrt (2.0 / 3.0)
      vz(3) =  vz(2)

      vx(4) =  vx(3)
      vy(4) = -vy(3)
      vz(4) =  vz(2)

c.... Generate the indices of the vertices bounding each edge.

      do 110 ne = 1, 6
        nv1(ne) = nver1(ne)
        nv2(ne) = nver2(ne)
  110 continue
cbugc***DEBUG begins.
cbug 9901 format (// 'tetrahedron 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, 4)
cbug      write ( 3, 9903) (nv1(n), nv2(n), n = 1, 6)
cbug      write ( 3, '(//)')
cbug
cbugc____     call plotpoly (4, vx, vy, vz, 6, nv1, nv2)
cbugc____     call rotax (4, vx, vy, vz, 1.0, 1.0, 1.0, 0, 30.0, rotm, nerr)
cbugc____     call plotpoly (4, vx, vy, vz, 6, nv1, nv2)
cbug
cbug      dl1 = 2.0 * sqrt (6.0) / 3.0
cbug      dl2 = dl1**2
cbug      dl3 = dl1 * dl2
cbug      rs1 = 1.0 / 3.0
cbug      rs2 = rs1**2
cbug      rs3 = rs1 * rs2
cbug      area = 2.0 / sqrt (3.0)
cbug      areatot = 4.0 * area
cbug      volume = 8.0 * sqrt (3.0) / 27.0
cbug      alpha = acos (1.0 / 3.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 apttetr.      (+1 line.)
      end

UCRL-WEB-209832