C BP8008.FOR C C -- MPS BINARY FORMAT CONVERSION ROUTINE. C C -- THE PROGRAM WILL ASK FOR INPUTS C -- AND OUTPUTS. C LOGICAL*1 MSK,ONE,ZERO,LDR,ICS,IBC LOGICAL*1 LLA,HLA,BUFF(64),BLOCK(71) DATA MSK/"377/ DATA ONE/"001/ DATA ZERO/"000/ DATA LDR/"200/ C C -- ASK FOR INPUT FILE C 1 WRITE(5,91) 91 FORMAT(//,'$INPUT ') CALL ASSIGN(1,'AS8008.BIN',-10,'OLD') C C -- ASK FOR OUTPUT FILE C WRITE(5,92) 92 FORMAT('$OUTPUT ') CALL ASSIGN(2,'BP8008.BIN',-10,'NEW') C C -- PUNCH LEADER C DO 10 I=1,71 10 BLOCK(I)=LDR WRITE(2,99)(BLOCK(M),M=1,71) C C -- PUNCH NEXT BLOCK C 15 IBC=6 ICS=0 K=1 20 READ(1,END=200)IS,IVAL 40 IF(IBC.NE.6) GOTO 25 HLA=IS/256 LLA=IS-HLA*256 JIS=IS LIS=IS 25 IF(IS.GT.JIS+63) GOTO 30 IF(IS.NE.LIS)GO TO 30 IBC=IBC+1 JBC=IBC-6 BUFF(JBC)=IVAL ICS=ICS+IVAL LIS=IS+1 GO TO 20 30 BLOCK(1)=ONE BLOCK(2)=ZERO BLOCK(3)=IBC BLOCK(4)=ZERO BLOCK(5)=LLA BLOCK(6)=HLA GO TO (42,42,44), K 42 DO 35 I=1,JBC 35 BLOCK(I+6)=BUFF(I) 44 ICS=ICS+LLA+HLA+IBC ICS=ICS.XOR.MSK BLOCK(JBC+7)=ICS WRITE(2,99)(BLOCK(M),M=1,JBC+7) 99 FORMAT(71A1) IBC=6 ICS=0 GO TO (40,205,210), K 200 K=2 GO TO 30 C C -- WRITE END BLOCK C 205 LLA=0 HLA=0 JBC=0 K=3 GOTO 30 210 DO 215 I=1,71 215 BLOCK(I)=LDR WRITE(2,99)(BLOCK(M),M=1,71) CALL CLOSE(2) CALL CLOSE(1) GO TO 1 END