C ***** SCANNER *************************  
C**** SCANR,BGSORT,FMT,RANR,SQYY,COLTTY,READER,CLEAN   7/74
	SUBROUTINE SCANR
	DIMENSION IP(30)
	COMMON P(30),J,L,CNT(27),BT,PL(48),MK,DF,DUR(27)
	1 ,IQ(27),ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JA,ISUB,NFLG,IXX,ISEMI,IQT
	1 ,INP(144),VX(70),ISCA(12),IDAT(11),IAMP,K,KN,M,ML,CODE,IBLA
	EQUIVALENCE(IF,ISCA(6)),(ISS,ISCA(9)),(IE,ISCA(5)),(IDOT,IDAT(11))
	1 ,(IEN,ISCA(4)),(IP,PL)
C 2/74 IP IS NOW EQUIV TO PL!  USED TO BE IP WITH P.(HURT 'TAP' ROUTINE.)
C  WILL THIS DO ANYTHING TO MUSIC5 VERSION??
      NNUM=-1     
      ISKP=0
      JJ=0  
	XMINUS=1.    
999      IDECI=-1  
      M=0   
2799	N=INP(ML)
	IF(N.NE.IQT)GO TO 899
	JA=-1
	ML=ML+1
	ISUB=8
	JJ=JJ+1
	VX(JJ)=ML
C  POINTS TO FIRST LIT. CHAR.
	DO 1177 K=ML,144
	IF(INP(K).NE.IQT)GO TO 1177
	ML=K+1
2177	N=INP(ML)
	GO TO 899
1177	CONTINUE
C  SKIPS 'LIT' ITEMS IN RAN. SELECTION
899   ML=ML+1
	IF(N.EQ.ISEMI)GO TO 751
	IF(N.NE.IBLA)GO TO 510
4702      IF(ISKP)202,2799,2799

510	IF(JA)GO TO 70
C********** MAY 22,71
      DO 77 K=1,12   
      IF(N.NE.ISCA(K))GO TO 77
	IF(K.NE.2.AND.K.NE.4)GO TO 511
	NSWCH=K-4
	GO TO 2177
C  TO SWITCH ALWAYS USE OCT.#  /PBF4/  /OE5/  P=PROXIMITY, O=ORDINARY
C ************ MAY 22,71
511   NNUM=K
	JJ=JJ+1
	NFLG=-1
	N=INP(ML)
	IF(N.NE.IF)GO TO 410
	NNUM=NNUM-1
	GO TO 610
410	IF(N.NE.ISS)GO TO 3410
	NNUM=NNUM+1
610	ML=ML+1
	N=INP(ML)
3410	IF(N.NE.IEN.AND.N.NE.'I')GO TO 371
C  'END' OR 'FINE' WILL END INST.
C******** MAY 20,71
3411	VX(JJ)=10000.
	IF(DUR(LK))DUR(LK)=1000.
	IAMP=-1
	RETURN
371	IF(N.EQ.ISEMI.OR.N.EQ.IBLA)GO TO 5410
	DO 177 KN=2,8
	IF(N.NE.IDAT(KN))GO TO 177
	JSCA=KN-2
	ML=ML+1
	GO TO 2410
177	CONTINUE
	GO TO 6410
5410	KN=-1
6410	IF(NSWCH.EQ.0)GO TO 2410
	IF(KN)GO TO 7410
CC	IF(N.EQ.'+')NOLD=NOLD+6
CC	IF(N.EQ.'-')NOLD=NOLD-6
C /B/B-/ JUMPS DOWN OCT., /B/B+/ UP OCT.
7410	IF(NOLD-NNUM.GT.5.AND.JSCA.LT.7)JSCA=JSCA+1
	IF(NOLD-NNUM.LT.-5.AND.JSCA.GT.0)JSCA=JSCA-1
C   WILL JUMP TO NEAREST NOTE ***********  MAY 22,71
2410	VX(JJ)=JSCA*12+NNUM
	NOLD=NNUM
C ********** MAY 22,71
4410	NNUM=-2
	IF(INP(ML).EQ.ISEMI)RETURN
C   ABOVE FINDS SCALE NOTES; IF NSWCH=0 OCT. NUM WILL STICK UNTIL RESET
	IF(N.EQ.IXX)GO TO 210
	GO TO 310
C *********MAY 22,71
77    CONTINUE    
70    IF(N.NE.'-')GO TO 71   
      XMINUS=-1.   
      GO TO 2799   
210	JJ=JJ+1
	IF(JJ.EQ.1)GO TO 3310
C****** MAY 19,71
	XMINUS=1.
	VX(JJ)=0
C  'X N1,N2' MAY REPLACE 'REP N1,N2'.  N2=0 BECOMES N2=2
	GO TO 310
71	IF(N.EQ.IXX)GO TO 210
	IF(N.EQ.'R')GO TO 73     

1410  DO 78 K=1,11
      IF(N.NE.IDAT(K))GO TO 78
	ISKP=-1
	IF(N.NE.IDOT)GO TO 79
	IDECI=M
	GO TO 75
79    M=M+1 
      IP(M)=K-1   
	GO TO 75
78	CONTINUE
	IF(N.NE.IE.AND.N.NE.IF)GO TO 781
C  'END' OR 'FINE' WILL END INST.
	JJ=1
	GO TO 3411
781	IF(N.EQ.'/')N=ISEMI
C   FOR MOTIVIC TRANFORMATIONS

75	IF(INP(ML).EQ.IXX)GO TO 202
C  FOR 2X3, ETC.    CHECK THIS OUT.  6/74
CC75	IF(INP(ML).NE.IXX)GO TO 752
CC	ML=ML-1
CC	GO TO 202
C  FOR 'X' WITHOUT SPACES.
752	IF(N.NE.ISEMI.AND.INP(ML).NE.1)GO TO 2799
751	IF(ISKP.EQ.0)RETURN
202   IF(IDECI.NE.-1)GO TO 302    
      IDECI=0     
      GO TO 402   
302   IDECI=M-IDECI     
402   KN=0  
      IEXP=M-1    
      IF(M.LT.1)M=1     
      DO 171 K=1,M
	KV=10**IEXP
	IF(IEXP.EQ.0)KV=1
      KN=KN+IP(K)*KV 
171     IEXP=IEXP-1     
      A=10**IDECI 
	IF(IDECI.EQ.0)A=1.
	JJ=JJ+1
	VX(JJ)=KN/A*XMINUS
	IF(ISUB.EQ.1)RETURN
	IF(CODE.NE.-22.)XMINUS=1.
C  ONLY ONE - NEEDED FOR RHY.COMPOSITE
1310	IF(INP(ML).NE.1)GO TO 310
	VX(JJ+1)=VX(JJ)*2.
	JJ=JJ+1
	ML=ML+1
	GO TO 1310
206	ML=ML+2
3310	VX(1)=-99.
C******** MAY 19,71
310      ISKP=0
        IF(N.NE.ISEMI)GO TO 999

    	RETURN
73	JJ=JJ+1
	 IF(INP(ML).EQ.IE)GO TO 206    
C   NEXT IS FOR A REST ('R')  
      VX(JJ)=85.
	GO TO 4410
  	END

	SUBROUTINE BGSORT(BW)
C  THIS SORTS BG TIMES SO NONE ARE DUPLICATED IN BNW ARRAY.
C  ALLOWS 100 BG TIMES.
	COMMON /Q/ BNW(100),NWZ
	DO 5308 K=1,NWZ
	X=BNW(K)-.0001
	Y=X+.0002
C   ROUND-OFF NONSENSE
5308	IF(BW.GT.X.AND.BW.LT.Y)RETURN
	NWZ=NWZ+1
	BNW(NWZ)=BW
	RETURN
	END

	SUBROUTINE FMT(JFM,INP,MLX)
	DIMENSION JFM(3),INP(1)
	DO 1 MLX=2,72
	J=INP(MLX)
1	IF(J.EQ.' '.OR.J.EQ.','.OR.J.EQ.';')GO TO 2
C  SPACE=COMMA=SPACE, ALSO STOPS ON ";"
2	MLX=MLX+1
	IF(MLX.GT.7)MLX=7
	JFM(2)='0'+(MLX-2)*536870912
C   FINDS NUMBER FOR 'A' FORMAT
	RETURN
	END

      SUBROUTINE RANR(VX,K)
C   FOR RAN. SELEC. OF NOTES.  FINDS HIGHEST NOTE.
      DIMENSION VX(1)
      X=VX(K)
      Y=VX(K+1)
      IF(X.GT.Y)VX(K)=X+.999
      IF(Y.GE.X)VX(K+1)=Y+.999
      RETURN
      END

      SUBROUTINE SQYY(YY,X,Y,Z)
      YY=2.*Z/(X+Y)
      IF(YY.NE.0)YY=2.*(Z-X*YY)/YY**2
      RETURN
      END

	SUBROUTINE COLTTY(JNP,JT)
	COMMON /TYP/SOS,JOUT,LN,ITYP,TPALN(4),JED /FRMT/J(2)
	DIMENSION JNP(1)
	DATA J(2)/'72A1)'/
	DO 1 K=72,1,-1
1	IF(JNP(K).NE.' ')GO TO 2
	K=1
2	IF(JT.EQ.21)GO TO 3
	J(1)='  (1X'
	IF(LN.EQ.0)GO TO 5
	J(1)='(I5,X'
	WRITE(JT,J)LN,(JNP(L),L=1,K)
	RETURN
3	J(1)='    ('
5	WRITE(JT,J)(JNP(L),L=1,K)
	END

	FUNCTION READER(JNP)
	DIMENSION JNP(72)
	COMMON /TYP/SOS,JOUT,LN,ITYP,TPALN(4),JED
	1 /FRMT/J(2)
	DATA TPALN/20H(' TYPE A LINE'/)   /
	J(1)='    ('
	READER=0
	IF(ITYP)GO TO 1
6 	TYPE TPALN
	ACCEPT J,JNP
	IF(JED)CALL COLTTY(JNP,21)
	IF(JNP(1).EQ.' ')GO TO 6
	RETURN
1	IF(LN.NE.0)GO TO 5
	READ(1,J,END=3)JNP
	GO TO 7
5	J(1)='  (I,'
	READ(1,J,END=3)LN,JNP
7	IF(SOS)CALL COLTTY(JNP,JOUT)
	RETURN
3	READER=-1
	END

	SUBROUTINE QUAD
C  DUMMY -- FOR NOW.  7/74
	END

	FUNCTION RMOVX(W,Y,Z)
	IF(W.EQ.0)W=.01
	IF(Y.EQ.0)Y=.01
	RMOVX=Y*((W/Y)**Z)
	END

	SUBROUTINE CLEAN(INP,LEND)
	DIMENSION INP(1)
C  CLEAR THE END OF ARRAY
	M=72
	LEND=-1
	K=0
1	K=K+1
	NN=INP(K)
	IF(NN.EQ.';'.OR.NN.EQ.'/')GO TO 2
	IF(NN.EQ.'<')GO TO 3
C  USE < FOR COMMENT--  AS IN MUS10
	IF(NN.EQ.',')INP(K)=' '
C  CHANGE ALL COMMAS TO BLANKS
	IF(NN.NE.'"')GO TO 4
7	K=K+1
	IF(INP(K).EQ.'"')GO TO 4
	IF(K.LT.M)GO TO 7
	TYPE 5
	STOP
5	FORMAT(' OPEN QUOTES')
2	LEND=K
4	IF(K.LT.M)GO TO 1
3	IF(LEND.GT.0)RETURN
	IF(M.EQ.144)CALL EXIT
	CALL READER(INP(73))
C  GO READ ANOTHER LINE.
	M=144
	K=72
	GO TO 1
	END