C DSKZAP.FTN 29-MAR-82 K.BETHE C C PROGRAM TO ZAP PHYSICAL BLOCKS ON THE SPECIFIED DISK C OR WRITE A PHYSICAL BLOCK FROM AN INPUT DISK TO C AN OUTPUT DISK C (PRIVILEDGED PROGRAM CAN DO IT ON EITHER F11 OR C FOREIGN MOUNTED DISKS) C C DESCRIPTION C ASKS FOR DISK BLOCK NUMBER (DECIMAL) C PRINTS ALL NON ZERO LINES ON TI: C PROMPTS FOR CHANGES IN OCTAL (1 TERMINATES) C INTEGER BUFF,ICOL(8),YES,IUNIT,OUNIT,ILUN,OLUN INTEGER*4 BLKNUM BYTE OUDEV(2),INDEV(2),COLON COMMON LUN,BLKNUM,BUFF(256) DATA ICOL/0,2,4,6,10,12,14,16/,YES/'Y'/,COLON/':'/ DATA ILUN/1/,OLUN/2/ C C GET OUTPUT DISK NAME AND ASSIGN IT TO LUN 2 (OLUN) C 5 WRITE(5,1) 1 FORMAT('$ ENTER OUTPUT DISK NAME (DDUU)> ') READ(5,2,END=100) OUDEV,OUNIT 2 FORMAT(2A1,O2) IO=1 IF(OUNIT.GE.8) IO=2 I=IO D WRITE(5,802) OUDEV,OUNIT,IO D802 FORMAT(' DISK DEVICE IS ',2A1,O3,' DIGITS =',I3) CALL ASNLUN(OLUN,OUDEV,OUNIT,K) IF(K.EQ.1) GOTO 4 WRITE(5,99) OUDEV,OUNIT GOTO 5 C C GET INPUT DISK NAME AND ASSIGN IT TO LUN 1 C 4 WRITE(5,3) 3 FORMAT('$ ENTER INPUT DISK NAME (DDUU)> ') READ(5,2,END=100) INDEV,IUNIT II=1 IF(IUNIT.GE.8) II=2 I=II D WRITE(5,802) INDEV,IUNIT,II CALL ASNLUN(ILUN,INDEV,IUNIT,K) IF(K.EQ.1) GOTO 10 WRITE(5,99) INDEV,IUNIT 99 FORMAT(1X,2A1,O,': IS NOT MOUNTED OR IS AN INVALID DEVICE NAME') GOTO 4 C C GET BLOCK # ON INPUT DISK C 10 I=II WRITE(5,11) INDEV,IUNIT 11 FORMAT('$ENTER BLOCK NUMBER ON ',2A1,O,'> ') READ(5,17) BLKNUM 17 FORMAT(I10) LUN=ILUN C F11RE WILL READ BLOCK # "BLKNUM" FROM LUN "LUN" INTO BUFF CALL F11RE C C PRINT THE BLOCK IN QUESTION C 20 CALL ASKFRM(IT) 69 WRITE(5,13) ICOL 13 FORMAT('1','OFFSET ',8I7,/,64('_')) DO 15 I=1,256,8 LINE=(I-1)*2 M=I+7 ISUM=0 DO 16 K=I,M 16 ISUM=ISUM+BUFF(K) IF(ISUM.EQ.0) GOTO 15 GO TO (71,72,73),IT 71 WRITE(5,21) LINE,(BUFF(K),K=I,M) 21 FORMAT(1X,O5,' |',8(5X,A2)) GOTO 15 72 WRITE(5,22) LINE,(BUFF(K),K=I,M) 22 FORMAT(1X,O5,' |',8O7) GOTO 15 73 WRITE(5,23) LINE,(BUFF(K),K=I,M) 23 FORMAT(1X,O5,' |',8I7) 15 CONTINUE C C ACCEPT CHANGES FOR BLOCK C WRITE(5,27) 27 FORMAT('$DO YOU WISH TO MAKE CHANGES (Y/N)? > ') READ (5,30) N 30 FORMAT(A2) IF(N.NE.YES) GOTO 50 CALL ASKFRM(IT) WRITE(5,31) 31 FORMAT(' TO CHANGE A WORD, ENTER THE OCTAL OFFSET AND THE NEW'/ + 'VALUE SEPARATED BY A COMMA; WHEN FINISHED, TYPE A 1.') C C 35 WRITE(5,36) 36 FORMAT('$-> ') GOTO (81,82,83),IT 81 READ(5,37) M,N 37 FORMAT(O5,A2) GOTO 85 82 READ(5,38) M,N 38 FORMAT(O5,O6) GOTO 85 83 READ(5,39) M,N 39 FORMAT(O5,I6) 85 IF(MOD(M,2).NE.0) GOTO 40 M=(M+2)/2 BUFF(M)=N GOTO 35 C C ASK IF CHANGED BLOCK SHOULD BE PRINTED OUT C 40 WRITE(5,41) 41 FORMAT('$ DO YOU WANT TO SEE THE CHANGED BLOCK (Y/N) ? ') READ(5,30) N IF(N.EQ.YES) GOTO 20 C C INQUIRE IF BLOCK SHOULD BE WRITTEN OUT C 50 WRITE(5,51) OUDEV,OUNIT 51 FORMAT('$ ARE YOU SURE YOU WANT TO WRITE THIS BLOCK', + ' TO ',2A1,O,' (Y/N) ? ') READ(5,30) N IF(N.NE.YES) GOTO 60 C C GET THE OUTPUT DISK BLOCK NUMBER TO WRITE TO C I=IO WRITE(5,11) OUDEV,OUNIT READ(5,17) BLKNUM LUN=OLUN C AND WRITE TO IT CALL F11WR C C ASK FOR MORE WORK C 60 WRITE(5,61) 61 FORMAT('$ DO ANOTHER BLOCK (Y/N) ? ') READ(5,30) N IF(N.EQ.YES) GOTO 10 100 CALL EXIT END SUBROUTINE ASKFRM(IT) BYTE TYPE(3),FRM DATA TYPE/'A','O','D'/ CC WRITE(5,66) 66 FORMAT('$ENTER DESIRED FORMAT (OCTAL=0,ASCII=A,DECIMAL=D)> ') READ(5,67) FRM 67 FORMAT(1A1) DO 68 IT=1,3 IF(TYPE(IT).EQ.FRM) GOTO 69 68 CONTINUE IT=3 69 RETURN END D SUBROUTINE F11RE D INTEGER LUN,BUFF(256) D INTEGER*4 BLKNUM D COMMON LUN,BLKNUM,BUFF D DO 15 I=1,15 D15 BUFF(I)=I+60 D WRITE(5,20) BLKNUM,LUN D20 FORMAT(' READING BLOCK ',I9,' FROM LUN ',I2) D RETURN D END D SUBROUTINE F11WR D INTEGER LUN,BUFF(256) D INTEGER*4 BLKNUM D COMMON LUN,BLKNUM,BUFF D WRITE(5,20) BLKNUM,LUN D20 FORMAT(' WRITING BLOCK ',I9,' TO LUN ',I2) D RETURN D END