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