!

PROGRAM P105

!

!

! CLASS LIST RETRIEVAL PROGRAM

! FIND SOME STUDENT GRADES

! USING A HASHING SCHEME WITH THE ID AS THE KEY

!

! DECLARE ARRAYS FOR FILE

!

IMPLICIT NONE

CHARACTER (LEN=25) :: NAMES(100),NAME

INTEGER :: ID(100),MARKS(100,7),GRADES(7)

!

INTERFACE

SUBROUTINE HASH(ID,NR)

IMPLICIT NONE

INTEGER ,INTENT(IN OUT) :: ID(:),NR

END SUBROUTINE HASH

END INTERFACE

!

PRINT *, 'This is Program >> P105 = Hashing'

!

! Tell program where data for READ is coming from

OPEN(UNIT=5, FILE='P105.DAT') ! UNIT=5 is the default input

!

!

!===== ZERO OUT ALL ID'S FOR STARTERS

!

L1: DO J=1,100

ID(J)=0

END DO L1

!

!==== READ IN FILE AND STORE IN MAIN MEMORY

!

L2: DO J=1,100

READ 15,KD,NAME,GRADES

15 FORMAT(I7,1X,A25,7I3)

IF(KD == 0) GO TO 101

Print 15,KD,NAME,GRADES

CALL HASH(KD,NR)

31 IF(ID(NR) == 0) THEN

! STORE AWAY THE DATA IN ANY EMPTY SLOT

ID(NR)=KD

NAMES(NR)=NAME

L3: DO K=1,7

MARKS(NR,K)=GRADES(K)

END DO L3

!

!=== HERE WE DEAL WITH THE CASE OF A USED SLOT

! TRY THE NEXT OVER, BUT WATCH FOR END OF THE FILE

!

ELSE

NR=NR+1

! IF AT END - START AT BEGINNING

IF(NR > 100) NR=1

GO TO 31

END IF

END DO L2

PRINT 16

16 FORMAT(/'TOO MUCH DATA FOR DEFINED ARRAYS'/ &

'INCREASE ARRAY SIZE AND RERUN'//)

STOP

!

!==== READ AND PROCESS NAMES REQUESTED

!

101 NREC=J-1

PRINT 102,NREC

102 FORMAT(/'CLASS LIST PROGRAM - RETRIEVAL BY NAME'/ &

I5,' RECORDS ON FILE')

NREQ=0

L4: DO J=1,NREC

READ 202,KID

202 FORMAT(I7)

IF(KID == 0) THEN

PRINT 203,NREQ

203 FORMAT(I5,' REQUESTS PROCESSED'/)

STOP

ELSE

NREQ=NREQ+1

CALL HASH(KID,NR)

231 IF(ID(NR) == 0) THEN

PRINT 205,KID

205 FORMAT(I9,' NOT ON FILE - CHECK SPELLING')

ELSE

IF(KID == ID(NR)) THEN

PRINT 206,KID,NAMES(NR),(MARKS(NR,I),I=1,7)

206 FORMAT(I9,' ',A25,7I5)

ELSE

NR=NR+1

IF(NR > 100) NR=1

GO TO 231

END IF

END IF

END IF

END DO L4

STOP

END PROGRAM P105

!

SUBROUTINE HASH(ID,NR)

IMPLICIT NONE

INTEGER ,INTENT(IN OUT) :: ID(:),NR

INTEGER :: NPRIME=97

NR=MOD(ID,NPRIME)+1

RETURN

END SUBROUTINE HASH