PROGRAM Direct_Access_File_Demo
!-----------------------------------------------------------------------
!  Program to read a part number during execution, access a record in
!  a direct access parts inventory file, and display this record.
!  Variables used are:
!    RecordLength  : length of records in the file (constant)
!    PartNumber    : a part number -- 0 to signal end of input
!    Filename      : name of the file
!    OpenStatus    : status variable for OPEN statement
!    InputStatus   : status variable for direct access READ
!    PartsRecord   : a record in the file
!
!  Input (keyboard): FileName, PartNumber
!  Input (file):     PartsRecord
!  Output (screen):  User prompts
!                    PartsRecord, or an error message for an invalid 
!                    part number
!  NOTE:  In this version of Fortran, the end-of-record mark is
!         counted in the record length.
!-----------------------------------------------------------------------

  IMPLICIT NONE
  INTEGER, PARAMETER :: RecordLength = 31
  INTEGER :: OpenStatus, InputStatus, PartNumber
  CHARACTER(20) :: FileName, PartsRecord*(RecordLength)

  ! Get the name of the file and open it for direct access

  WRITE (*, '(1X, A)', ADVANCE = "NO") "Enter name of file: "
  READ *, FileName

  OPEN (UNIT = 10, FILE = FileName, STATUS = "OLD", &
        ACCESS = "DIRECT", ACTION = "READ", POSITION = "REWIND", &
        FORM = "FORMATTED", RECL = RecordLength, IOSTAT = OpenStatus)
  IF (OpenStatus > 0) STOP " *** Cannot open file ***"

  ! Repeat the following so long as there are more
  ! part numbers to process:

  DO
     WRITE (*, '(1X, A)', ADVANCE = "NO") &
           "Enter part number (0 to stop): "
     READ *, PartNumber

     IF (PartNumber == 0) EXIT
     ! If no more part numbers to process, terminate repetition

     ! Otherwise, try to find the inventory record for this part
     READ (UNIT = 10, FMT = '(A)', REC = PartNumber, &
           IOSTAT = InputStatus) PartsRecord

     IF (InputStatus == 0) THEN 
        PRINT '(1X, "Part", I3, ": ", A)', PartNumber, PartsRecord
     ELSE
        PRINT '(1X, "Invalid part number: ", I3)', PartNumber
     END IF
  END DO

  CLOSE(10)

END PROGRAM Direct_Access_File_Demo