!
PROGRAM P101
!
!
! 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
INTEGER :: ID(100),MARKS(100,7),COUNTS,NCOMP
INTERFACE
SUBROUTINE KSCAN(LIST,N,KEY,KPOS,COUNTS,NCOMP)
IMPLICIT NONE
CHARACTER (LEN=25), INTENT(IN OUT) :: LIST(:),KEY
INTEGER, INTENT(IN OUT) :: N,KPOS,COUNTS,NCOMP
END SUBROUTINE KSCAN
END INTERFACE
!
PRINT *, 'This is Program >> P101 = Linear Search'
!
! Tell program where data for READ is coming from
OPEN(UNIT=5, FILE='P101.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 KSCAN(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,3X,A25,7I5)
END IF
END IF
END DO L2
STOP
END PROGRAM P101
!
SUBROUTINE KSCAN(LIST,N,KEY,KPOS,COUNTS,NCOMP)
IMPLICIT NONE
CHARACTER (LEN=25), INTENT(IN OUT) :: LIST(:),KEY
INTEGER, INTENT(IN OUT) :: N,KPOS,COUNTS,NCOMP
INTEGER :: I
NCOMP=0
L1: DO I=1,N
NCOMP=NCOMP+1
IF(KEY == LIST(I)) GO TO 100
END DO L1
KPOS=0
RETURN
100 KPOS=I
RETURN
END SUBROUTINE KSCAN