C     CAMPER
C  RECREATION OF WOODY ANDERSON'S CAMPER SYSTEM FROM 1968
      COMMON/CARD/NAME(1500),ISTACK(1500),IARRAY(1500),IFIG(1500),
     1ARG1(1500),ARG2(1500),ARG3(1500),ARG4(1500),ARG5(1500),
     2TEXT(18,1500)
      COMMON/STK/STACK(8,4000)
      COMMON/VAR/JMAX,X3DORG,Y3DORG,ISTKPT(8),JDO,JLP,LPCNT,LTIMES,
     1IARPT(8,100),INDPT(8,100),IARLST(8),VAR(10),IFRMCN
      CHARACTER*5  NAME
      CHARACTER*18 TEXT
      DATA X3DORG/0.0/,Y3DORG/0.0/
      DATA STACK/32000*0.0/
      DATA ISTKPT/8*1/
      DATA IARPT/800*0/
      DATA INDPT/800*0/
      DATA VAR/10*0.0/
      DATA IFRMCN/1/
C
C  STACK(8,2500) 8 4000-WORD STACKS CONTAINING ARRAYS (LINES, CURVES)
C  EACH STACK HAS UP TO 100 ARRAYS
C    ISTKPT   POINTS TO LAST USED WORD IN STACK
C    IARLST   LAST ARRAY IN STACK
C    IARPT    START POINT OF ARRAY IN STACK
C    INDPT    END   POINT OF ARRAY IN STACK
C    X3DORG   ORIGIN OF 3D DRAWING WITH Y3DORG
C    JMAX     NUMBER OF CARDS IN CAMPER PROGRAM
C    JDO      POSITION OF DO BEING OBEYED
C    JLP      POSITION OF LOOP BEING OBEYED
C    LTIMES   NUMBER OF TIMES LOOP TO BE OBEYED
C    LPCNT    NUMBER OF TIMES OBEYED SO FAR
C    CARD     /CARD/ CONTAINS CONTENTS OF ALL CARDS IN PROGRAM
C    VAR      CONTAINS VARIABLES V1 TO V9
C
C INITIALISE STACK AND ARRAY POINTERS
C
      DO 5 I=1,8
      STACK(I,1)=5000.
      ISTKPT(I)=1  
      IARPT(I,1)=1
      INDPT(I,1)=1
   5  CONTINUE
C
C     UNIT 5 CONTAINS 80-COLUMN CARDS IN PROGRAM
C     UNIT 3 OUTPUTS DIAGNOSTIC PRINTS AND CARDS READ
C     UNIT 6 CONTAINS THE DETAILS OF CAMPER FONT
C     UNIT 8 OUTPUT ANIMATION FROM THE PROGRAM
C
      OPEN(UNIT=3,FILE='camper_output.txt')
C     OPEN(UNIT=5,FILE='camper_input_aero.txt')
      OPEN(UNIT=5,FILE='camper_input_aeromovie.txt')
C     OPEN(UNIT=5,FILE='camper_input_can.txt')
C     OPEN(UNIT=5,FILE='camper_input_clocks.txt')
C     OPEN(UNIT=5,FILE='camper_input_move.txt')
C     OPEN(UNIT=5,FILE='camper_input_stick.txt')
C     OPEN(UNIT=5,FILE='camper_input_suitcase.txt')
      OPEN(UNIT=6,FILE='camper_font.txt')
      OPEN(UNIT=8,FILE='camper_output.svg')
C
C     INITIALISES SVG OUTPUT
C
      CALL BGSVG
C
C     LOADS CAMPER FONT INTO STACK 7
C
      CALL LDFONT
C
C  READ AND STORE CAMPER PROGRAM CARDS
C
      J=1
  10  CONTINUE
      READ(5,200) NAME(J),ISTACK(J),IARRAY(J),IFIG(J),
     1ARG1(J),ARG2(J),ARG3(J),ARG4(J),ARG5(J),
     2(TEXT(I,J),I=1,18)
 200  FORMAT(A5,I1,I3,I1,5F10.2,18A1)
      IF(NAME(J) .EQ. 'STOP ') GOTO 30
      IF(J .EQ. 1500) GOTO 30
      J=J+1
      GOTO 10
C
C  JMAX IS NUMBER OF CARDS IN CAMPER PROGRAM
C  STOPS WHEN STOP CARD TERMINATES THE CARD READING
C
  30  CONTINUE 
      JMAX=J 
C DIAGNOSTIC PRINT PART OF CAMPER PROGRAM
C     CALL PRCMPR(1,JMAX)
C
C     OBEY EACH CARD TO JMAX, DO LOOPS REPEATED
C
      J=1
  33  CONTINUE
C
      ARGG1=ARG1(J)
      ARGG2=ARG2(J)
      ARGG3=ARG3(J)
      ARGG4=ARG4(J)
      ARGG5=ARG5(J)
      IF(ARGG1 .GT.899. .AND. ARGG1 .LT. 910.)ARGG1=VAR(INT(ARGG1)-900)
      IF(ARGG2 .GT.899. .AND. ARGG2 .LT. 910.)ARGG2=VAR(INT(ARGG2)-900)
      IF(ARGG3 .GT.899. .AND. ARGG3 .LT. 910.)ARGG3=VAR(INT(ARGG3)-900)
      IF(ARGG4 .GT.899. .AND. ARGG4 .LT. 910.)ARGG4=VAR(INT(ARGG4)-900)
      IF(ARGG5 .GT.899. .AND. ARGG5 .LT. 910.)ARGG5=VAR(INT(ARGG5)-900)
      IF(NAME(J) .EQ. 'CIRCL') CALL CIRCL(NAME(J),ISTACK(J),IARRAY(J)
     1,IFIG(J),ARGG1,ARGG2,ARGG3,ARGG4)
      IF(NAME(J) .EQ. 'RECT ') CALL RECT (NAME(J),ISTACK(J),IARRAY(J)
     1,ARGG1,ARGG2,ARGG3,ARGG4,ARGG5)
      IF(NAME(J) .EQ. 'TRNGL') CALL TRNGL(NAME(J),ISTACK(J),IARRAY(J)
     1,ARGG1,ARGG2,ARGG3,ARGG4,ARGG5)
      IF(NAME(J) .EQ. 'ARROW') CALL ARROW(NAME(J),ISTACK(J),IARRAY(J)
     1,IFIG(J),ARGG1,ARGG2,ARGG3,ARGG4,ARGG5)
      IF(NAME(J) .EQ. 'SETCV') CALL SETCV(NAME(J),ISTACK(J),IARRAY(J)
     1,ARGG1,ARGG2,ARGG3)
      IF(NAME(J) .EQ. 'SETLN') CALL SETLN(NAME(J),ISTACK(J),IARRAY(J)
     1,ARGG1,ARGG2,ARGG3)
      IF(NAME(J) .EQ. 'EXPAR') CALL EXPAR(NAME(J),ISTACK(J),IARRAY(J)
     1,ARGG1,ARGG2,ARGG3)
      IF(NAME(J) .EQ. 'CROSS') CALL CROSS(NAME(J),ISTACK(J),IARRAY(J)
     1,ARGG1,ARGG2,ARGG3,ARGG4)
      IF(NAME(J) .EQ. 'BOX  ') CALL   BOX(NAME(J),ISTACK(J),IARRAY(J)
     1,ARGG1,ARGG2,ARGG3)
      IF(NAME(J) .EQ. 'CLOCK') CALL CLOCK(NAME(J),ISTACK(J),IARRAY(J)
     1,ARGG1,ARGG2,ARGG3,ARGG4,ARGG5)
      IF(NAME(J) .EQ. 'C    ') CALL     C(J)
      IF(NAME(J) .EQ. 'ERASE') CALL ERASE(NAME(J),ISTACK(J),IARRAY(J))
      IF(NAME(J) .EQ. 'XYROT') CALL XYROT(NAME(J),ISTACK(J),IARRAY(J)
     1,ARGG1,ARGG2,ARGG3)
      IF(NAME(J) .EQ. 'XZROT') CALL XZROT(NAME(J),ISTACK(J),IARRAY(J)
     1,ARGG1,ARGG2,ARGG3)
      IF(NAME(J) .EQ. 'YZROT') CALL YZROT(NAME(J),ISTACK(J),IARRAY(J)
     1,ARGG1,ARGG2,ARGG3)
      IF(NAME(J) .EQ. 'OFSET') CALL OFSET(NAME(J),ISTACK(J),IARRAY(J)
     1,ARGG1,ARGG2,ARGG3)
      IF(NAME(J) .EQ. 'SIZE ') CALL SIZE (NAME(J),ISTACK(J),IARRAY(J)
     1,ARGG1,ARGG2,ARGG3,ARGG4)
      IF(NAME(J) .EQ. 'ZSIZE') CALL ZSIZE(NAME(J),ISTACK(J),IARRAY(J)
     1,ARGG1,ARGG2)
      IF(NAME(J) .EQ. 'MOVE ') CALL MOVE (NAME(J),ISTACK(J),IARRAY(J)
     1,ARGG1,ARGG2)
      IF(NAME(J) .EQ. 'TNSFR') CALL TNSFR(NAME(J),ISTACK(J),IARRAY(J)
     1,IFIG(J),ARGG1,ARGG2,ARGG3,ARGG4,ARGG5)
      IF(NAME(J) .EQ. 'DUMP ') CALL DUMP (NAME(J),ISTACK(J),IARRAY(J))
      IF(NAME(J) .EQ. 'LETER') CALL LETER(NAME(J),ISTACK(J),IARRAY(J)
     1,J)
      IF(NAME(J) .EQ. 'ADDV ') CALL ADDV (NAME(J),IFIG(J),ARGG1
     1,ARGG2,ARGG3)
      IF(NAME(J) .EQ. 'SUBV ') CALL SUBV (NAME(J),IFIG(J),ARGG1
     1,ARGG2,ARGG3)
      IF(NAME(J) .EQ. 'MULTV ') CALL MULTV (NAME(J),IFIG(J),ARGG1
     1,ARGG2,ARGG3)
      IF(NAME(J) .EQ. 'DIVV ') CALL DIVV (NAME(J),IFIG(J),ARGG1
     1,ARGG2,ARGG3)
      IF(NAME(J) .EQ. 'SINV ') CALL SINV (NAME(J),IFIG(J),ARGG1
     1,ARGG2,ARGG3)
      IF(NAME(J) .EQ. 'COSV ') CALL COSV (NAME(J),IFIG(J),ARGG1
     1,ARGG2,ARGG3)
      IF(NAME(J) .EQ. 'EXPV ') CALL EXPV (NAME(J),IFIG(J),ARGG1
     1,ARGG2,ARGG3)
      IF(NAME(J) .EQ. 'SQRTV ') CALL SQRTV (NAME(J),IFIG(J),ARGG1
     1,ARGG2,ARGG3)
      IF(NAME(J) .EQ. 'SDRAW') CALL SDRAW(NAME(J),ISTACK(J),IARRAY(J)
     1,IFIG(J),ARGG1,ARGG2,ARGG3,ARGG4,ARGG5)
      IF(NAME(J) .EQ. 'RDRAW') CALL RDRAW(NAME(J),ISTACK(J),IARRAY(J)
     1,IFIG(J),ARGG1,ARGG2,ARGG3,ARGG4,ARGG5)
      IF(NAME(J) .EQ. 'NUORG') CALL NUORG(NAME(J),ARGG1,ARGG2)
      IF(NAME(J) .EQ. 'STOP ') CALL STOP(NAME(J))
      IF(NAME(J) .EQ. 'DO   ') CALL DO(NAME(J),INT(ARGG1),J)
      IF(NAME(J) .EQ. 'LOOP ') CALL LOOP(NAME(J),J)
      IF(NAME(J) .EQ. 'FRAME') CALL FRAME
      IF(NAME(J) .EQ. 'NDFRM') CALL NDFRM
C
      J=J+1
      IF(J.LE.JMAX) GOTO 33
C
      STOP
      END
C
      SUBROUTINE SIZE(NME,ISTCK,IAR,XREF,YREF,XMAG,YMAG)
      INCLUDE 'common.txt'
C
      WRITE(3,210) NME,ISTCK,IAR,XREF,YREF,XMAG,YMAG
 210  FORMAT(A5,1X,I1,1X,I3,1X,4F10.2,1X)
      IF(IAR .NE. 0) GOTO 100
C  SIZES ARRAYS ONE AT A TIME, IARIN=0 TO SAY ALL ARRAYS
      IARIN=0
      IAR=0
  60  CONTINUE
      IAR=IAR+1
      IF(IAR .GT.IARLST(ISTCK)) GOTO 70
      GOTO 110
  70  CONTINUE
      RETURN
C
C  SIZES SINGLE ARRAY
 100  CONTINUE
      IARIN=IAR
C
 110  CONTINUE
      IARMIN=IARPT(ISTCK,IAR)
      IARMAX=INDPT(ISTCK,IAR)
      INX=IARMIN
 120  CONTINUE
      IF(INX .GT. IARMAX) GOTO 500
      ITYPE=INT(STACK(ISTCK,INX))
      IF(ITYPE .EQ. 4000 .OR. ITYPE .EQ. 2000
     1.OR. ITYPE .EQ. 3000 .OR. ITYPE .EQ. 1000) GOTO 130
C
      STACK(ISTCK,INX)=(STACK(ISTCK,INX)-XREF)*XMAG+XREF
      STACK(ISTCK,INX+1)=(STACK(ISTCK,INX+1)-YREF)*YMAG+YREF
      INX=INX+3
      GOTO 120
C
 130  CONTINUE
      INX=INX+1
      GOTO 120
C
 500  CONTINUE
      IF(IARIN .NE. 0) GOTO 510
      GOTO 60
C
 510  CONTINUE
C      
      RETURN
      END
C
C     CAMPER WORKS IN DEGREES, FORTRAN IN RADIANS
C
      FUNCTION COSD(DEG)
      PI2=3.14159/180.
      COSD=COS(DEG*PI2)
      RETURN
      END
C
      FUNCTION SIND(DEG)
      PI2=3.14159/180.
      SIND=SIN(DEG*PI2)
      RETURN
      END
C
      SUBROUTINE CIRCL(NME,ISTCK,IAR,ID,X,Y,Z,RAD)
      INCLUDE 'common.txt'
      WRITE(3,210) NME,ISTCK,IAR,ID,X,Y,Z,RAD
 210  FORMAT(A5,1X,I1,1X,I3,1X,I1,1X,5F10.2,1X)
C
C CIRCLE CENTRED (X,Y,Z), RADIUS RAD PARALLEL TO XY PLANE
C ID NOT 0 THEN DASHED
      IST=ISTKPT(ISTCK)
      IARPT(ISTCK,IAR)=IST
      IF(ID .NE.0) GOTO 20
      STACK(ISTCK,IST)=3000.0
      THETA=0.0
      J=1
      DO 10 I=0,36
      STACK(ISTCK,IST+J)  =X+RAD*COSD(THETA)
      STACK(ISTCK,IST+J+1)=Y+RAD*SIND(THETA)
      STACK(ISTCK,IST+J+2)=Z
      J=J+3
      THETA=THETA+10.0
  10  CONTINUE
      STACK(ISTCK,IST+J)=5000.0
      ISTKPT(ISTCK)=IST+J
      INDPT(ISTCK,IAR)=ISTKPT(ISTCK)-1
      IARLST(ISTCK)=IAR
      GOTO 40
  20  CONTINUE
      STACK(ISTCK,IST)=4000.0
      THETA=0.0
      J=1
      DO 30 I=0,36
      STACK(ISTCK,IST+J)  =X+RAD*COSD(THETA)
      STACK(ISTCK,IST+J+1)=Y+RAD*SIND(THETA)
      STACK(ISTCK,IST+J+2)=Z
      J=J+3
      THETA=THETA+10.0
  30  CONTINUE
      STACK(ISTCK,IST+J)=5000.0
      ISTKPT(ISTCK)=IST+J
      INDPT(ISTCK,IAR)=ISTKPT(ISTCK)-1
      IARLST(ISTCK)=IAR
C
  40  CONTINUE
      RETURN
      END
C
      SUBROUTINE RECT (NME,ISTCK,IAR,X,Y,Z,ALNGTH,HGT)
      INCLUDE 'common.txt'
C
      WRITE(3,210) NME,ISTCK,IAR,X,Y,Z,ALNGTH,HGT
 210  FORMAT(A5,1X,I1,1X,I3,1X,5F10.2,1X)
C
      IST=ISTKPT(ISTCK)
      IARPT(ISTCK,IAR)=IST
      STACK(ISTCK,IST)=3000.0
      STACK(ISTCK,IST+1)=X
      STACK(ISTCK,IST+2)=Y
      STACK(ISTCK,IST+3)=Z
      STACK(ISTCK,IST+4)=X+ALNGTH
      STACK(ISTCK,IST+5)=Y
      STACK(ISTCK,IST+6)=Z
      STACK(ISTCK,IST+7)=X+ALNGTH
      STACK(ISTCK,IST+8)=Y+HGT
      STACK(ISTCK,IST+9)=Z
      STACK(ISTCK,IST+10)=X
      STACK(ISTCK,IST+11)=Y+HGT
      STACK(ISTCK,IST+12)=Z
      STACK(ISTCK,IST+13)=X
      STACK(ISTCK,IST+14)=Y
      STACK(ISTCK,IST+15)=Z
      STACK(ISTCK,IST+16)=5000.0
      ISTKPT(ISTCK)=IST+16
      INDPT(ISTCK,IAR)=ISTKPT(ISTCK)-1
      IARLST(ISTCK)=IAR
C
      RETURN
      END
C
      SUBROUTINE TRNGL(NME,ISTCK,IAR,X,Y,Z,BASE,HGT)
      INCLUDE 'common.txt'
C
      WRITE(3,210) NME,ISTCK,IAR,X,Y,Z,BASE,HGT
 210  FORMAT(A5,1X,I1,1X,I3,1X,5F10.2,1X)
      IST=ISTKPT(ISTCK)
      IARPT(ISTCK,IAR)=IST
      STACK(ISTCK,IST)=3000.0
      STACK(ISTCK,IST+1)=X
      STACK(ISTCK,IST+2)=Y
      STACK(ISTCK,IST+3)=Z
      STACK(ISTCK,IST+4)=X+BASE
      STACK(ISTCK,IST+5)=Y
      STACK(ISTCK,IST+6)=Z
      STACK(ISTCK,IST+7)=X+0.5*BASE
      STACK(ISTCK,IST+8)=Y+HGT
      STACK(ISTCK,IST+9)=Z
      STACK(ISTCK,IST+10)=X
      STACK(ISTCK,IST+11)=Y
      STACK(ISTCK,IST+12)=Z
      STACK(ISTCK,IST+13)=5000.0
      ISTKPT(ISTCK)=IST+13
      INDPT(ISTCK,IAR)=ISTKPT(ISTCK)-1
      IARLST(ISTCK)=IAR
      RETURN
      END
C
      SUBROUTINE ARROW(NME,ISTCK,IAR,IP,X1,Y1,X2,Y2,HEAD)
      INCLUDE 'common.txt'
C
C  COULD BE SHORTENED BUT CODE WOULD BE MORE OPAQUE
C
      WRITE(3,210) NME,ISTCK,IAR,IP,X1,Y1,X2,Y2,HEAD
 210  FORMAT(A5,1X,I1,1X,I3,1X,I1,1X,5F10.2,1X)
      DX=X2-X1
      DY=Y2-Y1
      ALNGTH=SQRT(DX*DX+DY*DY)
      ADX=(DX/ALNGTH)*HEAD
      ADY=(DY/ALNGTH)*HEAD
      X3=X2-ADX-ADY
      Y3=Y2+ADX-ADY
      X4=X2-ADX+ADY
      Y4=Y2-ADX-ADY
      DSHX=(X2-X1)/11.
      DSHY=(Y2-Y1)/11.
      IST=ISTKPT(ISTCK)
      IP1=IP+1
      GOTO(10,20,30,40),IP1
  10  CONTINUE
      IARPT(ISTCK,IAR)=IST
      STACK(ISTCK,IST)=4000.0
      STACK(ISTCK,IST+1)=X1
      STACK(ISTCK,IST+2)=Y1
      STACK(ISTCK,IST+3)=0.
      STACK(ISTCK,IST+4)=X2
      STACK(ISTCK,IST+5)=Y2
      STACK(ISTCK,IST+6)=0.
      STACK(ISTCK,IST+7)=1000.0
      STACK(ISTCK,IST+8)=X3
      STACK(ISTCK,IST+9)=Y3
      STACK(ISTCK,IST+10)=0.
      STACK(ISTCK,IST+11)=X2
      STACK(ISTCK,IST+12)=Y2
      STACK(ISTCK,IST+13)=0.
      STACK(ISTCK,IST+14)=X4
      STACK(ISTCK,IST+15)=Y4
      STACK(ISTCK,IST+16)=0.
      STACK(ISTCK,IST+17)=5000.0
      ISTKPT(ISTCK)=IST+17
      INDPT(ISTCK,IAR)=ISTKPT(ISTCK)-1
      IARLST(ISTCK)=IAR
      GOTO 50
  20  CONTINUE
      IARPT(ISTCK,IAR)=IST
      STACK(ISTCK,IST)=4000.0
      STACK(ISTCK,IST+1)=X1
      STACK(ISTCK,IST+2)=Y1
      STACK(ISTCK,IST+3)=0.
      STACK(ISTCK,IST+4)=X2
      STACK(ISTCK,IST+5)=Y2
      STACK(ISTCK,IST+6)=0.
      STACK(ISTCK,IST+7)=1000.0
      STACK(ISTCK,IST+8)=X3
      STACK(ISTCK,IST+9)=Y3
      STACK(ISTCK,IST+10)=0.
      STACK(ISTCK,IST+11)=X2
      STACK(ISTCK,IST+12)=Y2
      STACK(ISTCK,IST+13)=0.
      STACK(ISTCK,IST+14)=X4
      STACK(ISTCK,IST+15)=Y4
      STACK(ISTCK,IST+16)=0.
      STACK(ISTCK,IST+17)=X3
      STACK(ISTCK,IST+18)=Y3
      STACK(ISTCK,IST+19)=0.
      STACK(ISTCK,IST+20)=5000.0
      ISTKPT(ISTCK)=IST+20
      INDPT(ISTCK,IAR)=ISTKPT(ISTCK)-1
      IARLST(ISTCK)=IAR
      GOTO 50
C
  30  CONTINUE
      IARPT(ISTCK,IAR)=IST
      STACK(ISTCK,IST)=4000.0
      STACK(ISTCK,IST+1)=X1
      STACK(ISTCK,IST+2)=Y1
      STACK(ISTCK,IST+3)=0.
      STACK(ISTCK,IST+4)=X1+dshx
      STACK(ISTCK,IST+5)=Y1+dshy
      STACK(ISTCK,IST+6)=0.
      STACK(ISTCK,IST+7)=X1+2*dshx
      STACK(ISTCK,IST+8)=Y1+2*dshy
      STACK(ISTCK,IST+9)=0.
      STACK(ISTCK,IST+10)=X1+3*dshx
      STACK(ISTCK,IST+11)=Y1+3*dshy
      STACK(ISTCK,IST+12)=0.
      STACK(ISTCK,IST+13)=X1+4*dshx
      STACK(ISTCK,IST+14)=Y1+4*dshy
      STACK(ISTCK,IST+15)=0.
      STACK(ISTCK,IST+16)=X1+5*dshx
      STACK(ISTCK,IST+17)=Y1+5*dshy
      STACK(ISTCK,IST+18)=0.
      STACK(ISTCK,IST+19)=X1+6*dshx
      STACK(ISTCK,IST+20)=Y1+6*dshy
      STACK(ISTCK,IST+21)=0.
      STACK(ISTCK,IST+22)=X1+7*dshx
      STACK(ISTCK,IST+23)=Y1+7*dshy
      STACK(ISTCK,IST+24)=0.
      STACK(ISTCK,IST+25)=X1+8*dshx
      STACK(ISTCK,IST+26)=Y1+8*dshy
      STACK(ISTCK,IST+27)=0.
      STACK(ISTCK,IST+28)=X1+9*dshx
      STACK(ISTCK,IST+29)=Y1+9*dshy
      STACK(ISTCK,IST+30)=0.
      STACK(ISTCK,IST+31)=X1+10*dshx
      STACK(ISTCK,IST+32)=Y1+10*dshy
      STACK(ISTCK,IST+33)=0.
      STACK(ISTCK,IST+34)=X2
      STACK(ISTCK,IST+35)=Y2
      STACK(ISTCK,IST+36)=0.
      STACK(ISTCK,IST+37)=1000.0
      STACK(ISTCK,IST+38)=X3
      STACK(ISTCK,IST+39)=Y3
      STACK(ISTCK,IST+40)=0.
      STACK(ISTCK,IST+41)=X2
      STACK(ISTCK,IST+42)=Y2
      STACK(ISTCK,IST+43)=0.
      STACK(ISTCK,IST+44)=X4
      STACK(ISTCK,IST+45)=Y4
      STACK(ISTCK,IST+46)=0.
      STACK(ISTCK,IST+47)=X4
      STACK(ISTCK,IST+48)=Y4
      STACK(ISTCK,IST+49)=0.
      STACK(ISTCK,IST+50)=5000.0
      ISTKPT(ISTCK)=IST+50
      INDPT(ISTCK,IAR)=ISTKPT(ISTCK)-1
      IARLST(ISTCK)=IAR
      GOTO 50
  40  CONTINUE
      IARPT(ISTCK,IAR)=IST
      STACK(ISTCK,IST)=4000.0
      STACK(ISTCK,IST+1)=X1
      STACK(ISTCK,IST+2)=Y1
      STACK(ISTCK,IST+3)=0.
      STACK(ISTCK,IST+4)=X1+dshx
      STACK(ISTCK,IST+5)=Y1+dshy
      STACK(ISTCK,IST+6)=0.
      STACK(ISTCK,IST+7)=X1+2*dshx
      STACK(ISTCK,IST+8)=Y1+2*dshy
      STACK(ISTCK,IST+9)=0.
      STACK(ISTCK,IST+10)=X1+3*dshx
      STACK(ISTCK,IST+11)=Y1+3*dshy
      STACK(ISTCK,IST+12)=0.
      STACK(ISTCK,IST+13)=X1+4*dshx
      STACK(ISTCK,IST+14)=Y1+4*dshy
      STACK(ISTCK,IST+15)=0.
      STACK(ISTCK,IST+16)=X1+5*dshx
      STACK(ISTCK,IST+17)=Y1+5*dshy
      STACK(ISTCK,IST+18)=0.
      STACK(ISTCK,IST+19)=X1+6*dshx
      STACK(ISTCK,IST+20)=Y1+6*dshy
      STACK(ISTCK,IST+21)=0.
      STACK(ISTCK,IST+22)=X1+7*dshx
      STACK(ISTCK,IST+23)=Y1+7*dshy
      STACK(ISTCK,IST+24)=0.
      STACK(ISTCK,IST+25)=X1+8*dshx
      STACK(ISTCK,IST+26)=Y1+8*dshy
      STACK(ISTCK,IST+27)=0.
      STACK(ISTCK,IST+28)=X1+9*dshx
      STACK(ISTCK,IST+29)=Y1+9*dshy
      STACK(ISTCK,IST+30)=0.
      STACK(ISTCK,IST+31)=X1+10*dshx
      STACK(ISTCK,IST+32)=Y1+10*dshy
      STACK(ISTCK,IST+33)=0.
      STACK(ISTCK,IST+34)=X2
      STACK(ISTCK,IST+35)=Y2
      STACK(ISTCK,IST+36)=0.
      STACK(ISTCK,IST+37)=1000.0
      STACK(ISTCK,IST+38)=X3
      STACK(ISTCK,IST+39)=Y3
      STACK(ISTCK,IST+40)=0.
      STACK(ISTCK,IST+41)=X2
      STACK(ISTCK,IST+42)=Y2
      STACK(ISTCK,IST+43)=0.
      STACK(ISTCK,IST+44)=X4
      STACK(ISTCK,IST+45)=Y4
      STACK(ISTCK,IST+46)=0.
      STACK(ISTCK,IST+47)=X3
      STACK(ISTCK,IST+48)=Y3
      STACK(ISTCK,IST+49)=0.
      STACK(ISTCK,IST+50)=5000.0
      ISTKPT(ISTCK)=IST+50
      INDPT(ISTCK,IAR)=ISTKPT(ISTCK)-1
      IARLST(ISTCK)=IAR
      GOTO 50
  50  CONTINUE
C
      RETURN
      END
C
C SETCV, SETLN, EXPAR DEFINES LINES AND CURVES
C   CURVES             START WITH 3000. MARKER
C   INDIVIDUAL LINE SEQUENCE WITH 4000. MARKER
C   SUBCURVES          START WITH 1000. MARKER
C   SUB LINE SEQUENCE  START WITH 2000. MARKER
C
      SUBROUTINE SETCV(NME,ISTCK,IAR,X,Y,Z)
      INCLUDE 'common.txt'
C
      WRITE(3,210) NME,ISTCK,IAR,X,Y,Z
 210  FORMAT(A5,1X,I1,1X,I3,1X,3F10.2,1X)
      IST=ISTKPT(ISTCK)
      IARPT(ISTCK,IAR)=IST
      STACK(ISTCK,IST)=3000.0
      STACK(ISTCK,IST+1)=X
      STACK(ISTCK,IST+2)=Y
      STACK(ISTCK,IST+3)=Z
      STACK(ISTCK,IST+4)=5000.0
      ISTKPT(ISTCK)=IST+4
      INDPT(ISTCK,IAR)=ISTKPT(ISTCK)-1
      IARLST(ISTCK)=IAR
      RETURN
      END
C
      SUBROUTINE SETLN(NME,ISTCK,IAR,X,Y,Z)
      INCLUDE 'common.txt'
C
      WRITE(3,210) NME,ISTCK,IAR,X,Y,Z
 210  FORMAT(A5,1X,I1,1X,I3,1X,3F10.2,1X)
      IST=ISTKPT(ISTCK)
      IARPT(ISTCK,IAR)=IST
      STACK(ISTCK,IST)=4000.0
      STACK(ISTCK,IST+1)=X
      STACK(ISTCK,IST+2)=Y
      STACK(ISTCK,IST+3)=Z
      STACK(ISTCK,IST+4)=5000.0
      ISTKPT(ISTCK)=IST+4
      INDPT(ISTCK,IAR)=ISTKPT(ISTCK)-1
      IARLST(ISTCK)=IAR
      RETURN
      END
C
      SUBROUTINE EXPAR(NME,ISTCK,IAR,X,Y,Z)
      INCLUDE 'common.txt'
C
C
      WRITE(3,210) NME,ISTCK,IAR,X,Y,Z
 210  FORMAT(A5,1X,I1,1X,I3,1X,3F10.2,1X)
      IST=ISTKPT(ISTCK)
      STACK(ISTCK,IST)=X
      STACK(ISTCK,IST+1)=Y
      STACK(ISTCK,IST+2)=Z
      STACK(ISTCK,IST+3)=5000.0
      ISTKPT(ISTCK)=IST+3
      INDPT(ISTCK,IAR)=ISTKPT(ISTCK)-1
      IARLST(ISTCK)=IAR
      RETURN
      END
C
      SUBROUTINE CROSS(NME,ISTCK,IAR,X,Y,Z,SIDE)
      INCLUDE 'common.txt'
C
      WRITE(3,210) NME,ISTCK,IAR,X,Y,Z,SIDE
 210  FORMAT(A5,1X,I1,1X,I3,1X,4F10.2,1X)
      IST=ISTKPT(ISTCK)
      IARPT(ISTCK,IAR)=IST
      STACK(ISTCK,IST)=4000.0
      STACK(ISTCK,IST+1)=X+SIDE
      STACK(ISTCK,IST+2)=Y
      STACK(ISTCK,IST+3)=Z
      STACK(ISTCK,IST+4)=X
      STACK(ISTCK,IST+5)=Y+SIDE
      STACK(ISTCK,IST+6)=Z
      STACK(ISTCK,IST+7)=X+SIDE
      STACK(ISTCK,IST+8)=Y+SIDE
      STACK(ISTCK,IST+9)=Z
      STACK(ISTCK,IST+10)=X
      STACK(ISTCK,IST+11)=Y
      STACK(ISTCK,IST+12)=Z
      STACK(ISTCK,IST+13)=5000.0
      ISTKPT(ISTCK)=IST+13
      INDPT(ISTCK,IAR)=ISTKPT(ISTCK)-1
      IARLST(ISTCK)=IAR
      RETURN
      END
C
      SUBROUTINE BOX  (NME,ISTCK,IAR,DX,DY,DZ)
      INCLUDE 'common.txt'
C
      WRITE(3,210) NME,ISTCK,IAR,DX,DY,DZ
 210  FORMAT(A5,1X,I1,1X,I3,1X,3F10.2,1X)
      IST=ISTKPT(ISTCK)
      IARPT(ISTCK,IAR)=IST
      STACK(ISTCK,IST)=3000.0
      STACK(ISTCK,IST+1)=0.
      STACK(ISTCK,IST+2)=DY
      STACK(ISTCK,IST+3)=DZ
      STACK(ISTCK,IST+4)=DX
      STACK(ISTCK,IST+5)=DY
      STACK(ISTCK,IST+6)=DZ
      STACK(ISTCK,IST+7)=DX
      STACK(ISTCK,IST+8)=0.
      STACK(ISTCK,IST+9)=DZ
      STACK(ISTCK,IST+10)=0.
      STACK(ISTCK,IST+11)=0.
      STACK(ISTCK,IST+12)=DZ
      STACK(ISTCK,IST+13)=0.
      STACK(ISTCK,IST+14)=DY
      STACK(ISTCK,IST+15)=DZ
      STACK(ISTCK,IST+16)=0.
      STACK(ISTCK,IST+17)=DY
      STACK(ISTCK,IST+18)=0.
      STACK(ISTCK,IST+19)=DX
      STACK(ISTCK,IST+20)=DY
      STACK(ISTCK,IST+21)=0.
      STACK(ISTCK,IST+22)=DX
      STACK(ISTCK,IST+23)=DY
      STACK(ISTCK,IST+24)=DZ
      STACK(ISTCK,IST+25)=3000.0
      STACK(ISTCK,IST+26)=DX
      STACK(ISTCK,IST+27)=0.
      STACK(ISTCK,IST+28)=DZ
      STACK(ISTCK,IST+29)=DX
      STACK(ISTCK,IST+30)=0.
      STACK(ISTCK,IST+31)=0.
      STACK(ISTCK,IST+32)=DX
      STACK(ISTCK,IST+33)=DY
      STACK(ISTCK,IST+34)=0.
      STACK(ISTCK,IST+35)=1000.0
      STACK(ISTCK,IST+36)=0.
      STACK(ISTCK,IST+37)=0.
      STACK(ISTCK,IST+38)=DZ
      STACK(ISTCK,IST+39)=0.
      STACK(ISTCK,IST+40)=0.
      STACK(ISTCK,IST+41)=0.
      STACK(ISTCK,IST+42)=0.
      STACK(ISTCK,IST+43)=DY
      STACK(ISTCK,IST+44)=0.
      STACK(ISTCK,IST+45)=0.
      STACK(ISTCK,IST+46)=0.
      STACK(ISTCK,IST+47)=0.
      STACK(ISTCK,IST+48)=1000.0
      STACK(ISTCK,IST+49)=0.
      STACK(ISTCK,IST+50)=0.
      STACK(ISTCK,IST+51)=0.
      STACK(ISTCK,IST+52)=DX
      STACK(ISTCK,IST+53)=0.
      STACK(ISTCK,IST+54)=0.
      STACK(ISTCK,IST+55)=5000.0
      ISTKPT(ISTCK)=IST+55
      INDPT(ISTCK,IAR)=ISTKPT(ISTCK)-1
      IARLST(ISTCK)=IAR
      RETURN
      END
C
      SUBROUTINE CLOCK(NME,ISTCK,IAR,X,Y,Z,RAD,TIME)
      INCLUDE 'common.txt'
C
      HEAD=0.15*RAD
      IFLOOR=FLOOR(TIME)
      AMIN=TIME-FLOAT(IFLOOR)
      HR=TIME/12.
      COSMIN=COSD(AMIN*360.)
      SINMIN=SIND(AMIN*360.)
      COSHR=COSD(HR*360.)
      SINHR=SIND(HR*360.)
      XMIN=X + 0.88 * SINMIN * RAD
      YMIN=Y + 0.88 * COSMIN * RAD
      XHR=X + 0.6 * SINHR * RAD
      YHR=Y + 0.6 * COSHR * RAD
      IST=ISTKPT(ISTCK)
      IARPT(ISTCK,IAR)=IST
      STACK(ISTCK,IST)=3000.0
      DEG=10.0
      DO 40 I=1,37
      J=3*I-2
      DEG=10.0*FLOAT(I-1)
      STACK(ISTCK,IST+J)=X+RAD*COSD(DEG)
      STACK(ISTCK,IST+J+1)=Y+RAD*SIND(DEG)
      STACK(ISTCK,IST+J+2)=Z
  40  CONTINUE
      XMIND=XMIN-X
      YMIND=YMIN-Y
      AMNLNG=SQRT(XMIND*XMIND+YMIND*YMIND)
      XADMIN=(XMIND/AMNLNG)*HEAD
      YADMIN=(YMIND/AMNLNG)*HEAD
      XMIN3=XMIN-XADMIN-YADMIN
      YMIN3=YMIN+XADMIN-YADMIN
      XMIN4=XMIN-XADMIN+YADMIN
      YMIN4=YMIN-XADMIN-YADMIN
      STACK(ISTCK,IST+112)=4000.
      STACK(ISTCK,IST+113)=X
      STACK(ISTCK,IST+114)=Y
      STACK(ISTCK,IST+115)=Z
      STACK(ISTCK,IST+116)=XMIN
      STACK(ISTCK,IST+117)=YMIN
      STACK(ISTCK,IST+118)=Z
      STACK(ISTCK,IST+119)=3000.
      STACK(ISTCK,IST+120)=XMIN3
      STACK(ISTCK,IST+121)=YMIN3
      STACK(ISTCK,IST+122)=Z
      STACK(ISTCK,IST+123)=XMIN
      STACK(ISTCK,IST+124)=YMIN
      STACK(ISTCK,IST+125)=Z
      STACK(ISTCK,IST+126)=XMIN4
      STACK(ISTCK,IST+127)=YMIN4
      STACK(ISTCK,IST+128)=Z
      STACK(ISTCK,IST+129)=XMIN3
      STACK(ISTCK,IST+130)=YMIN3
      STACK(ISTCK,IST+131)=Z
      HRDX=0.7*(XHR-X)
      HRDY=0.7*(YHR-Y)
      HRLNG=SQRT(HRDX*HRDX+HRDY*HRDY)
      HRADX=(HRDX/HRLNG)*HEAD
      HRADY=(HRDY/HRLNG)*HEAD
      HRX3=XHR-HRADX-HRADY
      HRY3=YHR+HRADX-HRADY
      HRX4=XHR-HRADX+HRADY
      HRY4=YHR-HRADX-HRADY
      STACK(ISTCK,IST+132)=4000.
      STACK(ISTCK,IST+133)=X
      STACK(ISTCK,IST+134)=Y
      STACK(ISTCK,IST+135)=Z
      STACK(ISTCK,IST+136)=XHR
      STACK(ISTCK,IST+137)=YHR
      STACK(ISTCK,IST+138)=Z
      STACK(ISTCK,IST+139)=3000.
      STACK(ISTCK,IST+140)=HRX3
      STACK(ISTCK,IST+141)=HRY3
      STACK(ISTCK,IST+142)=Z
      STACK(ISTCK,IST+143)=XHR
      STACK(ISTCK,IST+144)=YHR
      STACK(ISTCK,IST+145)=Z
      STACK(ISTCK,IST+146)=HRX4
      STACK(ISTCK,IST+147)=HRY4
      STACK(ISTCK,IST+148)=Z
      STACK(ISTCK,IST+149)=4000.
      DEG=30.0
      DO 50 I=1,12
      J=6*I+144
      DEG=30.0*FLOAT(I-1)
      STACK(ISTCK,IST+J)=  X+0.9*RAD*COSD(DEG)
      STACK(ISTCK,IST+J+1)=Y+0.9*RAD*SIND(DEG)
      STACK(ISTCK,IST+J+2)=Z
      STACK(ISTCK,IST+J+3)=X+1.1*RAD*COSD(DEG)
      STACK(ISTCK,IST+J+4)=Y+1.1*RAD*SIND(DEG)
      STACK(ISTCK,IST+J+5)=Z
  50  CONTINUE
      STACK(ISTCK,IST+222)=5000.0
      ISTKPT(ISTCK)=IST+222
      INDPT(ISTCK,IAR)=ISTKPT(ISTCK)-1
      IARLST(ISTCK)=IAR
C
      WRITE(3,210) NME,ISTCK,IAR,X,Y,Z,RAD,TIME
 210  FORMAT(A5,1X,I1,1X,I3,1X,5F10.2,1X)
      RETURN
      END
C
      SUBROUTINE C(J)
      INCLUDE 'common.txt'
C
C
      WRITE(3,210) (TEXT(I,J), I=1,18)
 210  FORMAT(1HC,1X,18A1)
      RETURN
      END
C
      SUBROUTINE ERASE(NME,ISTCK,IAR)
      INCLUDE 'common.txt'
C
C
      WRITE(3,210) NME,ISTCK,IAR
 210  FORMAT(A5,1X,I1,1X,I3,1X)
      IF(IAR.NE.0) GOTO 300
      DO 10 I=2,2000
      STACK(ISTCK,I)=0.0
  10  CONTINUE
      STACK(ISTCK,1)=5000.0
      ISTKPT(ISTCK)=1  
      DO 20 J=1,100
      IARPT(ISTCK,J)=0
      INDPT(ISTCK,J)=0
  20  CONTINUE
      RETURN
 300  CONTINUE
      IBG=IARPT(ISTCK,IAR)
      IND=INDPT(ISTCK,IAR)
      DO 320 I=IBG,IND
      STACK(ISTCK,I)=0.0
 320  CONTINUE
      STACK(ISTCK,IBG)=5000.
      ISTKPT(ISTCK)=IBG
      RETURN
      END
C
C ROTATES ONE ARRAY OR A WHOLE STACK OF LINES AND CURVES
C ABOUT XY, XZ OR YZ AXES
C BASIC STRATEGY IS DEFINE MAINLY 2D OBJECTS AND ROTATE 
C INTO 3D POSITION
C
      SUBROUTINE XYROT(NME,ISTCK,IARL,X,Y,ANGL)
      INCLUDE 'common.txt'
C
      IAR=IARL
      WRITE(3,210) ISTCK,IAR,X,Y,ANGL
 210  FORMAT(5HXYROT,1X,I1,1X,I3,1X,3F10.2,1X)
      IF(IAR .NE. 0) GOTO 100
C  ROTATES ARRAYS ONE AT A TIME, IARIN=0 TO SAY ALL ARRAYS
      IARIN=0
      IAR=0
  60  CONTINUE
      IAR=IAR+1
      IF(IAR .GT.IARLST(ISTCK)) GOTO 70
      GOTO 110
  70  CONTINUE
      RETURN
C
C  ROTATES SINGLE ARRAY
 100  CONTINUE
      IARIN=IAR
C
 110  CONTINUE
      IARMIN=IARPT(ISTCK,IAR)
      IARMAX=INDPT(ISTCK,IAR)
      INX=IARMIN
 120  CONTINUE
      IF(INX .GT. IARMAX) GOTO 500
      ITYPE=INT(STACK(ISTCK,INX))
      IF(ITYPE .EQ. 4000 .OR. ITYPE .EQ. 2000
     1.OR. ITYPE .EQ. 3000 .OR. ITYPE .EQ. 1000) GOTO 130
      XOLD=STACK(ISTCK,INX)
      YOLD=STACK(ISTCK,INX+1)
      STACK(ISTCK,INX)=X +(XOLD-X)*COSD(ANGL)
     1 -  (YOLD-Y)*SIND(ANGL)
      STACK(ISTCK,INX+1)=Y +(YOLD-Y)*COSD(ANGL)
     1 + (XOLD-X)*SIND(ANGL)
      INX=INX+3
      GOTO 120
C
 130  CONTINUE
      INX=INX+1
      GOTO 120
C
 500  CONTINUE
      IF(IARIN .NE. 0) GOTO 510
      GOTO 60
C
 510  CONTINUE      
      RETURN
      END
C
      SUBROUTINE XZROT(NME,ISTCK,IARL,X,Z,ANGL)
      INCLUDE 'common.txt'
C
      IAR=IARL
      WRITE(3,210) ISTCK,IAR,X,Z,ANGL
 210  FORMAT(5HXZROT,1X,I1,1X,I3,1X,3F10.2,1X)
      ANG=0.-ANGL
      IF(IAR .NE. 0) GOTO 100
C  ROTATES ARRAYS ONE AT A TIME, IARIN=0 TO SAY ALL ARRAYS
      IARIN=0
      IAR=0
  60  CONTINUE
      IAR=IAR+1
      IF(IAR .GT.IARLST(ISTCK)) GOTO 70
      GOTO 110
  70  CONTINUE
      RETURN
C
C  ROTATES SINGLE ARRAY
 100  CONTINUE
      IARIN=IAR
C
 110  CONTINUE
      IARMIN=IARPT(ISTCK,IAR)
      IARMAX=INDPT(ISTCK,IAR)
      INX=IARMIN
 120  CONTINUE
      IF(INX .GT. IARMAX) GOTO 500
      ITYPE=INT(STACK(ISTCK,INX))
      IF(ITYPE .EQ. 4000 .OR. ITYPE .EQ. 2000
     1.OR. ITYPE .EQ. 3000 .OR. ITYPE .EQ. 1000) GOTO 130
      XOLD=STACK(ISTCK,INX)
      ZOLD=STACK(ISTCK,INX+2)
      STACK(ISTCK,INX)=X +(XOLD-X)*COSD(ANG)
     1 -  (ZOLD-Z)*SIND(ANG)
      STACK(ISTCK,INX+2)=Z +(ZOLD-Z)*COSD(ANG)
     1 + (XOLD-X)*SIND(ANG)
      INX=INX+3
      GOTO 120
C
 130  CONTINUE
      INX=INX+1
      GOTO 120
C
 500  CONTINUE
      IF(IARIN .NE. 0) GOTO 510
      GOTO 60
C
 510  CONTINUE      
      RETURN
      END
C
      SUBROUTINE YZROT(NME,ISTCK,IARL,Y,Z,ANGL)
      INCLUDE 'common.txt'
C
      IAR=IARL
      WRITE(3,210) ISTCK,IAR,Y,Z,ANGL
      ANG=0.- ANGL
C     ANG=ANGL
 210  FORMAT(5HYZROT,1X,I1,1X,I3,1X,3F10.2,1X)
      IF(IAR .NE. 0) GOTO 100
C  ROTATES ARRAYS ONE AT A TIME, IARIN=0 FOR ALL ARRAYS
      IARIN=0
      IAR=0
  60  CONTINUE
      IAR=IAR+1
      IF(IAR .GT.IARLST(ISTCK)) GOTO 70
      GOTO 110
  70  CONTINUE
      RETURN
C
C  ROTATES SINGLE ARRAY
 100  CONTINUE
      IARIN=IAR
C
 110  CONTINUE
      IARMIN=IARPT(ISTCK,IAR)
      IARMAX=INDPT(ISTCK,IAR)
      INX=IARMIN
 120  CONTINUE
      IF(INX .GT. IARMAX) GOTO 500
      ITYPE=INT(STACK(ISTCK,INX))
      IF(ITYPE .EQ. 4000 .OR. ITYPE .EQ. 2000
     1.OR. ITYPE .EQ. 3000 .OR. ITYPE .EQ. 1000) GOTO 130
      YOLD=STACK(ISTCK,INX+1)
      ZOLD=STACK(ISTCK,INX+2)
      STACK(ISTCK,INX+1)=Y +(YOLD-Y)*COSD(ANG)
     1 +  (ZOLD-Z)*SIND(ANG)
      STACK(ISTCK,INX+2)=Z +(ZOLD-Z)*COSD(ANG)
     1 - (YOLD-Y)*SIND(ANG)
      INX=INX+3
      GOTO 120
C
 130  CONTINUE
      INX=INX+1
      GOTO 120
C
 500  CONTINUE
      IF(IARIN .NE. 0) GOTO 510
      GOTO 60
C
 510  CONTINUE      
      RETURN
      END
C
      SUBROUTINE OFSET(NME,ISTCK,IAR,DX,DY,DZ)
      INCLUDE 'common.txt'
C
      WRITE(3,210) NME,ISTCK,IAR,DX,DY,DZ
 210  FORMAT(A5,1X,I1,1X,I3,1X,3F10.2,1X)
C
      IF(IAR .NE. 0) GOTO 100
C  OFSETS ARRAYS ONE AT A TIME, IARIN=0 TO SAY ALL ARRAYS
      IARIN=0
      IAR=0
  60  CONTINUE
      IAR=IAR+1
      IF(IAR .GT.IARLST(ISTCK)) GOTO 70
      GOTO 110
  70  CONTINUE
      RETURN
C
C  ROTATES SINGLE ARRAY
 100  CONTINUE
      IARIN=IAR
C
 110  CONTINUE
      IARMIN=IARPT(ISTCK,IAR)
      IARMAX=INDPT(ISTCK,IAR)
      INX=IARMIN
 120  CONTINUE
      IF(INX .GT. IARMAX) GOTO 500
      ITYPE=INT(STACK(ISTCK,INX))
      IF(ITYPE .EQ. 4000 .OR. ITYPE .EQ. 2000
     1.OR. ITYPE .EQ. 3000 .OR. ITYPE .EQ. 1000) GOTO 130
      XOLD=STACK(ISTCK,INX)
      YOLD=STACK(ISTCK,INX+1)
      ZOLD=STACK(ISTCK,INX+2)
      STACK(ISTCK,INX)=XOLD+DX
      STACK(ISTCK,INX+1)=YOLD+DY
      STACK(ISTCK,INX+2)=ZOLD+DZ
      INX=INX+3
      GOTO 120
C
 130  CONTINUE
      INX=INX+1
      GOTO 120
C
 500  CONTINUE
      IF(IARIN .NE. 0) GOTO 510
      GOTO 60
C
 510  CONTINUE      
      RETURN
      END
C
      SUBROUTINE ZSIZE(NME,ISTCK,IAR,ZREF,ZMAG)
      INCLUDE 'common.txt'
C
      WRITE(3,210) NME,ISTCK,IAR,ZREF,ZMAG
 210  FORMAT(A5,1X,I1,1X,I3,1X,2F10.2,1X)
      IF(IAR .NE. 0) GOTO 100
C  ZSIZES ARRAYS ONE AT A TIME, IARIN=0 TO SAY ALL ARRAYS
      IARIN=0
      IAR=0
  60  CONTINUE
      IAR=IAR+1
      IF(IAR .GT.IARLST(ISTCK)) GOTO 70
      GOTO 110
  70  CONTINUE
      RETURN
C
C  ZSIZES SINGLE ARRAY
 100  CONTINUE
      IARIN=IAR
C
 110  CONTINUE
      IARMIN=IARPT(ISTCK,IAR)
      IARMAX=INDPT(ISTCK,IAR)
      INX=IARMIN
 120  CONTINUE
      IF(INX .GT. IARMAX) GOTO 500
      ITYPE=INT(STACK(ISTCK,INX))
      IF(ITYPE .EQ. 4000 .OR. ITYPE .EQ. 2000
     1.OR. ITYPE .EQ. 3000 .OR. ITYPE .EQ. 1000) GOTO 130
C
      STACK(ISTCK,INX+2)=(STACK(ISTCK,INX+2)-ZREF)*ZMAG+ZREF
      INX=INX+3
      GOTO 120
C
 130  CONTINUE
      INX=INX+1
      GOTO 120
C
 500  CONTINUE
      IF(IARIN .NE. 0) GOTO 510
      GOTO 60
C
 510  CONTINUE
C      
      RETURN
      END
C
C
      SUBROUTINE MOVE(NME,ISTCK,IAR,STB,ARRB)
      INCLUDE 'common.txt'
C
C USED INSIDE DO LOOP
C IF X1,Y1 IS VALUE IN ISTCK,IAR AND
C X2,Y2 IS EQUIVALENT VALUE IN STB,ARRB
C AND DO IS 25 THEN ITH CONTENT HAS
C X=X1+((I-1)/24)*(X2-X1) AND SAME FOR Y
      ISTCK2=INT(STB)
      IAR2=INT(ARRB)
      WRITE(3,210) NME,ISTCK,IAR,STB,ARRB
 210  FORMAT(A5,1X,I1,1X,I3,1X,2F10.2,1X)

      IF(IAR .NE. 0) GOTO 100
C  SIZES ARRAYS ONE AT A TIME, IARIN=0 TO SAY ALL ARRAYS
      IARIN=0
      IAR=0
  60  CONTINUE
      IAR=IAR+1
      IF(IAR .GT.IARLST(ISTCK)) GOTO 70
      GOTO 110
  70  CONTINUE
      RETURN
C
C  SIZES SINGLE ARRAY
 100  CONTINUE
      IARIN=IAR
C
 110  CONTINUE
      IARMIN=IARPT(ISTCK,IAR)
      IARMAX=INDPT(ISTCK,IAR)
      INX=IARMIN
      INX2=IARPT(ISTCK2,IAR2)
 120  CONTINUE
      IF(INX .GT. IARMAX) GOTO 500
      ITYPE=INT(STACK(ISTCK,INX))
      IF(ITYPE .EQ. 4000 .OR. ITYPE .EQ. 2000
     1.OR. ITYPE .EQ. 3000 .OR. ITYPE .EQ. 1000) GOTO 130
C
      IF(LPCNT.NE.1) GOTO 125
      IF(LTIMES .NE. 1) STACK(ISTCK2,INX2)=
     1(STACK(ISTCK2,INX2) - STACK(ISTCK,INX))
     2 / (FLOAT(LTIMES-1))
      IF(LTIMES .NE. 1) STACK(ISTCK2,INX2+1)=
     1(STACK(ISTCK2,INX2+1) - STACK(ISTCK,INX+1))
     2 / (FLOAT(LTIMES-1))
      GOTO 127
 125  CONTINUE
      STACK(ISTCK,INX)=   STACK(ISTCK,INX)  + STACK(ISTCK2,INX2)
      STACK(ISTCK,INX+1)= STACK(ISTCK,INX+1)+STACK(ISTCK2,INX2+1) 
 127  CONTINUE
      INX=INX+3
      INX2=INX2+3
      GOTO 120
C
 130  CONTINUE
      INX=INX+1
      INX2=INX2+1
      GOTO 120
C
 500  CONTINUE
      IF(IARIN .NE. 0) GOTO 510
      GOTO 60
C
 510  CONTINUE
C      
      RETURN
C
      END
C
C  CAMPER TNSFR IS QUITE COMPLICATED ALLOWING  TRANSFERs
C  OF PARTIAL INFORMATION FROM ONE ARRAY TO ANOTHER
C  FULL COMPLEXITY RARELY USED AND DEPENDS ON STRUCTURE
C  SO ONLY A SKILLED USER COULD MAKE USE OF THEM
C  MAINLY USED FOR TAKING FIRST PART OF WHOLE OBJECT ONLY
C OR MOVING TEXT AROUND
C ONLY SIMPLE TRANSFERS ARE IMPLEMENTED
C
      SUBROUTINE TNSFR(NME,ISB,IARRB,IP,AR1,AR2,AR3,AR4,AR5)
      INCLUDE 'common.txt'
C
C
      WRITE(3,210) NME,ISB,IARRB,IP,AR1,AR2,AR3,AR4,AR5
 210  FORMAT(A5,1X,I1,1X,I3,1X,I1,1X,5F10.2,1X)
C
      IP1=AR1
      IP2=AR2
      ISA=AR3
      IARRA=AR4
C
C TRANSFERS POINTS IP1 TO IP2 FROM IARRA STACK ISA INTO
C IARRB STACK ISB IBP1 SHOULD BE 1,0 OR EMPTY
C ONLY SIMPLEST VERSION IMPLEMENTED
C IP=0 ALL XYZ TRANSFERRED NEW ARRAY
C IP1 TO IP2 TRANSFERRED
C
C   IST= START POINT OF DESTINATION IN ISB
      IST=ISTKPT(ISB)
C
C   ISTPR IS START POINT IN FROM ISA
C
      ISTPR=IARPT(ISA,IARRA)
C
C  SET START POS OF ISA,IARRA
C
      IARPT(ISB,IARRB)=IST
      STACK(ISB,IST)=STACK(ISA,ISTPR)
      IST=IST+1
      ISTA=ISTPR+1
      DO 10 I=IP1,IP2
      STACK(ISB,IST)=  STACK(ISA,ISTA)
      STACK(ISB,IST+1)=STACK(ISA,ISTA+1)
      STACK(ISB,IST+2)=STACK(ISA,ISTA+2)
      IST=IST+3
      ISTA=ISTA+3
   10 CONTINUE
      STACK(ISB,IST)=5000.0
      ISTKPT(ISB)=IST
      INDPT(ISB,IARRB)=ISTKPT(ISB)-1
      IARLST(ISB)=IARRB
      RETURN
      END
C
C  MORE FLEXIBLE THAN CAMPER ORIGINAL
C ALLOWS YOU TO DUMP A SINGLE ARRAY AS WELL AS WHOLE STACK
C
      SUBROUTINE DUMP(NME,ISTCK,IAR)
      INCLUDE 'common.txt'
      IF(IAR .EQ. 0) GOTO 50
      ISTART=IARPT(ISTCK,IAR)
      IEND=INDPT(ISTCK,IAR)
      WRITE(3,240) ISTCK,IAR,ISTART,IEND
  240 FORMAT(11HDUMP STACK ,I2,7H ARRAY ,I3,2I5)
      WRITE(3,241) STACK(ISTCK,ISTART)
  241 FORMAT(F10.3)
      WRITE(3,242) (STACK(ISTCK,I),I=ISTART+1,IEND)
  242 FORMAT(9F10.3)
      GOTO 100
C
  50  CONTINUE
      WRITE(3,243) ISTCK
  243 FORMAT(15HDUMP ALL STACK ,I2)
      WRITE(3,220)(STACK(ISTCK,I),I=1,1200)
 220  FORMAT(7F10.3)
      WRITE(3,230)(IARPT(ISTCK,I),I=1,50)
 230  FORMAT(10I5)
      WRITE(3,250)(INDPT(ISTCK,I),I=1,50)
 250  FORMAT(10I5)
 100  CONTINUE
C
C
      RETURN
      END
C
      SUBROUTINE LETER(NME,ISTCK,IAR,J)
      INCLUDE 'common.txt'
      WRITE(3,210) NME,ISTCK,IAR,(TEXT(I,J), I=1,18)
 210  FORMAT(A5,1X,I1,1X,I3,1X,18A1)
C ASSUMPTION IS EACH CHARACTER IS A SINGLE SETLN OR SETCV
C LOADS CHARACTERS INTO ISTCK START IS IAR
C ONE CHARACTER PER ARRAY
      DO 10 I=1,18
      ICH=IARLET(TEXT(I,J))
      IF(ICH .EQ. 100) GOTO 30
  10  CONTINUE
      IMX=18
      GOTO 40
C IMX NUMBER OF CHARACTERS TO TURN INTO ARRAYS
C
  30  IMX=I-1
C     ARRAYS ARE IAR, IAR+1,.. IAR+IMX-1,
  40  CONTINUE
C  MOVE EACH ICH ARRAY IN STACK 7 
C  INTO ISTCK ARRAY J ONWARDS
C
      DO 50 I=1,IMX
      ICH=IARLET(TEXT(I,J))
      ISTRT=IARPT(7,ICH)
      IEND=INDPT(7,ICH)
C ARRAY BEING DEFINED IS IAR OF ISTCK AT IST ONWARDS
      IST=ISTKPT(ISTCK)
      IARPT(ISTCK,IAR)=IST
      IX=0
      DO 60 K=ISTRT,IEND
      IF(MODULO(IX,3).EQ. 1)STACK(ISTCK,IST)=STACK(7,K)+FLOAT(I-1)
      IF(MODULO(IX,3).NE. 1)STACK(ISTCK,IST)=STACK(7,K)
      IST=IST+1
      IX=IX+1
  60  CONTINUE
      INDPT(ISTCK,IAR)=IST-1
      ISTKPT(ISTCK)=IST
      STACK(ISTCK,IST)=5000.
      IAR=IAR+1
  50  CONTINUE
      IARLST(ISTCK)=IAR-1
C
      RETURN
      END
C
C COULD BE SIMPLIFIED IF CHARACTER CODES OF FORTRAN KNOWN
C
      FUNCTION IARLET(CHR)
      INCLUDE 'common.txt'
      CHARACTER*1 CHR
C ARRAY POSITIONS IN STACK 7
      IF(CHR .EQ. 'A') IARLET=1
      IF(CHR .EQ. 'B') IARLET=2
      IF(CHR .EQ. 'C') IARLET=3
      IF(CHR .EQ. 'D') IARLET=4
      IF(CHR .EQ. 'E') IARLET=5
      IF(CHR .EQ. 'F') IARLET=6
      IF(CHR .EQ. 'G') IARLET=7
      IF(CHR .EQ. 'H') IARLET=8
      IF(CHR .EQ. 'I') IARLET=9
      IF(CHR .EQ. 'J') IARLET=10
      IF(CHR .EQ. 'K') IARLET=11
      IF(CHR .EQ. 'L') IARLET=12
      IF(CHR .EQ. 'M') IARLET=13
      IF(CHR .EQ. 'N') IARLET=14
      IF(CHR .EQ. 'O') IARLET=15
      IF(CHR .EQ. 'P') IARLET=16
      IF(CHR .EQ. 'Q') IARLET=17
      IF(CHR .EQ. 'R') IARLET=18
      IF(CHR .EQ. 'S') IARLET=19
      IF(CHR .EQ. 'T') IARLET=20
      IF(CHR .EQ. 'U') IARLET=21
      IF(CHR .EQ. 'V') IARLET=22
      IF(CHR .EQ. 'W') IARLET=23
      IF(CHR .EQ. 'X') IARLET=24
      IF(CHR .EQ. 'Y') IARLET=25
      IF(CHR .EQ. 'Z') IARLET=26
      IF(CHR .EQ. ',') IARLET=27
      IF(CHR .EQ. '.') IARLET=28
      IF(CHR .EQ. '-') IARLET=29
      IF(CHR .EQ. '0') IARLET=30
      IF(CHR .EQ. '1') IARLET=31
      IF(CHR .EQ. '2') IARLET=32
      IF(CHR .EQ. '3') IARLET=33
      IF(CHR .EQ. '4') IARLET=34
      IF(CHR .EQ. '5') IARLET=35
      IF(CHR .EQ. '6') IARLET=36
      IF(CHR .EQ. '7') IARLET=37
      IF(CHR .EQ. '8') IARLET=38
      IF(CHR .EQ. '9') IARLET=39
      IF(CHR .EQ. '+') IARLET=40
      IF(CHR .EQ. '*') IARLET=41
      IF(CHR .EQ. '/') IARLET=42
      IF(CHR .EQ. '=') IARLET=43
      IF(CHR .EQ. '(') IARLET=44
      IF(CHR .EQ. ')') IARLET=45
      IF(CHR .EQ. "'") IARLET=46
      IF(CHR .EQ. '?') IARLET=47
      IF(CHR .EQ. ' ') IARLET=48
      IF(CHR .EQ. '>') IARLET=100
      RETURN
      END
C
C STRAIGHTFORWARD VARIABLE ARITHMETIC
C
      SUBROUTINE ADDV(NME,IVAR,OPRND,BGIN,END)
      INCLUDE 'common.txt'
C
C
      WRITE(3,210) NME,IVAR,OPRND,BGIN,END
 210  FORMAT(A5,1X,I3,1X,3F10.2,1X)
      IF(VAR(9).LT. BGIN) GOTO 100
      IF(VAR(9).GT.END) GOTO 100
      VAR(IVAR)=VAR(IVAR)+OPRND
 100  CONTINUE
      RETURN
      END
C
      SUBROUTINE SUBV(NME,IVAR,OPRND,BGIN,END)
      INCLUDE 'common.txt'
      WRITE(3,210) NME,IVAR,OPRND,BGIN,END
 210  FORMAT(A5,1X,I3,1X,3F10.2,1X)
      IF(VAR(9).LT. BGIN) GOTO 100
      IF(VAR(9).GT.END) GOTO 100
C
      VAR(IVAR)=VAR(IVAR)-OPRND
C
 100  CONTINUE
      RETURN
      END
C
      SUBROUTINE MULTV(NME,IVAR,OPRND,BGIN,END)
      INCLUDE 'common.txt'
      WRITE(3,210) NME,IVAR,OPRND,BGIN,END
 210  FORMAT(A5,1X,I3,1X,3F10.2,1X)
      IF(VAR(9).LT. BGIN) GOTO 100
      IF(VAR(9).GT.END) GOTO 100
C
      VAR(IVAR)=VAR(IVAR)*OPRND
C
 100  CONTINUE
      RETURN
      END
C
      SUBROUTINE DIVV(NME,IVAR,OPRND,BGIN,END)
      INCLUDE 'common.txt'
C
      IF(VAR(9).LT. BGIN) GOTO 100
      IF(VAR(9).GT.END) GOTO 100
      VAR(IVAR)=VAR(IVAR)/OPRND
C
 100  CONTINUE
      RETURN
      END
C
      SUBROUTINE SINV(NME,IVAR,OPRND,BGIN,END)
      INCLUDE 'common.txt'
C
      IF(VAR(9).LT. BGIN) GOTO 100
      IF(VAR(9).GT.END) GOTO 100
      VAR(IVAR)=SIND(OPRND)
C
      WRITE(3,210) NME,IVAR,OPRND,BGIN,END
 210  FORMAT(A5,1X,I3,1X,3F10.2,1X)
 100  CONTINUE
      RETURN
      END
C
      SUBROUTINE COSV(NME,IVAR,OPRND,BGIN,END)
      INCLUDE 'common.txt'
C
      IF(VAR(9).LT. BGIN) GOTO 100
      IF(VAR(9).GT.END) GOTO 100
      VAR(IVAR)=COSD(OPRND)
C
      WRITE(3,210) NME,IVAR,OPRND,BGIN,END
 210  FORMAT(A5,1X,I3,1X,3F10.2,1X)
 100  CONTINUE
      END
C
C
      SUBROUTINE EXPV(NME,IVAR,OPRND,BGIN,END)
      INCLUDE 'common.txt'
C
      IF(VAR(9).LT. BGIN) GOTO 100
      IF(VAR(9).GT.END) GOTO 100
      VAR(IVAR)=EXP(OPRND)
C
      WRITE(3,210) NME,IVAR,OPRND,BGIN,END
 210  FORMAT(A5,1X,I3,1X,3F10.2,1X)
 100  CONTINUE
      RETURN
      END
C
      SUBROUTINE SQRTV(NME,IVAR,OPRND,BGIN,END)
      INCLUDE 'common.txt'
C
      IF(VAR(9).LT. BGIN) GOTO 100
      IF(VAR(9).GT.END) GOTO 100
      VAR(IVAR)=SQRT(OPRND)
C
      WRITE(3,210) NME,IVAR,OPRND,BGIN,END
 210  FORMAT(A5,1X,I3,1X,3F10.2,1X)
 100  CONTINUE
      RETURN
      END
C
      SUBROUTINE SDRAW(NME,ISTCK,IARI,IFG,OVER,UP,RAD,PP,AR5)
      INCLUDE 'common.txt'
C
      NODRAW=INT(AR5)
      WRITE(3,199)ISTCK,IARI,IFG,OVER,UP,RAD,PP,NODRAW
 199  FORMAT(6HSDRAW ,3I5,4F10.3,I5)
      IAR=IARI
      IF(IAR .NE. 0) GOTO 100
C  OUTPUTS ARRAYS ONE AT A TIME, IARIN=0 TO SAY ALL ARRAYS
      IARIN=0
      IAR=0
  60  CONTINUE
      IAR=IAR+1
      IF(IAR .GT. IARLST(ISTCK)) GOTO 70
      GOTO 110
  70  CONTINUE
      RETURN
C
C  OUTPUTS SINGLE ARRAY
C
 100  CONTINUE
      WRITE(3,298)
 298  FORMAT(13HOUTPUT SINGLE)
      IARIN=IAR
C
C
 110  CONTINUE
      IARMIN=IARPT(ISTCK,IAR)
      IARMAX=INDPT(ISTCK,IAR)
      WRITE(8,260)
 260  FORMAT(9H<path d=")
      INX=IARMIN
      ITYPE=INT(STACK(ISTCK,INX))
      IF(ITYPE .EQ. 4000 .OR. ITYPE .EQ. 2000) GOTO 300
      IF(ITYPE .EQ. 3000 .OR. ITYPE .EQ. 1000) GOTO 400
C MUST BE AN ERROR
      WRITE(8,299)INX,IARMIN,ITYPE,IARMAX,ISTCK,IAR,
     1IARLST(ISTCK),ISTCK
      WRITE(3,299)INX,IARMIN,ITYPE,IARMAX,ISTCK,IAR,
     1IARLST(ISTCK),ISTCK
 299  FORMAT(6HERROR ,8I5)
      RETURN
C
C  EXPECTING LINES
C
 300  CONTINUE
      INX=INX+1
 320  CONTINUE
      X1=STACK(ISTCK,INX)
      Y1=STACK(ISTCK,INX+1)
      Z1=STACK(ISTCK,INX+2)
      X2=STACK(ISTCK,INX+3)
      Y2=STACK(ISTCK,INX+4)
      Z2=STACK(ISTCK,INX+5)
      CALL PERSP(OVER,UP,RAD,PP,X1,Y1,Z1,XNEW1,YNEW1)
      CALL PERSP(OVER,UP,RAD,PP,X2,Y2,Z2,XNEW2,YNEW2)
      WRITE(8,322, ADVANCE="NO") XNEW1,YNEW1,XNEW2,YNEW2
 322  FORMAT(1HM,F7.2,1H,,F7.2,1HL,F7.2,1H,,F7.2)
      INX=INX+6
      IF(INX-1 .EQ. IARMAX) GOTO 500
      ITYPE=INT(STACK(ISTCK,INX))
      IF(ITYPE .EQ. 4000 .OR. ITYPE .EQ. 2000) GOTO 300
      IF(ITYPE .EQ. 3000 .OR. ITYPE .EQ. 1000) GOTO 400
      GOTO 320
C
C  EXPECTING CURVE
C
 400  CONTINUE
      WRITE(8,410, ADVANCE="NO")
 410  FORMAT(2HM )
      INX=INX+1
 420  CONTINUE
      X1=STACK(ISTCK,INX)
      Y1=STACK(ISTCK,INX+1)
      Z1=STACK(ISTCK,INX+2)
      CALL PERSP(OVER,UP,RAD,PP,X1,Y1,Z1,XNEW1,YNEW1)
      WRITE(8,422, ADVANCE="NO") XNEW1,YNEW1
 422  FORMAT(F7.2,1H ,F7.2,1H )
      INX=INX+3
      IF(INX-1 .EQ. IARMAX) GOTO 500
      ITYPE=INT(STACK(ISTCK,INX))
      IF(ITYPE .EQ. 4000 .OR. ITYPE .EQ. 2000) GOTO 300
      IF(ITYPE .EQ. 3000 .OR. ITYPE .EQ. 1000) GOTO 400
      GOTO 420
C
 500  CONTINUE
      IF(IARIN .NE. 0) GOTO 510
      WRITE(8,544)
      GOTO 60
 510  CONTINUE
      WRITE(8,544)
 544  FORMAT(3H"/>)
      RETURN
      END
C
C
      SUBROUTINE RDRAW(NME,ISTCK,IARI,IFG,X,Y,Z,PP,AR5)
      INCLUDE 'common.txt'
C
      NODRAW=INT(AR5)
      WRITE(3,199)ISTCK,IARI,IFG,X,Y,Z,PP,NODRAW
 199  FORMAT(6HRDRAW ,3I5,4F10.3,I5)
      IAR=IARI
      IF(IAR .NE. 0) GOTO 100
C  OUTPUTS ARRAYS ONE AT A TIME, IARIN=0 TO SAY ALL ARRAYS
      IARIN=0
      IAR=0
  60  CONTINUE
      IAR=IAR+1
      IF(IAR .GT.IARLST(ISTCK)) GOTO 70
      GOTO 110
  70  CONTINUE
      WRITE(8,544)
      RETURN
C
C  OUTPUTS SINGLE ARRAY
 100  CONTINUE
      WRITE(3,298)
 298  FORMAT(13HOUTPUT SINGLE)
      IARIN=IAR
 110  CONTINUE
      IARMIN=IARPT(ISTCK,IAR)
      IARMAX=INDPT(ISTCK,IAR)
      WRITE(8,260)
 260  FORMAT(9H<path d=")
      INX=IARMIN
      ITYPE=INT(STACK(ISTCK,INX))
      IF(ITYPE .EQ. 4000 .OR. ITYPE .EQ. 2000) GOTO 300
      IF(ITYPE .EQ. 3000 .OR. ITYPE .EQ. 1000) GOTO 400
C MUST BE AN ERROR
      RETURN
C
C  EXPECTING LINES
C
 300  CONTINUE
      INX=INX+1
 320  CONTINUE
      X1=STACK(ISTCK,INX)
      Y1=STACK(ISTCK,INX+1)
      Z1=STACK(ISTCK,INX+2)
      X2=STACK(ISTCK,INX+3)
      Y2=STACK(ISTCK,INX+4)
      Z2=STACK(ISTCK,INX+5)
      CALL PERSPR(X,Y,Z,PP,X1,Y1,Z1,XNEW1,YNEW1)
      CALL PERSPR(X,Y,Z,PP,X2,Y2,Z2,XNEW2,YNEW2)
      WRITE(8,322, ADVANCE="NO") XNEW1,YNEW1,XNEW2,YNEW2
 322  FORMAT(1HM,F7.2,1H,,F7.2,1HL,F7.2,1H,,F7.2)
      INX=INX+6
      IF(INX-1 .EQ. IARMAX) GOTO 500
      ITYPE=INT(STACK(ISTCK,INX))
      IF(ITYPE .EQ. 4000 .OR. ITYPE .EQ. 2000) GOTO 300
      IF(ITYPE .EQ. 3000 .OR. ITYPE .EQ. 1000) GOTO 400
      GOTO 320
C
C  EXPECTING CURVE
C
 400  CONTINUE
      WRITE(8,410, ADVANCE="NO")
 410  FORMAT(2HM )
      INX=INX+1
 420  CONTINUE
      X1=STACK(ISTCK,INX)
      Y1=STACK(ISTCK,INX+1)
      Z1=STACK(ISTCK,INX+2)
      CALL PERSPR(X,Y,Z,PP,X1,Y1,Z1,XNEW1,YNEW1)
      WRITE(8,422, ADVANCE="NO") XNEW1,YNEW1
 422  FORMAT(F7.2,1H ,F7.2,1H )
      INX=INX+3
      IF(INX-1 .EQ. IARMAX) GOTO 500
      ITYPE=INT(STACK(ISTCK,INX))
      IF(ITYPE .EQ. 4000 .OR. ITYPE .EQ. 2000) GOTO 300
      IF(ITYPE .EQ. 3000 .OR. ITYPE .EQ. 1000) GOTO 400
      GOTO 420
C
 500  CONTINUE
      IF(IARIN .NE. 0) GOTO 510
      WRITE(8,544)
      GOTO 60
 510  CONTINUE
      WRITE(8,544)
 544  FORMAT(3H"/>)
      RETURN
      END
C
      SUBROUTINE PERSP(OVER,UP,RAD,PP,X,Y,Z,XNEW,YNEW)
      INCLUDE 'common.txt'
      PI2=3.14159/180. 
      XH=X*PP*COS(OVER*PI2)-Z*PP*SIN(OVER*PI2)
      YH=Y*PP*COS(UP*PI2)-X*PP*SIN(UP*PI2)*SIN(OVER*PI2)
     1 - Z*PP*COS(OVER*PI2)*SIN(UP*PI2)
C     ZH=Z
      WH=RAD-X*SIN(OVER*PI2)*COS(UP*PI2)-SIN(UP*PI2)*Y
     1 - Z*COS(OVER*PI2)*COS(UP*PI2)
      XNEW=X3DORG+XH/WH
      YNEW=Y3DORG+YH/WH
      RETURN
      END
C
      SUBROUTINE PERSPR(XS,YS,ZS,PP,X,Y,Z,XNEW,YNEW)
      INCLUDE 'common.txt'
      RAD=SQRT(XS*XS+YS*YS+ZS*ZS)
      RXZ=SQRT(XS*XS+ZS*ZS)
      DX=X3DORG
      DY=Y3DORG
C
      XH=X*PP*(ZS/RXZ)-Z*PP*(XS/RXZ)
      YH=Y*PP*(RXZ/RAD)-X*PP*(YS/RAD)*(XS/RXZ)
     1 - Z*PP*(ZS/RXZ)*(YS/RAD)
C     ZH=Z
      WH=RAD-X*(XS/RXZ)*(RXZ/RAD)-(YS/RAD)*Y
     1 - Z*(ZS/RXZ)*(RXZ/RAD)
      XNEW=XH/WH+DX
      YNEW=YH/WH+DY
      RETURN
      END
C
      SUBROUTINE NUORG(NME,X,Y)
      INCLUDE 'common.txt'
C
C
      WRITE(3,210) NME,X,Y
 210  FORMAT(A5,1X,2F10.2,1X)
      X3DORG=X
      Y3DORG=Y
      RETURN
      END
C
      SUBROUTINE BGSVG
C INITIALISE SVG OUTPUT
      WRITE(8,705)
 705  FORMAT(39H<svg xmlns="http://www.w3.org/2000/svg" )
      WRITE(8,706)
 706  FORMAT(29H viewBox="-200 -200 400 400">)
      WRITE(8,707)
 707  FORMAT(23H<style type="text/css">)
      WRITE(8,708)
 708  FORMAT(49Hpath.bdr {stroke:blue;stroke-width:0.2;fill:none})
      WRITE(8,709)
 709  FORMAT(48Hpath {stroke:green;stroke-width:0.015;fill:none})
      WRITE(8,710)
 710  FORMAT(8H</style>)
      WRITE(8,711)
 711  FORMAT(48H<path class="bdr" d="M-200,-200h400v400h-400z"/>)
      WRITE(8,712)
 712  FORMAT(48H<g transform="translate(-200,130)scale(40,-40)">)
      RETURN
      END
C
      SUBROUTINE LDFONT
      INCLUDE 'common.txt'
      READ(6,190)(IARPT(7,I),I=1,50)
 190  FORMAT(10I5)
      READ(6,190)(INDPT(7,I),I=1,50)
      READ(6,191)(STACK(7,I),I=1,1048)
 191  FORMAT(7F10.3)
      ISTKPT(7)=1048
      RETURN
      END
C
      SUBROUTINE PRCMPR(IST,IND)
      INCLUDE 'common.txt'
C PRINT CAMPER PROGRAM
      WRITE(3,302) IST,IND
 302  FORMAT(5HFROM ,I5,1X,3HTO ,I5)
      WRITE(3,202) (NAME(J),ISTACK(J),IARRAY(J),IFIG(J),
     1ARG1(J),ARG2(J),ARG3(J),ARG4(J),ARG5(J)
     2,J=1,JMAX)
 202  FORMAT(A5,1X,I1,1X,I3,1X,I1,1X,5F10.2,1X)
C
      RETURN
      END
C
      SUBROUTINE DO(NME,NTIMES,J)
      INCLUDE 'common.txt'
C
      WRITE(3,210)NME, NTIMES,J
 210  FORMAT(A5,1X,2I5)
      JDO=J
      LPCNT=1
      LTIMES=NTIMES
      RETURN
      END
C
      SUBROUTINE LOOP(NME,J)
      INCLUDE 'common.txt'
C
C
      WRITE(3,210) NME,J
 210  FORMAT(A5,I5)
      JLP=J
      IF(LPCNT .EQ. LTIMES) RETURN
      LPCNT=LPCNT+1
      J=JDO
      RETURN
      END
C
      SUBROUTINE FRAME
      INCLUDE 'common.txt'
      IF(IFRMCN .LT. 10) WRITE(8,200) IFRMCN
 200  FORMAT(10H<g id="fr0,I1,23H" style="display:none">)
      IF(IFRMCN .GT. 9) WRITE(8,201) IFRMCN
 201  FORMAT(9H<g id="fr,I2,23H" style="display:none">)
      RETURN
      END
C
      SUBROUTINE NDFRM
      INCLUDE 'common.txt'
      WRITE(8,200) 
 200  FORMAT(4H</g>)
      IFRMCN=IFRMCN+1
      RETURN
      END
C
      SUBROUTINE STOP(NME)
      INCLUDE 'common.txt'
      IF(IFRMCN .EQ. 1 ) GOTO 190
      IFRMCN=IFRMCN-1
      DO 120 IFR=1,IFRMCN
      IF(IFR .GT. 9) GOTO 40
      IST=IFR-1
      INX=IFR
      WRITE(8,30, ADVANCE="NO")
  30  FORMAT(49H<set attributeName="display" to="block" begin="0.)
      WRITE(8,31, ADVANCE="NO")IST
  31  FORMAT(I1)
      WRITE(8,32, ADVANCE="NO")
  32  FORMAT(33Hs" attributeType="CSS" href="#fr0)
      WRITE(8,33, ADVANCE="NO")INX
  33  FORMAT(I1)
      WRITE(8,34)
  34  FORMAT(3H"/>)
C
      WRITE(8,35, ADVANCE="NO")
  35  FORMAT(48H<set attributeName="display" to="none" begin="0.)
      WRITE(8,36, ADVANCE="NO")INX
  36  FORMAT(I1)
      WRITE(8,37, ADVANCE="NO")
  37  FORMAT(33Hs" attributeType="CSS" href="#fr0)
      WRITE(8,38, ADVANCE="NO")INX
  38  FORMAT(I1)
      WRITE(8,39)
  39  FORMAT(3H"/>)
      GOTO 110
C
  40  CONTINUE
C FRAMES 10 ONWARDS
      IST10=INT(FLOAT(IFR-1)/10.)
      INX10=INT(FLOAT(IFR)/10.)
      IST1=IFR-1-10*IST10
      INX1=IFR-10*INX10
C
      WRITE(8,41, ADVANCE="NO")IST10
  41  FORMAT(47H<set attributeName="display" to="block" begin=",I1,1H.)
      WRITE(8,42, ADVANCE="NO")IST1
  42  FORMAT(I1)
      WRITE(8,43, ADVANCE="NO")
  43  FORMAT(32Hs" attributeType="CSS" href="#fr)
      WRITE(8,44, ADVANCE="NO")IFR
  44  FORMAT(I2)
      WRITE(8,45)
  45  FORMAT(3H"/>)
      IF(IFR .EQ. IFRMCN) GOTO 110
      WRITE(8,46, ADVANCE="NO")INX10
  46  FORMAT(46H<set attributeName="display" to="none" begin=",I1,1H.)
      WRITE(8,47, ADVANCE="NO")INX1
  47  FORMAT(I1)
      WRITE(8,48, ADVANCE="NO")
  48  FORMAT(32Hs" attributeType="CSS" href="#fr)
      WRITE(8,49, ADVANCE="NO")IFR
  49  FORMAT(I2)
      WRITE(8,50)
  50  FORMAT(3H"/>)
C
 110  CONTINUE
C
 120  CONTINUE
C
 190  CONTINUE
      WRITE(8,200)
 200  FORMAT(4H</g>,6H</svg>)
C
C
      WRITE(3,210) NME
 210  FORMAT(A5,1X)
      RETURN
      END