
      SUBROUTINE Close3DGraphics
      CALL CloseGraphics
      END !SUBROUTINE

      SUBROUTINE Concat2 (a, b, c)
      REAL a(0:8), b(0:8), c(0:8)
      INTEGER  i3
      DO i = 0 , 2
        i3 = i * 3
        DO j = 0 , 2
           c(i3 + j) = a(i3 + 0) * b(j) + a(i3 + 1) * b(3 + j) +
     +                 a(i3 + 2) * b(6 + j)
        END DO
      END DO
      END !SUBROUTINE

      SUBROUTINE Concat3 (a, b, c)
      REAL a(0:15), b(0:15), c(0:15)
      INTEGER i,j, i4

      DO i = 0 , 3
        i4 = i * 4
        DO j = 0 , 3
          c(i4 + j) = a(i4 + 0) * b(j) + a(i4 + 1) *
     +        b(4 + j) + a(i4 + 2) *
     +        b(8 + j) + a(i4 + 3) * b(12 + j)
        END DO
       END DO

      END !SUBROUTINE



      SUBROUTINE Draw3DAxes (x, y, z)
      CALL Move3Abs(0.0, 0.0, 0.0)
      CALL Line3Abs(x, 0.0, 0.0)
      CALL Move3Abs(0.0, 0.0, 0.0)
      CALL Line3Abs(0.0, y, 0.0)
      CALL Move3Abs(0.0, 0.0, 0.0)
      CALL Line3Abs(0.0, 0.0, z)
      END !SUBROUTINE

      SUBROUTINE IdArg (a)
      REAL a(0:8)
      INTEGER i, j, i3

      DO i = 0 , 2
        i3 = i * 3
        DO j = 0 , 2
          a(i3 + j) = 0.0
        END DO
        a(i3 + i) = 1.0
      END DO
      END !SUBROUTINE

      SUBROUTINE IdArg3 (a)
      REAL a(0:15)
      INTEGER i,j, i4
      DO i = 0 , 3
        i4  = i * 4
        DO j = 0 , 3
           a(i4 + j) = 0.0
        END DO
        a(i4 + i) = 1.0
      END DO
      END !SUBROUTINE



      SUBROUTINE Ident (a)
      REAL a(0:8)
      CALL IdArg(a)
      END !SUBROUTINE



      SUBROUTINE Ident3 (a)
      REAL a(0:15)

      CALL IdArg3(a)
      END !SUBROUTINE




      SUBROUTINE Init3D (mode, pathname)
      INTEGER mode
      CHARACTER * 80 pathname
      CALL OneTimeInit(mode, pathname)
      END !SUBROUTINE

      SUBROUTINE Label3D (s)
      CHARACTER * (*) s
      CHARACTER * 80 outstring
      INTEGER i
      DO i = 1, 80
       outstring(i:i) = ' '
      END DO
      outstring = s
      CALL OutTextXX (outstring)
      END !SUBROUTINE

      SUBROUTINE Line2Abs (x, y)
      REAL x,y, xt, yt

      CALL Xfrm2P(x, y, xt, yt)
      CALL lineworldabs(xt, yt)
      END !SUBROUTINE



      SUBROUTINE Line2Rel (x, y)
      REAL x,y, xt, yt

      CALL Xfrm2P(x, y, xt, yt)
      CALL lineworldRel(xt, yt)
      END !SUBROUTINE



      SUBROUTINE Line3Abs (x, y, z)
      REAL x, y, z, xt, yt, zt, wt

      CALL Xfrm3P(x, y, z, 1.0, xt, yt, zt, wt)
      xt = xt / wt
      yt = yt / wt
      CALL lineworldabs(xt, yt)
      END !SUBROUTINE



      SUBROUTINE Line3Rel (x, y, z)
      REAL x, y, z, xt, yt, zt, wt

      CALL Xfrm3P(x, y, z, 1.0, xt, yt, zt, wt)
      xt = xt / wt
      yt = yt / wt
      CALL lineworldRel(xt, yt)
      END !SUBROUTINE


      SUBROUTINE Move2Abs (x, y)
      REAL x, y, xt, yt

      CALL Xfrm2P(x, y, xt, yt)
      CALL moveworldabs(xt, yt)
      END !SUBROUTINE

      SUBROUTINE Move2Rel (x, y)
      REAL xt, yt

      CALL Xfrm2P(x, y, xt, yt)
      CALL moveworldrel(xt, yt)
      END !SUBROUTINE

      SUBROUTINE Move3Abs (x, y, z)
      REAL x, y, z, xt, yt, zt, wt

      CALL Xfrm3P(x, y, z, 1.0, xt, yt, zt, wt)
      xt = xt / wt
      yt = yt / wt
      CALL moveworldabs(xt, yt)
      END !SUBROUTINE

      SUBROUTINE Move3Rel (x, y, z)
      REAL x, y, z, xt, yt, zt, wt

      CALL Xfrm3P(x, y, z, 1.0, xt, yt, zt, wt)
      xt = xt / wt
      yt = yt / wt
      CALL moveworldrel(xt, yt)
      END !SUBROUTINE

      SUBROUTINE Persp (dist)
      REAL tmp3Mat(0 :15), t3Curnt(0:15), dist
      COMMON /mat3D/ t3Curnt

      CALL IdArg3(tmp3Mat)
      tmp3Mat(0) = -dist
      tmp3Mat(5) = -dist
      tmp3Mat(11) = 1.0
      tmp3Mat(15) = -dist
      CALL Concat3(t3Curnt, tmp3Mat, t3Curnt)
      END !SUBROUTINE

      SUBROUTINE PolyFill3D (p, fillstyle, fillcolor, numdat)
      INCLUDE 'GRAFTYPE.FOR'
      INCLUDE 'STDHDR.FOR'
      RECORD /point3D/  p(0:maxv)
      INTEGER  fillstyle, fillcolor, numdat
      REAL xt, yt, zt, wt
      REAL x(0 :maxv)
      REAL y(0 :maxv)
      LOGICAL Bw

      DO i = 0 , numdat - 1
        CALL Xfrm3P(p(i).x, p(i).y, p(i).z, 1.0, xt, yt, zt, wt)
        x(i) = xt / wt
        y(i) = yt / wt
      END DO
      CALL BlackAndWhite(Bw)
      IF ( Bw) THEN
        CALL PolyFillWorldAbs(x,y, fillstyle, fillcolor, numdat)
      ELSE
        CALL ColorPolyFillWorldAbs(x, y, fillstyle, fillcolor, numdat)
      END IF
      END !SUBROUTINE


      SUBROUTINE tInit
      REAL tCurnt(0:8)
      COMMON /mat2d/ tCurnt
      CALL Ident(tCurnt)
      END !SUBROUTINE



      SUBROUTINE tInit3
      REAL t3Curnt(0:15)
      COMMON /mat3d/ t3Curnt

      CALL Ident3(t3Curnt)
      END !SUBROUTINE

      SUBROUTINE WorldRotate2 (degree)
      REAL tmpMat(0 :8),radian, degree
      REAL tCurnt(0:8)
      COMMON /mat2d/ tCurnt

      CALL IdArg(tmpMat)
      radian = degree * 3.1415 / 180.0
      tmpMat(0) = COS(radian)
      tmpMat(1) = SIN(radian)
      tmpMat(3) = -SIN(radian)
      tmpMat(4) = COS(radian)
      CALL Concat2(tCurnt, tmpMat, tCurnt)
      END !SUBROUTINE

      SUBROUTINE WorldRotate3 (degree, iAxis)
      REAL tmp3Mat(0 :15), sign, radian,degree
      INTEGER i1, i2, iAxis, i14, i24
      REAL t3Curnt(0:15)
      COMMON /mat3d/ t3Curnt

      SELECT CASE (iAxis)
       CASE (0)
         i1 = 1
         i2 = 2
         sign = 1.0
       CASE (1)
         i1 = 0
         i2 = 2
         sign = -1.0
       CASE (2)
         i1 = 0
         i2 = 1
         sign = 1.0
       CASE DEFAULT
         i1 = 1
         i2 = 2
       END SELECT
      CALL IdArg3(tmp3Mat)
      radian = degree * 3.1415 / 180.0
      i14 = i1 * 4
      i24 = i2 * 4
      tmp3Mat(i14 + i1) = COS(radian)
      tmp3Mat(i24 + i2) = tmp3Mat(i14 + i1)
      tmp3Mat(i14 + i2) = sign * SIN(radian)
      tmp3Mat(i24 + i1) = -tmp3Mat(i14 + i2)
      CALL Concat3(t3Curnt, tmp3Mat, t3Curnt)
      END !SUBROUTINE

      SUBROUTINE WorldScale2 (x, y)
      REAL tmpMat(0 :8), x, y
      REAL tCurnt(0:8)
      COMMON /mat2d/ tCurnt

      CALL IdArg(tmpMat)
      tmpMat(0) = x
      tmpMat(4) = y
      CALL Concat2(tCurnt, tmpMat, tCurnt)
      END !SUBROUTINE

      SUBROUTINE WorldScale3 (x, y, z)
      REAL tmp3Mat(0 :15), x, y
      REAL t3Curnt(0:15)
      COMMON /mat3d/ t3Curnt

      CALL IdArg3(tmp3Mat)
      tmp3Mat(0) = x
      tmp3Mat(5) = y
      tmp3Mat(10) = z
      CALL Concat3(t3Curnt, tmp3Mat, t3Curnt)
      END !SUBROUTINE



      SUBROUTINE WorldTran2 (x, y)
      REAL tmpMat(0 :8), x, y
      REAL tCurnt(0:8)
      COMMON /mat2d/ tCurnt

      CALL IdArg(tmpMat)
      tmpMat(6) = x
      tmpMat(7) = y
      CALL Concat2(tCurnt, tmpMat, tCurnt)
      END !SUBROUTINE



      SUBROUTINE WorldTran3 (x, y, z)
      REAL tmp3Mat(0 :15), x, y, z
      REAL t3Curnt(0:15)
      COMMON /mat3d/ t3Curnt

      CALL IdArg3(tmp3Mat)
      tmp3Mat(12) = x
      tmp3Mat(13) = y
      tmp3Mat(14) = z
      CALL Concat3(t3Curnt, tmp3Mat, t3Curnt)
      END !SUBROUTINE


      SUBROUTINE Xfrm2P (x, y, xt, yt)
      REAL x, y, xt, yt
      REAL tCurnt(0:8)
      COMMON /mat2d/ tCurnt
      xt = x * tCurnt(0) + y * tCurnt(3) + tCurnt(6)
      yt = x * tCurnt(1) + y * tCurnt(4) + tCurnt(7)
      xt = xt / tCurnt(8)
      yt = yt / tCurnt(8)
      END !SUBROUTINE

      SUBROUTINE Xfrm3P (x, y, z, w, xt, yt, zt, wt)
      REAL x, y, z, w, xt, yt, zt, wt
      REAL t3Curnt(0:15)
      COMMON /mat3d/ t3Curnt
      xt = x * t3Curnt(0) + y * t3Curnt(4) + z *
     +          t3Curnt(8) + w * t3Curnt(12)
      yt = x * t3Curnt(1) + y * t3Curnt(5) + z *
     +          t3Curnt(9) + w * t3Curnt(13)
      zt = x * t3Curnt(2) + y * t3Curnt(6) + z *
     +          t3Curnt(10) + w * t3Curnt(14)
      wt = x * t3Curnt(3) + y * t3Curnt(7) + z *
     +          t3Curnt(11) + w * t3Curnt(15)
      END !SUBROUTINE

