C	TCI.FTN		PROGRAM TO COMPARE 2 TASK IMAGES
C			ESPECIALLY FOR USE IN COMMAND FILES
C	INSTALLS AS ...TCI
C
C	>TCI FILENAME1=FILENAME2
C			RETURNS EXIT STATUS AS FOLLOWS:
C				1	FILES ARE =
C				2	FILES ARE <>
C				4	COULDN'T DO THE OPERATION
C	ALSO OUTPUTS APPROPRIATE MESSAGES, IF FILES
C	ARE NOT THE SAME THE FIRST 10 DIFFERENCES ARE LISTED
C	N.B. HEADER DIFFERENCES ARE LISTED, BUT NOT CONSIDERED
C	A REASON TO DECLARE THE TASKS <> (UNLESS MORE THAN 10)
C

	PARAMETER MAXBUF = 1536,IORVB = "10400,LUN1 = 1, LUN2 = 2
	PARAMETER ISKIP = 3,LBFLG = 13, LBDAT = 14
	PARAMETER LIMIT = 50, LSTCK = 9
C
	BYTE BUF(80),NAME1(80),NAME2(32),IOS1(4),IOS2(4),BYT(2)
	BYTE EXT(4),SEGN(6)
	INTEGER*2 IN1(256),IPARS1(8),IBYT
	INTEGER*2 IN2(256),IPARS2(8)
	INTEGER*4 I4N2(128),I4N1(128),FIVE12
	INTEGER*2 LB1(768),LB2(768)
	INTEGER*4 L4B1(384),L4B2(384),SEGNAM(200),LODADR(200)
	INTEGER*2 LODISK(200),HIDISK(200),I2NAME(400)
C
	COMMON /SEGDAT/ NOSEG,NADDR,SEGN,LODISK,HIDISK,LODADR,I2NAME
C
	EQUIVALENCE (BUF(5),NAME1(1))
	EQUIVALENCE (LB1(1),L4B1(1))
	EQUIVALENCE (LB2(1),L4B2(1))
	EQUIVALENCE (I4N1(1),IN1(1))
	EQUIVALENCE (I4N2(1),IN2(1))
	EQUIVALENCE (IBYT,BYT(1))
	EQUIVALENCE (SEGNAM(1),I2NAME(1))
C
	DATA NAME1/80*' '/,NAME2/32*' '/,FIVE12/512/
	DATA IPARS1/8*0/,IPARS2/8*0/,EXT/'.','T','S','K'/
C
1	CALL GETMCR (BUF,IDS)
	IDS=IDS-4
	IF(IDS.LE.0) GOTO 800
D	WRITE(5,2) (NAME1(J),J=1,IDS)
D2	FORMAT(' COMMAND LINE: ',64A1)
	IP1=0
	IP2=0
	DO 120 I=1,IDS
	IF(NAME1(I).EQ.'.') IP1=I
	IF(NAME1(I).EQ.'=') GOTO 25
120	CONTINUE
	GOTO 800
25	K=1
	N1=I
	I=I+1
	N2=0
	DO 30 K=I,IDS
	N2=N2+1
	IF(NAME1(K).EQ.EXT(1)) IP2=K
30	NAME2(N2)=NAME1(K)

	IF(IP2.NE.0) GOTO 35
	DO 32 I=1,4
	N2=N2+1
32	NAME2(N2)=EXT(I)
35	NAME2(N2+1)=0		! DELIMIT FILENAME
	IF(IP1.NE.0) GOTO 38
	DO 36 I=1,4
	NAME1(N1)=EXT(I)
36	N1=N1+1
38	NAME1(N1)=0		! DELIMIT FILENAME
C
C	TRY TO OPEN EACH FILE
C
	OPEN (UNIT=1,NAME=NAME1,TYPE='OLD',ERR=105,SHARED,READONLY,
	1	ACCESS='DIRECT')
	OPEN (UNIT=2,NAME=NAME2,TYPE='OLD',ERR=106,SHARED,READONLY,
	1	ACCESS='DIRECT')
C
	IRECSZ=512
	IBLKSZ=1
	IMAX=300
	CALL GETADR(IPARS1,LB1)
	IPARS1(2)=512
	IPARS1(3)=0
	IPARS1(4)=0
	CALL GETADR(IPARS2,LB2)
	IPARS2(2)=512
	IPARS2(3)=0
	IPARS2(4)=0
	IRRN=1
	ASSIGN 200 TO IRET	! SET LOCAL SUB RETURN ADDR
	GOTO 400		! LOCAL SUBROUTINE "CALL"
200	LBSEG=119
	IF(LB1(121).EQ.0) LBSEG=231
	IF(LB1(120).EQ.0.AND.LB1(240).NE.0) LBSEG=231
D	WRITE(5,609) LBSEG,(LB1(K),K=119,122)
D609	FORMAT(' LBSEG = ',I4,4I6)
	IHEAD=LB1(LBSEG+1)+1		! BLOCK NUMBER OF HEADER
	NOLUN=LB1(LBSEG+3)		! NUMBER OF LOGICAL UNITS
	ISEG=LB1(LBSEG)			! SEG LIST BLK #
	NRSIZ=LB1(12)/2			! SIZE OF A SEGMENT TABLE ENTRY
D	WRITE(5,601) NOLUN,ISEG,IHEAD
D601	FORMAT(' THERE ARE ',I6,' LUNS, THE SEG LIST STARTS AT ',
D    +	I3,' THE HEADER AT ',I3)
C
C	COMPARE LABEL BLOCK (BLOCK 1)
C
D	WRITE(5,950) IRRN
D950	FORMAT(' START COMPARISON OF LABEL AT BLOCK ',I4)
	IF(L4B1(1).NE.L4B2(1)) WRITE(5,201)
201	FORMAT(' * WARNING *  TASK NAME FOR INSTALL DIFFERS ')
	IF(L4B1(2).NE.L4B2(2)) WRITE(5,202)
202	FORMAT(' * WARNING *  PARTITION NAME FOR INSTALL DIFFERS ')
	IDIF=0
	LDIF=0
	DO 210 I=10,13
	IF(LB1(I).EQ.LB2(I)) GOTO 210
	LDIF=LDIF+1
	IL=(I-1)*2
	WRITE (5,94) IRRN,IL
210	CONTINUE

	DO 215 I=14,16
	IF(LB1(I).EQ.LB2(I)) GOTO 215
	WRITE(5,211)
211	FORMAT(' * WARNING *  CREATION DATE DIFFERS')
	GOTO 220
215	CONTINUE

220	K=LBSEG-1
	DO 225 I=17,K
	IF(LB1(I).EQ.LB2(I)) GOTO 225
	WRITE(5,221)
221	FORMAT(' * WARNING *  LIBRARY LINKAGE DIFFERS')
	GOTO 226
225	CONTINUE
226	I=LBSEG-4
	IF(LB1(I).NE.LB2(I)) GOTO 90
	I=I+1
	IF(LB1(I).NE.LB2(I)) WRITE(5,227)
227	FORMAT(' * WARNING *  INSTALL PRIORITY DIFFERS')
	L=LBSEG-2
	K=LBSEG+5
	DO 230 I=L,K
	IF(LB1(I).EQ.LB2(I)) GOTO 230
	LDIF=LDIF+1
	IL=(I-1)*2
	WRITE (5,94) IRRN,IL
	IF(LDIF.GT.100) GOTO 90
230	CONTINUE
C
	IRRN=2
	J=LB1(13)+"40000
	IF(J.LT.0) GOTO 350	! TASK HAS NO HEADER
	IF(IRRN.EQ.IHEAD) GOTO 300 ! NEXT BLOCK IS HEADER
	IF(NOLUN.EQ.0) GOTO 270	! TASK HAS NO LUNS
C
C 	COMPARE THE LUN TABLES (BLOCK 2 ...)
C
245	N=NOLUN
	IF(N.GT.128) N=128
	IRRN=2
D	WRITE(5,951) IRRN
D951	FORMAT(' START COMPARISON OF LUT AT BLOCK',I3)
	ASSIGN 250 TO IRET	! SET UP "RETURN ADDRESS"
	GOTO 400		! CALL THE LOCAL SUB TO READ BLK	
250	DO 260 I=1,N
	IF(L4B1(I).EQ.L4B2(I)) GOTO 260
	WRITE(5,261) I
261	FORMAT(' * WARNING *  ASSIGNMENT FOR LUN ',I3,' DIFFERS')
260	CONTINUE
	IF(NOLUN.LE.128) GOTO 270
	NOLUN=NOLUN-128
	IRRN=IRRN+1
	GOTO 245	
C
C	COMPARE THE SEGMENT LOAD LISTS (BLOCK 3 ...)
C
270	IF(ISEG.EQ.0) GOTO 300
	IRRN=ISEG+1
D	WRITE(5,952) IRRN
D952	FORMAT(' START COMPARISON OF SEGMENT LIST AT BLOCK',I3)
275	ASSIGN 280 TO IRET
	GOTO 400
280	DO 285 J=1,128
	IF(L4B1(J).EQ.L4B2(J)) GOTO 285
	I=J*2
	IF(LB1(I).EQ.LB2(I)) I=I-1
	LDIF=LDIF+1
	IL=(I-1)*2
	WRITE (5,94) IRRN,IL
	IF(LDIF.GT.100) GOTO 90
285	CONTINUE
	IRRN=IRRN+1
	IF(IRRN.NE.IHEAD) GOTO 275
C
C	COMPARE THE HEADERS (USUALLY BLOCK 3 OR 4)
C
300	IRRN=IHEAD
D	WRITE(5,953) IRRN
D953	FORMAT(' START HEADER COMPARISON AT BLOCK',I4)
	ASSIGN 310 TO IRET	! SET "RETURN" ADDRESS
	GOTO 400		! "CALL" LOCAL SUBROUTINE
310	DO 312 I=1,4
	IF(LB1(I).EQ.LB2(I)) GOTO 312
	LDIF=LDIF+1
	IL=(I-1)*2
	WRITE (5,94) IRRN,IL
	IF(LDIF.GT.100) GOTO 90
312	CONTINUE
	IF(L4B1(3).NE.L4B2(3)) WRITE (5,314)
314	FORMAT(' * WARNING *  UIC IN HEADER DIFFERS')
	DO 320 I=8,31
	IF(LB1(I).EQ.LB2(I)) GOTO 320
	LDIF=LDIF+1
	IL=(I-1)*2
	WRITE (5,94) IRRN,IL
	IF(LDIF.GT.100) GOTO 90
320	CONTINUE
	LS=128
	IHSZ=LB1(2)/2+1		! LAST INDEX NUMBER IN HEADER BLOCK
	IF(IHSZ.LE.256) GOTO 322
	CALL GETADR(IPARS1,LB1(257))
	CALL GETADR(IPARS2,LB2(257))
	IRRN=IRRN+1
	LS=LS+128
D	WRITE(5,954) IRRN
D954	FORMAT(' READING A SECOND HEADER BLOCK AT',I4)
	ASSIGN 321 TO IRET
	GOTO 400		! READ IN 2ND HEADER BLOCK

321	IF(IHSZ.LE.512) GOTO 322
	CALL GETADR(IPARS1,LB1(513))
	CALL GETADR(IPARS2,LB2(513))
	IRRN=IRRN+1
	LS=LS+128
D	WRITE(5,955) IRRN
D955	FORMAT(' READING A THIRD HEADER BLOCK AT ',I4)
	ASSIGN 322 TO IRET
	GOTO 400		! READ IN 3RD HEADER BLOCK

322	NOLUN=LB1(31)
	K=30+(NOLUN*2)
	DO 330 I=32,K,2
	IF(LB1(K).NE.LB2(K)) GOTO 323
	IF(LB1(K+1).EQ.LB2(K+1)) GOTO 330
323	J=(I-30)/2
	WRITE(5,331) J
331	FORMAT(' * WARNING * LUN TABLE DIFFERENCE FOR LUN',I4)
330	CONTINUE

	I=K+2
	IF(LB1(I).EQ.LB2(I)) GOTO 324	! NUMBER OF WINDOW BLKS
	LDIF=LDIF+1
	IL=(I-1)*2
	WRITE (5,94) IRRN,IL
324	I=I+2
	IF(LB1(I).EQ.LB2(I)) GOTO 325	! LOW VIRT ADDR
	LDIF=LDIF+1
	IL=(I-1)*2
	WRITE (5,94) IRRN,IL
325	I=I+1
	IF(LB1(I).EQ.LB2(I)) GOTO 326	! HI VIRT ADDR
	LDIF=LDIF+1
	IL=(I-1)*2
	WRITE (5,94) IRRN,IL
326	L=I+2
	K=I+2
	DO 327 I=L,K		! WINDOW SIZE,OFFSET 1ST PDR
	IF(LB1(I).EQ.LB2(I)) GOTO 327
	LDIF=LDIF+1
	IL=(I-1)*2
	WRITE (5,94) IRRN,IL
	IF(LDIF.GT.100) GOTO 90
327	CONTINUE
	IBYT=LB1(K+1)
	BYT(1)=BYT(2)
	BYT(2)=0
	L=K+2
	K=L+IBYT-1
	DO 328 I=L,K
	IF(LB1(I).EQ.LB2(I)) GOTO 328
	LDIF=LDIF+1
	IL=(I-1)*2
	WRITE (5,94) IRRN,IL
	IF(LDIF.GT.100) GOTO 90
328	CONTINUE
	L=IHSZ-6
	IF(LB1(L).NE.LB2(L)) GOTO 341
	IF(LB1(L+1).EQ.LB2(L+1)) GOTO 342
341	WRITE (5,343)
343	FORMAT(' * WARNING *  IDENT DIFFERS ')
342	L=L+2
	IF(LB1(L).NE.LB2(L)) GOTO 347
	IF(LB1(L+1).EQ.LB2(L+1)) GOTO 346
347	WRITE (5,344)
344	FORMAT(' * WARNING *  TASK NAME DIFFERS')
346	I=L+2
	IF(LB1(I).EQ.LB2(I)) GOTO 345
	WRITE(5,348)
348	FORMAT(' ** FATAL ** PROGRAM TRANSFER ADDRESS DIFFERS ')
	GOTO 92
345	L=L+4
	CALL GETADR(IPARS1,LB1(1))
	CALL GETADR(IPARS2,LB2(1))
	NDSTAK=LB1(LSTCK)	! GET STACK START VALUE
	NDSTAK=NDSTAK/2-L	! INTO WORDS LESS HEADER
C
C	FIND SEGMENT TABLE AND BUILD ONE WE CAN USE
C
	IF(LB1(23).NE.0) GOTO 500
	NOSEG=1
	LODISK(1)=3
	HIDISK(1)=1000
	LODADR(1)=0
	I2NAME(1)=0
	I2NAME(2)=0
	GOTO 590
C
500	IRSAV=IRRN
	IN1(2)=0		! MAKE HI ORDER 0
	IN1(1)=LB1(23)		! COPY ADDRESS OF OVERLAY AREA TO LOW ORDER
	I4N1(2)=I4N1(1)/FIVE12	! CALCULATE REL BLK #
	I4N1(3)=I4N1(1)-(I4N1(2)*FIVE12) ! AND OFFSET
	LOFF=I4N1(3)/2+1	! TO INDEX
	IRRN=I4N1(2)+3		! AND BLK WITHIN FILE
D	WRITE(5,501) IRRN,LOFF		
D501	FORMAT(' OVERLAY IMPURE AREA AT BLOCK #',I4,'. WORD ',I3,'.')
	ASSIGN 510 TO IRET
	GOTO 400		! CALL QIO READING ROUTINE
510	IN1(2)=0		! MAKE HI ORDER 0
	IN1(1)=LB1(LOFF+1)	! COPY ADDRESS OF SEGMENT TABLE TO LOW ORDER
	I4N1(2)=I4N1(1)/FIVE12	! CALCULATE REL BLK #
	I4N1(3)=I4N1(1)-(I4N1(2)*FIVE12) ! AND OFFSET
	LOFF=I4N1(3)/2+1	! TO INDEX
	IRRN=I4N1(2)+3		! AND BLK WITHIN FILE
D	WRITE(5,502) IRRN,LOFF
D502	FORMAT(' SEGMENT TABLE IN BLOCK #',I4,'. WORD ',I3,'.')
	ASSIGN 520 TO IRET
	GOTO 400		! READ IN SEGMENT TABLE BLOCK
520	CALL GETADR(IPARS1,LB1(257))
	CALL GETADR(IPARS2,LB2(257))
	IRRN=IRRN+1
	ASSIGN 530 TO IRET
	GOTO 400		! READ A SECOND BLOCK IN CASE
530	CALL GETADR(IPARS1,LB1(513))
	CALL GETADR(IPARS2,LB2(513))
	IRRN=IRRN+1
	ASSIGN 540 TO IRET
	GOTO 400		! AND READ A THIRD BLOCK
C
C	CONSTRUCT OUR SEGMENT TABLE
C	
540	N=0
550	N=N+1
	CALL BIC("130000,LB1(LOFF))	! GET DISK BLOCK
	LODISK(N)=LB1(LOFF)+3
	IN1(1)=LB1(LOFF+2)-1	! GET LOAD SIZE (ENSURE NOT AT BLK BOUND)
	IN1(2)=0
	I4N1(1)=I4N1(1)/FIVE12	! TURN INTO # OF ADDITIONAL BLKS
	HIDISK(N)=LODISK(N)+I4N1(1)
	IN1(1)=LB1(LOFF+1)
	LODADR(N)=I4N1(1)	! LOAD ADDRESS
	M=((N-1)*2)+1		! GET I*2 INDEX IN I*4 EQUIV ARRAY
	I2NAME(M)=LB1(LOFF+6)
	I2NAME(M+1)=LB1(LOFF+7)
D	CALL R50NAM(SEGN,SEGNAM(N))
D	WRITE(5,551) LODISK(N),HIDISK(N),SEGN
D551	FORMAT(' FROM DISK BLK',I4,' TO BLK ',I4,'. NAME ',6A1)	
	LOFF=LOFF+NRSIZ
	IF(LB1(LOFF).NE.0) GOTO 550
	NOSEG=N
C
	CALL GETADR(IPARS1,LB1)
	CALL GETADR(IPARS2,LB2)
	IRRN=IRSAV
D	WRITE(5,961) NDSTAK,L
D961	FORMAT(' STARTING STACK COMPARE OF',I6,'. WORDS AT ',O6)
590	L=L/2
	NDSTAK=NDSTAK/2		! INTO DBL WORDS
	IF(L.LE.LS) GOTO 350
355	DO 349 J=L,LS
	IF(L4B2(J).EQ.L4B1(J)) GOTO 349
	I=J*2
	IF(LB1(I).EQ.LB2(I)) I=I-1
	IF(NDSTAK.LE.0) IDIF=IDIF+1
	IF(IDIF.GE.LIMIT) GOTO 90
	IL=(I-1)*2
	IF(NDSTAK.GT.0) WRITE (5,94) IRRN,IL
	IF(NDSTAK.LE.0) WRITE (5,91) IRRN,IL
	CALL INSEG(IRRN,IL)
	WRITE(5,415) SEGN,NADDR
349	NDSTAK=NDSTAK-1
C
350	IF(NDSTAK.LE.0) GOTO 390
	IRRN=IRRN+1
D	WRITE(5,964) NDSTAK,IRRN
D964	FORMAT(' ANOTHER ',I8,' DBL WORDS OF STACK TO DO AT BLK ',I4)
	LS=128
	L=1
	ASSIGN 355 TO IRET
	GOTO 400			! LOCAL SUB TO READ NEXT BLK
	
390	ASSIGN 410 TO IRET		! CODE AT 400 NO LONGER A SUB
	CALL GETADR(IPARS1,IN1)
	CALL GETADR(IPARS2,IN2)
C
C	LOOP TO DO EACH RECORD
C
5	IRRN = IRRN + 1			! GO TO NEXT RECORD
CD	WRITE (5,66) IRRN
CD66	FORMAT (' DOING BLOCK ',I8)
C
C  ** THIS SECTION IS USED AS A LOCAL SUBROUTINE - RETURN IS
C  ** VIA GOTO IRET
C
C	START BOTH THE READS AND WAIT FOR THEM
C
400	IDSW = 1
	IDS = 1
	IPARS1(5)=IRRN
	IPARS2(5)=IRRN
	CALL QIO (IORVB,LUN1,LUN1,50,IOS1,IPARS1,IDS)
	IF (IDS.NE.1) GOTO 107
	CALL QIO (IORVB,LUN2,LUN2,50,IOS2,IPARS2,IDSW)
	IF (IDSW.NE.1) GOTO 108
	CALL WAITFR(LUN2)
	CALL WAITFR(LUN1)
CD	WRITE(5,69) IOS1,IDS,IOS2,IDSW
CD69	FORMAT('  FIRST READ STATUS - IOSTAT: ',4I4,' DSW: ',I6,/
CD    +	' SECOND READ STATUS - IOSTAT: ',4I4,' DSW: ',I6)
	IF(IOS1(1).EQ.-10.AND.IOS1(1).EQ.IOS2(1)) GOTO 1000
	IF (IDSW.EQ.-10.AND.IDS.EQ.IDSW) GOTO 1000	! NORMAL EXIT
	IF(IOS1(1).NE.1) GOTO 107
	IF(IOS2(1).NE.1) GOTO 108
	GO TO IRET	! LOCAL SUBROUTINE RETURN
C
C	COMPARE
C
410	DO 420 J=1,128
	IF (I4N1(J).EQ.I4N2(J)) GOTO 420
	I=J*2
	IF(IN1(I).EQ.IN2(I)) I=I-1
	IDIF=IDIF+1
	IF(IDIF.GE.LIMIT) GOTO 90
	IL=(I-1)*2
	WRITE (5,91) IRRN,IL
	CALL INSEG(IRRN,IL)
	WRITE(5,415) SEGN,NADDR
415	FORMAT(5X,'WHICH CORRESPONDS TO SEGMENT ',6A1,' ADDRESS ',O6)
420	CONTINUE
	GO TO 5			! LOOP BACK TO DO NEXT BLOCK
C
C	FILES NOT THE SAME
C
90	I=(I-1)*2
	WRITE (5,91) IRRN,I
91	FORMAT (' BLOCK',I8,'. IN THE CODE DIFFERS AT OCTAL OFFSET ',O4)
	WRITE (5,93) IDIF,LDIF
94	FORMAT (' BLOCK',I8,'.   IN HEADER DIFFERS AT OCTAL OFFSET ',O4)
	WRITE (5,93) IDIF,LDIF
93	FORMAT (' COMPARISON TERMINATED AFTER ',I3,' CODE',
     +	' AND ',I3,' HEADER DIFFERENCES FOUND')
92	IDS=2
	GOTO 1010

105	WRITE (5,205) (NAME1(L),L=1,N1)
205	FORMAT (' UNABLE TO OPEN ',<N1>A1)
	GO TO 900
106	N1=N2
	WRITE (5,205) (NAME2(L),L=1,N2)
	GO TO 900
107	WRITE (5,1070) (NAME1(L),L=1,N1),IRRN,IOS1(1),IDS
1070	FORMAT (' READ ERROR ON ',<N2>A1,' AT RRN # ',I4,
     +	' IOSTAT - ',I4,' DSW - ',I6)
	GO TO 900
108	N1=N2
	WRITE (5,1070) (NAME2(L),L=1,N2),IRRN,IOS2(1),IDSW
	GO TO 900
999	CONTINUE
C
C	EXITS
C
800	IDS=IDS+4
	WRITE(5,902) IDS
902	FORMAT(' FATAL ATTEMPT TO GET COMMAND LINE - STATUS = ',I6)
900	IDS=4
	GOTO 1010
C
C	SUCCESS
C
1000	IF(IDIF.EQ.0.AND.LDIF.LE.10) GOTO 1004
	IDS=2
	WRITE(5,1001) IDIF,LDIF
1001	FORMAT(1X,I3,' CODE DIFFERENCES AND',I3,' HEADER',
     +	' DIFFERENCES FOUND')
	GOTO 1010
1004	IDS=1
	WRITE(5,1005)
1005	FORMAT(' NO REAL DIFFERENCES FOUND')
1010	CLOSE (UNIT= 1)
	CLOSE (UNIT= 2)
	CALL EXST(IDS)
	END
	SUBROUTINE INSEG(IRRN,INDX)
C
C	INPUTS	IRRN	BLOCK NUMBER IN FILE
C		INDX	I*2 INDEX INTO BLOCK
C
C	OUTPUTS	NADDR	OCTAL ADDRESS
C		SEGN	LOADED WITH SECTION NAME
C
	BYTE SEGN(6)
	INTEGER*4 SEGNAM(200),I4,J4,LODADR(200)
	INTEGER*2 LODISK(200),HIDISK(200),I2NAME(400),I2(2)
C
	COMMON /SEGDAT/ NOSEG,NADDR,SEGN,LODISK,HIDISK,LODADR,I2NAME
C
	EQUIVALENCE (SEGNAM(1),I2NAME(1))
	EQUIVALENCE (I2(1),I4)
C
	DO 10 I=1,NOSEG
	IF (IRRN-LODISK(I)) 10,20,5
5	IF(IRRN.LE.HIDISK(I)) GOTO 20
10	CONTINUE
C
20	I4=IRRN-LODISK(I)
	I4=LODADR(I)+(I4*512)
	NADDR=I2(1)+INDX
	CALL R50NAM(SEGN,SEGNAM(I))
	RETURN
	END