!
PROGRAM P102
!
!
! CLASS LIST PROGRAM
! FIND SOME STUDENT GRADES
! USING A LINEAR SEARCH BY NAME
!
! DECLARE ARRAYS FOR FILE
!
IMPLICIT NONE
CHARACTER (LEN=25) :: NAME(100),KEY,COUNTS,NCOMP,APROBE
INTEGER :: ID(100),MARKS(100,7),NREC,I,J,NREQ,NC,KPOS
INTERFACE
SUBROUTINE SCAN2(LIST,N,KEY,KPOS,COUNTS,NCOMP)
IMPLICIT NONE
CHARACTER (LEN=25) ,INTENT(IN OUT) :: LIST(:),KEY
INTEGER ,INTENT(IN OUT) :: COUNTS,NCOMP,N,KPOS
END SUBROUTINE SCAN2
END INTERFACE
!
PRINT *, 'This is Program >> P102 = Linear Search in sorted data'
!
! Tell program where data for READ is coming from
OPEN(UNIT=5, FILE='P102.DAT') ! UNIT=5 is the default input
!
NC=0
!
!==== READ IN FILE AND STORE IN MAIN MEMORY
!
L1: DO J=1,100
READ 15,ID(J),NAME(J),(MARKS(J,I),I=1,7)
Print 15,ID(J),NAME(J),(MARKS(J,I),I=1,7)
15 FORMAT(I7,' ',A25,7I3)
IF(ID(J) == 0) GO TO 101
END DO L1
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')
L2: DO J=1,NREC
READ 202,KEY
202 FORMAT(A25)
IF(KEY == 'Done') THEN
NREQ=J-1
PRINT 203,NREQ
203 FORMAT(/ I5,' REQUESTS PROCESSED'/)
APROBE=NC/NREQ
PRINT 204,APROBE
204 FORMAT(/'AVERAGE NUMBER OF PROBES =',F6.1)
STOP
ELSE
CALL SCAN2(NAME,NREC,KEY,KPOS)
NC=NC+NCOMP
IF(KPOS <= 0) THEN
PRINT 205,KEY
205 FORMAT(/ A25,' NOT ON FILE - CHECK SPELLING'/)
ELSE
PRINT 206,ID(KPOS),KEY,(MARKS(KPOS,I),I=1,7)
206 FORMAT(I9,' ',A25,7I5)
END IF
END IF
END DO L2
STOP
END PROGRAM P102
!
SUBROUTINE SCAN2(LIST,N,KEY,KPOS,COUNTS,NCOMP)
IMPLICIT NONE
CHARACTER (LEN=25) ,INTENT(IN OUT) :: LIST(:),KEY
INTEGER ,INTENT(IN OUT) :: COUNTS,NCOMP,N,KPOS
INTEGER :: I
NCOMP=0
!
!==== LINEAR SEARCH ASSUMING SORTED DATA
!
L1: DO I=1,N
NCOMP=NCOMP+1
IF(KEY > LIST(I)) CYCLE
IF(KEY == LIST(I)) GO TO 100
KPOS=0
RETURN
END DO L1
KPOS=0
RETURN
100 KPOS=I
RETURN
END SUBROUTINE SCAN2