Computers in Engineering WWW Site - Example 16.2

Example 16.2

FORTRAN Version

```!
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
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
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
```

Pascal Version

```{\$G256}
{\$P512}
{\$D+}
PROGRAM p102 (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 scan2 ( 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 ] );
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);
WHILE ( ( j <= rec ) AND ( key <> 'done                     ' ) ) DO
BEGIN
scan2 ( 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 );
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
```