C C CALL ASTAT(JSTAT) C C JSTAT=0 Buffer available C 1 Buffer not available C 2 Run stopped C 4 Run ended C SUBROUTINE ASTAT(JSTAT) COMMON /SYSTAT/IRUN,MTIN,MTER,IAB,ISTAT,IFIND,ICNT,IA DATA ISTAT/5/,ICNT/-10/ CALL KBYES JSTAT = ISTAT RETURN END C C CALL C2END C C This ends a run C SUBROUTINE C2END INTEGER*2 IA(1024) COMMON /SYSTAT/IRUN,MTIN,MTER,IAB,ISTAT,IFIND,ICNT,IA IF(ISTAT .GE. 4) RETURN ! Has run ended already ? ISTAT = 5 ! End run/ no buffers available ICNT = -10 ! No data in buffers CALL MSG('Run ended') ! And notify user END SUBROUTINE C2BEG INTEGER*2 IA(1024) COMMON /SYSTAT/IRUN,MTIN,MTER,IAB,ISTAT,IFIND,ICNT,IA IF(ISTAT .LT. 4) RETURN ! Has run already begun ? ISTAT = IAND(ISTAT,3) IF(IFIND .eq. 0) GO to 100 ! Do not search for first buffer ? CALL MSG('Searching for run number') ! Notify user of run number search 10 CALL KBYES IF(ISTAT .GE. 4) RETURN CALL MTGET(2,IA,2048,IERR,ICNT) IF(IERR .EQ. 1) go to 20 IF(IERR .NE. "366) go to 15 ! Not eof IEOF = IEOF + 1 IF(EOF .LE. 1) go to 10 ! Previous not EOF CALL MSG('END of tape') ! Tell user end of tape encountered CALL C2END ! And end the run RETURN 15 CALL MSG('ERROR on MT:') ! Notiffy user of mag tape error IEOF = 0 GO TO 10 20 IEOF = 0 ! Not EOF IF(IA(1) .ne. 'C2') Go to 10 MTIN = IA(2) ! Show run number IF(IRUN .EQ. -1) GO TO 30 ! Accept any run # ? IF(IA(2) .ne. IRUN) go to 10 ! Run number not found 30 IRUN = IA(2) ! Run number accepted ISTAT = 0 IAB = 0 MTER = 0 MTIN = 0 CALL RBTS ! Discard this buffer and get the next 100 CALL MSG('Run begin') ! Tell user run has begun END C C CALL RBTS C C Return Buffer To System C This subroutine discards the current buffer and gets the next C SUBROUTINE RBTS INTEGER*2 IA(1024) COMMON /SYSTAT/IRUN,MTIN,MTER,IAB,ISTAT,IFIND,ICNT,IA 10 CALL KBYES IF(ISTAT .GE. 4) RETURN ! Run currently ended ? CALL MTGET(2,IA,2048,IERR,ICNT) D CALL MSG('Get buffer') D WRITE(5,*) IERR,ICNT,(IA(j),J=1,10) MTIN = MTIN + 1 ! Increment number of input buffers IF(IERR .EQ. "366) GO TO 50 ! End of file ? IF(IERR .NE. 1) GO TO 60 ! Error ? IF(IA(1) .EQ. -1) GO TO 55 ! End of run ? IF(IA(1) .EQ. 'C2') GO to 55 ! Beginning of next run ? IAB = IAB + 1 ICNT = ICNT/2 - 4 RETURN ! Buffer is OK!! 50 CALL MSG('End-of-File encountered') 55 CALL C2END RETURN 60 CALL MSG('Error on MT:') MTER = MTER + 1 ! Increment mag tape errors GO TO 10 END C C CALL BTRAN(IB,ICHAN,ISIZE) C C IB = Array to recieve the data C ICHAN = Channel number to start transfer C ISIZE = Number of channels to transfer C SUBROUTINE BTRAN(IB,ICHAN,ISIZE) INTEGER*2 IA(1024) COMMON /SYSTAT/IRUN,MTIN,MTER,IAB,ISTAT,IFIND,ICNT,IA ISZ = ICNT - ICHAN IF(ISZ .GT. ISIZE) ISZ = ISIZE IF(ISZ .lt. 1) RETURN ! Bad channel number or size IF(ICHAN .LT. -4) RETURN ! Bad channel number ? CALL MOVEW(IA(ICHAN+5),IB,ISZ) ! Transfer the data END C C I = IBR(ICHAN) C C Read 1 channel of buffer C FUNCTION IBR(ICHAN) INTEGER*2 IA(1024) COMMON /SYSTAT/IRUN,MTIN,MTER,IAB,ISTAT,IFIND,ICNT,IA IBR = 0 IF(ICHAN .GE. ICNT) RETURN IF(ICHAN .LT. -4) RETURN IBR = IA(ICHAN+5) END SUBROUTINE C2RUN COMMON /SYSTAT/IRUN,MTIN,MTER,IAB,ISTAT,IFIND,ICNT,IA ISTAT = IAND(ISTAT,2) ! Mark run in progress CALL MSG('Run continued') END SUBROUTINE C2STP COMMON /SYSTAT/IRUN,MTIN,MTER,IAB,ISTAT,IFIND,ICNT,IA ISTAT = IOR(ISTAT,2) ! Mark run stopped CALL MSG('Run stopped') END SUBROUTINE FCNA END SUBROUTINE C2SET COMMON /SYSTAT/IRUN,MTIN,MTER,IAB,ISTAT,IFIND,ICNT,IA IFIND = -1 END SUBROUTINE SYSSET COMMON /SYSTAT/IRUN,MTIN,MTER,IAB,ISTAT,IFIND,ICNT,IA INTEGER*2 ISSW(8),IUSW(8),IDIR(4),JDIR(4) COMMON /SYSW/ISSW,IUSW,IDIR,JDIR CALL PSET(LERR,0,0,0,2,IRUN,1,'RUN#',8,0) CALL PSET(LERR,0,0,0,2,MTIN,3,'MT: MTERAB''S',0,0) CALL PSET(LERR,15,0,0,1,ISSW,16, 1 'SYS0REWDSYS2SYS3ZEROSYS5SYS6SYS7USW0USW1USW2USW3USW4USW5USW6USW7' 2 ,8,0) CALL PSET(LERR,15,1,0,1,IDIR,8, 1 'DI#0DI#1DI#2DI#3DI$0DI$1DI$2DI$3',8,0) END FUNCTION IUSSW(I) INTEGER*2 ISSW(8),IUSW(8) COMMON /SYSW/ISSW,IUSW IF(I .LT. 0 .OR. I .GT. 7) GO TO 20 ! I NO GOOD ? IUSSW = IUSW(I+1) RETURN 20 IUSSW = 0 RETURN END FUNCTION ISYSW(I) INTEGER*2 ISSW(8),IUSW(8) COMMON /SYSW/ISSW,IUSW IF(I .LT. 0 .OR. I .GT. 7) GO TO 20 ! I NO GOOD ? ISYSW = IUSW(I+1) RETURN 20 ISYSW = 0 RETURN END SUBROUTINE FLUSH COMMON /SYSTAT/IRUN,MTIN,MTER,IAB,ISTAT,IFIND,ICNT,IA INTEGER*2 ISSW(8),IUSW(8) COMMON /SYSW/ISSW,IUSW IF(ISSW(2) .EQ. 0) RETURN CALL MTSPB(2,-MTIN-4,IERR) ! Backspace to beginning of run END SUBROUTINE LITON END SUBROUTINE LITOF END FUNCTION LDINT(I) INTEGER*2 ISSW(8),IUSW(8),IDIR(4),JDIR(4) COMMON /SYSW/ISSW,IUSW,IDIR,JDIR DATA JDIR/4*-1/ DATA IDIR/4*100/ LDINT = 0 IF(I .LT. 0 .OR. I .GT. 3) RETURN IF(JDIR(I+1) .LT. 0) GO TO 20 JDIR(I+1) = JDIR(I+1) - 1 RETURN 20 LDINT = -1 END SUBROUTINE RESET(I) INTEGER*2 ISSW(8),IUSW(8),IDIR(4),JDIR(4) COMMON /SYSW/ISSW,IUSW,IDIR,JDIR IF(I .LT. 0 .OR. I .GT. 3) RETURN JDIR(I + 1) = IDIR(I + 1) END SUBROUTINE DISET END SUBROUTINE ECAM END SUBROUTINE C1SET END SUBROUTINE HIVOLT END SUBROUTINE BRI(ICHAN,ISTAT) C C CALL BRI(ICHAN,ISTAT) C C ICHAN = data type required (0-255) C = -1 any data is OK C ISTAT = Current run status C BYTE IDATE(20) COMMON /IDISP/IB1,IB2,IDATE,IB 10 CALL ASTAT(ISTAT) IF(ISTAT .GE. 5) RETURN IF(IAND(ISTAT,3) .NE. 0) GO TO 10 ! No buffer available ? I = IBR(-4) ! Get buffer type IF(I .NE. -4) GO TO 50 ! Not cumulative scaler buffer ? C C Handle cumulative scaler buffers C ISIZ = IB1 + 10 ! Number of words to transfer CALL BTRAN(IDATE,3,ISIZ) ! Transfer the cumulative scaler GO TO 100 50 IF(ICHAN .LT. 0) return ! Any input buffer is ok ? IF(IAND("377,I) .eq. ICHAN) RETURN ! Is it type selected ? 100 CALL RBTS ! Next input buffer GO TO 10 END