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         : length of character strings (constant)
!   Formula        : array of formulas
!   Name           : array of names
!   SpecificHeat   : array of specific heats
!   MaxRecords     : maximum number of records in the file
!   NumRecords     : actual number of records in the file
!   AllocateStatus : status variable for ALLOCATE
!
! Input:  Arrays Formula, Name, and SpecificHeat (by 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
  CHARACTER (2*Length), DIMENSION(:), ALLOCATABLE :: Name
  REAL, DIMENSION(:), ALLOCATABLE :: SpecificHeat
  INTEGER :: MaxRecords, NumRecords, AllocateStatus

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

  ALLOCATE(Formula(MaxRecords),Name(MaxRecords),&
  SpecificHeat(MaxRecords), STAT = AllocateStatus)
  IF (AllocateStatus /= 0) STOP "*** Not enough memory ***"

  CALL ReadData(Formula, Name, SpecificHeat, MaxRecords, NumRecords)
  CALL LookUp(Formula, Name, SpecificHeat, NumRecords)
  STOP
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 are:
  !   FileName    : name of data file
  !   OpenStatus  : status variable for OPEN
  !   InputStatus : status variable for READ
  ! 
  ! 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(IN OUT) :: Formula, Name
    REAL, DIMENSION(:), INTENT(IN OUT) :: SpecificHeat
    INTEGER, INTENT(IN) :: MaxRecords
    INTEGER, INTENT(OUT) :: NumRecords
    INTEGER :: OpenStatus, InputStatus
    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", IOSTAT = OpenStatus)
    IF (OpenStatus > 0) STOP "*** Cannot open the file ***"

    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 = '(A10, A20, F6.0)', IOSTAT = InputStatus) &
         Formula(NumRecords), Name(NumRecords), SpecificHeat(NumRecords)
       IF (InputStatus > 0) STOP "*** Input error ***"

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

    END DO
    RETURN
  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.  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


    ! 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 '(A10)', 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
    RETURN
  END SUBROUTINE LookUp 

END PROGRAM Chemical_Formulas