LIB UTIL:KERNEL
LIB UTIL:CORE
DEF.DEV 2 * MOT
FORTRAN 0 0 NON-ANSI
      *IMPORT 'MOVA2','MOVA3','MOVR2','MOVR3'
      *IMPORT 'IPSN2','IPSN3','LINA2'
      *IMPORT 'LINA3','LINR2','LINR3','PLINA2'
      *IMPORT 'PLINA3','PLINR2','PLINR3','PMRKR3'
      *IMPORT 'TEXTT','MARKA2','MARKA3','MARKR2'
      *IMPORT 'MARKR3','PMRKA2','PMRKA3','PMRKR2'
      *IMPORT 'CRRSEG','CLRSEG','DERSEG','DELALL'
      *IMPORT 'RENSEG','IRSSRF','IRSNAM','IOSEG'
      *IMPORT 'CRTSEG','CLTSEG','IOTSEG','SLSTYL'
      *IMPORT 'SLWID','SPEN','SFONT','SCHSIZ'
      *IMPORT 'SCHPLA','SCHUP2','SCHUP3','SCHPTH'
      *IMPORT 'SCHSPA','SCHJST','SCHPRE','SMKSYM'
      *IMPORT 'SPID','SPISTY','SPESTY','SLNDX'
      *IMPORT 'SFNDX','STNDX','SLNCOL','SFLCOL','STXCOL'
      *IMPORT 'SLNINT','SFLINT','STXINT','SVINDC'
      *IMPORT 'SVCOLS','SVINTS','SPRAT2','SPRAT3'
      *IMPORT 'ILSTYL','ILWID','IPEN','IFONT'
      *IMPORT 'ICHSIZ','ICHPLA','ICHUP2','ICHUP3'
      *IMPORT 'ICHPTH','ICHSPA','ICHJST','ICHPRE'
      *IMPORT 'IMKSYM','IPID','IPISTY','IPESTY'
      *IMPORT 'ILNDX','IFNDX','ITNDX','ILNCOL'
      *IMPORT 'IFLCOL','ITXCOL','ILNINT','IFLINT'
      *IMPORT 'ITXINT','IVINDC','IVCOLS','IVINTS'
      *IMPORT 'IPRAT2','IPRAT3','STRTYP','ITRTYP'
      *IMPORT 'ISTTYP','SVISIB','SHILIT','SDTECT'
      *IMPORT 'SITN2','SITR2','SITR3','IVISIB'
      *IMPORT 'IHILIT','IDTECT','IITN2','IITR2'
      *IMPORT 'IITR3','SSVIS','SSHILT','SSDET'
      *IMPORT 'SSITN2','SSITR2','SSITR3','ISVIS'
      *IMPORT 'ISHILT','ISDET','ISITN2','ISITR2'
      *IMPORT 'SWINDO','SVUP2','SNDCS2','SVPRT2'
      *IMPORT 'IWINDO','IVUP2','INDCS2','IVPRT2'
      *IMPORT 'MNTOW2','MWTON2','SVRFPT','SVPNOR'
      *IMPORT 'SVPDIS','SVDPTH','SPROJ'
      *IMPORT 'SVUP3','SNDCS3','SVPRT3','SVPARM'
      *IMPORT 'IVRFPT','IVPNOR','IVPDIS','IVDPTH'
      *IMPORT 'IPROJ','IVUP3','INDCS3','IVPRT3'
      *IMPORT 'IVPARM','MNTOW3','MWTON3','SCLIPW'
      *IMPORT 'SCLPFP','SCLPBP','SCORTP','IVCPAR'
      *IMPORT 'SWMTX2','SWMTX3','IWMTX2','IWMTX3'
      *IMPORT 'INIT','TERM','NITSRF','TRMSRF'
      *IMPORT 'SELSRF','DELSRF','SIMVIS','MPICC'
      *IMPORT 'BGNUPD','ENDUPD','ICONST','NEWFRM'
       *IMPORT 'POLYA3','POLYA2','POLYR3','POLYR2','ESCAPE'
      *IMPORT 'DRIVER'

       CALL INIT (3,0,2)
      CALL SCORTP(1)
      CALL STRTYP(4)
      CALL SVRFPT(0.,0.,0.)
      CALL SVPNOR(-1.,-1.,-1.4)
      CALL SVPDIS(0.)
      CALL SNDCS3(1., .85,1.)
  95   PRINT*, 'Type "1" to select  SADDLE !'
       PRINT*, 'Type "2" to select PARALLEL CUBE !'
       PRINT*, 'Type "3" to select PERSPECTIVE CUBE !'
       PRINT*, 'Type "4" to select FILLED POLYGON !'
       PRINT*, 'Type "5" to terminate display !'
       READ*, II
       GOTO (10,20,30,40,50) II
  10     CALL SADDLE
       GOTO  95

  20     CALL CUBPAR
       GOTO 95

  30    CALL CUBPER
       GOTO 95


  40    CALL  CUBFILL
       GOTO 95
  50   CALL TERM
       STOP
       END

        SUBROUTINE SADDLE

      CALL SCLIPW(.FALSE.)
      CALL SVUP3(0.,1.,0.)
      CALL NITSRF(2,1,1)
      CALL SELSRF(2)

      CALL NEWFRM
      CALL SVDPTH(-100.,100.)
      CALL SWINDO(-30.,40.,-30.,40.)
       CALL SPROJ(2.,50.,50.,80.)
      CALL SVPRT3(0.1,0.9,0.1,0.7,0.1,0.8)
       CALL SCHPRE(3)
      CALL CRRSEG(1)
      CALL SLNDX (3)

        B=-20.0
        E=20.0
        S=2.0
        A=10.0
       DO 10 X=B,E,S
         Y= (X*X-B*B)/A
        CALL MOVA3 (X,Y,B)
       DO 10 Z= B,E,S
          Y= (X*X- Z*Z)/A
         CALL LINA3 (X, Y, Z)
  10   CONTINUE

       CALL  SLNDX(2)
       DO 20 Z= B, E, S
        Y=(B*B - Z*Z)/A
        CALL MOVA3 (B, Y, Z)
        DO 20 X= B, E, S
         Y= (X*X - Z*Z)/A
         CALL LINA3 (X, Y, Z)
  20   CONTINUE

      CALL CLRSEG

      CALL DELSRF(2)
      CALL TRMSRF(2)
      END

        SUBROUTINE CUBPAR

      CALL SCLIPW(.TRUE.)
      CALL SVUP3(0.,1.,0.)
      CALL NITSRF(2,1,1)
      CALL SELSRF(2)

      CALL NEWFRM
      CALL SVDPTH(-100.,100.)
       CALL SWINDO (-35.0,35.0,-35.0,35.0)
       CALL SPROJ(1.,40.,40.,56.)
       CALL SVPRT3 (0.1,0.98,0.01,0.84,0.1,0.9)
       CALL SCHPRE(3)
      CALL CRRSEG(1)
        CALL SLNDX (4)
       CALL AXES(40.,2.)
       CALL CUB(30.)

       CALL SCHPLA (0.,0.,-1.)
       CALL SCHUP3 (0.,1.,0.)
       CALL SCHPTH (0)
        CALL STNDX (3)
       CALL SCHSIZ (1., 1.)
       CALL MOVA3 (0.5,20.,30.)
       CALL TEXTT ('PARALLEL PROJECTION TO A CUBE',29)
       CALL SCHPLA (0.,0.,1.)
       CALL MOVA3 (29.5,20.,0.)
       CALL TEXTT ('PARALLEL PROJECTION TO A CUBE',29)
       CALL SCHSIZ (3.,3.)
       CALL SCHPLA (0.,-1.,0.)
       CALL SCHUP3 (0.,0.,-1.)
       CALL MOVA3 (4.,0.,10.)
       CALL TEXTT ('PARALLEL',8)
       CALL SCHUP3 (0.,0.,1.)
       CALL MOVA3 (26.,0.,20.)
       CALL TEXTT ('PARALLEL',8)
       CALL SCHPTH (1)
       CALL SCHUP3 (0.,1.,0.)
       CALL SCHPLA (1.,0.,0.)
       CALL MOVA3 (0.,20.,-20.)
       CALL TEXTT ('PARALLEL',8)
       CALL SCHPLA (-1.,0.,0.)
       CALL MOVA3 (30.,20.,48.)
       CALL TEXTT ('PARALLEL',8)
       CALL CLRSEG


      CALL DELSRF(2)
      CALL TRMSRF(2)
      END

        SUBROUTINE CUBPER
      CALL SCLIPW(.TRUE.)
      CALL SVUP3(0.,1.,0.)
      CALL NITSRF(2,1,1)
      CALL SELSRF(2)

      CALL NEWFRM
      CALL SVDPTH(-100.,100.)
       CALL SWINDO (-35.0,35.0,-35.0,35.0)
        CALL SPROJ (2., 70.,70.,98.)
       CALL SVPRT3 (0.01,0.98,0.01,0.84,0.01,0.9)
       CALL SCHPRE(3)
      CALL CRRSEG(1)
        CALL SLNDX (5)
       CALL AXES(40.,2.)
       CALL CUB(30.)

       CALL SCHPLA (0.,0.,-1.)
       CALL SCHUP3 (0.,1.,0.)
       CALL SCHPTH (0)
        CALL STNDX (2)
       CALL SCHSIZ (1., 1.)
       CALL MOVA3 (0.5,20.,30.)
       CALL TEXTT ('PERSPECT PROJECTION TO A CUBE',29)
       CALL SCHPLA (0.,0.,1.)
       CALL MOVA3 (29.5,20.,0.)
       CALL TEXTT ('PERSPECT PROJECTION TO A CUBE',29)
       CALL SCHSIZ (3.,3.)
       CALL SCHPLA (0.,-1.,0.)
       CALL SCHUP3 (0.,0.,-1.)
       CALL MOVA3 (4.,0.,10.)
       CALL TEXTT ('PERSPECT',8)
       CALL SCHUP3 (0.,0.,1.)
       CALL MOVA3 (26.,0.,20.)
       CALL TEXTT ('PERSPECT',8)
       CALL SCHPTH (1)
       CALL SCHUP3 (0.,1.,0.)
       CALL SCHPLA (1.,0.,0.)
       CALL MOVA3 (0.,20.,-20.)
       CALL TEXTT ('PERSPECT',8)
       CALL SCHPLA (-1.,0.,0.)
       CALL MOVA3 (30.,20.,48.)
       CALL TEXTT ('PERSPECT',8)
       CALL CLRSEG


      CALL DELSRF(2)
      CALL TRMSRF(2)
      END
       SUBROUTINE  CUBFILL

        REAL X1(4),Y1(4),Z1(4)
        REAL X2(4),Y2(4),Z2(4)
        REAL X3(4),Y3(4),Z3(4)
        REAL X4(4),Y4(4),Z4(4)

        CALL ESCAPE (1,3)
        CALL SPISTY (1)
        CALL SPESTY (1)
      CALL SCLIPW(.TRUE.)
      CALL SVUP3(0.,1.,0.)
      CALL NITSRF(2,1,1)
      CALL SELSRF(2)

      CALL NEWFRM
      CALL SVDPTH(-100.,100.)
       CALL SWINDO (-50.0,50.0,-50.0,50.0)
        CALL SPROJ (2., 50., 50.,70.)
       CALL SVPRT3 (0.1,0.8,0.1,0.70,0.01,0.9)
       CALL SCHPRE(3)
        X1(1) =30.
        Y1(1) =30.
        Z1(1) =30.
        X2(1) =30.
        Y2(1) =30.
        Z2(1) =30.
        X3(1) =30.
         Y3(1) =30.
        Z3(1) =30.
        X1(2) =30.
        X3(2) =30.
        Y1(2) =30.
        Y3(2) =30.
       Y1(3) =30.
       Y1(4) =30.
       Z1(4) =30.
       Y2(2) =30.
       Z2(2) =30.
       Z2(3) =30.
       X2(4) =30.
       Z2(4) =30.
       X3(4) =30.
       Z3(4) =30.
       X3(3) =30.

      CALL CRRSEG(1)
        CALL SLNDX (4)
       CALL AXES(40.,2.)
       CALL CUB(30.)

        CALL SLNDX (3)
        CALL POLYA3 (X1,Y1,Z1,4)
        CALL SLNDX (7)
        CALL POLYA3 (X2,Y2,Z2,4)
        CALL SLNDX (6)
        CALL POLYA3 (X3,Y3,Z3,4)

       CALL SCHPLA (0.,0.,-1.)
       CALL SCHUP3 (0.,1.,0.)
       CALL SCHPTH (0)
        CALL STNDX (0)
       CALL SCHSIZ (1., 1.)
       CALL MOVA3 (0.5,20.,30.)
C       CALL TEXTT ('PARALLEL PROJECTION TO A CUBE',29)
       CALL SCHPLA (0.,0.,1.)
       CALL MOVA3 (29.5,20.,0.)
C       CALL TEXTT ('PARALLEL PROJECTION TO A CUBE',29)
       CALL SCHSIZ (3.,3.)
       CALL SCHPLA (0.,-1.,0.)
       CALL SCHUP3 (0.,0.,-1.)
       CALL MOVA3 (4.,0.,10.)
C       CALL TEXTT ('PARALLEL',8)
       CALL SCHUP3 (0.,0.,1.)
       CALL MOVA3 (26.,0.,20.)
C       CALL TEXTT ('PARALLEL',8)
       CALL SCHPTH (1)
       CALL SCHUP3 (0.,1.,0.)
       CALL SCHPLA (1.,0.,0.)
       CALL MOVA3 (0.,20.,-20.)
C       CALL TEXTT ('PARALLEL',8)
       CALL SCHPLA (-1.,0.,0.)
       CALL MOVA3 (30.,20.,48.)
C       CALL TEXTT ('PARALLEL',8)
       CALL CLRSEG


      CALL DELSRF(2)
      CALL TRMSRF(2)
      END


      SUBROUTINE CUB(SIDE)
       CALL MOVA3(0.,0.,0.)
       CALL LINR3(SIDE,0.,0.)
       CALL LINR3(0.,SIDE,0.)
       CALL LINR3(-SIDE,0.,0.)
       CALL LINR3(0.,-SIDE,0.)
       CALL LINR3(0.,0.,SIDE)
       CALL LINR3(SIDE,0.,0.)
       CALL LINR3(0.,SIDE,0.)
       CALL LINR3(-SIDE,0.,0.)
       CALL LINR3(0.,-SIDE,0.)
       CALL MOVA3(0.,SIDE,0.)
       CALL LINR3(0.,0.,SIDE)
       CALL MOVA3(SIDE,0.,0.)
       CALL LINR3(0.,0.,SIDE)
       CALL MOVA3(SIDE,SIDE,0.)
       CALL LINR3(0.,0.,SIDE)
       RETURN
       END

      SUBROUTINE BOX(ORIX,ORIY,WIDTH,HEIT)
       ORIX=ORIX+0.001
       ORIY=ORIY+0.001
       WIDTH=WIDTH-0.002
       HEIT=HEIT-0.002
       CALL MNTOW3(ORIX,ORIY,0.2,X1,Y1,Z1)
       CALL MNTOW3(ORIX+WIDTH,ORIY,0.2,X2,Y2,Z2)
       CALL MNTOW3(ORIX,ORIY+HEIT,0.2,X3,Y3,Z3)
       CALL MNTOW3(ORIX+WIDTH,ORIY+HEIT,0.2,X4,Y4,Z4)
       CALL MOVA3(X1,Y1,Z1)
       CALL LINA3(X2,Y2,Z2)
       CALL LINA3(X4,Y4,Z4)
       CALL LINA3(X3,Y3,Z3)
       CALL LINA3(X1,Y1,Z1)
       CALL MOVA3( (X2-X1)/5.+X1,(Y3-Y1)/10.+Y1,0.)
      RETURN
      END

      SUBROUTINE AXES(RLEGTH,AW)
       CALL MOVA3(0.,0.,0.)
       CALL LINR3(RLEGTH,0.,0.)
       CALL LINR3(-AW,-AW/2,0.)
       CALL MOVA3(RLEGTH,0.,0.)
       CALL LINR3(-AW,AW/2.,0.)
       CALL MOVA3(0.,0.,0.)
       CALL LINR3(0.,RLEGTH,0.)
       CALL LINR3(-AW/2.,-AW,0.)
       CALL MOVA3(0.,RLEGTH,0.)
       CALL LINR3(AW/2.,-AW,0.)
       CALL MOVA3(0.,0.,0.)
       CALL LINR3(0.,0.,RLEGTH)
       CALL LINR3(-AW/2.,0.,-AW)
       CALL MOVA3(0.,0.,RLEGTH)
       CALL LINR3(AW/2.,0.,-AW)
      RETURN
      END

      *END
RUN
RELEASE.LIB UTIL:KERNEL
RELEASE.LIB UTIL:CORE
IN -1
STOP
