PROGRAM ASTOBI C C ASCII TO BINARY CONVERSION ROUTINE: C CONVERTS A ASCII FILE INTO BINARY FORM. C BYTE FILE(40), INPUT(768) INTEGER*2 OUTPUT(256) C C------- GET THE FILE NAME TO CONVERT AND OPEN IT ---------------------------- C WRITE (5,10) 10 FORMAT (' ASCII TO BINARY CONVERSION ROUTINE.'/) 20 WRITE (5,30) 30 FORMAT (' NAME OF ASCII FILE TO CONVERT TO BINARY: ',$) READ (5,40) N,FILE 40 FORMAT (Q,40A1) FILE(N+1) = 0 OPEN (UNIT=2,NAME=FILE,TYPE='OLD',FORM='FORMATTED', 1 ACCESS='SEQUENTIAL',CARRIAGECONTROL='LIST') C C------- GET THE DESTINATION FILE NAME AND OPEN IT --------------------------- C WRITE (5,50) 50 FORMAT (' NAME OF OUTPUT FILE FOR BINARY CODE: ',$) READ (5,60) N,FILE 60 FORMAT (Q,40A1) FILE(N+1) = 0 OPEN (UNIT=3,NAME=FILE,TYPE='NEW',FORM='UNFORMATTED', 1 ACCESS='DIRECT',RECORDSIZE=128) C C------- GENERATE INTERNAL TABLES TO SPEED CONVERSION ------------------------ C D WRITE (5,100) D100 FORMAT (' GENERATING INTERNAL TABLES. PLEASE WAIT A MOMENT.') C CALL TABLES C C------- PROCESS THE RECORDS ------------------------------------------------- C NREC = 1 200 CONTINUE C D WRITE (5,210) NREC D210 FORMAT (' READING RECORD 'I4) C READ (2,230,END=2000) INPUT 230 FORMAT (12(64A1/)) CALL UNPACK (INPUT,OUTPUT) C D WRITE (5,220) INPUT,OUTPUT D220 FORMAT (' INPUT:'/12(1X,64A1/)/,' OUTPUT:'/32(1X,8O9/)/) C WRITE (3'NREC,END=1000) OUTPUT NREC = NREC + 1 GO TO 200 C C------- FINISH UP ----------------------------------------------------------- C 1000 WRITE (5,1010) 1010 FORMAT (' RAN OUT OF ROOM IN THE OUTPUT FILE.') C 2000 CLOSE (UNIT=2) CLOSE (UNIT=3) END C******************************************************************* TABLES ** SUBROUTINE TABLES C COMMON /UNPACK/ TABLE1(256),TABLE2(256) BYTE TABLE1,TABLE2 C DO 100 I=0,255 MASK = 1 IP = "4 DO 10 J=1,8 IF ((MASK.AND.I) .NE. 0) IP = "4 - IP MASK = MASK * 2 10 CONTINUE TABLE1(I+1) = I/64 .OR. IP TABLE2(I+1) = TABLE1(I+1) * "10 100 CONTINUE C D WRITE (5,200) TABLE1,TABLE2 D200 FORMAT (' TABLE 1:'/16(1X,16O4/)/' TABLE 2:'/16(1X,16O4/)/) RETURN END C******************************************************************* PACK **** SUBROUTINE UNPACK (INPUT,OUTPUT) C C CONVERT THE ASCII DATA IN INPUT TO BINARY DATA IN OUTPUT C COMMON /UNPACK/ TABLE1(256), TABLE2(256) BYTE TABLE1, TABLE2 C BYTE INPUT(768), BYTE(2), II INTEGER*2 OUTPUT(256), WORD EQUIVALENCE (WORD,BYTE(1)) C N = 1 DO 100 I=1,256 II = INPUT(N+1)-"40 J = (INPUT(N)-"40).AND."77 .OR. ((II.AND."3)*"100) J = J.AND."377 K = (INPUT(N+2)-"40).AND."77 .OR. ((II.AND."30)*"10) K = K.AND."377 L = II.AND."44 M = TABLE1(J+1).OR.TABLE2(K+1) M = M.AND."44 IF (L.NE.M) WRITE (5,10) I,INPUT(N),INPUT(N+1),INPUT(N+2),J,K,L,M 10 FORMAT (' BAD DATA AT WORD 'I3' = '3O4' ('O6','O6'),P:'2O7) BYTE(1) = J BYTE(2) = K OUTPUT(I) = WORD N = N + 3 100 CONTINUE C RETURN END