! 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
{G256} {P512} {D+} PROGRAM p101 (input, output); { Class list program Find some student grades using a linear search by name } TYPE char_string = ARRAY[1..25] OF CHAR; char_array = ARRAY[1..100] OF char_string; VAR blank : char; names : char_array; key : char_string; id : ARRAY[1..100] OF REAL; marks : ARRAY [ 1..100, 1..7 ] OF INTEGER; comp, j, i, rec, c, pos, req : INTEGER; probe : REAL; PROCEDURE scan ( list : char_array; n : INTEGER; key : char_string; VAR pos, comp : INTEGER); VAR i : INTEGER; BEGIN comp := 0; i := 0; REPEAT i := i + 1; comp := comp + 1; UNTIL ( ( i >= n ) OR ( key = list[i] ) ); IF ( key = list[i] ) THEN pos := i ELSE pos := 0 END; BEGIN c := 0; { Read in file and store in main memory } j := 0; REPEAT j := j + 1; read ( id[j], names[j] ); FOR i := 1 TO 7 DO read ( marks [ j, i ] ); readln; UNTIL ( ( j >= 100 ) OR ( id[j] = 0 ) ); IF ( id[j] <> 0 ) THEN BEGIN writeln; writeln ( 'too much data for defined arrays' ); writeln ( ' increase array size and rerun' ); writeln END { end if } ELSE { Read and process names requested } BEGIN rec := j - 1; writeln ( ^l ); writeln ( 'Class list program - retrieval by name' ); writeln ( rec:5, ' records on file' ); j := 1; read ( key, blank); readln; WHILE ( ( j <= rec ) AND ( key <> 'done ' ) ) DO BEGIN scan ( names, rec, key, pos, comp ); c := c + comp; IF ( pos <= 0 ) THEN BEGIN writeln; writeln ( key:25, ' not on file - check spelling' ) END { end if } ELSE BEGIN write ( id[pos]:9:0, ' ', key:25 ); FOR i := 1 TO 7 DO write ( marks [ pos, i ]:5 ); writeln END; { end else } j := j + 1; read ( key, blank ); readln END; { end while } req := j - 1; writeln; writeln ( req:5, ' requests processed' ); probe := c / req; writeln ( ' average number of probes =', probe:6:1 ) END { end else } END.DATA :
8414154 Binkley Mike 15 16 16 17 17 39 76 7613986 Bloom Milo 16 17 16 18 17 41 79 7412978 Cat Bill the 13 12 11 13 14 31 64 7613693 Dallas Steven 18 18 19 17 19 41 82 7515010 John Cutter 15 16 15 15 15 38 77 7510633 Jones Oliver W 17 17 18 17 17 42 80 7513221 Opus 19 19 19 18 19 45 91 0000000 Dummy 0 0 0 0 0 0 0 Jones John Cutter Bloom Milo Opuus done
Last modified: 08/07/97