	PROGRAM SAMPLE
C
C
C	THIS PROGRAM IS A SAMPLE OF HOW TO USE THE
C	SUPER INDEX ISAM DATA FILE GENERATED BY THE
C	USE OF THE /PRESERVE SWITCH.
C
C	OPEN SUPER INDEX DATA FILE
C
	CALL OPEN_FILE
C
C	MAKE A QUICK SCAN OF THE DATA
C	AND OUTPUT IT TO THE USER
C
	CALL ANALYZE
C
C	EXECUTE COMMANDS
C
	CALL COMMANDS
C
C	DONE-CLOSE DOWN AND EXIT
C
	CALL CLOSE_FILE
	STOP
	END
	SUBROUTINE OPEN_FILE
C
C	SUBROUTINE TO GET THE NAME OF THE DATA FILE AND TO 
C	OPEN IT
C
	CHARACTER*50 DATA_FILE_NAME
C
C
	WRITE(6,100)
100	FORMAT('$Enter the full name of SUPER INDEX data file ? ')
	READ(5,101,END=500)DATA_FILE_NAME
101	FORMAT(A50)
	OPEN(UNIT=1,ACCESS='KEYED',DEFAULTFILE='SUPERIDX.DAT',ERR=600,
	1 FILE=DATA_FILE_NAME,TYPE='OLD',READONLY,BUFFERCOUNT=25)
	RETURN
C
C	HANDLE E.O.F. INPUT
C
500	STOP '^Z input-run terminated'
C
C	HANDLE OPEN ERRORS	
C
600	STOP 'Error opening data file'
	END
	SUBROUTINE CLOSE_FILE
	CLOSE(UNIT=1)
	RETURN
	END
	SUBROUTINE ANALYZE
C
C	STORAGE AREA FOR SCAN RESULTS
C
	INTEGER*4 RECORDS,KEY_0,KEY_1,KEY_2,KEY_3,KEY_4
	COMMON/RECORDS/RECORDS,KEY_0,KEY_1,KEY_2,KEY_3,KEY_4
C
C	SCAN THE SUPER INDEX DATA FILE AND REPORT THE RESULTS
C
	BYTE RECORD(0:196)
	CHARACTER KEY_31*31,KEY_36*36
C
	WRITE(6,99)
99	FORMAT(' Please standby while the data file is scanned ')
C
C	SCAN 1-SEE HOW MANY RECORDS ARE IN THE FILE
C
C	DO A SEQUENTIAL READ ON THE ISAM FILE TO COUNT THE NUMBER OF RECORDS
C
	RECORDS=0		! COUNT IS INITIALLY ZERO
100	CONTINUE
	READ(1,END=101)RECORD	! READ A RECORD TO SEE IF THERE
	RECORDS=RECORDS+1	! YES-COUNT IT
	GOTO 100		! REPEAT UNTILL ALL RECORDS HAVE BEEN READ
101	CONTINUE		! WHEN ALL RECORDS READ-COME HERE
C
C	SCAN FOR NUMBER OF UNIQUE KEY 0
C
C	INIT THE RECORD BUFFER FOR A NULL KEY
C
	KEY_0=0			! SET KEY 0 COUNT TO ZERO
	DO I=1,31
		RECORD(I)=0
	ENDDO
103	CONTINUE		! KEY 0 COUNT LOOP BACK POINT
	DO I=1,31		! INIT THE KEY TO SEARCH FOR FROM LAST RECORD
		KEY_31(I:I)=CHAR(RECORD(I))
	ENDDO
C
C	READ THE NEXT KEY 0  SYMBOL THAT IS GREATER THAN THE CURRENT SYMBOL
C
	READ(1,KEYID=0,KEYGT=KEY_31,ERR=104)RECORD
	KEY_0=KEY_0+1		! NEW SYMBOL FOUND-COUNT IT
	GOTO 103		! AND LOOP BACK TO SEE IF ANOTHER SYMBOL EXISTS
104	CONTINUE		! RAN OUT OF SYMBOLS FOR KEY 0
C
C	SCAN FOR NUMBER OF UNIQUE KEY 1
C
	KEY_1=0
	DO I=33,63
		RECORD(I)=0
	ENDDO
106	CONTINUE
	DO I=1,31
		KEY_31(I:I)=CHAR(RECORD(I+32))
	ENDDO
	READ(1,KEYID=1,KEYGT=KEY_31,ERR=107)RECORD
	KEY_1=KEY_1+1
	GOTO 106
107	CONTINUE
C
C	SCAN FOR NUMBER OF UNIQUE KEY 2
C
	KEY_2=0
	DO I=65,95
		RECORD(I)=0
	ENDDO
109	CONTINUE
	DO I=1,31
		KEY_31(I:I)=CHAR(RECORD(I+64))
	ENDDO
	READ(1,KEYID=2,KEYGT=KEY_31,ERR=110)RECORD
	KEY_2=KEY_2+1
	GOTO 109
110	CONTINUE
C
C	SCAN FOR NUMBER OF UNIQUE KEY 3
C
	KEY_3=0
	DO I=97,127
		RECORD(I)=0
	ENDDO
112	CONTINUE
	DO I=1,31
		KEY_31(I:I)=CHAR(RECORD(I+96))
	ENDDO
	READ(1,KEYID=3,KEYGT=KEY_31,ERR=113)RECORD
	KEY_3=KEY_3+1
	GOTO 112
113	CONTINUE
C
C	SCAN FOR NUMBER OF UNIQUE KEY 4
C
	KEY_4=0
	DO I=129,164
		RECORD(I)=0
	ENDDO
115	CONTINUE
	DO I=1,36
		KEY_36(I:I)=CHAR(RECORD(I+128))
	ENDDO
	READ(1,KEYID=4,KEYGT=KEY_36,ERR=116)RECORD
	KEY_4=KEY_4+1
	GOTO 115
116	CONTINUE
C
C	ALL RECORDS AND KEYS HAVE BEEN SCANNED-NOW TO REPORT THE RESULTS
C
C	NOTE THE ALT. ENTRY POINT TO ALLOW RE-DISPLAY OF THE RESULTS
C	FROM THE COMMAND LEVEL
C
	ENTRY	DISPLAY_ANALYSIS
C
	WRITE(6,200)RECORDS,KEY_0,KEY_1,KEY_2,KEY_3,KEY_4
200	FORMAT(
	1    ' Total number of records in data file                 is ',I6
	1 ,/,' Number of unique entries for Key_0 (NAME)            is ',I6
	1 ,/,' Number of unique entries for Key_1 (MODULE)          is ',I6
	1 ,/,' Number of unique entries for Key_2 (TAG)             is ',I6
	1 ,/,' Number of unique entries for Key_3 (STORAGE)         is ',I6
	1 ,/,' Number of unique entries for Key_4 (ARGUMENT USEAGE) is ',I6)
	RETURN
	END
	SUBROUTINE COMMANDS
	CHARACTER  COMMAND*2,VALUE*73
C
C	TAKE THE USER COMMANDS AND EXECUTE THEM
C
100	CONTINUE
C
C	LIST THE COMMANDS CURRENTLY AVAILABLE
C
	WRITE(6,500)
500	FORMAT(/,
	1 ' Commands            Currently available',//,
	1 ' Command             Action',/,
	1 ' DA                  Display Initial analysis',/,
	1 ' EX                  Exit Program',/,
	1 ' Dx                  Display All Unique Values of Key x  x=0..4',/,
	1 ' Kx symbol[,symbol]  List all records with the specified key x',/,
	1 '                     or with the range between specified symbols',/)

C
C	PROMPT FOR COMMAND
C
	WRITE(6,501)
501	FORMAT('$?')
	READ(5,502,END=506)COMMAND,VALUE	! READ COMMAND AND ARGUMENTS
502	FORMAT(A2,1X,A73)
C
C	DETERMINE COMMAND AND CARRY IT OUT
C
	IF(COMMAND.EQ.'EX')THEN			! EXIT-RETURN TO MAIN ROUTINE
506		RETURN				! AND DO A CLEAN SHUT DOWN
	ELSEIF(COMMAND.EQ.'DA')THEN		! RE-DISPLAY ANALYSIS RESULTS
		CALL DISPLAY_ANALYSIS
	ELSEIF(COMMAND(1:1).EQ.'D')THEN		! DISPLAY THE UNIQUE KEY VALUES
		I=ICHAR(COMMAND(2:2))-ICHAR('0')! GET KEY NUMBER TO DISPLAY
		IF(I.GE.0.AND.I.LE.4)THEN	! SEE IF LEGAL VALUE
			CALL LIST_KEY(I)	! LEGAL-LIST IT
		ELSE
			WRITE(6,503)		! ILLEGAL-SAY SO
503			FORMAT(' Invalid key number specified for Display')
		ENDIF
	ELSEIF(COMMAND(1:1).EQ.'K')THEN		! LIST RECORDS FOR SPECIFIED
		I=ICHAR(COMMAND(2:2))-ICHAR('0')! KEY AND SYMBOL RANGE
		IF(I.GE.0.AND.I.LE.4)THEN	! LEGAL KEY SYMBOL
			CALL EXAMINE_KEY(I,VALUE)
		ELSE
			WRITE(6,505)		! ILLEGAL KEY SYMBOL
505			FORMAT(' Invalid key number specified for Examine')
		ENDIF
	ELSE
		IF(COMMAND.NE.'  ')WRITE(6,504)	! NO SUCH COMMAND
504		FORMAT(' Invalid command entered')
	ENDIF
	GOTO 100				! GET NEXT COMMAND
	END
	SUBROUTINE LIST_KEY(KEY)
C
C	LIST ALL UNIQUE VALUES OF THE SPECIFIED KEY
C
	BYTE RECORD(0:196)
	CHARACTER KEY_31*31,KEY_36*36,KEY_NAME(0:4)*10
C
	DATA KEY_NAME/'NAME      ','MODULE    ','TAG       ',
	1             'STORAGE   ','ARGUMENT  '/
C
	WRITE(6,50)KEY,KEY_NAME(KEY)
50	FORMAT(' Unique entries for key ',I1,' (',A10,')',/)
C
	DO I=0,164
		RECORD(I)=0
	ENDDO
	IF(KEY.NE.4)THEN
100		CONTINUE
			DO I=1,31
				KEY_31(I:I)=CHAR(RECORD(I+KEY*32))
			ENDDO
			READ(1,KEYID=KEY,KEYGT=KEY_31,ERR=300)RECORD
			WRITE(6,101)(RECORD(J),J=KEY*32+1,KEY*32+31)
101			FORMAT(1X,31A1)
		GOTO 100
	ELSE
200		CONTINUE
			DO I=1,36
				KEY_36(I:I)=CHAR(RECORD(I+128))
			ENDDO
			READ(1,KEYID=4,KEYGT=KEY_36,ERR=300)RECORD
			WRITE(6,201)(RECORD(J),J=129,164)
201			FORMAT(1X,36A1)
		GOTO 200
	ENDIF
300	CONTINUE
	RETURN
	END
	SUBROUTINE EXAMINE_KEY(KEY,SYMBOL)
	CHARACTER SYMBOL*73,KEY_31*31,KEY_36*36,KEY_NAME(0:4)*10
	CHARACTER UPPER*36,LOWER*36,TEMP*36
	LOGICAL SWAP
	BYTE RECORD(0:196)
	INTEGER*4 RECORD_NUMBER
	DATA KEY_NAME/'NAME      ','MODULE    ','TAG       ',
	1             'STORAGE   ','ARGUMENT  '/
C
C	DISPLAY ALL RECORDS OF KEY "KEY" MATCHING "SYMBOL"
C	OR WITHIN THE RANGE OF THE 2 SYMBOLS GIVEN
C
	IU=0
	IL=0
	SWAP=.FALSE.
	UPPER='                                    '
	LOWER=UPPER
	DO I=1,73
		IF(SYMBOL(I:I).EQ.',')THEN
			SWAP=.TRUE.
		ELSEIF(SYMBOL(I:I).EQ.' ')THEN
		ELSEIF(.NOT.SWAP)THEN
			IU=IU+1
			UPPER(IU:IU)=SYMBOL(I:I)
		ELSE
			IL=IL+1
			LOWER(IL:IL)=SYMBOL(I:I)
		ENDIF
	ENDDO
	IF(IL.EQ.0)LOWER=UPPER
	IF(LOWER.GT.UPPER)THEN
		TEMP=LOWER
		LOWER=UPPER
		UPPER=TEMP
	ENDIF		
	IF(I.NE.4)THEN
		KEY_31=LOWER(1:31)
		READ(1,KEYID=KEY,KEYGE=KEY_31,ERR=300)RECORD
	ELSE
		KEY_36=LOWER
		READ(1,KEYID=4,KEYGE=KEY_36,ERR=300)RECORD
	ENDIF
	IF(UPPER.EQ.LOWER)THEN
		WRITE(6,50)KEY,KEY_NAME(KEY),LOWER
50		FORMAT(/,' List of records with key ',I1,' (',A10,
	1 	') matching symbol ',A36)
	ELSE
		WRITE(6,51)KEY,KEY_NAME(KEY),LOWER,UPPER
51		FORMAT(/,' List of records with key ',I1,' (',A10,
	1 	') in the range of symbols '/,1X,A36,' to ',A36)
	ENDIF
	IF(KEY.NE.4)THEN
		KEY_36(32:36)='     '
		DO I=1,31
			KEY_36(I:I)=CHAR(RECORD(KEY*32+I))
		ENDDO
	ELSE
		DO I=1,36
			KEY_36(I:I)=CHAR(RECORD(128+I))
		ENDDO
	ENDIF
	IF(KEY_36.GT.UPPER)GOTO 300
100	CONTINUE
	WRITE(6,101)
101	FORMAT(1X)
	WRITE(6,102)0,KEY_NAME(0),(RECORD(J),J=1,31)
102	FORMAT(10X,'Key ',I1,' (',A10,')  ',36(A1:))
	WRITE(6,102)1,KEY_NAME(1),(RECORD(J),J=33,63)
	WRITE(6,102)2,KEY_NAME(2),(RECORD(J),J=65,95)
	WRITE(6,102)3,KEY_NAME(3),(RECORD(J),J=97,127)
	WRITE(6,102)4,KEY_NAME(4),(RECORD(J),J=129,164)
	WRITE(6,104)(RECORD(J),J=165,196)
104	FORMAT(15X,' (Var. Type )  ',31A1)
	READ(1,ERR=200)RECORD
	IF(KEY.NE.4)THEN
		KEY_36(32:36)='     '
		DO I=1,31
			KEY_36(I:I)=CHAR(RECORD(KEY*32+I))
		ENDDO
	ELSE
		DO I=1,36
			KEY_36(I:I)=CHAR(RECORD(128+I))
		ENDDO
	ENDIF
	IF(KEY_36.LE.UPPER)GOTO 100
C
C	ALL MATCHING RECORDS HAVE BEEN OUTPUT
C
200	CONTINUE
	RETURN
C
C	NO SUCH SYMBOL
C
300	CONTINUE
	WRITE(6,301)
301	FORMAT(' No matching entries found ')
	RETURN
	END
