PROGRAM MODHOM
C
	LOGICAL*1 VOLNAM(12),IBYTE(512),ITEMP(12),IOS(4),YN
	INTEGER*4 NBL,ITOT
	EQUIVALENCE (NBL,IPARAM(5)),(IOS(1),IOSB(1)),(ITO(1),ITOT)
	EQUIVALENCE (VOLNAM(1),IBUF(8)),(IBUF(1),IBYTE(1))
	DIMENSION IBUF(256),IPARAM(6),IOSB(2),ITO(2)
C
	WRITE(5,1)
1	FORMAT(//' *** THE PURPOSE OF THIS PROGRAM IS TO MODIFY VOLUME
     $ LABELS ***'/)
	WRITE(5,2)
2	FORMAT(/' *** LOGICAL UNIT NUMBER #1 IS USED FOR LOGICAL READ
     $/WRITE ON DM1:'/' *** IF YOU WANT TO CHANGE THIS, YOU HAVE TO
     $ INSTALL "MODHOM" FIRST'/' *** AND THEN PERFORM A REASSIGNMENT.
     $ [E.G. REA MODHOM 1 DM0:]'//'$*** CONTINUE? [Y/N]: ')
	READ(5,3) YN
3	FORMAT(A1)
	IF(YN.NE.'Y') GO TO 100
C
C
C	TRY TO ATTACH DEVICE ON LUN #1
C	IF IT FAILS.... STOP
C
C
	CALL WTQIO("1400,1,1,,IOSB)
	IF(IOS(1).EQ.1) GO TO 10
	WRITE(5,5) IOS
5	FORMAT(/' *** FATAL *** FAILED TO ATTACH DEVICE -- STATUS: ',4O5/)
	GO TO 100
C
C
C	START PROCEDURE TO READ HOME BLOCK.
C	THE HOME BLOCK IS POSITIONED ON LOGICAL BLOCK #1 OR ON
C	LOGICAL BLOCK #MULTIPLE OF 256.
C	THE PROGRAM CHECKS FOR THE VALIDITY OF THE HOME BLOCK ON ITS
C	TWO CHECKSUMS ON LOCATION 30 AND 256, AND ON ITS HAVING SET AT
C	LEAST 1 BIT. AFTER 200 TRIES (LOG.BL. #52100) THE PROGRAM STOPS
C	WITH AN ERROR MESSAGE.
C
C
10	CALL GETADR(IPARAM(1),IBUF(1))
	IPARAM(2)=512
	NBL=1
	NHOM=0
11	CALL WTQIO("1000,1,1,,IOSB,IPARAM)
	IF(IOSB(1).EQ.1) GO TO 12
13	WRITE(5,15) IOS
15	FORMAT(/' *** FATAL *** READ ERROR -- STATUS: ',4O5/)
	GO TO 100
12	ITOT=0
	DO 16 I=1,29
16	ITOT=ITOT+IBUF(I)
	IF(ITO(1).EQ.IBUF(30).AND.ITOT.NE.0) GO TO 17
	NHOM=NHOM+1
	IF(NHOM.GE.200) STOP 'HOME BLOCK READ ERROR'
	NBL=NHOM*256
	GO TO 11
17	ITOT=0
	DO 18 I=1,255
18	ITOT=ITOT+IBUF(I)
	IF(ITO(1).EQ.IBUF(256).AND.ITOT.NE.0) GO TO 19
	NHOM=NHOM+1
	IF(NHOM.GE.200) STOP 'HOME BLOCK READ ERROR'
	NBL=NHOM*256
	GO TO 11
C
C
C	WRITE OLD LABEL ON TERMINAL AND ASK FOR NEW ONE.
C	WRITE THE NEW LABEL ON THE TERMINAL AND ASK IF OKAY.
C
C
19	WRITE(5,21) VOLNAM
21	FORMAT(/'$***** OLD VOLUME LABEL: ',12A1,' -- NEW: ')
	READ(5,25) NC,(ITEMP(I),I=1,NC)
25	FORMAT(Q,12A1)
	IF(NC.GT.12) NC=12
	IF(NC.LE.0) GO TO 27
	DO 266 I=15,26
266	IBYTE(I)=0
	DO 26 I=1,NC
26	IBYTE(I+14)=ITEMP(I)
27	WRITE(5,28) (IBYTE(I),I=15,26)
28	FORMAT(/'$***** NEW VOLUME LABEL WILL BE: ',12A1,
     $' -- OKAY? [Y/N]: ')
	READ(5,3) YN
	IF(YN.NE.'Y') GO TO 19
C
C
C	CALCULATE CHECKSUMS AND PRINT THEM ON TERMINAL
C
C
	ITOT=0
	DO 70 I=1,29
70	ITOT=ITOT+IBUF(I)
	IBUF(30)=ITO(1)
	ITOT=0
	DO 80 I=1,255
80	ITOT=ITOT+IBUF(I)
	IBUF(256)=ITO(1)
	WRITE(5,85) IBUF(30),IBUF(256)
85	FORMAT(/' ***** NEW CHECKSUMS WILL BE: ',2O8' *****'/)
C
C
C	WRITE NEW HOME BLOCK TO DISK.
C	IF ANY WRITE ERROR, SAY SO AND EXIT.
C
C
	CALL WTQIO("400,1,1,,IOSB,IPARAM)
	IF(IOS(1).EQ.1) GO TO 100
	WRITE(5,90) IOS
90	FORMAT(/' *** FATAL *** WRITE ERROR -- STATUS: ',4O5/)
100	STOP
	END