SUBROUTINE TAPER
C			FILE: ADTAPE:SAMTAP.FT
	COMMON NDEV,ND2,NAME,NBLK,NMAX,NLEN
	COMMON NEW,NSAM,NDIS,NADC,NADCS
	COMMON NSPB,NCAL,JC,IC,JB,IB
	COMMON NBI,NII,NBF,NIF
	DIMENSION NAME(4),NADCS(8)
C
	DIMENSION MBLKR(2),MBLKS(15)
	EQUIVALENCE(MBLKR(2),MBLKS(1))
C	MBLKS(0:15)
SOPDEF JMPI	5400
SOPDEF DCAI	3400
C
SOPDEF CLLR	6132
SOPDEF CLAB	6133
SOPDEF CLEN	6134
SOPDEF CLSA	6135
C
SOPDEF LINC	6141
SABSYM SAM	0100
SABSYM PDP	0002
C
C	TAPER STARTS WRITEING AT NLEN
C	TAPER SETS RELAY 1 WHEN TAPE BUFFERS OVERFILL
C	TAPEC ALSO SETS RELAY 1 WHEN CALIBRATING
C
	DO 7 MBLK=0,15
7	MBLKS(MBLK)=0
	MBLK=0
	NBI=NLEN
	NII=1
	I=0
C	CALL STSAM
SJMS STSAM
C
10	DO 14 IBLK=0,15
	GOTO 111
11	CONTINUE
SIAC
SCPAGE 3
SLINC
S0014	/ATR: SET RELAY 1
SPDP
SCLA
111	CONTINUE
C	CALL DTAPE
SJMS DTAPE
	IF(MBLKS(IBLK))11,12,11
12	CONTINUE
SCPAGE 3
SLINC
S0014	/ATR: CLEAR RELAY 1
SPDP
C
	DO 13 I=0,248,NADC
CK	UNTIL(CLSA<0)[CALL DTAPE]
SCK, JMS DTAPE
SCLSA
SSMA CLA
SJMP CK
C	IWP=AC=256*IBLK+I
STAD \IBLK
SCPAGE 3
SLINC
S0250	/ROL 8
SPDP
STAD \I
C	CALL SAMPL
SJMS SAMPL
C	IF(XL1 IS HIGH)EXIT 17
SCPAGE 4
SLINC
S0401	/SXL 1
S0017	/COM (AC=-1)
SPDP
SSNA CLA
SJMP \17	/BUTTON UP(AC=0)
C
C	IF(KRB=375)EXIT 17
S6031	/KSF
SJMP \13	/IF(NO KEY)GOTO 13
S6036	/KRB
STAD (-375
SSNA CLA
SJMP \17	/AC=0: 'ALTMODE' TYPED
13	CONTINUE
	MBLKS(IBLK)=1
C	CALL DTAPE
SJMS DTAPE
14	CONTINUE
	GOTO 10
C
17	CONTINUE
C	CALL SFILL
SJMS SFILL
	I=I+NADC
	MBLKS(IBLK)=1
SJMS CTAPE
	NIF=I
	NBF=NLEN-1
	RETURN
C
C======================
C
C	SUBROUTINE SETU
C
SENTRY SETU
SSETU,BLOCK 2
	CONTINUE
STAD \NDEV
SAND (1
SCLL RTL
SRAL
STAD (706
SDCA TWRI
	CONTINUE
C	NDEV='LTA0' + NDEV
	NDEV=LAND(1,NDEV)-1148
	ND2=0
	NLEN=0
	NEW=-1408
	NBLK=LFILE(NDEV,NAME,NMAX)
	NBLK=MFILE(NDEV,NAME,NMAX)
	CALL CFILE(0)
	CONTINUE
	CALL RNAME
C
C===========================
C
C	INTERNAL CTAPE (CLEAR BUFFER)
30	CONTINUE
SCPAGE 2
SJMPI CTAPE
SCTAPE, 0
32	CALL DISP9(-200,100,'TAPE')
	CALL DFILE
	IF(NLEN-NMAX)36,34,34
34	I=NSPB
36	CONTINUE
C	CALL DTAPE	(CLEAR BUFFER)
SJMS DTAPE
	IF(MBLKS(MBLK))32,30,32
C
C=====================================
C
C	INTERNAL DTAPE (DUMP TO TAPE)
40	CONTINUE
SCPAGE 2
SJMPI DTAPE
SDTAPE,	0
41	IF(MBLKS(MBLK))45,40,42
42	MBLKS(MBLK)=-1
	IF(NLEN-NMAX)43,49,49
43	CONTINUE
C	TA=2*(NBLK+NLEN)
STAD \NBLK
STAD \NLEN
SCLL RAL
SDCA TA
44	CONTINUE
STAD \MBLK
SCPAGE 6
SLINC
S0270	/ROL I 8:MBLK*356 (+128)
S0023	/TMA: SET MEMORY ADDRESS
STWRI,0706	/WRI 1 BLK ON SELECTED UNIT
STA,0	/TAPE ADDRESS (BLOCK)
SPDP
SCLA
	GOTO 40
45	CONTINUE
SCPAGE 4
SLINC
S0416	/STD: SKIP IF TAPE DONE
S0017	/COM:AC=-1
SPDP	/AC=0 IFF TAPE DONE
SSZA CLA
SJMP \40	/TAPE NOT DONE
C
SINC TA
STAD TA		/CHECK FOR SECOND PAGE DONE
SRAR		/BIT 11 TO LINK
SSZL CLA
SJMP \44	/WITH LINK SET
48	NLEN=NLEN+1
49	MBLKS(MBLK)=0
C	MBLK=IREM((MBLK+1)/16)
STAD \MBLK
SIAC
SAND (17
SDCA \MBLK
	GOTO 41
C
C=======================
C
C	SUBROUTINE TAPEC
C
SENTRY TAPEC
STAPEC,	BLOCK 2
50	CONTINUE
	CALL RELAY(1,1)
	J=0
	MBLKR=NADC*4
	DO 55 I=0,248,MBLKR
	J=J+1
	IF(J-NCAL)502,502,57
C
502	CONTINUE
	CALL DISP9(10,192,'SS1:')
	IF(LSENS(1))502,502,51
C
51	CONTINUE
	CALL DISP9(10,192,'CAL:')
	CALL DISP9(30,192,ENCODE(J))
	IF(LSENS(2))50,50,512
512	CONTINUE
C	IF(KRB=375)EXIT 57
SKSF
SSKP
SKRB
STAD (-375	/ A CONTROL-Z
SSNA CLA
SJMP \57
	CONTINUE
	IF(LSENS(1))52,52,51
C
52	CONTINUE
C	CALL STSAM
SJMS STSAM
	DO 53 MBLK=0,3
	IS=I+MBLK*NADC
CCKA	UNTIL(CLSA<0)GOTO CKA
SCKA, CLSA
SSMA CLA
SJMP CKA
STAD \IS
C	CALL SAMPL
SJMS SAMPL
53	CONTINUE
55	CONTINUE
C
57	CONTINUE
C	CALL SFILL
SJMS SFILL
	MBLK=0
C	MBLKR>0
	MBLKS=0
SJMS CTAPE
	CALL RELAY(1,0)
SRETRN	TAPEC
C
C==============================
C
C	INTERNAL SUBROUTINE STSAM
C
60	CONTINUE
S4045
SCLA
SJMPI STSAM
SSTSAM, 0
C
	CONTINUE
	NADC1=NADC+1
	DO 63 IS=1,NADC1
	JS=NADCS(IS)
C	SMPL(4*IS)=JS+'SAM'

STAD \IS
SCLL RAL
SCLL RAL
STAD SMPLA	/CDF CURRENT !
SDCA DSAM
STAD \JS
STAD (100		/+ 'SAM'
SCPAGE 3
SDCAI DSAM
SSKP
SDSAM, 0
63	CONTINUE
C	SMPL(4*NADC1)='JMP LSAM'
STAD DSAM
SDCA DJMP
STAD SAMA
SAND (1777
STAD (6000
SCPAGE 3
SDCAI DJMP
SSKP
SDJMP, 0
C
C
C	SETUP TAPE OPERATIONS & FAST SAMPLE
SCPAGE 10
SLINC
S1020		/LDA I;
S4030		/DF=4,XADD,NO PAUSE
S0001		/AXO: AC => XOB
S1020		/LDA I;
S0100		/FAST SAMPLE MODE
S0004		/ESF:
SPDP
SCLA
STAD \NSAM
C
C	INTERNAL SUBROUTINE STIME(AC=COUNT)
C
SDCA \IS		/IS=COUNT
SCLLR		/MODE 0
SCLEN		/DISABLE ALL
STAD \IS
SCIA
SCLAB		/COUNT=-NSAM
SCLA
STAD (100	/RESET MODE + CLR COUNTER
SCLLR
SCLSA		/CLEAR STATUS + OVFL
SCLA
STAD (200	/MOVE COUNT
SCLEN		/TO COUNTER
SCLA
STAD (4100	/RATE & MODE
SCLLR		/ENABLE
SCLA
	GOTO 60
C
SPAGE
C==============================
C
C	SUBROUTINE SAMPL(AC=IWP)
C
SIWP, 0
SSAMA,	LSAM
SSMPLA,	SMPL
SSTC, 0		/INTERNAL STC
SDCAI IWP
SISZ IWP
SJMPI STC
SJMPI STC
C
SSAMPL,	BLOCK 1
SSMPL,	DCA IWP
S6241
SLINC
S0006		/DJR
SSAM		/START ADC
SPDP
SNOP
SLINC
SSAM		/AC = FIRST ADC
SPDP
SJMS STC
SLINC
SSAM
SPDP
SJMS STC
SLINC
SSAM
SPDP
SJMS STC
SLINC
SSAM
SPDP
SJMS STC
SLINC
SSAM
SPDP
SJMS STC
SLINC
SSAM
SPDP
SJMS STC
SLINC
SSAM
SPDP
SJMS STC
SLINC
SSAM		/SMPL(9) & JMP LSAM
SLSAM,SAM	/AC=LAST ADC
SPDP
SJMS STC
S4045		/CDF CURRENT + SKIP
SJMPI SAMPL
SJMPI SAMPL
C
C==============================
C
C	SUBROUTINE SFILL
SSFILL,	BLOCK 1
S6241
SSFIL,	TAD IWP
SAND (377
SSNA CLA
S4045
SSKP
SJMPI SFILL
STAD (5000
SJMS STC
SJMP SFIL
	END