	program INDEX_FORTRAN
	implicit integer*4 (A-Z)
c++	Jim Hintze 
c	Weeg Computing Center
c	Univ. of Iowa
c	Iowa City
c	Iowa		52242		(319) 353-3170

c	23 Jan 1986	J. R. Cutler	Edited 
c	MAP(130) changed to MAP(255) to allow for RA80 disk size

c	 7 Apr 1986	J. R. Cutler	Edited for V4 differences
c					moved h_name from buff(76) to buff(80)
c					changed last_nb to use str$trim

c	25 Aug 1986	J. R. Cutler	Added full device name output and
c					use of sys$disk for device
c--

	parameter	(WINDOW = 7)	!Normal WINDOW size.
	parameter	(SC_ROW = 11)	!Screen row for Scanning ... message.
	parameter	(BA_DIM = 1500)	!Number of big free areas to remember.
	parameter	(FA_DIM = 300)	!Number of free areas in order.

	logical*1	BUFF(0:511)

	integer*4	colon

	integer*2	CLUST_FACT,ALLOC_LO,ALLOC_HI,USED_LO,USED_HI,
	1		FID_SEQ,FID_NUM,FID_RVN,EXT_NUM,EXT_SEQ,EXT_RVN,
	2		MPMODE(0:500),SEG_NUM,CHECK_SUM,SET_RVN,UIC_GRP,
	3		UIC_MEM, MAX_HDR_FID(2), MAX_MP_FID(2), CUR_FID(2)
	integer*2	map_file_name_length,pdev_name_length

C.. Control sequences for the VT100 terminal.
	character	CLRBOL*4, 	!Clear cursor to beginning of line.
	1		CLREOL*3,	!Clear cursor to end of line.
	1		CLRSCR*4,	!Clear entire screen.OM
	1		REVV*4,		!Set to reverse video attribute.
	1		NORV*3,		!Set to normal video.
	1		DWL*3,		!Set to double width line.
	1		SWL*3,		!Set to single width line.
	1		SAVC*2,		!Save current cursor and attributes.
	1		RESC*2,		!Restore saved cursor and attributes.
	1		ESC*1		!The escape character.

	character*65	pdev_name, map_file_name
	character	ANS*1, LIST*50, TIME_BUF*24, DEV*6
	character*12	VNAME,VOL_NAME,BLANKS
	character*20	H_NAME, MAX_HDR_NAME, MAX_MP_NAME, CUR_NAME 
	character*512	MAP(255)	!Must be as big as [0,0]BITMAP.SYS.

	integer*4	status,outlen
	integer*4	BIG_AREA(BA_DIM), FREE_AREA(FA_DIM)

	real*4		HD_FRAGIDX,FS_FRAGIDX,PERCENT,MP_MEAN,MP_STDDEV,TEST,
	1		RS,MP_SSQ,MP_N,MP_S,FS_SSQ,FS_MEAN,FS_STDDEV
	real*4		r_temp

	common /BITMAP/	MAP	!INDEX.MAR needs this address.

	external	lib$getdvi, DVI$_DEVNAM, DVI$_FULLDEVNAM

	data	BLANKS /'            '/

C..  Equivalences for first block of volume bitmap.
	equivalence	(BUFF(2),CLUST_FACT),
	1		(BUFF(4),BLOCKS)

C..  Equivalences for index file home block.
	equivalence	(BUFF(28), MAX_FIL),		! HM2$L_MAXFILES
	1		(BUFF(38), SET_RVN),		! HM2$W_RVN
	1		(BUFF(456),SER_NUM),		! HM2$L_SERIALNUM
	1		(BUFF(472),VNAME)		! HM2$T_VOLNAME

C..  Equivalences for individual header blocks.
	equivalence	(BUFF(4),  SEG_NUM),		! FH2$W_SEG_NUM
	1		(BUFF(8),  FID_NUM),		! FH2$W_FID_NUM
	2		(BUFF(10), FID_SEQ),		! FH2$W_FID_SEQ
	2		(BUFF(12), FID_RVN),		! FH2$W_FID_RVN
	3		(BUFF(14), EXT_NUM),		! FH2$W_EX_FIDNUM
	4		(BUFF(16), EXT_SEQ),		! FH2$W_EX_FIDSEQ
	4		(BUFF(18), EXT_RVN),		! FH2$W_EX_FIDRVN
	5		(BUFF(24), ALLOC_HI),		!In recatr area.
	6		(BUFF(26), ALLOC_LO),
	7		(BUFF(28), USED_HI),
	8		(BUFF(30), USED_LO),
	8		(BUFF(32), FREE_BYTE),
	1		(BUFF(60), UIC_MEM),		! FH2$W_UICMEMBER
	2		(BUFF(62), UIC_GRP),		! FH2$W_UICGROUP
	9		(BUFF(66), BACK_NUM),		! FH2$W_BK_FIDNUM
	1		(BUFF(68), BACK_SEQ),		! FH2$W_BK_FIDSEQ
	2		(BUFF(80), H_NAME),		! was 76, jrc 7 apr 86
	3		(BUFF(510),CHECK_SUM)		! FH2$W_CHECKSUM

1	format(a)

C.. Initialize VT100 escape sequences.
	ESC	  = char(27)
	CLRSCR    = esc// '[2J'
	DWL	  = esc// '#6'	!Double width line.
	SWL	  = esc// '#5'	!Single width line.
	NORV	  = esc// '[m'
	REVV	  = esc// '[7m'
	SAVC	  = esc// '7'
	RESC	  = esc// '8'
	CLRBOL	  = esc// '[1K'
	CLREOL	  = esc// '[K'

	call sys$asctim(,TIME_BUF,,)
	open(unit=6,file='sys$output',carriagecontrol='none',status='old')

C.. Clear screen and write double-width headings.
	write(6,1)CLRSCR
	call PCHAR(1,1,NORV//DWL//
	1		'  UNIVERSITY OF IOWA ODS-2 DISK MONITOR   ')
	call PCHAR(3,3,	DWL//	'VOLUME')
	call PCHAR(3,13,	'BLOCKS')
	call PCHAR(3,22,	'FILES')
	call PCHAR(3,31,	'CONDITION')
	call CURSOR(2,62) !Bug in VT-100 switching DWL to SWL.  The first
C			cursor position is misinterpreted, so we must do twice.
	call PCHAR(2,62,TIME_BUF(:17))

C.. Write labels for volume section.
	call PCHAR(4,2,		'drive')
	call PCHAR(5,2,		'label')
	call PCHAR(6,2,		'ser #')
	call PCHAR(7,2,		'files')
	call PCHAR(8,2,		'clust')

C.. Write labels for DEVICE BLOCKS section.
	call PCHAR(4,23,	'total')
	call PCHAR(5,23,	'used')
	call PCHAR(6,23,	'free')
	call PCHAR(7,23,	'contig')
	call PCHAR(8,23,	'holes')

C.. Labels for FILES section.
	call PCHAR(4,40,	'idx siz')
	call PCHAR(5,40,	'total')
	call PCHAR(6,40,	'non ctg')
	call PCHAR(7,40,	' mp > 7')
	call PCHAR(8,40,	'hdr > 1')

C.. Labels for FRAGMENTATION section.
	call PCHAR(4,61,	'#mp in mmp files')
	call PCHAR(5,61,	' - median')
	call PCHAR(6,61,	' - mean')
	call PCHAR(7,61,	' - stddev')
	call PCHAR(8,61,	'frag. index for')
	call PCHAR(9,61,	'mmp hdrs')
	call PCHAR(10,61,	'free space')
	call PCHAR(11,61,	'size of free areas')
	call PCHAR(12,61,	' - mean')
	call PCHAR(13,61,	' - stddev')
	call PCHAR(14,61,	'largest free areas')
C	CALL PCHAR(20,1,' Come to the session on Wednesday afternoon')
C	call pchar(21,1,' On the Fragmentation of Disk.')

C.. Get information from bitmap initial block and the home block.

c (old)	open(unit = 3,file = '[0,0]BITMAP.SYS',status = 'OLD',

	status = lib$getdvi( %loc(DVI$_DEVNAM), , 'SYS$DISK', , 
	2	pdev_name, pdev_name_length )
	
	map_file_name_length = pdev_name_length + 15

	map_file_name(1:pdev_name_length) = pdev_name 
	map_file_name(pdev_name_length+1:map_file_name_length + 1) =
	1	'[0,0]BITMAP.SYS'
c		 123456789012345	

	call copy_map_file_name( pdev_name_length, pdev_name )

	open(unit = 3,file = map_file_name, status = 'OLD',
	1	carriagecontrol = 'NONE',recordsize = 128,recordtype = 'FIXED',
	2	form = 'UNFORMATTED',blocksize = 512,readonly)
	read(3)BUFF
	CLUS_FACT = CLUST_FACT
	T_VOL_BLOCKS = BLOCKS

	call COPY_IDX_BLK(BUFF,2)
	MAX_FILES = MAX_FIL
	VOL_NAME = VNAME
	SERIAL_NUM = SER_NUM
	VOLSET_RVN = SET_RVN
	FILEH1 = CLUS_FACT*4+(MAX_FILES/4096)+2	!First header in indexf
	call COPY_IDX_BLK(BUFF,FILEH1)			! is the indexf header
	long_used_hi = used_hi		!patch for large disk
	IDX_SIZE = long_used_hi*2**16 + USED_LO -1	! USED BLOCKS in file

c	call GET_DEVICE_NAME(DEV)

	status = lib$getdvi( %loc(DVI$_FULLDEVNAM), , 'SYS$DISK', , 
	2	pdev_name, pdev_name_length )
	
	

C.. Write the first group of information.
	colon = index(pdev_name, ':' ) - 1
	call PCHAR(4,8,REVV//BLANKS(:12-colon)//pdev_name(:colon))
	lb = last_nb(VOL_NAME)
	call PCHAR(5,8,BLANKS(:12-lb)//VOL_NAME(:lb))
	call PNUM(6,8,SERIAL_NUM,12)
	call PNUM(7,8,MAX_FILES,12)
	call PNUM(8,8,CLUS_FACT,12)
	call PNUM(4,30,T_VOL_BLOCKS,7)
	call PNUM(4,48,IDX_SIZE,6)

C..  Analyze volume bitmap.
	MAX_FREE = 0
	BIT_MAP_SIZE = T_VOL_BLOCKS/CLUS_FACT/4096+1
	do 910 J = 1,BIT_MAP_SIZE
		read(3,end = 15),MAP(J)
910	    continue
	call VBM_SETUP(T_VOL_BLOCKS/CLUS_FACT)

15	if (.not.VBM_SCAN(USED,FREE)) goto 129
	if (FREE .gt. 0) then
		HOLES = HOLES + 1
		BLKS = FREE*CLUS_FACT 
		BLKS_FREE = BLKS_FREE +  BLKS 
		r_temp	  = blks
		r_temp	  = r_temp**2
		FS_SSQ    = FS_SSQ    + r_temp
		if (BLKS .gt. MAX_FREE) MAX_FREE = BLKS 
		if (BLKS .gt. BIG_AREA(1)) then   !Add to large space array.
			p = max(1,BA_DIM-HOLES)	!Skip over unused part.
 16			if (BLKS .le. BIG_AREA(p+1)) goto 17  !Found place.
			BIG_AREA(p) = BIG_AREA(p+1)	!Shuffle the array.
			p = p + 1			!Up one location.
			if (p+1 .le. BA_DIM) goto 16	!More to do.
 17			BIG_AREA(p) = BLKS		!Add it to the array.
		    endif
		if (FA_CNT.lt.FA_DIM) then
			FA_CNT = FA_CNT+1		!Bump pointer to frees.
			FREE_AREA(FA_CNT) = BLKS	!Append to array.
		    endif
	    endif
	BLKS_USED = BLKS_USED + USED*CLUS_FACT
	goto 15

129	close(unit = 3)
	if (HOLES.gt.1) then
		BA_CNT = BA_DIM
		if (HOLES.lt.BA_CNT) BA_CNT = HOLES
		FS_STDDEV = sqrt((FS_SSQ-(float(BLKS_FREE)**2 /
	1			float(HOLES))) / float(HOLES-1))
		FS_MEAN    = float(BLKS_FREE)/float(HOLES)
		FS_FRAGIDX = float(HOLES-1)/float((BLKS_FREE/CLUS_FACT)-1)*100.
	    else
		BA_CNT = 1
		FS_STDDEV  = 0.0	!Saves divide by zero after DSC.
		FS_MEAN = 0.0
		if (HOLES.eq.1) FS_MEAN = BLKS_FREE
		FS_FRAGIDX = 0.0
	    endif

	call PNUM(5,30,BLKS_USED,7)
	call PNUM(6,30,BLKS_FREE,7)
	call PNUM(7,30,MAX_FREE,7)
	call PNUM(8,30,HOLES,7)
	call PNUMR(10,71,FS_FRAGIDX,7,2)
	call PNUM(12,71,ifix(FS_MEAN+.5),7)
	call PNUM(13,71,ifix(FS_STDDEV+.5),7)

C.. Do big free area table.
	FFC = BA_DIM+1	!Initialize array counter.
	BIG_COL = 80
	LAST = -1
	write(6,1) REVV
 241	WID = max(3,ifix(log10(float(BIG_AREA(FFC-1)))+2))
	BIG_COL = BIG_COL-WID
	if (BIG_COL.le.1) goto 251
	if (BIG_COL.gt.60) CLR_COL = BIG_COL-1	!Save for later trim.
	do 250 j = 15,23
 243		FFC = FFC -1
		if (FFC .le. BA_DIM-BA_CNT) then
			if (LAST_CNT.gt.1) then
				call CURSOR(j,BIG_COL)
				write(6,246,err=251) NORV,LAST_CNT,REVV
			    endif
		    	goto 251
		    endif
		if (BIG_AREA(FFC).eq.LAST) then
			LAST_CNT = LAST_CNT+1
			goto 243
		    else 
			call CURSOR(j,BIG_COL)
			if (LAST_CNT.gt.1) then
				write(6,246,err=247) NORV,LAST_CNT,REVV
 246				    format(A,i<WID>,A)
 247				LAST_CNT = 0
				FFC = FFC+1	!Repeat this one.
			    else
				write(6,248,err=250) BIG_AREA(FFC)
 248				    format(i<WID>)
				LAST = BIG_AREA(FFC)
				LAST_CNT = 1
			    endif
		    endif
 250	    continue
	goto 241

C.. Scan headers.
 251	call PCHAR(SC_ROW-1,12,REVV//'                             ')
	call PCHAR(SC_ROW,  12,'  Scanning file headers ...  ')
	call PCHAR(SC_ROW+1,12,'                             ')
	call CURSOR(SC_ROW,13)
	SCP = 0	!Scan portion is 0 (will be 0 to 26).

 9909	do 9910 HDR_REC = FILEH1,IDX_SIZE
		call COPY_IDX_BLK(BUFF,HDR_REC)	!"Read" the header.
		if (FID_NUM.lt.1 .or. CHECK_SUM.eq.0 	!Hdr not used.
	1		.or. SEG_NUM.ne.0) goto 9910	!Extension header.
		N_SCP = (HDR_REC*26)/IDX_SIZE
		if (N_SCP.gt.SCP) then
			SCP = N_SCP
			call CURSOR(SC_ROW,13+SCP)
		    endif
		FILE_CNT = FILE_CNT + 1
		long_alloc_hi = alloc_hi	!patch for large files
		CUR_ALL = long_alloc_hi*2**16 + ALLOC_LO

C..  Follow all headers for this file.
		CUR_NAME   = H_NAME	!Save name of root header.
		CUR_FID(1) = FID_NUM
		CUR_FID(2) = FID_SEQ
		long_alloc_hi = alloc_hi	!patch for large disk
		CUR_ALLOC  = long_alloc_hi*2**16 + ALLOC_LO
		HDR_CNT = 0
		MP_SUM_FIL = 0
		BLK_MAP_FIL =  0
 9908		call ANAL_MAP_AREA(BUFF,MSF,BMF)
		HDR_CNT     = HDR_CNT     + 1
		MP_SUM_FIL  = MP_SUM_FIL  + MSF
		BLK_MAP_FIL = BLK_MAP_FIL + BMF
		if (SEG_NUM .eq. 1) MULTI_HDR_FILES = MULTI_HDR_FILES+1
		if (EXT_NUM .gt. 0 .and. EXT_RVN .eq. 0) then
			call COPY_IDX_BLK(BUFF,EXT_NUM+FILEH1-1)
			goto 9908
		    endif

C..  All headers for this file analyzed, update statistics.		
		if (HDR_CNT .ge. MAX_HDR_CNT) then
			MAX_HDR_CNT    = HDR_CNT
			MAX_HDR_NAME   = CUR_NAME
			MAX_HDR_FID(1) = CUR_FID(1)
			MAX_HDR_FID(2) = CUR_FID(2)
			MAX_HDR_ALLOC  = CUR_ALLOC
		    endif
		if (MP_SUM_FIL .ge. MAX_MP_CNT) then
			MAX_MP_CNT    = MP_SUM_FIL
			MAX_MP_NAME   = CUR_NAME
			MAX_MP_FID(1) = CUR_FID(1)
			MAX_MP_FID(2) = CUR_FID(2)
			MAX_MP_ALLOC  = CUR_ALLOC
		    endif
		MP_SUM = MP_SUM + MP_SUM_FIL
		BLKS_MAPPED = BLKS_MAPPED + BLK_MAP_FIL
		if (MP_SUM_FIL.gt.WINDOW) MP_GT_WIN = MP_GT_WIN + 1
		if (MP_SUM_FIL.gt.1) then
			NON_CONTIG = NON_CONTIG + 1
			MMP_BLKS   = MMP_BLKS  + BLK_MAP_FIL
			MMP_MPSUM  = MMP_MPSUM + MP_SUM_FIL
		    endif
		if (MP_SUM_FIL.gt.500) MP_SUM_FIL = 500
		MPMODE(MP_SUM_FIL) = MPMODE(MP_SUM_FIL) + 1
 9910	    continue

C.. Write header section.
	COL = 60
	do 9911 i= SC_ROW-1, 24
		if (i.ge.15) COL = CLR_COL
		call CURSOR(i,COL)
 9911		write(6,1) CLRBOL

	call PNUM(5,48,FILE_CNT,6)
	call PNUM(6,48,NON_CONTIG,6)
	call PNUM(7,48,MP_GT_WIN,6)
	call PNUM(8,48,MULTI_HDR_FILES,6)
	if (BLKS_USED .ne. BLKS_MAPPED) then
		call PCHAR(2,2,NORV//' Volume in use or cached,'//
	1			' index not consistent with bitmap.')
		write(6,1) REVV
		BLKS_USED = BLKS_MAPPED		!"Correct" bitmap stats.
		BLKS_FREE = T_VOL_BLOCKS-BLKS_MAPPED
		call PNUM(5,30,BLKS_USED,7)	!Rewrite alloc information.
		call PNUM(6,30,BLKS_FREE,7)
	    endif

C.. Compute and print condition statistics.
	TEST = float(MP_SUM-MPMODE(1)) / 2.0
	MP_N = 0
	do 300 i = 2,500	!Find median # of map pointers.
	    if (MPMODE(i).gt.0) then
		RS = RS + MPMODE(i)*i	!Compute running sum for median.
		if (RS .gt. TEST  .and. MP_MEDIAN.eq.0) MP_MEDIAN = i
		MP_N   = MP_N   + MPMODE(i)	!Population count of mp sizes.
		MP_S   = MP_S   + i*MPMODE(i)	!Sum of map pointers.
		MP_SSQ = MP_SSQ + (i**2 * MPMODE(i))	!Sum of squares.
	      endif
 300	    continue
	if (MP_N.gt.1) then
		MP_MEAN = MP_S/MP_N		!Mean # mp in mmp files.
		MP_STDDEV = sqrt((MP_SSQ-(MP_S**2/MP_N)) / (MP_N-1))
	    else
		MP_MEAN = 0.0
		MP_STDDEV = 0.0	!Saves divide by zero after DSC.
	    endif

	if (MMP_MPSUM.gt.0 .and. MMP_BLKS.gt.0) then
		HD_FRAGIDX = float(MMP_MPSUM)/float(MMP_BLKS/CLUS_FACT) *100.
	    else
		HD_FRAGIDX = 0.0	!Saves divide by zero after DSC.
	    endif
	call PNUMR(5,71,float(MP_MEDIAN),7,2)
	call PNUMR(6,71,MP_MEAN,7,2)
	call PNUMR(7,71,MP_STDDEV,7,2)
	call PNUMR(9,71,HD_FRAGIDX,7,2)

C.. Print max files.
	call PCHAR(10,2,NORV//'max mp')
	call PCHAR(9,15,'blocks')
	write(6,1) REVV
	call PNUM(10,9,MAX_MP_CNT,4)
	call PNUM(10,15,MAX_MP_ALLOC,5)
	call PCHAR(11,2, NORV//'max hdr')
	if (MAX_HDR_CNT.le.1) then
		write(6,1) ' (none)'
	    else
		write(6,1) REVV
		call PNUM(11,9,MAX_HDR_CNT,4)
		call PNUM(11,15,MAX_HDR_ALLOC,5)
	    endif

C.. Do map pointer table and histogram.
	MMC = -1	!Initialize array counter.
	call PCHAR(12,2 ,NORV//'MP   #')
	call PCHAR(12,10,'MP   #')
	call CURSOR(15,1)
	write(6,1) REVV
	do 210 MODE_COL = 2,10,8
	  do 210 j = 13,23
		MMC = MMC +1
		call CURSOR(j,MODE_COL)
		write(6,3,err=210) MMC,MPMODE(MMC)
3		    format(I2,I5)
 210	    continue
c	call PCHAR(13,1,NORV)
c	do 211 j= 14,23
c		call CURSOR(j,1)	!Move to the border.
c 211		write(6,212)		!And restore the border.
c 212		    format(' ')
c
	do 220 i =  21, 500	!Get sum of all above 20 pointers.
 220	    MP20PLUS = MP20PLUS + MPMODE(i)
	call CURSOR(23,10)	!This will overprint above.
	write(6,230) REVV,MP20PLUS
 230	    format(A,'20+',I4)
	call PCHAR(12,18,NORV//'2345678901234567890+')
	write(6,1) REVV
	do 240 i = 2,20
		call HISTO(i+16,MPMODE(i))
 240	    continue
	call HISTO(21+16,MP20PLUS)

C.. Print the free area, in logical block order.
	FFC = 1				!Start at beginning of array.
	BIG_COL = 39
	call PCHAR(9,BIG_COL,NORV//'free areas (LBN seq)')
	write(6,1) REVV
 255	MX = -1
	do 256 i=FFC, min(FA_CNT,FFC+14)
		if (FREE_AREA(i).gt.MX) MX = FREE_AREA(i)
 256	    continue
	WID = log10(float(MX))+2
	if (BIG_COL+WID.gt.59) goto 261
	do 260 j = 10,23
		call CURSOR(j,BIG_COL)
		write(6,258,err=259) FREE_AREA(FFC)
 258		    format(I<wid>,' ')
 259		FFC = FFC + 1
		if (FFC .gt. FA_CNT) goto 261
 260	    continue
	BIG_COL = BIG_COL+WID
	goto 255

C.. See if file output wanted.
 261	write(6,1) NORV//esc//'[1;20r'	!Don't scroll last line.
	call PCHAR(24,2,'Output in file? [y/n] (n): ')
	call UNMAP_INDEXF
	accept 1, ANS
	call PCHAR(24,34,CLRBOL)
	if (ANS.ne.'Y' .and. ANS.ne.'y') then
		write(6,1) esc//'[1;24r'
		call CURSOR(23,1)
		call exit
	    endif
	call PCHAR(24,2,CLREOL//'Name for output? (INDEX.LIS): ')
	read(5,1) LIST
	if (LIST.eq.' ') LIST = 'INDEX.LIS'
	open(unit=3,file=LIST,status='NEW',carriagecontrol='LIST',recl=255)
	inquire(unit=3,name=LIST)
	call PCHAR(24,20,CLRBOL//
	1		'Listing in file "'//LIST(:last_nb(LIST))//'"')
	write(3,400) TIME_BUF(:17)
 400	format(8x,'O D S - 2     D I S K    M O N I T O R  V 2 . 0',2x,A)

	colon = index(pdev_name, ':' ) - 1
	write(3,410) BLANKS(:12-colon)//pdev_name(:colon),
 	3		T_VOL_BLOCKS, BLANKS(:12-lb)//VOL_NAME(:lb),
	1		BLKS_USED,SERIAL_NUM,BLKS_FREE,MAX_FILES,MAX_FREE,
	2		CLUS_FACT,HOLES
 410	    format(/
	1	'	Disk drive:           ',A,
	1	'    Total blocks on drive:',I10	/
	2	'	Volume label:         ',A,
	2	'    Blocks in use:        ',I10	/
	3	'	Volume serial number: ',I12,
	3	'    Available blocks:     ',I10	/
	4	'	Maximum # of files:   ',I12,
	4	'    Largest contig free space:',I6	/
	5	'	Cluster factor:       ',I12,
	5	'    Number of holes:      ',I10)
	write(3,430) IDX_SIZE,FILE_CNT,NON_CONTIG,MP_GT_WIN,MULTI_HDR_FILES,
	1	MAX_MP_CNT, MAX_MP_FID, MAX_MP_NAME(:last_nb(MAX_MP_NAME)),
	2	MAX_HDR_CNT, MAX_HDR_FID, MAX_HDR_NAME(:last_nb(MAX_HDR_NAME))
 430	    format(/
	1	'	Size of index file:   ',I12	/
	2	'	Total number of files:',I12	/
	3	'	Non-contiguous files: ',I12	/
	4	'	Files w/ > 7 map pointers:',I8	/
	5	'	Multi-header files:   ',I12	/
	6	'	Most pointers for 1 file: ',I8,
	6				'  (',O6,',',O6,')  ',A /
	7	'	Most headers for 1 file:  ',I8,
	8				'  (',O6,',',O6,')  ',A)
	write(3,440,err=441) float(MP_MEDIAN),MP_MEAN,MP_STDDEV,HD_FRAGIDX,
	1		FS_FRAGIDX,FS_MEAN,FS_STDDEV,HOLES
 440	    format(/
	1	'	Number of map pointers per header (for',
	2			' headers with >1 pointer only)'	/
	3	43x,'- median:         ',F10.4 /
	4	43x,'- mean:           ',F10.4 /
	5	43x,'- std dev of mean:',F10.4 /
	6	'	Fragmentation index for header map',
	7			' areas:            ',F10.4 /
	6	'	Fragmentation index for free space',
	7			' areas:            ',F10.4 /
	8	'	Size of free spaces on volume:',
	6	 5x,'- mean:       ',F14.2 /
	5	43x,'- std dev of mean:',F10.2 //
	6	'	Largest free spaces on volume (blocks):',I10,' Holes')
 441	do 442 k=BA_DIM, BA_DIM-BA_CNT+1, -1
 442		call PACK_OUT(BIG_AREA(k))	!Close pack the output.
	call PACK_OUT(-1)			!Flush the last line.
	write(3,443)
 443	    format(/'	Free spaces in LBN Sequence:')
	do 444 k=1,min(FA_DIM,HOLES)
 444		call PACK_OUT(FREE_AREA(k))	!Close pack the output.
	call PACK_OUT(-1)			!Flush the last line.
	write(3,450) 12	!form feed.
 450	    format(A,/'	 MP  Files   %   12345678901234567890123456789',
	1		'012345678901234567890+')
	do 470 i=0,20
		PERCENT = float(MPMODE(i))/float(FILE_CNT)*100.
		STARS = MPMODE(i)
		if (STARS.le.50) then
			ANS = ' '
		    else
			ANS = '>'
			STARS = 50
		    endif
		write(3,460) i,MPMODE(i),PERCENT,('*',k=1,STARS),ANS
 460		    format('	',I3,I6,F6.2,2x,51A1)
 470	    continue
	PERCENT = float(MP20PLUS)/float(FILE_CNT)*100
	STARS = MP20PLUS
	if (STARS.le.50) then
		ANS = ' '
	    else
		ANS = '>'
		STARS = 50
	    endif
	write(3,480) MP20PLUS,PERCENT,('*',i=1,STARS),ANS
 480	    format('	 20+',I5,F6.2,2x,51A1)

	write(6,1) esc//'[1;24r'
	call CURSOR(23,1)
	end



	subroutine HISTO(COL,FILE_CNT)
	implicit integer*4 (A-Z)
	integer*2	FILE_CNT

	STARS = FILE_CNT
	if (STARS.gt.10) STARS = 10
	if (STARS.gt.0) then
		ROW = 24
		do 30 i = 1, STARS
			ROW = ROW -1	!histo goes up from bottom
			call CURSOR(ROW,COL)
			write(6,10) '*'
 10			    format(a)
 30		    continue
		if (STARS.ne.FILE_CNT) then
			call CURSOR(13,COL)
			write(6,10) '+'
		    endif
	    endif
	return
	end

	subroutine PACK_OUT(HOL)
	implicit integer*4 (A-Z)
	character	BUF*80
	data		LB /1/,  LAST /-1/,  BUF(1:1) /'	'/
	
	if (HOL.eq.-1) then
		if (LAST_CNT.gt.1) then
			WID = log10(float(LAST_CNT))+1
			write(BUF(LB+1:LB+WID+2),20) LAST_CNT
			LB = LB+WID+2
		    endif
		LAST = -1
		LAST_CNT = 0
		write(3,10) BUF(:LB)
 10		    format(a)
		LB = 1
		return
	    endif

	if (HOL.eq.LAST) then
		LAST_CNT = LAST_CNT+1
	    else 
		if (LAST_CNT.gt.1) then
			WID = log10(float(LAST_CNT))+1
			write(BUF(LB+1:LB+WID+2),20) LAST_CNT
 20			    format('(',i<WID>,')')
			LB = LB+WID+2
		    endif
		if (LB.ge.67) then
			write(3,10) BUF(:LB)
			LB = 1
		    endif
		WID = log10(float(HOL))+3
		write(BUF(LB+1:LB+WID),30) HOL
 30		    format(i<WID>)
		LAST = HOL
		LAST_CNT = 1
		LB = LB+WID
	    endif

	return
	end

	subroutine PCHAR(row,col,string)
	integer*4     row,col
	character*(*) string
	call CURSOR(ROW,COL)
	write(6,1)string
 1	format(a,' ')
	return
	end


	subroutine PNUM(row,col,number,len)
	integer*4   row,col
	call CURSOR(ROW,COL)
	write(6,2,err=3)number
 2	format(i<LEN>,' ')
 3	return
	end


	subroutine PNUMR(row,col,number,wid,frac)
	integer*4 row,col,wid,frac
	real      number
	call CURSOR(ROW,COL)
	write(6,2,err=3)number
 2	format(f<wid>.<frac>,' ')
 3	return
	end


	subroutine CURSOR(ROW,COL)
	integer*4	ROW,COL
	character	ROWC*2, COLC*2, ESC*1
	ESC = char(27)
	if (COL.lt.10) then	!0 thru 9 are one digit.
		cstrt = 2
	    else
		cstrt = 1
	    endif
	write(COLC,10) COL	!Encode the column number.
 10	    format(I2)
	if (ROW.lt.10) then	!0 thru 9 are one digit.
		rstrt = 2
	    else
		rstrt = 1
	    endif
	write(ROWC,10) ROW	!Encode the row number.
	write(6,20) esc//'['// rowc(rstrt:) //';'// colc(cstrt:) //'H'
 20	format(a)
	return
	end

	integer*4 function last_nb(string)

	implicit integer*4 (a-z)
	integer*2	strlen

	character*(*)	string

c		7 Apr 1986	J. R. Cutler
c		rewrote to use str$trim

c	last_nb = index( string, ' ' )
c	if ( last_nb .ne. 0 )  last_nb = last_nb - 1

	status = str$trim( string, string, strlen )
	last_nb = strlen

	return

	end
