!
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