C C ****** PYTAPE.FTN ****** C C C C C PYTAPE reads a TU58 tape cartridge (produced by PYRO) and C copies the data to a disc file. The file may then be read C with a FORTRAN unformatted read. C C C C C TU58 DATA LAYOUT: C C BLOCK 0 (CREATED BY THIS PROGRAM) C C WD 0 = TAPE SEQUENCE NUMBER (0-32768) C WD 1 = INTEGRATION INTERVAL (SECS) C WD 2 = A/D RANGE +$- MV. C BY 6-12. = PROCESS NAME (10 CHARS) C C BLOCKS 1-511. C C WD 0 =DATE 15 8 4 0 C ------------- C ! Y ! M ! D ! C ------------- C C WD 1 = TIME 15 12 5 0 C ------------- C ! ! H ! M ! C ------------- C C WD 2 = ADDR LAST BLK 15 0 C ------------- C ! ! C ------------- C C WD 3-511. = DATA 15 14 0 15 14 11 0 C ------------- -------------- C !F1! #INCS ! !F2! CH! VAL ! C ------------- -------------- C Where: C F1 = 1 C F2 = 0 C #INCS = # 10 sec increments (keeps incrementing until overflow) C CH = Channel number C VAL = Raw channel word. C C C C C REAL*8 OUTB(8),IBL LOGICAL TU58,NEWF BYTE NAME(20),IMODE,INF(20) INTEGER IN(256),CHAN(8),MCR(2),PNME(5) DATA IBL/8H / DATA IZ,IB/0,"40/ DATA MCR/3RMCR,3R.../ 21 PRINT 300 300 FORMAT('$Initialize or Read tape (I/R) ?') ACCEPT 210,IMODE IF(IMODE.EQ.'R'.OR.IMODE.EQ.'r')GOTO 9 IF(IMODE.NE.'I'.AND.IMODE.NE.'i')GOTO 21 PRINT 301 301 FORMAT('$Enter Tape Sequence Number (0-32768) ->') ACCEPT 302,ISEQ 302 FORMAT(I5) PRINT 303 303 FORMAT('$Enter Integration Time (secs) ->') ACCEPT 302,IINT PRINT 306 306 FORMAT('$Enter A/D range setting +&-(mv) ->') ACCEPT 302,IRANG PRINT 304 304 FORMAT('$Enter Process name (10 chars) ->') ACCEPT 305,PNME 305 FORMAT(5A2) IN(1)=ISEQ IN(2)=IINT IN(3)=IRANG DO 14 I=1,5 14 IN(I+3)=PNME(I) CALL TU58IO('W',1,IN,0,0,IER) IF(IER.EQ.0)STOP GOTO 30 9 PRINT 160 160 FORMAT('$Reading from TAPE or FILE (T/F) ?') ACCEPT 210,JT IF(JT.EQ.'T'.OR.JT.EQ.'t')GOTO 23 IF(JT.NE.'F'.AND.JT.NE.'f')GOTO 9 TU58=.FALSE. PRINT 162 162 FORMAT('$Enter name of input file ->') ACCEPT 200,INF INF(20)=0 OPEN(UNIT=1,NAME=INF,FORM='UNFORMATTED',TYPE='OLD',READONLY) GOTO 24 23 TU58=.TRUE. 24 PRINT 100 100 FORMAT('$Enter output filename ->') ACCEPT 200,NAME 200 FORMAT(20A1) NAME(20)=0 25 PRINT 163,NAME 163 FORMAT('$Is ',20A1,' a NEW file ?') ACCEPT 210,JT IF(JT.EQ.'Y'.OR.JT.EQ.'y')GOTO 26 IF(JT.NE.'N'.AND.JT.NE.'n')GOTO 25 NEWF=.FALSE. PRINT 164,NAME 164 FORMAT('0DATA WILL BE APPENDED TO ',20A1) OPEN(UNIT=2,NAME=NAME,FORM='UNFORMATTED',TYPE='OLD', 1 RECORDSIZE=5,ACCESS='APPEND') GOTO 28 26 NEWF=.TRUE. OPEN(UNIT=2,NAME=NAME,FORM='UNFORMATTED',RECORDSIZE=5) 28 IF(TU58)GOTO 32 READ(1)IN GOTO 34 32 PRINT 135 135 FORMAT(' ****** Rewinding tape ******') C C Read header block zero C CALL TU58IO('R',1,IN,0,0,IER) IF(IER.NE.0)GOTO 30 34 IF(NEWF)WRITE(2)IN ISEQ=IN(1) IINT=IN(2) DO 15 I=1,5 15 PNME(I)=IN(I+3) C PRINT 110 110 FORMAT('$Do you want data displayed (Y/N) ?') ACCEPT 210,IANS 210 FORMAT(A1) IF(IANS.EQ.'y')IANS='Y' IF(IANS.NE.'Y')GOTO 11 ISTART=1 IEND=512 PRINT 111 111 FORMAT('$Display all blocks (Y/N) ?') ACCEPT 210,IDP IF(IDP.NE.'N'.AND.IDP.NE.'n')GOTO 13 PRINT 112 112 FORMAT('$Enter start,end blocks (sss,eee) ->') ACCEPT *,ISTART,IEND 13 PRINT 150 150 FORMAT('$Display to screen or printer (S/P) ?') ACCEPT 210,IDEV IF(IDEV.NE.'P'.AND.IDEV.NE.'p')GOTO 12 OPEN(UNIT=3,NAME='PYRO.LST') GOTO 11 12 IF(IDEV.NE.'S'.AND.IDEV.NE.'s')GOTO 13 OPEN(UNIT=3,NAME='TI:') 11 DO 10 I=1,513 LBN=I IF(TU58)GOTO 38 READ(1,END=40)IN GOTO 42 38 CALL TU58IO('R',1,IN,0,LBN,IER) 42 IF(IER.NE.0)GOTO 30 IF(IN(3).EQ.0)GOTO 40 WRITE(2)IN IF(IANS.NE.'Y')GOTO 10 IF(LBN.LT.ISTART.OR.LBN.GT.IEND)GOTO 10 C C EXTRACT DATE AND TIME C IDAY=IAND("37,IN(1)) II=IAND("740,IN(1)) IMNTH=ISHFT(II,-5) II=IAND("177000,IN(1)) IYR=ISHFT(II,-9) IMIN=IAND("77,IN(2)) II=IAND("17700,IN(2)) IHR=ISHFT(II,-6) WRITE(3,130)PNME,IDAY,IMNTH,IYR,IHR,IMIN,ISEQ,IINT,LBN 130 FORMAT('1',5A2,2(I2,'/'),I2,2X,I2,':',I2,'***TAPE',I5, 1 '***INTEG',I5,'secs','***DATA*IN*MILLI-VOLTS*(X10)'/ 2 ' BLOCK',I4) WRITE(3,129) 129 FORMAT(9X,' CH0 CH1 CH2 CH3 CH4 CH5', 1 ' CH6 CH7') C C EXTRACT CHANNEL DATA C 6 LWD=IN(3)+1 J=4 1 ITIC=IAND("77777,IN(J)) DO 2 K=1,8 2 CHAN(K)=-1 DO 3 K=1,8 J=J+1 IF(J.GT.LWD)GOTO 4 IF(IN(J).LT.0)GOTO 4 IC=IAND("170000,IN(J)) IC=ISHFT(IC,-12) IC=IC+1 3 CHAN(IC)=IAND("7777,IN(J)) J=J+1 4 DO 5 L=1,8 IF(CHAN(L).GT.0)GOTO 8 OUTB(L)=IBL GOTO 5 8 X=CHAN(L) X=(X-2048.)*0.1221 X=X*10. ICHAN=X ENCODE(8,500,OUTB(L))ICHAN 500 FORMAT(I8) 5 CONTINUE WRITE(3,120)ITIC,OUTB 120 FORMAT(1X,I8,8A8) 7 IF(J.LE.LWD)GOTO 1 10 CONTINUE I=I-1 GOTO 40 30 PRINT 205,IER 205 FORMAT('0TU58 I/O ERROR ',I4) STOP 40 IF(TU58)CALL TU58IO('R',1,IN,0,0,IER) PRINT 230,I-1 230 FORMAT('0',I4,' Blocks read') IF(IDEV.EQ.'S')GOTO 50 IF(IDEV.NE.'P')GOTO 50 CLOSE(UNIT=3) CALL SPAWN(MCR,,,1,,,,'PRI =PYRO.LST/DE',18) 50 CLOSE(UNIT=2) STOP END