Example 16.1

FORTRAN Version

!
       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

Pascal Version

{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.

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