PROGRAM Chemical_Formulas_2
!-----------------------------------------------------------------------
! Program to read a file containing the chemical formula, name, and
! specific heat for various inorganic compounds and store these in
! an array of structures.  The first line of the file contains the 
! number of compounds.  Also, the file is sorted so that the formulas 
! are in alphabetical order.  The user enters a formula; the array is
! searched using binary search to locate a structure containing this
! formula as one of its components.  If such a structure is found
! the name and specific heat components are displayed.   Identifiers
! used are:
!   Length       : length of character strings (constant)
!   ChemicalData : derived type
!   Compound     : array of structures of type ChemicalData
!   MaxRecords   : maximum number of records in the file
!   NumRecords   : number of records in the file
!
! Input:  Formulas, names, and specific heats (from ReadData)
!         -- stored in array Compound
! Output: Names and specific heats for certain formulas (by LookUp)
!-----------------------------------------------------------------------

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

    ! Get the number of records to be stored and 
  ! allocate the array Compound of this size
  WRITE (*, '(1X, A)', ADVANCE = "NO") &
        "Enter the maximum number of records in the file: "
  READ *, MaxRecords
  ALLOCATE(Compound(MaxRecords))

  CALL ReadData(Compound, MaxRecords, NumRecords)
  CALL LookUp(Compound, NumRecords)

CONTAINS

  !-ReadData------------------------------------------------------------
  ! Subroutine to read a list of up to MaxRecords chemical formulas,
  ! names, and specific heats, store them in an array of structures 
  ! (Compound), and count (NumRecords) how many sets of readings are 
  ! stored.  Local variables used: 
  !   FileName  : name of data file
  !   EndOfFile : end-of-file indicator
  ! 
  ! Accepts:          Array Compound and integer MaxRecords
  ! Input (keyboard): FileName
  ! Input (file):     Formulas, names, and specific heats
  ! Returns:          Array Compound 
  !---------------------------------------------------------------------
  
  SUBROUTINE ReadData(Compound, MaxRecords, NumRecords)

    TYPE(ChemicalData), DIMENSION(:), INTENT(INOUT) :: Compound
    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  = 0
    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
       NumRecords = NumRecords + 1
       READ (UNIT = 15, FMT = '(2A, F6.0)', IOSTAT = EndOfFile) &
         Compound(NumRecords)%Formula, Compound(NumRecords)%Name, &
         Compound(NumRecords)%SpecificHeat

       ! If end of data, adjust count, 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
  ! structures in array Compound are then searched to locate a structure
  ! whose Formula component matches this formula, and if found, the
  ! Name and SpecificHeat components 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:          Array Compound 
  ! 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(Compound, NumRecords)
  
    TYPE(ChemicalData), DIMENSION(:), INTENT(INOUT) :: Compound
    INTEGER, INTENT(IN) :: NumRecords
    INTEGER :: Location
    INTEGER, PARAMETER :: Length = 10
    CHARACTER(Length) :: InputFormula
    LOGICAL :: Found
  
    ! 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(Compound(1:NumRecords), InputFormula, &
                         Found, Location)
       IF (Found) THEN
          PRINT '(1X, A, 1X, A, F7.4)', Compound(Location)%Name, &
              "has specific heat", Compound(Location)%SpecificHeat
       ELSE
          PRINT *, "      *** not found ***"
       END IF
    END DO
  
  END SUBROUTINE LookUp 


  !-BinarySearch--------------------------------------------------------
  ! Subroutine to search the first NumRecords of array Compound to 
  ! locate a structure whose Formula component matches InputFormula
  ! using binary search,  If InputFormula is found, Found is returned as
  ! true and the Location of the structure is returned; otherwise Found
  ! is false. Local variables used are:
  !   First   :  first item in (sub)list being searched
  !   Last    :  last    "   "      "      "      " 
  !   Middle  :  middle  "   "      "      "      " 
  !
  ! Accepts:  Array Compound and InputFormula 
  ! Returns:  If InputFormula is found: 
  !              Found = true and Location = its position in array
  !              Compound
  !           Otherwise:
  !              Found = false (and Location = last position examined)
  !---------------------------------------------------------------------
  
  SUBROUTINE BinarySearch(Compound, InputFormula, Found, Location)
  
    TYPE(ChemicalData), DIMENSION(:), INTENT(IN) :: Compound
    CHARACTER(*), INTENT(IN) :: InputFormula
    LOGICAL, INTENT(OUT) :: Found
    INTEGER, INTENT(OUT) :: Location
    INTEGER :: First, Last, Middle
  
    First = 1
    Last = SIZE(Compound)
    Found = .FALSE.
  
      ! While First less than or equal to Last and not Found do
  
    DO
       IF ((First > Last) .OR. Found) RETURN
       ! If empty list to be searched or item found, return
  
       ! Otherwise continue with the following
  
       Middle = (First + Last) / 2
       IF (InputFormula < Compound(Middle)%Formula) THEN
          Last = Middle - 1
       ELSE IF (InputFormula > Compound(Middle)%Formula) THEN
          First = Middle + 1
       ELSE
          Found = .TRUE.
          Location = Middle
       END IF
    END DO
  
  END SUBROUTINE BinarySearch
  
END PROGRAM Chemical_Formulas_2