HP 3000 Manuals HP 3000 Manuals
Appendix E Indexed Sequential Access Program
The following program uses indexed sequential access (ISAM) I/O. Its
operation is described in comments within the program.
C**************************************************************************
C This program shows different indexed sequential access operations.
C This program is menu driven. It creates an ISAM file with three
C keys and writes some records into the file. It then displays the
C menu and prompts for these options: add, read, delete, and modify
C a record. This program has an option to dump the entire ISAM file.
C**************************************************************************
PROGRAM test1
INTEGER key,phone
CHARACTER buf*80,filename*8,keyed*5,unfo*4
EQUIVALENCE (buf(1:4),phone)
LOGICAL modified
C*******************************************************************
C field definition
C 1:4:integer ----------- primary key
C 5:15: character -------- alternate key (last name)
C 16:25: character ------- alternate key (first name)
C 26:80: character ------- not a key (for general description)
C*******************************************************************
filename = 'datafile'
keyed = 'keyed'
unfo = 'unfo'
C*************************************************************
C Define primary key as 1:4:integer
C secondary key1 : 5:15:character
C secondary key2 : 16:25:character
C*************************************************************
C OPEN ISAM file as
OPEN(10,file='DATAFILE',access='keyed',form='unfo',recl=80,
1 key=(1:4:integer,5:15:character,16:25),err=1000)
C*************************************************************
C ADD some records
C*************************************************************
phone = 1231111
buf(5:15) = 'micky'
buf(16:25)= 'mouse'
buf(26:) = ' DISNEYLAND'
WRITE (10,err=1 ) buf ! records might already be created
phone = 1232222
buf(5:15) = 'donald'
buf(16:25)= 'duck'
buf(26:) = ' DISNEYLAND'
WRITE (10) buf
phone = 1233333
buf(5:15) = 'big'
buf(16:25)= 'bird'
buf(26:) = ' SESAME STREET'
WRITE (10) buf
C*************************************************************
C PRINT the menu
C*************************************************************
5 CONTINUE
1 PRINT *,' ****************'
PRINT *,' M E N U'
PRINT *,' ****************'
PRINT *,' '
PRINT *,' 1. ADD A RECORD'
PRINT *,' 2. READ A RECORD'
PRINT *,' 3. DELETE A RECORD'
PRINT *,' 4. MODIFY A RECORD'
PRINT *,' 5. MENU'
PRINT *,' 6. EXIT'
PRINT *,' 7. DUMP THE FILE'
PRINT *,' '
PRINT *,' '
2 PRINT 11
11 FORMAT(' enter your option :',$)
READ *,i
GOTO (100,200,300,400,500,600,700) I
PRINT *,'invalid option, try again'
GOTO 2
12 FORMAT(1x,'enter phone number:',$)
13 FORMAT(1x,'enter first name:',$)
14 FORMAT(1x,'enter last name:',$)
15 FORMAT(1x,'enter project name(optional):',$)
C*************************************************************
C ADD a record
C*************************************************************
100 PRINT 12
READ *,phone
PRINT 13
READ (*,'(A10)') buf(16:25)
PRINT 14
READ (*,'(A11)') buf(5:15)
PRINT 15
READ (*,'(A55)') buf(26:80)
WRITE (10,err=101) buf
GOTO 1
101 PRINT *,'error in reading, try again'
GOTO 1
C*************************************************************
C READ a record
C*************************************************************
200 PRINT *,' 1. BY PHONE NUMBER'
PRINT *,' 2. BY FIRST NAME'
PRINT *,' 3. BY LAST NAME'
PRINT *,' '
PRINT *,' '
PRINT 11
READ *,i
IF (I .EQ. 1) THEN
PRINT 12
READ *,phone
READ (10,keyeq=phone,keyid=0,err=212,end=211,iostat=ii) buf
PRINT *,phone,' ',buf(5:)
ELSEIF (I .EQ. 2) THEN
PRINT 13
READ (*,'(A10)') buf(16:25)
READ (10,keyeq=buf(16:25),keyid=2,err=212,end=211,iostat=ii) buf
PRINT *,phone,' ',buf(5:)
ELSEIF (I .EQ. 3) THEN
PRINT 14
READ (*,'(A11)') buf(5:15)
READ (10,keyeq=buf(5:15),keyid=1,err=212,end=211,iostat=ii) buf
PRINT *,phone,' ',buf(5:)
ELSE
PRINT *,'invalid option, try again'
GOTO 200
ENDIF
GOTO 1
211 PRINT *,'record does not exist, try again',ii
GOTO 1
212 PRINT *,'error in reading :' ,ii
GOTO 1
C*************************************************************
C DELETE a record
C*************************************************************
300 PRINT 12
READ *,phone
READ (10,keyeq=phone,err=301) buf !default primary key
PRINT *,phone,' ',buf(5:70)
DELETE(10,err=302)
GOTO 1
301 PRINT *,'error in reading the record for delete'
GOTO 1
302 PRINT *,'error in deleting the record'
GOTO 1
C*************************************************************
C MODIFY a record
C*************************************************************
400 modified = .false.
PRINT 12
READ *,phone
READ(10,keyeq=phone,err=402) buf ! default is primary key
PRINT *,phone,' ',buf(5:)
401 PRINT *,' 1. first name'
PRINT *,' 2. last name',ii
PRINT *,' 3. project'
PRINT *,' 4. exit'
PRINT *,' '
PRINT 11
READ *,i
IF (I. EQ. 1) THEN
PRINT 13
READ (*,'(A10)') buf(16:25)
modified = .true.
ELSEIF (I. EQ. 2) THEN
PRINT 14
READ (*,'(A11)') buf(5:15)
modified = .true.
ELSEIF (I .EQ. 3) THEN
PRINT 15
READ (*,'(A55)') buf(26:80)
modified = .true.
ELSEIF (I .EQ. 4) THEN
IF (modified .EQ. .true.) THEN
REWRITE(10,err=441) buf
PRINT *,phone,' ',buf(5:70)
GOTO 1
ENDIF
ELSE
PRINT *,'invalid option, try again'
GOTO 401
ENDIF
GOTO 401
402 PRINT *,'record does not exist, try again'
GOTO 1
441 PRINT *,' rewriting the record failed'
GOTO 1
C******** MENU
500 GOTO 1
C******** EXIT
600 CLOSE (10)
STOP
C*************************************************************
C DUMP all the records in the ISAM file
C*************************************************************
700 phone = 0
READ (10,keygt=phone,err=702,iostat=ii) buf ! default is primary key
PRINT *, phone,' ',buf(5:76)
DO i=1,100 ! reading ISAM sequentailly
READ (10,err=702,end=701,iostat=ii) buf
PRINT *, phone,' ',buf(5:)
ENDDO
GOTO 1
701 PRINT *,' number of records in the file :',(i-1),ii
GOTO 1
702 PRINT *,' error in reading :',ii
GOTO 1
1000 PRINT *,' open failed on isam '
END