*-----------------------------------------------------------------------
*     3-D PROJECTION
*-----------------------------------------------------------------------
*     Copyright (C) 2000-2016 GFD Dennou Club. All rights reserved.
*-----------------------------------------------------------------------
      SUBROUTINE STFPR3(X, Y, Z, RX, RY)

      REAL      X0(3), X1(3), X2(3), A(3,3)
      LOGICAL   LAFFIN, LPRJCT, LPRJCZ

      SAVE

      DATA      LAFFIN /.FALSE./,        LPRJCT /.FALSE./,
     +          NX, NY /1, 2/,           SIGNX, SIGNY /1., 1./,
     +          SEC    /0.0 /,
     +          A      /1.0, 0.0, 0.0,
     +                  0.0, 1.0, 0.0,
     +                  0.0, 0.0, 1.0/


      X1(1) = X
      X1(2) = Y
      X1(3) = Z

      DO 10 I=1, 3
        X1(I) = X1(I) - X0(I)
   10 CONTINUE

      DO 15 I=1, 3
        X2(I) = A(I,1)*X1(1) + A(I,2)*X1(2) + A(I,3)*X1(3)
   15 CONTINUE

      IF (LAFFIN) THEN
        RX = X2(1) + RX0
        RY = X2(2) + RY0
      ELSE
        CC = RZ0/(RZ0-X2(3))
        RX = CC*X2(1) + RX0
        RY = CC*X2(2) + RX0
      END IF

      RETURN
*-----------------------------------------------------------------------
      ENTRY STSPR3(XFC, YFC, ZFC, THETA, PHI, PSI, FAC,
     +             ZVIEW, RXOFF, RYOFF)

      CALL CR3C(THETA, PHI, PSI, FAC, 0., 0., A(1,1), A(2,1), A(3,1))
      CALL CR3C(THETA, PHI, PSI, 0., FAC, 0., A(1,2), A(2,2), A(3,2))
      CALL CR3C(THETA, PHI, PSI, 0., 0., FAC, A(1,3), A(2,3), A(3,3))

      X0(1) = XFC
      X0(2) = YFC
      X0(3) = ZFC

      RX0 = RXOFF
      RY0 = RYOFF
      RZ0 = ZVIEW

      LAFFIN = ZVIEW .LE. 0.

      RETURN
*-----------------------------------------------------------------------
      ENTRY STFPR2(X, Y, RX, RY)

      IF (LPRJCT) THEN

        X1(NX) = X*SIGNX
        X1(NY) = Y*SIGNY
        X1(NS) = SEC

        DO 20 I=1, 3
          X1(I) = X1(I) - X0(I)
   20   CONTINUE

        DO 25 I=1, 3
          X2(I) = A(I,1)*X1(1) + A(I,2)*X1(2) + A(I,3)*X1(3)
   25   CONTINUE

        IF (LAFFIN) THEN
          RX = X2(1) + RX0
          RY = X2(2) + RY0
        ELSE
          CC = RZ0/(RZ0-X2(3))
          RX = CC*X2(1) + RX0
          RY = CC*X2(2) + RY0
        END IF

      ELSE
        RX = X
        RY = Y
      END IF

      RETURN
*-----------------------------------------------------------------------
      ENTRY STIPR2(RX, RY, X, Y)

      IF (LPRJCT) THEN

        PPX = (RX - RX0) / RZ0
        PPY = (RY - RY0) / RZ0

        IF (LAFFIN) THEN
          B11 = A(1,NX)
          B12 = A(1,NY)
          B13 = A(1,NS)
          B21 = A(2,NX)
          B22 = A(2,NY)
          B23 = A(2,NS)
        ELSE
          B11 = A(1,NX) + A(3,NX)*PPX
          B12 = A(1,NY) + A(3,NY)*PPX
          B13 = A(1,NS) + A(3,NS)*PPX
          B21 = A(2,NX) + A(3,NX)*PPY
          B22 = A(2,NY) + A(3,NY)*PPY
          B23 = A(2,NS) + A(3,NS)*PPY
        END IF

        BX = RZ0*PPX - B13*(SEC-X0(NS))
        BY = RZ0*PPY - B23*(SEC-X0(NS))

        DET = B11*B22 - B12*B21
        IF (DET.EQ.0.) THEN
          CALL GLRGET('RUNDEF',RNA)
          X = RNA
          Y = RNA
        ELSE
          X = (( B22*BX - B12*BY ) / DET + X0(NX) ) * SIGNX
          Y = ((-B21*BX + B11*BY ) / DET + X0(NY) ) * SIGNY
        END IF
      ELSE
        X = RX
        Y = RY
      END IF

      RETURN
*-----------------------------------------------------------------------
      ENTRY STSPR2(IX, IY, SECT)

      NX = ABS(IX)
      NY = ABS(IY)

      LPRJCT = NX.NE.0 .AND. NY.NE.0

      IF (.NOT. LPRJCT) RETURN

      IF (.NOT.(1.LE.NX .AND. NX.LE.3)) THEN
        CALL MSGDMP('E', 'STSPR2', 'INVALID COORDINATE NUMBER (IX).')
      END IF

      IF (.NOT.(1.LE.NY .AND. NY.LE.3)) THEN
        CALL MSGDMP('E', 'STSPR2', 'INVALID COORDINATE NUMBER (IY).')
      END IF

      SIGNX = SIGN(1, IX)
      SIGNY = SIGN(1, IY)
      SEC  = SECT

      DO 50 I=1, 3
        IF (I.NE.NX .AND. I.NE.NY) GO TO 55
   50 CONTINUE
   55 CONTINUE
      NS = I

      RETURN
*-----------------------------------------------------------------------
      ENTRY STEPR2

      LPRJCZ = LPRJCT
      LPRJCT = .FALSE.

      RETURN
*-----------------------------------------------------------------------
      ENTRY STRPR2

      LPRJCT = LPRJCZ

      RETURN
      END
