perm filename S3.F4[LX,LCS]2 blob
sn#165222 filedate 1975-06-24 generic text, type T, neo UTF8
00100 C SCORB.F4 2ND HALF OF SCORE.
00200 SUBROUTINE RUNIT
00300 COMMON /Q/ BNW(100),NWZ /INS/INST(27),BG(60) /TYP/SOS,JOUT
00400 1 ,LN,ITYP,TPALN,JED
00500 COMMON/A/ V(2000),ROFF(27),NP(27),PCH(27,32),
00600 1 RDEV(27),IPT(27,31),XT(27),OTH(20,16),SCAL(101)
00700 1 ,P1(27),JFM(4),COPY(30),IFM(80)
00800 1 ,FINM(6),TINST(5),ENFI(5),TEDIT(4),INVIS(27)
00900 DIMENSION IV(2000),IT(30),IOUT(70),JPT(837),NCNT(27,32)
01000 C WITH VX,IOUT AT 70 AND IFM AT 80 OK FOR ONLY
01100 C 40 LIT CHARS + 30 PARAMS PER INST.
01200 C 60 BG TIMES AVAILABLE. FOR INSTS AND INSERTS AND EDITS.
01300 COMMON P(30),J,L,CNT(27),BT,PL(48),MK,DF,DUR(27)
01400 1 ,IQ(27),KL,X,ZPAR,KA,LK,NNUM,JJ,JA,ISUB,NFLG,IXX,ISEMI,IQT
01500 1 ,INP(144),VX(70),ISCA(12),IDAT(11),IAMP,K,KN,M,ML,CODE,IBLA
01600 COMMON/B/MOT,PR,T5,NINS,I,TP,RA,KZY,NWX,INONLY,MX,
01700 1 Y,Z,ISLAC,MZ,N,IDALL,JC,JG,RB,IJ,IX,BW,KB,NL,RC,W,
01800 1 CHN,YY
01900 1 /D/TF,AMPFAC,OP1,DURX,IXIN,IFLNM
02000 1 /C/T,NWZZ,IT3,T6,NW,TDUR,A,T2,T4,IL,
02100 1 KODE,RD,LP,TBG,AC,NPA,BX,IDF,PM,NM,PAR,PX2,T1,NPAR,
02200 1 VIJ2
02300 C /C/=26
02400 EQUIVALENCE (PP1,P(1)),(P(2),P2),(P(3),P3),(P(4),P4),
02500 1 (VX1,VX(1)),(INP1,INP(1)),(PL4,PL(4)),(IPT,JPT)
02600 1 ,(VX2,VX(2)),(VX3,VX(3)),(NCNT,PCH),(VX4,VX(4))
02700 1 ,(VX5,VX(5)),(VX,IOUT),(IFM3,IFM(3))
02800 1 ,(IT,INP(27)),(V,IV),(PLAY,ISCA(7)),(IFM2,IFM(2))
02900 1 ,(IFM4,IFM(4))
03000 DATA SCAL/'C/8','CS/8','D/8','DS/8','E/8','F/8','FS/8','G/8',
03100 1 'GS/8','A/8','AS/8','B/8','C/4','CS/4','D/4','DS/4','E/4',
03200 1 'F/4','FS/4','G/4','GS/4','A/4','AS/4','B/4','C/2','CS/2',
03300 1 'D/2','DS/2','E/2','F/2','FS/2','G/2','GS/2','A/2','AS/2',
03400 1 'B/2','C','CS','D','DS','E','F','FS','G','GS','A','AS',
03500 1 'B','C*2','CS*2','D*2','DS*2','E*2','F*2','FS*2','G*2',
03600 1 'GS*2','A*2','AS*2','B*2','C*4','CS*4','D*4','DS*4','E*4',
03700 1 'F*4','FS*4','G*4','GS*4','A*4','AS*4','B*4','C*8','CS*8',
03800 1 'D*8','DS*8','E*8','F*8','FS*8','G*8','GS*8','A*8','AS*8',
03900 1 'B*8','R','F1','F2','F3','F4','F5','F6','F7','F8','F9',
04000 1 'F10','F11','F12','F13','F14','F15','END'/,I1X/'1X'/
04100 1 ,IFM(1)/'('/,IFM2/'1XA5,'/,IFCOM/5H', ',/,IA1/'A1,'/
04200 PR=0
04300 2337 T=0
04400 DO 1107 K=1,30
04500 1107 PL(K)=1.
04600 C 2/74--WAS AT 17300/1 SETS DEFAULT OUTPUT MODE TO 1.
04700 IF(ITYP)GO TO 23371
04800 END FILE 21
04900 DATA ENFI /25H(' INPUT ON FOR21.DAT '/)/
05000 TYPE ENFI
05100 C PUTS AWAY TYPED IN DATA. TO REUSE, EDIT FOR21.DAT.
05200 23371 IF(SOS)WRITE(JOUT,902)
05300 C WRITES A BLANK LINE
05400 NWZZ=0
05500 IAMP=0
05600 IT3=0
05700 K=1
05800 IX=0
05900 BG(NINS+1)=19999.
06000 4011 IF(CNT(K))GO TO 5011
06100 6011 IF(K.EQ.KZY)GO TO 4337
06200 K=K+1
06300 GO TO 4011
06400 5011 L=V(I-1)/(-9900.)
06500 IF(L.EQ.1)I=I-1
06600 V(I)=CNT(K)
06700 V(I+1)=P(K)
06800 V(I+3)=-44.
06900 I=I+5
07000 IF(P(K).EQ.980000.)I=I-4
07100 KL=I
07200 REWIND 1
07300 ICT=IPT(K,1)
07400 CALL IFILE(1,ICT)
07500 9011 L=I+6
07600 READ(1,7011)(V(M),M=I,L)
07700 C READS "CONDUCT" AND "RHYTHM" (TAP) DATA.
07800 IF(V(L).EQ.999.)GO TO 8011
07900 I=L+1
08000 GO TO 9011
08100 8011 IF(P(K).NE.980000.)GO TO 6337
08200 DO 7337 K=L,I,-1
08300 7337 IF(V(K).NE.999.)GO TO 8337
08400 8337 I=K-1
08500 V(I)=0
08600 V(I+1)=V(K)
08700 V(I+2)=V(K)
08800 C K WAS I-1 ABOVE.
08900 I=I+3
09000 V(KL+1)=I-KL-1
09100 C ABOVE RESETS WORDCOUNT FOR 'CONDUCT' DATA.
09200 GO TO 4337
09300 6337 DO 5337 M=I,L
09400 KN=M
09500 5337 IF(V(M).EQ.999.)GO TO 3337
09600 3337 I=KN
09700 KN=I-KL
09800 V(KL-1)=KN
09900 V(KL-3)=KN+3
10000 GO TO 6011
10100 7011 FORMAT(7F)
10200 4337 IF(V(I-1).EQ.-9900.-BY)I=I-1
10300 V(I)=-19899.
10400 PP1=0
10500 T6=10000.
10600 DO 2118 K=1,NINS
10700 ROFF(K)=0
10800 C********* FEB 17,71
10900 M=NP(K)
11000 IT(K)=0
11100 IPT(K,31)=0
11200 NCNT(K,31)=1
11300 DO 2118 L=1,M
11400 NCNT(K,L)=1
11500 2118 IPT(K,L)=0
11600 DO 5013 K=1,IXIN
11700 5013 X=RAND(0.0,0.0)
11800 REWIND 1
11900 IF(MX)CALL OFILE(1,ISLAC)
12000 NW=1
12100 NWX=0
12200 TDUR=0
12300 A=0
12400 T2=1.
12500 T4=1.
12600 T5=0
12700 J=1
12800 MK=0
12900 C IS THE ABOVE NEEDED?
13000 IF(MX.NE.3)GO TO 40021
13100 K=4
13200 10023 N=AMOD(V(K),100.0)/-11.
13300 C AMOD NEEDED BECAUSE CODE # MAY HAVE -100 FOR DF OR -200 FOR SUBR.
13400 IF(N.EQ.2)GO TO 77
13500 IF(N.EQ.3)GO TO 77
13600 IF(N.NE.4)GO TO 10021
13700 77 IF(V(K-2).LT.10000.)GO TO 10021
13800 J=V(K+1)
13900 IF(J.EQ.1)GO TO 10024
14000 IF(N.NE.3)GO TO 177
14100 IF(V(K+J+1).EQ.101.)J=J-1
14200 177 N=V(K-2)
14300 L=N/10000
14400 M=N-L*10000
14500 TYPE 10022,INST(L),M,J
14600 10024 K=K+ABS(V(K-1))
14700 10021 K=K+1
14800 IF(K.LT.I)GO TO 10023
14900 40021 IF(MZ.NE.-4)GO TO 1002
15000 N=1
15100 40022 K=N+1
15200 IF(N.GT.I)CALL EXIT
15300 X=V(N)
15400 IF(X.EQ.-199.)GO TO 40024
15500 IF(X.EQ.-99.)GO TO 40024
15600 IF(X.GE.0)GO TO 40023
15700 PRINT 4002,X
15800 N=N+1
15900 GO TO 40022
16000 40024 J=N+1
16100 GO TO 40025
16200 C FOR 'SECTIONS'
16300 40023 J=ABS(V(K))+K-1
16400 40025 PRINT 4002,(V(K),K=N,J)
16500 N=J+1
16600 GO TO 40022
16700 10022 FORMAT(1XA5,' P',I2,' HAS ',I3,' ITEMS.')
16800 4002 FORMAT(10F12.3)
16900 1002 IF(IDALL)GO TO 600
17000 X=DUR(IDALL)
17100 DO 2002 K=1,NINS
17200 2002 IF(DUR(K))DUR(K)=X
00100 C ***** SORTER *************************
00200 C ******* OUTPUT LOOP FROM HERE ON ********
00300 600 IL=0
00400 C********** BELOW IS FOR 'SECTIONS'
00500 KODE=0
00600 NWX=NWX+1
00700 MK=MK+1
00800 Y=BNW(NW)
00900 723 IL=IL+1
01000 3723 Z=V(IL)
01100 IF(Z.EQ.-19899.)GO TO 732
01200 IF(Z.NE.-9900.-Y)GO TO 723
01300 C********** BELOW IS FOR 'SECTIONS'
01400 IF(V(IL-2).EQ.-199.)KODE=IV(IL-1)
01500 2723 IL=IL+1
01600 729 K=IL+2
01700 MOT=V(IL+1)
01800 RD=V(K)
01900 IF(RD.EQ.-67.)GO TO 3726
02000 RB=V(IL)
02100 C************ DOWN TO 4150 IS FOR 'SECTIONS'
02200 IF(RB.NE.-99.)GO TO 4150
02300 KODE=IV(K-1)
02400 2160 IF(KODE.EQ.0)GO TO 723
02500 IF(MZ)WRITE(JOUT,9150),KODE
02600 KL=Y/10000.
02700 RB=Y+KL*10000.
02800 DO 5150 KL=1,I
02900 IF(V(KL).NE.-199.)GO TO 5150
03000 IF(IV(KL+1).NE.KODE)GO TO 5150
03100 IV(K-1)=0
03200 C WHEN 'PLAY' HAS BEEN FOUND, INDENTIFIER CHNGED TO 0
03300 RD=V(KL+2)+9900.
03400 DO 6150 L=KL+2,I
03500 M=V(L)/(-9900.)
03600 IF(M.NE.1)GO TO 6150
03700 RA=RB+RD-V(L)-9900.
03800 V(L)=-9900.-RA
03900 C UPDATES BG TIMES INSIDE SECTION.
04000 CALL BGSORT(RA)
04100 C7150 IF(RA.EQ.BNW(KA))GO TO 6150
04200 C UPDATES LIST OF CHANGE TIMES.
04300 6150 IF(V(L).EQ.-299.)GO TO 160
04400 5150 CONTINUE
04500 160 IL=1
04600 GO TO 3723
04700 C*********** ABOVE IS FOR 'SECTION' REPEATS
04800 4150 LK=RB/10000.+.2
04900 IF(LK.GE.98)GO TO 7700
05000 LP=RB-LK*10000
05100 C LK=INST # LP=PARAM #
05200 LN=IPT(LK,LP)
05300 IPT(LK,LP)=IL+2
05400 IF(RD.EQ.-66.)GO TO 726
05500 IF(RD.EQ.-55.)GO TO 1726
05600 IF(RD.EQ.-56.)GO TO 1726
05700 IF(RD.EQ.-23)GO TO 6700
05800
05900 2727 ML=IPT(LK,LP)
06000 IF(MOT.GT.0)GO TO 3727
06100 C USE NEG WDCNT FOR 'ALL'
06200 DO 4727 KL=LK+1,NINS
06300 IF(NP(KL).GE.LP)GO TO 277
06400 IF(LP.LT.31)NP(KL)=LP
06500 277 IPT(KL,LP)=-(LK+(LP-1)*KZY)
06600 NCNT(KL,LP)=10000
06700 4727 IF(DUR(KL))DUR(KL)=1000.
06800 C ASSUMES THAT DURATIONS ARE SET IN 'NOTES'.
06900 C AFTER 'ALL' IS USED ONCE IT WORKS LIKE DUPL OR REP.
07000 GO TO 727
07100 C 'MOVE' WITH 'ALL' KEEPS ORIGINAL TIME DATA REGARDLESS OF BG TIMES.
07200 3727 IF(V(IL).NE.V(LN-1))GO TO 727
07300 IF(LN.EQ.0)GO TO 727
07400 DO 1727 L=1,NINS
07500 DO 1727 KL=1,NP(L)
07600 IF(LN.NE.IPT(L,KL))GO TO 1727
07700 NCNT(L,KL)=10000
07800 C ******* JAN 29,70
07900 IPT(L,KL)=ML
08000 C RESETS POINTERS FOR DUPL AND REP INSTS.
08100 C *** 'ALL' WILL NOT WORK WITH RAN TF.!!!!!*******FEB 21,73
08200 1727 CONTINUE
08300 727 NCNT(LK,LP)=10000
08400 C******** MAY 13,71 RHY REP. FEATURE OMITTED.
08500 2150 IF(MOT)MOT=-MOT
08600 IL=IL+MOT+1
08700 3150 IF(V(IL))GO TO 3723
08800 GO TO 729
08900 726 RB=V(IL+3)
09000 K=RB/10000.
09100 L=RB-K*10000
09200 IPT(LK,LP)=-(K+(L-1)*KZY)
09300 GO TO 2727
09400 3726 LK=V(IL)
09500 M=V(K+1)
09600 KL=NP(M)
09700 DO 4726 L=1,KL
09800 IPT(LK,L)=IPT(M,L)
09900 IF(IPT(M,L).NE.0)NCNT(LK,L)=10000
10000 C****** JUN 29 71 (LK,L) WAS (L,K)....???????
10100 4726 CONTINUE
10200 IPT(LK,31)=IPT(M,31)
10300 K=0
10400 GO TO 2150
10500 C ABOVE IS FOR DUPLICATION ROUTINE NEXT ADJUSTS TIMES FOR 'RTAP'
10600 6700 KL=IL+V(IL+1)+1.3
10700 RC=V(K-2)
10800 1770 IF(V(KL))GO TO 700
10900 2700 KL=KL+V(KL+1)+1.3
11000 GO TO 1770
11100 700 KL=KL+1
11200 IF(Z.NE.V(KL-1))GO TO 2700
11300 IF(V(KL).NE.RC)GO TO 2700
11400 KL=KL+3
11500 KN=IL+3
11600 LN=V(KN)+.3
11700 DO 3700 L=1,LN,2
11800 RA=V(L+KN)
11900 KA=V(L+KN+1)+.3
12000 RB=0
12100 DO 4700 LP=1,KA
12200 4700 RB=RB+V(KL+LP)
12300 DO 5700 LP=1,KA
12400 5700 V(KL+LP)=V(KL+LP)/RB*RA
12500 V(KL+KA)=V(KL+KA)+.00030
12600 3700 KL=KL+KA
12700 GO TO 2150
12800
12900 C BELOW FOR 'TEMPO' SETUP
13000 7700 T2=V(IL+4)
13100 T1=V(IL+3)
13200 TBG=Y
13300 TDUR=V(IL+2)
13400 CALL SQYY(AC,T1,T2,TDUR)
13500 8700 IF(TDUR.EQ.0)TDUR=10000.
13600 T5=1.
13700 T6=TBG+TDUR
13800 IT3=1.
13900 IF(LK.EQ.98)IT3=IL+2
14000 T4=1.
14100 GO TO 2150
14200 C*************** ANY WDCNTS DOWN FROM HERE. *********
14300 C NEXT ADJUSTS 'MOVE' TIMES IF BG IS AT A NOTE NUMBER.
14400 1726 IF(V(IL-1).GT.-19000.)GO TO 2727
14500 RA=BT
14600 K=IL-1
14700 2726 V(K)=-9900.-RA
14800 ISUB=-1
14900 L=K+5
15000 RB=V(L)+V(L-1)
15100 V(L-1)=RA
15200 K=K+V(K+2)+2
15300 IF(V(K).GT.-19000.)GO TO 2727
15400 IF(V(K+1).NE.V(IL))GO TO 2727
15500 IF(V(K).NE.-9900.-RB)GO TO 2727
15600 RA=RA+V(L)
15700 CALL BGSORT(RA)
15800 GO TO 2726
15900 C CONVERTS BG TIME OF NOTE NUM TO REAL TIME. DOESN'T WORK WITH -66!
16000 C NOW WE BEGIN ON!! NOTE NUM. NOT AFTER NOTE NUM.
16100 732 DO 2606 K=NW,NWZ
16200 2606 BNW(K)=BNW(K+1)
16300 NWZ=NWZ-1
16400 IF(NWZ.EQ.0)GO TO 2111
16500 IF(NWZZ.EQ.1)GO TO 5111
16600 NWZZ=1
16700 IF(NWZ.EQ.1)GO TO 1111
16800 DO 3111 K=1,NWZ
16900 IF(BNW(K).LT.1000.)GO TO 3111
17000 X=BNW(NWZZ)
17100 BNW(NWZZ)=BNW(K)
17200 BNW(K)=X
17300 NWZZ=NWZZ+1
17400 3111 CONTINUE
17500 5111 IF(NWZZ.EQ.NWZ)GO TO 1111
17600 L=NWZZ+1
17700 X=BNW(NWZZ)
17800 DO 4111 K=L,NWZ
17900 IF(BNW(K).GT.X)GO TO 4111
18000 RA=BNW(K)
18100 BNW(K)=X
18200 X=RA
18300 4111 CONTINUE
18400 BNW(NWZZ)=X
18500 GO TO 1111
18600 111 FORMAT(1XA5,'.DAT',12X,'EDIT FILE NAME=',A5,8X,
18700 1'V ARRAY=',I4,'/2000',/' TEMPO FACTOR=',F6.2/)
18800 1023 FORMAT(/' < ',A5,'.DAT -- RANDOM NUMBER=',I6/1XA5)
18900 C********** BELOW IS FOR 'SECTIONS'
19000 9150 FORMAT(/3X'******* SECTION ',A1)
19100 2111 NWZ=-1
19200 C ABOVE ORDERS BNW DATA TO SAVE TIME AT 1108 ON PG5.
19300 1111 IF(MZ.EQ.0)GO TO 1601
19400 IF(NWX.NE.1)GO TO 1486
19500 WRITE(JOUT,111)ISLAC,IFLNM,I,TF
19600 C*********** JUNE 1,71
19700 C********** BELOW IS FOR 'SECTIONS'
19800 1486 IF(KODE.NE.0)WRITE(JOUT,9150),KODE
19900 K=NWX-1
20000 C*********** JUNE 1,71
20100 IF(NWX.LE.1)GO TO 377
20200 IF(IT(J).NE.-3)WRITE(JOUT,3154),K,Y
20300 377 IF(IT(J).EQ.-3)WRITE(JOUT,5154),K,BX,INST(J)
20400 C*********** JUNE 1,71 X 3 K'S
20500
20600 DO 602 K=1,NINS
20700 48 LK=INST(K)
20800 C*********** JUNE 1,71
20900 IF(NCNT(K,31).EQ.10000)GO TO 477
21000 IF(NWX.GT.1)GO TO 602
21100 477 NCNT(K,31)=1
21200 IJ=IPT(K,31)
21300 X=0
21400 IF(IJ.NE.0)X=V(IJ+2)
21500 WRITE(JOUT,5396),LK,X
21600 X=DUR(K)
21700 IF(X.GT.10000.)GO TO 83
21800 WRITE(JOUT,8396),X
21900 GO TO 602
22000 5396 FORMAT(5XA5,' RANDOM TF =',F4.2,10X,'DURATION =',$)
22100 7396 FORMAT('+',F5.0,' NOTES')
22200 8396 FORMAT('+',F6.2,'"')
22300 83 X=X-10000.
22400 WRITE(JOUT,7396),X
22500 602 CONTINUE
22600 715 IF(IT3.NE.1.)GO TO 1602
22700 RA=T1*TP
22800 RB=T2*TP
22900 WRITE(JOUT,6154),RA,RB,TDUR
23000 IT3=0
23100 1602 IF(NWX.EQ.1)GO TO 315
23200 IF(IT(J).EQ.-3)GO TO 1108
23300 C*********** JUNE 1,71
23400 6154 FORMAT(' TMP=',F7.3,' TO',F8.3,' DURING',F6.2,' SECS.'/)
23500 7154 FORMAT(' ''CONDUCT'' FILE NAME = ',A5/)
23600 5154 FORMAT(/' << CHANGE',I3,' BEGINS ON NOTE',F5.0,1XA5,' >>'/)
23700 902 FORMAT(1XA5/)
23800 3154 FORMAT(/' << BASIC TIME OF CHANGE',I3,' IS',F8.3,'" >>'/)
23900 4154 FORMAT(' THE FIRST',F9.4,'" ARE OMITTED'/)
24000 C*********** JUNE 1,71
24100 IT(J)=IT(J)/10
24200 GO TO 1108
24300 315 IF(IT3.GT.1)WRITE(JOUT,7154),ICT
24400 IF(OP1.NE.0)WRITE(JOUT,4154),OP1
24500 1601 IF(NWX.GT.1) GO TO 1108
24600 IF(TF.GT.10.)TF=TF/60.
24700 TF=1000./TF
24800 DO 6015 K=1,30
24900 6015 COPY(K)=-9900.
25000 C INITS PARAM REPRESSION FEATURE.
25100 IF(KB.EQ.0)GO TO 9926
25200 ML=NINS+1
25300 NL=NINS+KB
25400 DO 9826 K=ML,NL
25500 BW=OTH(K-NINS,1)
25600 IF(BW.NE.-99)GO TO 9826
25700 K=K-NINS
25800 GO TO 5741
25900 C 'INSERT -99;' COMES BEFORE 'PLAY;'
26000 9726 BW=19999.
26100 K=K+NINS
26200 9826 BG(K)=BW
26300 C 'OTH' INSERTS, WITH BG TIME IN SECONDS, CAN ONLY BE SET WITH TF=1
26400 9926 DO 5015 K=1,NINS
26500 IQ(K)=BG(K)*10000.
26600 BG(K)=0
26700 INP(K)=0
26800 P1(K)=0
26900 IF(DUR(K).LT.10000.)DUR(K)=DUR(K)-.0001
27000 C******* FEB. 16,71 FOR ROUND-OFF NONSENSE
27100 5015 CNT(K)=0
27200 IF(MZ)WRITE(JOUT,1023),ISLAC,IXIN,PLAY
27300 IF(MX)WRITE(1,1023)ISLAC,IXIN,PLAY
27400 BW=0
27500 GO TO 500
00100 752 FORMAT(1X15A5)
00200 1108 M=0
00300 JC=0
00400 IF(NWZ)GO TO 1740
00500 C NWZZ IS SET AT 3111 IN SORTR.
00600 DO 740 K=1,NWZZ
00700 X=BNW(K)
00800 IF(X-.0001.GT.BT)GO TO 2740
00900 IF(X.LE.BW)GO TO 2740
01000 IF(BW)GO TO 2740
01100 IT(J)=IT(J)*10
01200 NW=K
01300 GO TO 600
01400 2740 IF(X.LT.1000.)GO TO 740
01500 IF(X-J*10000.NE.CNT(J)+1.)GO TO 740
01600 X=BT+PR
01700 NW=K
01800 BX=CNT(J)+1.
01900 IT(J)=-3
02000 GO TO 600
02100 740 CONTINUE
02200 IT(J)=0
02300 1740 IF(J.LE.NINS)GO TO 31
02400 7021 K=J-NINS
02500 IF(JC.GT.0)K=JC
02600 5740 IF(PP1.LT.OP1)GO TO 1752
02700 5741 IF(MZ)WRITE(JOUT,752),(OTH(K,L),L=2,16)
02800 IF(MX)WRITE(1,752)(OTH(K,L),L=2,16)
02900 C IF TF .NE.1, ALL INSERT TIMES MUST BE RESET
03000 C IF FIRST PART OF NOTE LIST IS 'OMITTED', CHECK YOUR 'INSERTS'.
03100 DO 17521 L=3,30
03200 17521 COPY(L)=-9900.
03300 C SO THAT ALL PARAMS WILL PRINT,AFTER AN INSERT.
03400 1752 BG(K+NINS)=19999.
03500 OTH(K,1)=19999.
03600 IF(BW.EQ.-99)GO TO 9726
03700 IF(JC.GT.0)GO TO 21
03800 31 KL=1
03900 IF(KB.EQ.0)GO TO 2031
04000 DO 1031 L=1,KB
04100 K=L
04200 X=OTH(K,1)-1000000.
04300 M=X/100000.
04400 IF(M.NE.J)GO TO 1031
04500 IF(IQ(J).NE.0)GO TO 1031
04600 C M=INST
04700 IF(X-M*100000.EQ.CNT(J)+1)GO TO 5740
04800 1031 CONTINUE
04900 IF(J.GT.NINS)GO TO 500
05000 2031 CNT(J)=CNT(J)+1
05100 ICT=CNT(J)
05200 C INSERT TRAP HERE FOR OVERLAP OF RESTARTED INSTS.******
05300 NPA=NP(J)
05400 PP1=P1(J)
05500 IF(BT.GE.DUR(J))GO TO 5174
05600 IF(IQ(J).EQ.0)GO TO 200
05700 P2=-IQ(J)/10000.
05800 IQ(J)=0
05900 CNT(J)=-1
06000 ICT=-1
06100 GO TO 4203
06200
06300 C MK IS FLAG FOR RESTS
06400 200 MK=0
06500 IF(BT.NE.0)GO TO 577
06600 IF(J.EQ.1)GO TO 203
06700 577 IF(IPT(J,1).EQ.0)GO TO 203
06800 KN=IPT(J,1)-1
06900 IF(KN.GT.0)GO TO 12033
07000 12032 KN=JPT(-KN)
07100 IF(KN)GO TO 12032
07200 KN=KN-1
07300 C FOR 'ALL' IN P32. FOLLOWS UP ON POINTERS TO POINTERS!
07400 C SOMEDAY PUT P1(32) IN WITH OTHER PARAMS BELOW!!!!
07500 12033 IJ=V(KN)
07600 IF(ABS(V(KN)).EQ.4.)GO TO 1203
07700 C 'IABS' IS FOR -4 USED WITH 'ALL'
07800 Z=(BT+9900.+V(KN-2))/V(KN+2)
07900 C******* FEB 19,71
08000 IF(Z.GT.1.)Z=1.
08100 Y=V(KN+3)
08200 X=(V(KN+4)-Y)*Z+Y
08300 C******* FEB 19,71
08400 GO TO 204
08500 1203 X=V(KN+3)
08600 204 Y=RAND(0.0,1.0)
08700 IF(Y-X)MK=-1
08800
08900 203 DF=1.
09000 C DF=DUTY FACTOR
09100 DO 2155 L=2,NPA
09200 ISUB=0
09300 C WHY DOES ISUB APPEAR AT 14700/5?
09400 IDF=0
09500 C IDF IS DUTY FACTOR FLAG
09600 IJ=IPT(J,L)
09700 12031 IF(IJ)IJ=JPT(-IJ)
09800 IF(IJ)GO TO 12031
09900 C FOLLOWS UP ON POINTERS TO POINTERS!
10000 PM=1.
10100 IF(IJ.GT.1)GO TO 2157
10200 P(L)=0
10300 GO TO 21551
10400 C 7/73
10500 2157 LN=IJ+2
10600 NM=ABS(V(IJ-1))+LN-4
10700 NL=V(IJ)
10800 IF(NL.GT.-100)GO TO 272
10900 IF(NL.GT.-200)GO TO 372
11000 ISUB=-1
11100 NL=NL+200
11200 C FOR SUBROUTINE FLAG
11300 372 IF(NL.GT.-100)GO TO 272
11400 IDF=-1
11500 NL=NL+100
11600 C DEC.6,72 FINDS DUTY FACTOR PARAM
11700 272 VIJ2=V(IJ+1)
11800 KN=NL/(-11)
11900 IF(KN.EQ.0)GO TO 1100
12000 GO TO (61,62,62,62,65,65,67,68),KN
12100 1100 IF(VIJ2.EQ.1.)GO TO 1200
12200 ML=3
12300 1900 KA=1
12400 VX1=0
12500 DO 1156 K=LN,NM,ML
12600 VX(KA+1)=V(K)+VX(KA)
12700 1156 KA=KA+1
12800 X=RAND(0.0,1.)
12900 DO 1157 K=2,11
13000 IF(X.GT.VX(K))GO TO 1157
13100 KL=K-1
13200 IF(KN.EQ.7)GO TO 6157
13300 GO TO 1400
13400 1157 CONTINUE
13500 1400 LN=IJ+3*KL
13600 1462 RA=V(LN)
13700 IF(RA.EQ.10000.)GO TO 5174
13800 C FOR "FINE" IN RLIST
13900 RB=V(LN+1)
14000 PAR=RAND(RA,RB)
14100 1300 IF(NL.NE.-1)PM=2.
14200 C IF 2 THEN PRINTS A5
14300 GO TO 1155
14400 1200 PAR=V(IJ+2)
14500 GO TO 1300
14600 C NEXT IS FOR SUBROUTINE AND QUAD CALLS
14700 61 IF(NL.LT.-12)GO TO 6100
14800 601 X=P2
14900 C '.5' MAKES ALL SUBR PARAMS PRINTOUT.
15000 CALL SUBR
15100 CC 7/74 NOW SET DUR(J) =0 IN SUBR IF(DF)GO TO 5174
15200 C* OUT--COLGATE DF=-1 IN 'SUBR' WILL CAUSE 'END' FOR INST.
15300 IF(L.EQ.2)GO TO 4203
15400 IF(X.EQ.P2)GO TO 21552
15500 PP2=P2
15600 PR=P2
15700 GO TO 21552
15800 C ABOVE IS FOR P2 CHANGES IN SUBROUTINE
15900 C TF,TEMPO,CONDUCT WILL AFFECT P2 ONLY WHEN P2 CALLS THE SUBR.,
16000 C ALL 'TEMPO' CHANGES WILL BE IGNORED!! (THEN DUR. IN SECS. MUST
16100 C BE SET TO 'REAL TIME'.)
16200
16300 C NEXT IS FOR QUAD ROUTINES
16400 6100 CALL QUAD(NL)
16500 GO TO 21552
16600
16700 C FOLLOWING IS FOR STRINGS OF VALUES.
16800 62 KL=NCNT(J,L)+1
16900 IF(KL.GT.VIJ2)KL=1
17000 IF(NL.EQ.-46)GO TO 677
17100 IF(NL.NE.-36)GO TO 162
17200 C THIS PART FOR STRINGS OF RAND SELECTION
17300 677 LN=KL+IJ+1
17400 KL=KL+1
17500 IF(KL.GT.VIJ2)KL=1
17600 NL=NL+45
17700 C FOR NUMBERS ONLY SO FAR(THIS MAKES NL=-1. FOR NOTES, =9)
17800 162 NCNT(J,L)=KL
17900 IF(NL.GT.-22)GO TO 1462
18000 C JUMP RAND SELECTION
18100 PAR=V(IJ+KL+1)
18200 C********** MAY 13,71 RHY REPEAT FEATURE OMITTED.
18300 C************************
18400 IF(KN.NE.3)GO TO 1155
18500 C*******JULY 16,71 IF(PAR.EQ.101.)GO TO 5174
18600 IF(PAR.EQ.10000.)GO TO 5174
18700 PM=2.
18800 IF(PAR.GT.100.)GO TO 777
18900 IF(PAR.GE.1.)GO TO 877
19000 777 PM=3.
19100 877 IF(PAR.EQ.85.)MK=-1
19200 GO TO 5155
19300 65 W=-9900.-V(IJ-3)
19400 C W=BG TIME OF MOVE.
19500 X=ABS(V(IJ-1))
19600 IF(NL.EQ.-56)GO TO 977
19700 IF(NL.NE.-58)GO TO 771
19800 977 PM=2.
19900 771 Z=(BT-W)/VIJ2
20000 C Z= % OF WAY THROUGH.
20100 IF(Z.GT.1.)Z=1.
20200 Y=V(LN)
20300 W=V(IJ+3)
20400 IF(X.EQ.7.)W=V(IJ+4)
20500 IF(NL.LT.-58)GO TO 16002
20600 PAR=(W-Y)*Z+Y
20700 IF(X.EQ.7.)GO TO 1600
20800 GO TO 1155
20900 C************** JUNE 1,71
21000 C FOR "MOVX"
21100 C******** FEB/73
21200 C THE .01 IS NEEDED FOR MOVE TO OR FROM 0.
21300 16002 PAR=RMOVX(W,Y,Z)
21400 C SEE FUNCTION RMOVX 6/74 -- CAN'T HAVE -20→+20, ETC., -20→-40 OK.
21500 C THIS NEEDS WORK!
21600 IF(X.NE.7.)GO TO 1155
21700 W=V(IJ+5)
21800 Y=V(IJ+3)
21900 X=RMOVX(W,Y,Z)
22000 GO TO 16003
22100 C NEXT IS FOR MOVING RAND RANGES.
22200 C1600 PAR=(V(IJ+4)-Y)*Z+Y
22300 1600 W=V(IJ+3)
22400 C*********** BACK TO 65 IS NEW. FEB. 15,71
22500 X=(V(IJ+5)-W)*Z+W
22600 C************ JUNE 1,71
22700 16003 PAR=RAND(PAR,X)
22800 GO TO 1155
22900 67 LN=IJ+3
23000 NM=LN+VIJ2-1
23100 ML=1
23200 GO TO 1900
23300 4155 K=(PAR-9999.0)*100.+.1
23400 P(L)=P(K)
23500 IF(L.NE.2)GO TO 772
23600 IF(K.EQ.2)P2=PX2
23700 C PX2=LAST UNPROCESSED VALUE OF P2 (+ OR -) 7/74
23800 772 PM=PL(K)
23900 GO TO 21551
24000 C ANY # OVER 9999. REPEATS ANOTHER PARAM.(9999.21 REPEATS P21)
24100 C 7/74 **** NOTE PROBLEMS OF P2 WITH SUBR, TEMPO, TF AND RAND. TF.
24200 C ALSO DF. THE REAL TIME VALUE PRINTED MAY HAVE GONE THROUGH MANY
24300 C CHANGES. HENCE WHEN TRANSFERING THE VALUE TO OTHER PARAMS OR
24400 C INSTS GREAT CARE MUST BE TAKEN TO BE SURE THE RESULTS ARE CORRECT.
24500 6157 LN=V(LN-1)
24600 DO 1068 K=1,KL
24700 1068 IF(K.LT.KL)LN=LN+V(LN)+1
24800 2068 PM=LN+1
24900 PAR=LN+V(LN)
25000 GO TO 5155
25100 68 KL=NCNT(J,L)
25200 IF(KL.EQ.0)GO TO 774
25300 IF(KL.NE.10000)GO TO 773
25400 774 KL=VIJ2
25500 773 PM=KL+1
25600 PAR=PM+V(KL)-1
25700 KL=PAR+1
25800 IF(V(KL).EQ.10000.)DUR(J)=BT
25900 C 'END' OR 'FINE' IN 'LIT' LIST.
26000 IF(V(KL).EQ.999.)KL=IJ+2
26100 NCNT(J,L)=KL
26200 GO TO 5155
26300 C ******* JAN 20 *************
26400 1155 IF(PAR.EQ.10000.)GO TO 5174
26500 C TYPE 'END' OR 'FINE' AS LAST IN ANY STRING TO SET DURATION.
26600 IF(PAR.LE.9999.)GO TO 5155
26700 IF(PM.EQ.1.)GO TO 4155
26800 C****JULY 16,71 1155 IF((PAR.GT.9999.).AND.(PM.EQ.1.))GO TO 4155
26900 5155 P(L)=PAR
27000 21551 PL(L)=PM
27100 IF(ISUB)GO TO 601
27200 IF(L.EQ.2)GO TO 4203
27300 21552 IF(IDF.GE.0)GO TO 2155
27400 DF=PAR
27500 C DUTY FAC. IS ALWAYS % OF P2 - WHETHER CONSIDERING BASIC OR REAL TIME.
27600 IDF=0
27700 2155 CONTINUE
27800
27900 9203 IF(KB.EQ.0)GO TO 1170
28000 NL=KB
28100 DO 2203 K=1,KB
28200 X=OTH(NL,1)
28300 IF(X.LT.100000.)GO TO 2203
28400 L=X/100000.
28500 Y=(X-L*100000.)/100.
28600 IX=Y
28700 JC=NL
28800 IF(J.NE.L)GO TO 2203
28900 IF(IX.EQ.ICT)GO TO 5203
29000 2203 NL=NL-1
29100 GO TO 1170
29200 4203 PR=P2
29300 PX2=P2
29400 C TO SAVE THE UNPROCESSED P2 FOR 'P2 P2;' IN INPUT. 7/74
29500 IF(T5.EQ.0)GO TO 7203
29600 IF(IT3.LE.1)GO TO 6203
29700 IF(BT.LT.TBG+TDUR)GO TO 6203
29800 3155 IT3=IT3+3
29900 TBG=TBG+TDUR
30000 TDUR=V(IT3)
30100 IF(BT.GE.TBG+TDUR)GO TO 3155
30200 T1=V(IT3+1)
30300 T2=V(IT3+2)
30400 CALL SQYY(AC,T1,T2,TDUR)
30500 6203 RA=PR
30600 IF(BT.EQ.TBG)XT(J)=T1
30700 K=IT3
30800 RC=0
30900 RD=1
31000 KA=1
31100 RB=0
31200 Z=TDUR+TBG-BT
31300 X=T1
31400 Y=T2
31500 YY=AC
31600 CHN=TBG
31700 ZZ=TDUR
31800 CALL ACCEL
31900 8203 P2=RA*RD
32000 7203 P2=P2*T4
32100 X=P2*TF
32200 C P2 IS KEPT WITHOUT TF*
32300 K=X+.5
32400 IF(X)K=X-.5
32500 72031 ROFF(J)=ROFF(J)+K-X
32600 IF(ABS(ROFF(J)).LT.1.)GO TO 7155
32700 Y=1.
32800 IF(ROFF(J))Y=-1.
32900 K=K-Y
33000 ROFF(J)=ROFF(J)-Y
33100 C ROUND-OFF GAP WILL NOT EXCEED .001
33200 C*********** FEB 17,71
33300 7155 PP2=K/1000.
33400 C AVOIDS ROUND-OFF PROBLEMS
33500 C AFTER ALL THIS P2 IN SUBR MAY NOT EQUAL PP2(REAL TIME) DF COMES LATER!
33600 IF(IPT(J,31).EQ.0)GO TO 6155
33700 IF(ICT)GO TO 1170
33800 X=V(IPT(J,31)+2)/2.
33900 Y=RAND(-X,X)
34000 IF(PP2.GE.0)GO TO 615
34100 MK=-1
34200 PP2=-PP2
34300 615 PP2=PP2-RDEV(J)+Y
34400 RDEV(J)=Y
34500 C TOTAL RAND DEV. WON'T EXCEED P31
34600 C SET P31 TO .0001 TO BRING VOICE BACK TO EXACT TIME(0 WON'T DO IT)
34700
34800 K=PP2*1000.+.5
34900 C****** CHECK THIS OUT 1/10/72 :::::::
35000 61551 PP2=K/1000.
35100 C NEVER MORE THAN .1( DEVIATION WITH RAN TF. (RTF=.05)
35200 6155 IF(ICT)GO TO 9203
35300 GO TO 2155
35400 5203 JD=Y*100-IX*100+.5
35500 IF(JD.GT.0)GO TO 3203
35600 M=0
35700 P1(J)=PP1+PP2
35800 GO TO 7021
35900 3203 P(JD)=OTH(JC,2)
36000 X=OTH(JC,3)
36100 IF(X.NE.1.)X=3.
36200 C 'EDITS' PRINT,NUM. OR 5 CHARS.
36300 PL(JD)=X
36400 C NEXT ADDED NOV.72 CHECK FOR SIDE AFFECTS !!!!! **********
36500 IF(JD.EQ.2)PP2=P2
36600 C 'TF' AND 'TEMPO' WILL NOT AFFECT PP2 'EDITS'.
36700 1170 IF(MK)GO TO 2022
36800 IF(PP2)GO TO 2022
36900
37000 ZPAR=PP1
37100 P1(J)=PP1+PP2
37200 C ZPAR IS USED HERE WHEN OP1(OMIT) IS .GT.0. OMIT IS IN REAL TIME.
37300 LK=INST(J)
37400 2021 IF(PP1.LT.OP1)GO TO 2612
37500 IF(INVIS(J).LT.0)GO TO 2170
37600 C ALL PARAMS WILL PRINT,1ST TIME WHEN USING 'OMIT'.
37700 IF(INONLY.GT.0)GO TO 1204
37800 C*********** MAY 16,71 ↑↑↑
37900 6021 IF(P(NPA).NE.COPY(NPA))GO TO 5021
38000 IF(PL(NPA).GT.1)GO TO 5021
38100 C******* MAY 25,71
38200 C 'LIT' DATA WILL ALWAYS PRINT.
38300 NPA=NPA-1
38400 IF(NPA.GT.2)GO TO 6021
38500 5021 DO 1304 K=3,NPA
38600 1304 COPY(K)=P(K)
38700 1204 IF(PL4.NE.1.)GO TO 2170
38800 P4=P4*AMPFAC
38900 L=0
39000 INP(J)=P4
39100 DO 1021 K=1,NINS
39200 1021 IF(P1(K).GT.PP1)L=L+INP(K)
39300 IF(L-IAMP-1)GO TO 2170
39400 IAMP=L
39500 AMPTIM=PP1
39600 2170 IF(MX.EQ.3)GO TO 2612
39700 C ********* MAY 17,71
39800 PP1=PP1-OP1
39900 C PUTS SPACES BETWEEN NOTES .GT. .05( APART
40000 IF(MZ.NE.-1)GO TO 5170
40100 IF(A.GE.PP1)GO TO 5170
40200 IF(INONLY)WRITE(JOUT,902)
40300 A=PP1+.05
40400 5170 ML=10
40500 IF(NPA.LT.10)ML=NPA
40600 MLX=3
40700 NL=2
40800 IF(INVIS(J).EQ.0)GO TO 3170
40900 LK=0
41000 C NEEDED TO INIT INVISIBLE MODE PRINT-OUT (NO INST NAME, P1, P2)
41100 C NEXT CREATES FORMAT DATA IN IFM ARRAY.
41200 31701 KL=3
41300 GO TO 4170
41400 3170 IF(J.EQ.INONLY)GO TO 775
41500 IF(.NOT.INONLY)GO TO 2612
41600 775 VX(1)=PP1
41700 IF(DF.GT.0)GO TO 6170
41800 VX2=-DF
41900 IF(VX2.GT.PP2)VX2=PP2
42000 C NEG. DF=FIXED NOTE DUR. NOT.GT.PP2 7/74 COLGATE -AND BELOW
42100 GO TO 7170
42200 6170 IF(DF.LT.100)GO TO 8170
42300 C DF>100 = FIXED REST AREA BEFORE NEXT ATTACK.
42400 VX2=PP2-DF+100.
42500 IF(VX2.LE.0)VX2=PP2/2.
42600 C NO NEG. TIME VALUES ALLOWED.
42700 GO TO 7170
42800 8170 VX2=PP2*DF
42900 7170 IFM3='F9.3,'
43000 IFM4=IFM3
43100 KL=5
43200 IF(NPA.LT.3)GO TO 2121
43300
43400 4170 NL=2
43500 DO 1121 K=MLX,ML
43600 X=P(K)
43700 L=PL(K)
43800 IF(L-2)321,521,621
43900 C L=1 NUMBS, =2 NOTES,FUNCS, =3 LITS.
44000 321 IF(X.GE.0)GO TO 4211
44100 IFM(KL)=IFCOM
44200 NL=NL+1
44300 KL=KL+1
44400 4211 IFM(KL)='F9.3,'
44500 C CREATES 'F9.3'
44600 421 VX(KL-NL)=X
44700 GO TO 1121
44800 521 IFM(KL)=IFM2
44900 C CREATES '1XA5'
45000 LN=X
45100 VX(KL-NL)=SCAL(LN)
45200 GO TO 42
45300 621 IF(L.GT.3)GO TO 721
45400 VX(KL-NL)=X
45500 C ABOVE LETS A5 WD BE USED IN SUBR BY SETTING PL(N)=3.
45600 42 IFM(KL)=IFM2
45700 GO TO 1121
45800 721 LN=X
45900 IFM(KL)=I1X
46000 NL=NL+1
46100 DO 821 M=1,LN-L+1
46200 KL=KL+1
46300 IOUT(KL-NL)=IV(L-1+M)
46400 821 IFM(KL)=IA1
46500 1121 KL=KL+1
46600
46700 C NO MORE THAN 80 ITEMS IN FORMAT.
46800 2121 IF(KL.LE.80)GO TO 21211
46900 21212 FORMAT(' ERROR! TOO MANY LIT. ITEMS')
47000 TYPE 21212
47100 21211 DO 921 M=KL+1,80
47200 921 IFM(M)=IBLA
47300 IFM(KL)=')'
47400 L=KL-NL-1
47500 IF(MX)WRITE(1,IFM)LK,(VX(K),K=1,L)
47600 IF(.NOT.MZ)GO TO 30210
47700 IF(ML.GE.NPA)IFM(KL)='$)'
47800 WRITE(JOUT,IFM),LK,(VX(K),K=1,L)
47900 30210 IF(ML.GE.NPA)GO TO 3021
48000 MLX=ML+1
48100 ML=ML+10
48200 IF(ML.GT.NPA)ML=NPA
48300 LK=IBLA
48400 GO TO 31701
48500 3021 IF(MX)WRITE(1,3616)INST(J),ICT
48600 30211 IF(MZ)WRITE(JOUT,8902),J,INST(J),ICT,BT
48700 2612 PP1=ZPAR
48800 GO TO 21
48900 8902 FORMAT('+;<'I2,1XA5,I4,' >',F7.3)
49000 3616 FORMAT(';PRINT(P1);< ',A5,I4)
49100 C PRINTS RESTS
49200 2022 PP2=ABS(PP2)
49300 C IN THIS VERSION TYPE 'R' FOR RESTS IN ANY PARAM BUT P2.
49400 C FOR RESTS IN SEQS. TYPE -DUR.
49500 C WHEN RANDOM RESTS ARE CHOSEN, SEQS. MISS NOTES.
49600 C RAN RESTS ARE TOUCHED BY SUBROUTINES ONLY BY SETTING IREST!!
49700 INP(J)=0
49800 P1(J)=PP1+PP2
49900 C STORES NEXT P1 TIME FOR THIS INST.
50000 IF((MZ.NE.-1).OR.(PP1.LT.OP1))GO TO 21
50100 X=PP1-OP1
50200 IF(A.GE.X)GO TO 121
50300 WRITE(JOUT,902)
50400 A=X+.05
50500 121 IF(INONLY.OR.J.EQ.INONLY)WRITE(JOUT,1110),INST(J),X,PP2,
50600 1 J,INST(J),ICT
50700 21 PR=ABS(PR)
50800 BG(J)=BT+PR
50900 IF(ICT.EQ.DUR(J)-10000.)GO TO 5174
51000 IF(BG(J).LT.DUR(J))GO TO 500
51100 5174 BG(J)=19999.
51200 DO 3174 K=1,NINS
51300 C INSERTS CANT FOLLOW LAST REGULAR NOTE.
51400 C (ADD REST IF INSERT AT END IS NEEDED.)
51500 3174 IF(BG(K).LT.19999.)GO TO 500
51600 GO TO 175
51700 C CHOOSES INST WITH NEXT BEGIN TIME.
51800 500 J=1
51900 BW=BT
52000 NL=NINS+KB
52100 DO 22 K=2,NL
52200 22 IF(BG(J).GT.BG(K))J=K
52300 IF(J.GT.NINS.OR.NINS.EQ.1)GO TO 3022
52400 J=1
52500 DO 5022 K=2,NINS
52600 X=P1(J)
52700 Y=P1(K)+.0001
52800 C LOWEST NUMBERED INST WILL COME 1ST IF BG TIMES ARE VERY CLOSE
52900 IF(BG(J).EQ.19999.)X=19999.
53000 IF(BG(K).EQ.19999.)Y=19999.
53100 5022 IF(X.GT.Y)J=K
53200 C ABOVE IS FOR ROUND-OFF PROBLEMS WITH 'TEMPO' AND 'CONDUCT'.
53300 3022 BT=BG(J)
53400 IF((BT.EQ.19999.).OR.(P1(J).GE.DURX))GO TO 175
53500 IF(CNT(J).GT.0)GO TO 1022
53600 IF(CNT(J).EQ.0)P1(J)=0
53700 IF(CNT(J).EQ.-1)CNT(J)=0
53800 C N.B. 'TF' CONTROLS BG TIME WHEN BG .GT. 0
53900 1022 IF((BT.LT.T6).OR.(IT3.GT.1))GO TO 1108
54000 T4=T2
54100 T5=0
54200 T6=10000.
54300 GO TO 1108
54400 1175 FORMAT('+',A5,'=',F7.3,2X,$)
54500 1109 FORMAT(' FINISH; < ',A5,'.DAT')
54600 1110 FORMAT(' <',A5,2F9.3,2X,'******* REST <'I2,1XA5,I4)
54700 1603 FORMAT(' AMPL. FACTOR=',F4.2,', P4 MAX.AMP.=',I4,', AT TIME'
54800 1,F8.3)
54900 175 IF(MZ)WRITE(JOUT,1109),ISLAC
55000 IF(MX.GE.0)GO TO 4175
55100 WRITE(1,1109),ISLAC
55200 END FILE 1
55300 603 FORMAT(' TOTAL DURS: ',$)
55400 CC FOR COLGATE ONLY***4175 CALL ENDSUB
55500 C CLEARS CNTL O --- IF YOU HAVE HIT IT.
55600 4175 WRITE(JOUT,1603),AMPFAC,IAMP,AMPTIM
55700 WRITE(JOUT,603)
55800 5175 DO 2175 K=1,NINS
55900 X=P1(K)-OP1
56000 IF(MZ)GO TO 6175
56100 TYPE 1175,INST(K),X
56200 GO TO 2175
56300 6175 WRITE(JOUT,1175),INST(K),X
56400 2175 CONTINUE
56450 IF(JOUT.NE.22)GO TO 3175
56460 END FILE 22
56470 CALL PRINT
56480 REWIND 22
56490 K='FOR22'
56495 CALL OFILE(22,K)
56497 END FILE 22
56500 3175 TYPE 1023,ISLAC,IXIN
56600 CALL EXIT
56700 END