PROGRAM Chemical_Formulas
!-----------------------------------------------------------------------
! Program to read a file containing the chemical formula, name, and
! specific heat for various inorganic compounds and store these in
! parallel arrays.  The first line contains the number of items in 
! these lists.  Also, the file is sorted so that the formulas are in
! alphabetical order.  The user enters a formula; the list of formulas
! is searched using the binary search algorithm; and if the formula is
! found, its name and specific heat are displayed.   Identifiers used
! are:
!   Length       : parameter specifying length of character strings
!   Formula      : array of formulas
!   Name         : array of names
!   SpecificHeat : array of specific heats
!   MaxRecords   : maximum number of records in the file
!   NumRecords   : number of records in the file
!
! Input:  Arrays Formula, Name, and SpecificHeat (from ReadData)
! Output: Names and specific heats for certain formulas (by LookUp)
!-----------------------------------------------------------------------

  USE Search_Routines, ONLY : BinarySearch

  IMPLICIT NONE
  INTEGER, PARAMETER :: Length = 10
  CHARACTER(Length), DIMENSION(:), ALLOCATABLE :: &
                     Formula, Name*(2*Length)
  REAL, DIMENSION(:), ALLOCATABLE :: SpecificHeat
  INTEGER :: MaxRecords, NumRecords

  ! Allocate the arrays Formula, Name, and SpecificHeat
  WRITE (*, '(1X, A)', ADVANCE = "NO") &
        "Enter the maximum number of records in the file: "
  READ *, MaxRecords
  ALLOCATE(Formula(MaxRecords))
  ALLOCATE(Name(MaxRecords))
  ALLOCATE(SpecificHeat(MaxRecords))

  CALL ReadData(Formula, Name, SpecificHeat, MaxRecords, NumRecords)
  CALL LookUp(Formula, Name, SpecificHeat, NumRecords)

CONTAINS

  !-ReadData------------------------------------------------------------
  ! Subroutine to read a list of up to MaxRecords chemical formulas,
  ! names, and specific heats, store them in parallel arrays Formula,
  ! Name, and SpecificHeat, and count (NumRecords) how many sets of
  ! readings are stored.   Local variables used: 
  !   FileName  : name of data file
  !   EndOfFile : end-of-file indicator
  ! 
  ! Accepts:          Arrays Formula, Name, SpecificHeat,
  !                   integers MaxRecords and NumRecords
  ! Input (keyboard): FileName
  ! Input (file):     Elements of Formula, Name, SpecificHeat 
  ! Returns:          Arrays Formula, Name, SpecificHeat and NumRecords
  !---------------------------------------------------------------------
  
  SUBROUTINE ReadData(Formula, Name, SpecificHeat, MaxRecords, &
                      NumRecords)

    CHARACTER(*), DIMENSION(:), INTENT(INOUT) :: Formula, Name
    REAL, DIMENSION(:), INTENT(INOUT) :: SpecificHeat
    INTEGER, INTENT(IN) :: MaxRecords
    INTEGER, INTENT(OUT) :: NumRecords
    INTEGER :: EndOfFile
    CHARACTER(20) :: FileName
  
    ! Open the file, then read, count, and store the records
  
    WRITE (*, '(1X, A)', ADVANCE = "NO") "Enter name of file: "
    READ *, FileName
    OPEN (UNIT = 15, FILE = FileName, STATUS = "OLD")

    NumRecords  = 1
    DO  
       ! Check if there is still room in the arrays.  If not,
       ! terminate input and process the records that have been read.
       IF (NumRecords == MaxRecords) THEN
          PRINT *, "No more data can be read.  Processing the first"
          PRINT *, MaxRecords, " formulas."
          RETURN
       END IF

       ! Otherwise read and store more records
       READ (UNIT = 15, FMT = '(2A, F6.0)', IOSTAT = EndOfFile) &
         Formula(NumRecords), Name(NumRecords), SpecificHeat(NumRecords)
       NumRecords = NumRecords + 1

       ! If end of data, close the file and terminate repetition
       IF (EndOfFile < 0) THEN
          NumRecords = NumRecords - 1
          CLOSE (15)
          EXIT
       END IF

    END DO
   
  END SUBROUTINE ReadData
  
  !-LookUp--------------------------------------------------------------
  ! Subroutine that allows user to enter formulas.  The first NumRecords
  ! chemical formulas in array Formula are then searched for this
  ! formula, and if found, the corresponding elements of the parallel
  ! arrays Name and SpecificHeat are displayed.  User enters QUIT to
  ! stop searching.  Local identifiers used are:
  !     InputFormula :  formula entered by the user
  !     Found        :  signals if InputFormula found in array Formula
  !     Location     :  location of InputFormula in Formula if found
  !     Length       :  parameter used to specify length of InputFormula
  !
  ! Accepts:          Arrays Formula, Name, SpecificHeat, and
  !                   integer NumRecords
  ! Input (keyboard): Several values of InputFormula or a "QUIT" signal
  ! Output:           For each formula that is found, its name and 
  !                   specific heat; otherwise a "not found" message
  !---------------------------------------------------------------------  

  SUBROUTINE LookUp(Formula, Name, SpecificHeat, NumRecords)
  
    CHARACTER(*), DIMENSION(:), INTENT(IN) :: Formula, Name
    REAL, DIMENSION(:), INTENT(IN) ::  SpecificHeat
    INTEGER, INTENT(IN) :: NumRecords
    INTEGER :: Location
    INTEGER, PARAMETER :: Length = 10
    CHARACTER(Length) :: InputFormula
    LOGICAL :: Found
  
    PRINT *

   ! While there are formulas to search for, do the following:

    DO
       WRITE (*, '(1X, A)', ADVANCE = "NO") & 
             "Enter formula to search for, (QUIT to stop): "
       READ *, InputFormula
       IF (InputFormula == "QUIT") EXIT
       ! If done searching for formulas, terminate repetition
 
       ! Otherwise, search Formula array for InputFormula
       ! and display information found
  
       CALL BinarySearch(Formula(1:NumRecords), InputFormula, &
                        Found, Location)
       IF (Found) THEN
          PRINT '(1X, A, 1X, A, F7.4)', Name(Location), &
               "has specific heat",  SpecificHeat(Location)
       ELSE
          PRINT *, "      *** not found ***"
       END IF
    END DO
  
  END SUBROUTINE LookUp 

END PROGRAM Chemical_Formulas