MODULE free_module 
!###
!*****************************************************************************
!                                                                            *
!     Module Name: free_module                                               *
!                                                                            *
!     File Name: free_module.f90                                             *
!                                                                            *
!     Purpose:  Contains constants for program free                          *
!                                                                            *
!     Author:    Robert L. *****                                             *
!                                                                            *
!     Date: March 03, 2004                                                   *
!                                                                            *
!     Language:  Salford FORTRAN 95, Version 0.9.0                           *
!                                                                            *
!     Hardware: IBM Cosmpatible PC                                           *
!                                                                            *
!     Operating System: Microsoft Windows 98                                 *
!                                                                            *
!     Update History:                                                        *
!                                                                            *
!     Name        Date      Revision          Changes                        *
!     ----        ----      ---------         -------                        *
!                                                                            *
!    R.L. *****   03/03/04      0             Initial Release                *
!                                                                            *
!----------------------------------------------------------------------------*
!                                                                            *
!  Usage:                                                                    *
!                                                                            *
!  USE free_module                                                           *
!                                                                            *
!----------------------------------------------------------------------------*
!                                                                            *
!     Definitions:                                                           *
!                                                                            *
!     Local Variables:                                                       *
!     ----------------                                                       *
!                                                                            *
!     None                                                                   *
!                                                                            *
!     Global Variables:                                                      *
!     -----------------                                                      *
!                                                                            *
!     None                                                                   *
!                                                                            *
!     Local Common Blocks:                                                   *
!     -------------------                                                    *
!                                                                            *
!     None                                                                   *
!                                                                            *
!     Constants:                                                             *
!     ---------                                                              *
!                                                                            *
!     al_l_index       - Integer index of position of aluminum liquid        *
!                        index                                               *
!     al_g_index       - Integer index of position of aluminum gas           *
!                        index                                               *
!     aluminum_liq     - Real value of temperature for aluminum liquid       *
!     atom_divide      - Real value used to divide mole number for           *
!                        gases                                               *
!     b_size           - Integer size of b array                             *
!     c_index          - Integer index of position of carbon values          *
!     ca_g_index       - Integer index of position of calcium gas            *
!                        index                                               *
!     ca_l_index       - Integer index of position of calcium liquid         *
!                        index                                               *
!     ca_sa_index      - Integer index of position of calcium a              *
!                        index                                               *
!     ca_sb_index      - Integer index of position of calcium b              *
!                        index                                               *
!     calcium_ab       - Real value of temp break point between calcium      *
!                        a and calcium b                                     *
!     calcium_gas      - Real value of temp break point between calcium      *
!                        liquid and calcium gas                              *
!     calcium_liq      - Real value of temp break point between calcium      *
!                        b and calcium liquid                                *
!     char_len         - Integer value used as len of char to replace        *
!                        default length of 4 characters in one word for      *
!                        FORTRAN 4 and FORTRAN 77                            *
!     coef_size_first  - Integer size of first dimension of coef array       *
!     coef_size_second - Integer size of second dimension of coef            *
!                        array                                               *
!     coef_size_third  - Integer size of third dimension of coef array       *
!     double_kind      - Integer variable containing kind value for 15       *
!                        bit precision                                       *
!     double_p         - Integer value of number of digits of precision      *
!     error_first      - Integer value of error message for elements         *
!     error_second     - Integer value of error message for species          *
!                        name of input specie                                *
!     error_third      - Integer value of error message for species          *
!                        mole record                                         *
!     error_fourth     - Integer value of error message for input            *
!                        specie coefficient records                          *
!     file_len         - Integer value of length of file names               *
!     first_char_len   - Integer value of single character length            *
!     first_index      - Integer value of index to first set of              *
!                        coefficients                                        *
!     h2_index         - Integer index of position of hydrogen values        *
!     hsum_size        - Integer size of hsum array                          *
!     ht_size          - Integer size of ht array                            *
!     ial              - Character*2 containing 'AL'                         *
!     ic               - Character*1 containing 'C'                          *
!     ica              - Character*2 containing 'CA'                         *
!     ih               - Character*1 containing 'H'                          *
!     inp              - Integer value of input logical unit                 *
!     io               - Character*1 containing 'O'                          *
!     isi              - Character*2 containing 'SI'                         *
!     it               - Character*2 containing 'TI'                         *
!     last             - Character*4 containing 'LAST'                       *
!     lt_default       - Integer value default of lower limit of T           *
!                        range                                               *
!     lt_reset         - Integer value reset value of lower limit of T       *
!                        range if T1 greater than 1000 degrees               *
!     magnesium_gas    - Real value of temperature for magnesium gas         *
!     magnesium_liq    - Real value of temperature for magnesium liquid      *
!     mg               - Character*2 containing 'MG'                         *
!     mg_g_index       - Integer index of positon of magnesium gas           *
!                        index                                               *
!     mg_l_index       - Integer index of positon of magnesium liquid        *
!                        index                                               *
!     mg_s_index       - Integer index of positon of magnesium solid         *
!                        index                                               *
!     mid_temp         - Real value of temperature used to decide which      *
!                        set of coefficients to use                          *
!     mt_size          - Integer value of size of mt array                   *
!     nam_size         - Integer value of size of nam array                  *
!     nt_default       - Integer value default of upper limit of T           *
!                        range                                               *
!     nt_reset         - Integer value reset value of upper limit of T       *
!                        range if T2 less than 1000 degrees                  *
!     null_jj          - Integer value used as index to element when         *
!                        current mole value is zero or less                  *
!     num_elements     - Integer value of number of element                  *
!                        coefficients input for use as data                  * 
!     o2_index         - Integer index of position of oxygen values          *
!     out              - Integer value of output logical unit                *
!     phaz_len         - Integer value of length of phaz character           *
!     r                - Real parameter containing universal gas             *
!                        constant                                            *
!     second_char_len  - Integer value of double character length            *
!     second_index     - Integer value of index to second set of             *
!                        coefficients                                        *
!     si_l_index       - Integer index of position of silicon liquid         *
!                        index                                               *
!     si_s_index       - Integer index of position of silicon solid          *
!                        index                                               *
!     silicon_temp     - Real value of temperature for silicon break         *
!                        from solid to liquid                                *
!     st_size          - Integer size of st array                            *
!     status           - Integer value of status of last read                *
!     sum_all_size     - Integer size of sum_all array                       *
!     temp             - Real array containing t to be considered from       *
!                        DATA statement                                      *
!     temp_size        - Integer size of temp array                          *
!     ti_a_index       - Integer index of position of titanium alpha         *
!                        index                                               *
!     ti_b_index       - Integer index of position of titanium beta          *
!                        index                                               *
!     titanium_ab      - Real value of temperature break point between       *
!                        titanium alpha and beta                             *
!                                                                            *
!     Modules:                                                               *
!     --------                                                               *
!     None                                                                   *
!                                                                            *
!     Interfaces:                                                            *
!     -----------                                                            *
!                                                                            *
!     None                                                                   *
!                                                                            *
!*****************************************************************************
!###

  IMPLICIT none

  INTEGER,PARAMETER :: al_l_index       = 10
  INTEGER,PARAMETER :: al_s_index       = 9
  INTEGER,PARAMETER :: b_size           = 10
  INTEGER,PARAMETER :: c_index          = 2
  INTEGER,PARAMETER :: ca_g_index       = 14
  INTEGER,PARAMETER :: ca_l_index       = 13
  INTEGER,PARAMETER :: ca_sa_index      = 11
  INTEGER,PARAMETER :: ca_sb_index      = 12
  INTEGER,PARAMETER :: char_len         = 4
  INTEGER,PARAMETER :: coef_size_first  = 2
  INTEGER,PARAMETER :: coef_size_second = 7
  INTEGER,PARAMETER :: coef_size_third  = 20
  INTEGER,PARAMETER :: error_first      = 1
  INTEGER,PARAMETER :: error_second     = 2
  INTEGER,PARAMETER :: error_third      = 3
  INTEGER,PARAMETER :: error_fourth     = 4
  INTEGER,PARAMETER :: file_len         = 80
  INTEGER,PARAMETER :: first_char_len   = 1
  INTEGER,PARAMETER :: first_index      = 1
  INTEGER,PARAMETER :: h2_index         = 1
  INTEGER,PARAMETER :: hsum_size        = 20
  INTEGER,PARAMETER :: ht_size          = 20
  INTEGER,PARAMETER :: inp              = 5
  INTEGER,PARAMETER :: lt_default       = 1
  INTEGER,PARAMETER :: lt_reset         = 8
  INTEGER,PARAMETER :: mg_g_index       = 8
  INTEGER,PARAMETER :: mg_l_index       = 7
  INTEGER,PARAMETER :: mg_s_index       = 6
  INTEGER,PARAMETER :: mt_size          = 10
  INTEGER,PARAMETER :: nam_size         = 8 
  INTEGER,PARAMETER :: nt_default       = 18
  INTEGER,PARAMETER :: nt_reset         = 8
  INTEGER,PARAMETER :: null_jj          = 20
  INTEGER,PARAMETER :: num_elements     = 16
  INTEGER,PARAMETER :: o2_index         = 3
  INTEGER,PARAMETER :: out              = 6
  INTEGER,PARAMETER :: phaz_len         = 1
  INTEGER,PARAMETER :: second_char_len  = 2
  INTEGER,PARAMETER :: second_index     = 2
  INTEGER,PARAMETER :: si_l_index       = 5
  INTEGER,PARAMETER :: si_s_index       = 4
  INTEGER,PARAMETER :: st_size          = 20
  INTEGER,PARAMETER :: sum_all_size     = 20
  INTEGER,PARAMETER :: temp_size        = 18
  INTEGER,PARAMETER :: ti_a_index       = 15
  INTEGER,PARAMETER :: ti_b_index       = 16
 
  INTEGER, PARAMETER :: double_p        = 15
  INTEGER, PARAMETER :: double_kind     = selected_real_kind(p = double_p)

  REAL(kind = double_kind),PARAMETER             :: aluminum_liq  = 933.0
  REAL(kind = double_kind),PARAMETER             :: atom_divide   = 2.0
  REAL(kind = double_kind),PARAMETER             :: calcium_ab    = 737.0
  REAL(kind = double_kind),PARAMETER             :: calcium_gas   = 1756.0
  REAL(kind = double_kind),PARAMETER             :: calcium_liq   = 1123.0
  REAL(kind = double_kind),PARAMETER             :: magnesium_gas = 1363.0
  REAL(kind = double_kind),PARAMETER             :: magnesium_liq = 922.0
  REAL(kind = double_kind),PARAMETER             :: mid_temp      = 1000.0
  REAL(kind = double_kind),PARAMETER             :: r             = 8314.3/4184.
  REAL(kind = double_kind),PARAMETER             :: silicon_temp  = 1685.0
  REAL(kind = double_kind),PARAMETER             :: titanium_ab   = 1155.0

  REAL(kind = double_kind),DIMENSION(temp_size),PARAMETER  :: temp = &
                       (/  298.15,400., 500., 600., 700., &
                           800.,900.,1000.,1100.,1200., &
                           1300.,1400.,1500.,1600.,1700., &
                           1800.,1900.,2000./)

  CHARACTER(len = second_char_len),PARAMETER     :: ial  = 'AL'
  CHARACTER(len = first_char_len), PARAMETER     :: ic   = 'C'
  CHARACTER(len = second_char_len),PARAMETER     :: ica  = 'CA'
  CHARACTER(len = first_char_len), PARAMETER     :: ih   = 'H'
  CHARACTER(len = first_char_len), PARAMETER     :: io   = 'O'
  CHARACTER(len = second_char_len),PARAMETER     :: isi  = 'SI'
  CHARACTER(len = second_char_len),PARAMETER     :: it   = 'TI'
  CHARACTER(len = char_len),       PARAMETER     :: last = 'LAST'
  CHARACTER(len = second_char_len),PARAMETER     :: mg   = 'MG'

END MODULE free_module

MODULE read_error_module
!###
!*****************************************************************************
!                                                                            *
!     Module Name: read_error_module                                         *
!                                                                            *
!     File Name: read_error_module.f90                                       *
!                                                                            *
!     Purpose:  Contains interface for subroutine read_error                 *
!                                                                            *
!     Author:    Robert L. *****                                             *
!                                                                            *
!     Date: June 01, 2003                                                    *
!                                                                            *
!     Language:  Salford FORTRAN 95, Version 0.9.0                           *
!                                                                            *
!     Hardware: IBM Cosmpatible PC                                           *
!                                                                            *
!     Operating System: Microsoft Windows 98                                 *
!                                                                            *
!     Update History:                                                        *
!                                                                            *
!     Name        Date      Revision          Changes                        *
!     ----        ----      ---------         -------                        *
!                                                                            *
!    R.L. *****   06/01/03      0             Initial Release                *
!                                                                            *
!----------------------------------------------------------------------------*
!                                                                            *
!  Usage:                                                                    *
!                                                                            *
!  USE read_error_module                                                     *
!                                                                            *
!----------------------------------------------------------------------------*
!                                                                            *
!     Definitions:                                                           *
!                                                                            *
!     Local Variables:                                                       *
!     ----------------                                                       *
!                                                                            *
!     None                                                                   *
!                                                                            *
!     Global Variables:                                                      *
!     -----------------                                                      *
!                                                                            *
!     None                                                                   *
!                                                                            *
!     Local Common Blocks:                                                   *
!     -------------------                                                    *
!                                                                            *
!     None                                                                   *
!                                                                            *
!     Constants:                                                             *
!     ---------                                                              *
!                                                                            *
!     None                                                                   *
!                                                                            *
!     Modules:                                                               *
!     --------                                                               *
!     None                                                                   *
!                                                                            *
!     Interfaces:                                                            *
!     -----------                                                            *
!                                                                            *
!     read_error  - Process the status returned from a read                  *
!                                                                            *
!*****************************************************************************
!###
 
  IMPLICIT none
 
  INTERFACE error_read
 
    SUBROUTINE read_error( &
               unit, &
               message, &
               status)

      IMPLICIT none
      INTEGER,INTENT(in)     :: message
      INTEGER,INTENT(inout)  :: status
      INTEGER,INTENT(in)     :: unit

    END SUBROUTINE read_error
 
  END INTERFACE error_read
 
END MODULE read_error_module
 
PROGRAM free
!###
!***********************************************************************
!                                                                      *
!     Program Name: free                                               *
!                                                                      *
!     File Name: free.f90                                              *
!                                                                      *
!     Purpose: Program to compute Gibbs Free Energy of a species from  *
!              formation of its elements. Input data is in form of     *
!              coefficients derived from heat capacity, enthalpy, and  *
!              entropy by use of a least square program for the        *
!              elements and species. Written at Arizona State          *
!              University, under DR. John Holloway.                    *
!                                                                      *
!     Author:    Robert L. *****                                       *
!                                                                      *
!     Date:      JUNE 1, 1973                                          *
!                                                                      *
!     Language: Salford FORTRAN 95, Version 0.9.0                      *
!                                                                      *
!     Hardware: IBM Compatible PC                                      *
!                                                                      *
!     Operating System: Microsoft Windows 98                           *
!                                                                      *
!     Update History:                                                  *
!                                                                      *
!     Name          Date        Revision        Changes                *
!     ----          ----        ---------        -------               *
!                                                                      *
!    R.L. *****     06/01/73        0           Initial Release        *
!    R.L. *****     06/01/03        0           Converted to FORTRAN 95*
!                                                                      *
!----------------------------------------------------------------------*
!                                                                      *
!  Execution Command:                                                  *
!                                                                      *
!  free  Where:                                                        *
!                                                                      *
!     No Parameters                                                    *
!                                                                      *
!     Program will request name of input parameter file and output     *
!     listing file.                                                    *
!                                                                      *
!----------------------------------------------------------------------*
!                                                                      *
!     Definitions:                                                     *
!                                                                      *
!     Local Variables:                                                 *
!     ---------------                                                  *
!                                                                      *
!     atom       - Real variable containing stoichiometric coefficient *
!                  of element being considerec in computation          *
!     b          - Real array containing stoichiometric coefficient of *
!                  element read from the specie record                 *
!     coef       - Real array containing Coefficients read from element*
!                  data records and specie records                     *
!     date1      - Real variable containing reference date read from   *
!                  species record                                      *
!     date2      - Real variable containing reference date read from   *
!                  species record                                      *
!     day        - Integer value of current day of month               *
!     f          - Real variable containing Gibbs free energy          *
!     file_error - Logical variable used to denote file open error     *
!     h          - Real variable containing dimensionless enthalpy     *
!                  calculated from coefficient records                 *
!     hour       - Integer value of current hour of day                *
!     hsum       - Real array containing enthalpy of elements of specie*
!                  being considered                                    *
!     ht         - Real array containing summation of enthalpy of      *
!                  elements of specie being considered                 *
!     hundred    - Integer value of current hundredth second           *
!     i          - Integer variable used as do loop index              *
!     ine        - Integer variable used as counter to identify element*
!                  in specie record being considered                   *
!     infile     - Character*80 variable containing name of input file *
!     j          - Integer variable used as do loop index              *
!     jj         - Integer variable used to determine which element or *
!                  specie coefficients are to be used to compute s and *
!                  h                                                   *
!     k          - Integer variable used to Determine what set of      *
!                  coefficients are to be used from coefficient records*
!     kk         - Integer variable used to store value of k           *
!     l          - Integer variable used as do loop index              *
!     lt         - Integer variable used as lower limit of T range     *
!     m          - Integer variable used as do loop index              *
!     main_loop  - Logical variable used to control main loop          *
!     minute     - Integer value of current minute of day              *
!     month      - Integer value of current month of the year          *
!     mt         - Character*4 array containing alphameric symbol of   *
!                  element in specie record                            *
!     n          - Integer variable used as do loop index              *
!     nam        - Character*4 array containing alphameric name of     *
!                  specie being considered                             *
!     not_open   - Integer variable used to return status of file open *
!     nt         - Integer variable containing upper limit of T range  *
!     outfile    - Character*80 variable containing name of output file*
!     phaz       - Character*1 variable containing Phase of specie     *
!                  being considered                                    *
!     s          - Real variable containing dimensionless entropy      *
!                  calculated from coefficient records                 *
!     second     - Integer value of current second of day              *
!     st         - Real array containing summation of entropy of       *
!                  elements in specie being considered                 *
!     sum_all    - Real array containing entropy of specie being       *
!                  considered                                          *
!     t1         - Real variable containing lower limit of T range read*
!                  from specie records                                 *
!     t2         - Real variable containing upper limit of T range read*
!                  from specie records                                 *
!     tln        - Real variable containing log T, natural logarithm of*
!                  T being considered                                  *
!     tt         - Real variable containing present T being considered *
!     vol        - Real variable containing molar volume of specie     *
!                  being considered                                    *
!     year       - Integer value of current year                       *
!                                                                      *
!     Global Variables:                                                *
!     ----------------                                                 *
!                                                                      *
!     None                                                             *
!                                                                      *
!     Local Common Blocks:                                             *
!     -------------------                                              *
!                                                                      *
!     None                                                             *
!                                                                      *
!     Constants:                                                       *
!     ---------                                                        *
!                                                                      *
! ** Note - Magic numbers left in to ease examination of some formulas *
!     free_module                                                      *
!     al_l_index       - Integer index of position of aluminum liquid  *
!                        index                                         *
!     al_g_index       - Integer index of position of aluminum gas     *
!                        index                                         *
!     aluminum_liq     - Real value of temperature for aluminum liquid *
!     atom_divide      - Real value used to divide mole number for     *
!                        gases                                         *
!     b_size           - Integer size of b array                       *
!     c_index          - Integer index of position of carbon values    *
!     ca_g_index       - Integer index of position of calcium gas      *
!                        index                                         *
!     ca_l_index       - Integer index of position of calcium liquid   *
!                        index                                         *
!     ca_sa_index      - Integer index of position of calcium a        *
!                        index                                         *
!     ca_sb_index      - Integer index of position of calcium b        *
!                        index                                         *
!     calcium_ab       - Real value of temp break point between calcium*
!                        a and calcium b                               *
!     calcium_gas      - Real value of temp break point between calcium*
!                        liquid and calcium gas                        *
!     calcium_liq      - Real value of temp break point between calcium*
!                        b and calcium liquid                          *
!     char_len         - Integer value used as len of char to replace  *
!                        default length of 4 characters in one word for*
!                        FORTRAN 4 and FORTRAN 77                      *
!     coef_size_first  - Integer size of first dimension of coef array *
!     coef_size_second - Integer size of second dimension of coef      *
!                        array                                         *
!     coef_size_third  - Integer size of third dimension of coef array *
!     double_kind      - Integer variable containing kind value for 15 *
!                        bit precision                                 *
!     double_p         - Integer value of number of digits of precision*
!     error_first      - Integer value of error message for elements   *
!     error_second     - Integer value of error message for species    *
!                        name of input specie                          *
!     error_third      - Integer value of error message for species    *
!                        mole record                                   *
!     error_fourth     - Integer value of error message for input      *
!                        specie coefficient records                    *
!     file_len         - Integer value of length of file names         *
!     first_char_len   - Integer value of single character length      *
!     first_index      - Integer value of index to first set of        *
!                        coefficients                                  *
!     h2_index         - Integer index of position of hydrogen values  *
!     hsum_size        - Integer size of hsum array                    *
!     ht_size          - Integer size of ht array                      *
!     ial              - Character*2 containing 'AL'                   *
!     ic               - Character*1 containing 'C'                    *
!     ica              - Character*2 containing 'CA'                   *
!     ih               - Character*1 containing 'H'                    *
!     inp              - Integer value of input logical unit           *
!     io               - Character*1 containing 'O'                    *
!     isi              - Character*2 containing 'SI'                   *
!     it               - Character*2 containing 'TI'                   *
!     last             - Character*4 containing 'LAST'                 *
!     lt_default       - Integer value default of lower limit of T     *
!                        range                                         *
!     lt_reset         - Integer value reset value of lower limit of T *
!                        range if T1 greater than 1000 degrees         *
!     magnesium_gas    - Real value of temperature for magnesium gas   *
!     magnesium_liq    - Real value of temperature for magnesium liquid*
!     mg               - Character*2 containing 'MG'                   *
!     mg_g_index       - Integer index of positon of magnesium gas     *
!                        index                                         *
!     mg_l_index       - Integer index of positon of magnesium liquid  *
!                        index                                         *
!     mg_s_index       - Integer index of positon of magnesium solid   *
!                        index                                         *
!     mid_temp         - Real value of temperature used to decide which*
!                        set of coefficients to use                    *
!     mt_size          - Integer value of size of mt array             *
!     nam_size         - Integer value of size of nam array            *
!     nt_default       - Integer value default of upper limit of T     *
!                        range                                         *
!     nt_reset         - Integer value reset value of upper limit of T *
!                        range if T2 less than 1000 degrees            *
!     null_jj          - Integer value used as index to element when   *
!                        current mole value is zero or less            *
!     num_elements     - Integer value of number of element            *
!                        coefficients input for use as data            * 
!     o2_index         - Integer index of position of oxygen values    *
!     out              - Integer value of output logical unit          *
!     phaz_len         - Integer value of length of phaz character     *
!     r                - Real parameter containing universal gas       *
!                        constant                                      *
!     second_char_len  - Integer value of double character length      *
!     second_index     - Integer value of index to second set of       *
!                        coefficients                                  *
!     si_l_index       - Integer index of position of silicon liquid   *
!                        index                                         *
!     si_s_index       - Integer index of position of silicon solid    *
!                        index                                         *
!     silicon_temp     - Real value of temperature for silicon break   *
!                        from solid to liquid                          *
!     st_size          - Integer size of st array                      *
!     status           - Integer value of status of last read          *
!     sum_all_size     - Integer size of sum_all array                 *
!     temp             - Real array containing t to be considered from *
!                        DATA statement                                *
!     temp_size        - Integer size of temp array                    *
!     ti_a_index       - Integer index of position of titanium alpha   *
!                        index                                         *
!     ti_b_index       - Integer index of position of titanium beta    *
!                        index                                         *
!     titanium_ab      - Real value of temperature break point between *
!                        titanium alpha and beta                       *
!                                                                      *
!     Modules:                                                         *
!     --------                                                         *
!                                                                      *
!     free_module       - Contains constants for free                  *
!     read_error_module - Contains interface for read_error            *
!                                                                      *
!     External Software:                                               *
!     -----------------                                                *
!                                                                      *
!     alog               - FORTRAN 95 math library routine for log     *
!                          value                                       *
!     getdat             - FORTRAN 95 routine to get current date      *
!     gettim             - FORTRAN 95 routine to get current time      *
!     read_error         - Routine to check status of last read for    *
!                          errors                                      *
!     selected_real_kind - FORTRAN  95 routine that returns kind type  *
!                          for precision required                      *
!                                                                      *
!     Files:                                                           *
!     -----                                                            *
!                                                                      *
!       Input Files:                                                   *
!                                                                      *
!       infile       - Input parameter file                            *
!                                                                      *
!       Intermediate Files:                                            *
!                                                                      *
!       None                                                           *
!                                                                      *
!       Output Files:                                                  *
!                                                                      *
!       outfile      - Output listing file                             *
!                                                                      *
!***********************************************************************
!###
 
  USE free_module
  USE read_error_module
 
  IMPLICIT none
  
  REAL(kind = double_kind),DIMENSION(coef_size_first,coef_size_second, &
                                     coef_size_third) :: coef
 
  REAL(kind = double_kind),DIMENSION(b_size)       :: b
  REAL(kind = double_kind),DIMENSION(hsum_size)    :: hsum
  REAL(kind = double_kind),DIMENSION(ht_size)      :: ht
  REAL(kind = double_kind),DIMENSION(st_size)      :: st
  REAL(kind = double_kind),DIMENSION(sum_all_size) :: sum_all
  
  REAL(kind = double_kind) :: atom
  REAL(kind = double_kind) :: date1
  REAL(kind = double_kind) :: date2
  REAL(kind = double_kind) :: f
  REAL(kind = double_kind) :: h
  REAL(kind = double_kind) :: s
  REAL(kind = double_kind) :: t1
  REAL(kind = double_kind) :: t2
  REAL(kind = double_kind) :: tln
  REAL(kind = double_kind) :: tt
  REAL(kind = double_kind) :: vol
 
  INTEGER :: i
  INTEGER :: ine
  INTEGER :: j
  INTEGER :: jj
  INTEGER :: k
  INTEGER :: kk
  INTEGER :: l
  INTEGER :: lt
  INTEGER :: n
  INTEGER :: m
  INTEGER :: not_open
  INTEGER :: nt
  INTEGER :: status
 
  INTEGER :: day
  INTEGER :: hour
  INTEGER :: hundred
  INTEGER :: minute
  INTEGER :: month
  INTEGER :: second
  INTEGER :: year
 
  CHARACTER(len = file_len) :: infile
  CHARACTER(len = file_len) :: outfile
  CHARACTER(len = phaz_len) :: phaz
 
  CHARACTER(len = char_len),DIMENSION(mt_size)   :: mt
  CHARACTER(len = char_len),DIMENSION(nam_size)  :: nam
  
  LOGICAL :: file_error
  LOGICAL :: main_loop

! Get the input and output file names
 
  WRITE(*,fmt = "(a)",advance = 'NO')' Input name of input file : '
  READ (*,*) infile
  WRITE(*,fmt = "(a,a)")' INPUT FILE : ',infile
  WRITE(*,fmt = "(a)",advance = 'NO')' Input name of output file : '
  READ (*,*) outfile
  WRITE(*,fmt = "(a,a)") ' OUTPUT FILE : ',outfile
 
  file_error = .false.
  main_loop =  .true.

! Open the input and output files and check for open errors
 
  OPEN(unit = out,file = outfile,status = 'unknown',iostat = not_open)

  free_1 : IF (not_open /= 0) THEN
    WRITE(*,fmt = "(a)") 'UNABLE TO OPEN LISTING FILE'
    WRITE(*,fmt = "(a)") 'PROGRAM TERMINATED'
    main_loop = .false.
    file_error = .true.

  ELSE free_1
    REWIND out
    OPEN(unit = inp,file = infile,status = 'old',iostat = not_open)
    free_2 : IF (not_open /= 0) THEN
      WRITE(*,fmt = "(a)") 'UNABLE TO OPEN INPUT FILE'
      WRITE(*,fmt = "(a)") 'PROGRAM TERMINATED'
      main_loop = .false.
      file_error = .true.
    END IF free_2
  END IF free_1

  free_3 : IF(.not.file_error)THEN
    REWIND inp
  END IF free_3

! Output current date, time and file names to listing file
 
  CALL getdat( &
       year, &
       month, &
       day)
  CALL gettim( &
       hour, &
       minute, &
       second, &
       hundred)
  WRITE(unit = out,fmt = "(a,i2.2,a,i2.2,a,i4)")&
       ' Date = ',month,'/',day,'/',year
  WRITE(unit = out,fmt = "(a,i2.2,a,i2.2)")&
       ' Time = ',hour,':',minute
  WRITE(unit = out,fmt = "(a)")" " 
  WRITE(unit = out,fmt="(a,a)")" Input File  = ",infile
  WRITE(unit = out,fmt="(a,a)")" Output File = ",outfile
  WRITE(unit = out,fmt = "(a)")" " 
  status = 0

! Read and store element data.

  free_4 : DO n = 1,num_elements
    READ(unit = inp,fmt = "(5e15.0,/,5e15.0,/,4e15.0,)",iostat = status) &
   (coef(1,j,n),j = 1,5),(coef(1,k,n),k = 6,7), &
   (coef(2,l,n),l = 1,3),(coef(2,m,n),m = 4,7)
   CALL read_error( &
        unit = inp, &
        message = error_first, &
        status = status)
   free_5 : IF(status /= 0)THEN
     main_loop = .false.
     EXIT free_4
   END IF free_5

  END DO free_4

! Read and store specie data for specie to compute free energy for.

  free_6 : DO WHILE(main_loop)
    READ(unit = inp,fmt = "(8a4,6x,2a3,2x,a1,2e10.0)",iostat = status) &
    (nam(i),i = 1,8),date1,date2,phaz,t1,t2
    CALL read_error( &
         unit = inp, &
         message = error_second, &
         status = status)
    free_7 : IF(status /= 0)THEN
      EXIT free_6
    END IF free_7

! If last record read, exit loop and exit program

    free_8 : IF(nam(1) == last) THEN
      EXIT free_6
    END IF free_8

! Read specit element symbols, mole numbers and volume

    READ(unit = inp,fmt = "(10(a2,f3.0),e15.8)",iostat = status) &
    (mt(j),b( j),j = 1,10),vol
    CALL read_error( &
         unit = inp, &
         message = coef_size_third, &
         status = status)

    free_9 : IF(status /= 0)THEN
      EXIT free_6
    END IF free_9

    WRITE(unit = out,fmt = &
         "(1x,8a4,6x,2a3,6x,a1,6x,2f14.3,/,/,1x,10(a2,f5.0),e16.8,/)") &
         (nam(i),i = 1,8),date1,date2,phaz,t1,t2,(mt(j), &
         b(j),j = 1,10),vol

! Read current species coefficients

    READ(unit = inp,fmt = "(5e15.8,/,5e15.8,/,4e15.8)",iostat = status) &
    (coef(1,j,20),j = 1,5),(coef(1,k,20),k = 6,7),(coef(2,l,20),l = 1,3), &
    (coef(2,m,20),m = 4,7)
    CALL read_error( &
         unit = inp, &
         message = error_fourth, &
         status = status)

    free_10 : IF(status /= 0)THEN
      EXIT free_6
    END IF free_10

    WRITE(unit = out,fmt = "(/,1x,5e15.8,/,1x,5e15.8,/,1x,4e15.8,/)") &
    (coef(1,j,20),j = 1,5),(coef(1,k,20),k = 6,7),(coef(2,l,20),l = 1,3), &
    (coef(2,m,20),m = 4,7)

! Output header labels in output listing file

    WRITE(unit = out,fmt = "(/,4x,a,8x,a,9x,a,4x,a,/,4x,a,20x,a,8x,a,/)") &
    'TEMP.','DELH','ST','FREE ENERGY','DEG/K','CAL.','KCAL'

! Set temperature range.

    lt = lt_default
    nt = nt_default
    free_11 : IF(t1 > mid_temp)THEN
      lt = lt_reset
    END IF free_11

    free_12 : IF(t2 <= mid_temp) THEN
      nt = nt_reset
    END IF free_12

    free_13 : DO j = lt,nt
      tt = temp(j)
      tln = alog(tt)
      st(j) = 0.
      ht(j) = 0.
      ine = 1

      free_14 : DO
        free_15 : IF(b(ine) <= 0.0)THEN
          jj = null_jj
        END IF free_15
        atom = b(ine)

! Choose individual element of specie.

! Hydrogen

        free_16 : SELECT CASE (mt(ine))
          CASE (ih) free_16
            atom = atom/atom_divide
            jj = h2_index

! Carbon

          CASE(ic) free_16
            jj = c_index

! Oxygen

          CASE(io) free_16
            atom = atom/atom_divide
            jj = o2_index

! Silicon, solid and liquid

          CASE(isi) free_16
            jj = si_s_index
            free_17 : IF(tt > silicon_temp)THEN
              jj = si_l_index
            END IF free_17

! Magnesium,  solid, liquid and gas

         CASE(mg) free_16
           jj= mg_s_index
           free_18 : IF(tt >  magnesium_liq)THEN
             jj = mg_l_index
           END IF free_18
           free_19 : IF(tt >= magnesium_gas)THEN
             jj = mg_g_index
           END IF free_19

! Aluminum, solid and liquid

          CASE(ial) free_16
            jj  = al_s_index
            free_20 : IF(tt > aluminum_liq) THEN
              jj = al_l_index
            END IF free_20

! Calcium, solid, liquid and gas

          CASE(ica) free_16
            jj = ca_sa_index
            free_21 : IF(tt > calcium_ab )THEN
              jj = ca_sb_index
            END IF free_21
            free_22 : IF(tt > calcium_liq)THEN
              jj = ca_l_index
            END IF free_22
            free_23 : IF(tt > calcium_gas)THEN
              jj = ca_g_index
            END IF free_23

! Titanium, alpha and beta

          CASE(it) free_16
            jj = ti_a_index
            free_24 : IF(tt > titanium_ab) THEN
              jj = ti_b_index
            END IF free_24
 
        END select free_16
 

! Use first seven values

        k = first_index

! Use last seven values

        free_25 : IF(tt <= mid_temp) THEN
          k = second_index
        END IF free_25
        kk = k
 
        free_26 : IF(coef(k,1,jj) == 0.0) THEN
          free_27 : IF(kk == 2)THEN
            k = first_index
          END IF free_27
          free_28 : IF(kk == 1)THEN
            k = second_index
          END IF free_28
        END IF free_26

! Compute s/r and ht-ho/rt

        s = coef(k,1,jj)*tln+coef(k,2,jj)*tt+coef(k,3,jj)*(tt**2/2.)+ &
            coef(k,4,jj)*(tt**3/3.)+coef(k,5,jj)*(tt**4/4.)+coef(k,7,jj)
        h = coef(k,1,jj)+coef(k,2,jj)*(tt/2.)+coef(k,3,jj)*(tt**2/3.)+ &
            coef(k,4,jj)*(tt**3/4.)+coef(k,5,jj)*(tt**4/5.)+coef(k,6,jj)/tt

! Sum heat of formation and entropy of elements in ht(j) and st(j)

        free_29 : IF(b(ine) == 0.0) THEN
          EXIT free_14
        END IF free_29

        ht(j) = ((h * r * tt) * atom) + ht(j)
        st(j) = ((s * r) * atom) + st(j)
        ine = ine + 1

      END DO free_14

! Sum heat of formation and entropy of species in hsum(j) and sum_all(j)

      hsum(j)    = h * r * tt
      sum_all(j) = s * r

    END DO free_13

    free_30 : DO i = lt,nt

! Compute Gibbs Free Energy

      f = (hsum(i) - ht(i)) - (temp(i)*(sum_all(i) - st(i)))
      f = f / mid_temp
      hsum(i) = hsum(i) / (r * temp(i))
      WRITE(unit = out,fmt = "(1x,f8.2,3f12.3)")temp(i),hsum(i),sum_all(i),f
    END DO free_30

! Go back for next specie to compute Free Energy for it

  END DO free_6
 
END PROGRAM free

SUBROUTINE read_error( &
           input_unit, &
           message_number, &
           status)
!###
!*****************************************************************************
!                                                                            *
!     Subroutine Name: read_error                                            *
!                                                                            *
!     File Name: read_error.f90                                              *
!                                                                            *
!     Purpose:  Checks the status of a read and if an error occurred,        *
!               outputs the appropiate error message.                        *
!                                                                            *
!     Author:    Robert L. *****                                             *
!                                                                            *
!     Date: June 01, 2003                                                    *
!                                                                            *
!     Language: Salford FORTRAN 95, Version 0.9.0                            *
!                                                                            *
!     Hardware: IBM Compatible PC                                            *
!                                                                            *
!     Operating System: MICROSOFT Windows 98                                 *
!                                                                            *
!     Update History:                                                        *
!                                                                            *
!     Name        Date      Revision          Changes                        *
!     ----        ----      ---------         -------                        *
!                                                                            *
!    R.L. *****   06/01/03      0             Initial Release                *
!                                                                            *
!----------------------------------------------------------------------------*
!                                                                            *
!  Usage:                                                                    *
!                                                                            *
!  CALL read_error(                                                          *
!       input_unit,                                                          *
!       message_number,                                                      *
!       status) where                                                        *
!                                                                            *
!     input_unit     - integer value of logical output unit                  *
!     message_number - integer value of message to output                    *
!     status         - integer value of status returned from read            *
!                      <0 - end of file read                                 *
!                       0 - no error                                         *
!                      >0 - read error                                       *
!                                                                            *
!                                                                            *
!----------------------------------------------------------------------------*
!                                                                            *
!     Definitions:                                                           *
!                                                                            *
!     Local Variables:                                                       *
!     ----------------                                                       *
!                                                                            *
!     message       - Chracter array  containing error messages to output    *
!     message_index - Integer variable used to find which error message to   *
!                     output                                                 *
!     re_read       - Character*80 buffer used to read previous record       *
!                                                                            *
!     Global Variables:                                                      *
!     -----------------                                                      *
!     None                                                                   *
!                                                                            *
!     Local Common Blocks:                                                   *
!     -------------------                                                    *
!                                                                            *
!     None                                                                   *
!                                                                            *
!     Constants:                                                             *
!     ---------                                                              *
!                                                                            *
!     message_offset  - Integer value for offset of message number to use    *
!                                                                            *
!     Modules:                                                               *
!     --------                                                               *
!                                                                            *
!     None                                                                   *
!                                                                            *
!                                                                            *
!     External Software:                                                     *
!     -----------------                                                      *
!                                                                            *
!     None                                                                   *
!                                                                            *
!     Files:                                                                 *
!     -----                                                                  *
!                                                                            *
!       Input Files:                                                         *
!                                                                            *
!       unit - Input logical unit where read error occurred                  *
!                                                                            *
!       Intermediate Files:                                                  *
!                                                                            *
!       None                                                                 *
!                                                                            *
!       Output Files:                                                        *
!                                                                            *
!       Outputs to computer screen                                           *
!                                                                            *
!*****************************************************************************
!###
 
  IMPLICIT none
 
  INTEGER               :: message_index
 
  INTEGER,INTENT(in)     :: message_number
  INTEGER,INTENT(inout)  :: status
  INTEGER,INTENT(in)     :: input_unit
 
  INTEGER,PARAMETER :: message_offset  = 2
 
  CHARACTER(len = 80) :: re_read
 
  CHARACTER(len = *),DIMENSION(8),PARAMETER :: message = &
                  (/' ERROR IN ABOVE ELEMENT RECORD            ', &
                    ' EOF READ WHILE READING ELEMENT RECORD    ', &
                    ' ERROR IN ABOVE SPECIE NAME RECORD        ', &
                    ' EOF READ WHILE READING SPECIE NAME RECORD', &
                    ' ERROR IN ABOVE ELEMENT RECORD            ', &
                    ' EOF READ WHILE READING ELEMENT RECORD    ', &
                    ' ERROR IN ABOVE COEFFICIENT RECORD        ', &
                    ' EOF READ WHILE READING COFFICIENT RECORD '/)
  IF(status >0)THEN
    BACKSPACE(unit=input_unit)
    READ(unit=input_unit,fmt="(a80)")re_read
    WRITE(*,fmt="(1x,a80)")re_read
    message_index = (message_number*message_offset) - 1
    WRITE(*,FMT="(a)")message(message_index)

  ELSE IF(status < 0)THEN

    message_index = message_number*message_offset
    WRITE(*,fmt="(a)")message(message_index)

  END IF
 
END SUBROUTINE read_error

SUBROUTINE getdat(iyr,imon,iday)
 
! Temporary fix for Salford Compiler which does not have getdat
 
  IMPLICIT none
 
  INTEGER :: iday
  INTEGER :: imon
  INTEGER :: iyr
 
  INTEGER,PARAMETER :: date_all_size  = 8
  INTEGER,PARAMETER :: day_index      = 3
  INTEGER,PARAMETER :: mon_index      = 2
  INTEGER,PARAMETER :: time_date_size = 8
  INTEGER,PARAMETER :: time_size      = 10
  INTEGER,PARAMETER :: year_index     = 1
  INTEGER,PARAMETER :: zone_size      = 5
 
  INTEGER,DIMENSION(time_date_size) :: time_date
 
  CHARACTER(len=date_all_size)     :: date_all
  CHARACTER(len=time_size)         :: time
  CHARACTER(len=zone_size)         :: zone
  CHARACTER(len=time_size)         :: dummy
!
!-----Get current data and time and output title line.
!
 
  CALL date_and_time(date_all,time,zone,time_date)
  imon = time_date(mon_index)
  iday = time_date(day_index)
  iyr  = time_date(year_index)
!
!-----Satisfy Lahey Compiler warning messages
!
  dummy(1:date_all_size) = date_all
  date_all = dummy(1:date_all_size)
  dummy(1:time_size) = time
  time = dummy(1:time_size)
  dummy(1:zone_size) = zone
  zone = dummy(1:zone_size)
 
END SUBROUTINE getdat

SUBROUTINE gettim(ihr,imin,isec,ihun)
 
! Temporary fix for Salford compiler which does not have gettim
 
  IMPLICIT none
 
  INTEGER :: ihr
  INTEGER :: ihun
  INTEGER :: imin
  INTEGER :: isec
 
  INTEGER,PARAMETER :: date_all_size  = 8
  INTEGER,PARAMETER :: hour_index     = 5
  INTEGER,PARAMETER :: min_index      = 6
  INTEGER,PARAMETER :: sec_index      = 7
  INTEGER,PARAMETER :: tenth_index    = 8
  INTEGER,PARAMETER :: time_date_size = 8
  INTEGER,PARAMETER :: time_size      = 10
  INTEGER,PARAMETER :: zone_size      = 5
 
  INTEGER,DIMENSION(time_date_size) :: time_date
 
  CHARACTER(len=date_all_size)     :: date_all
  CHARACTER(len=time_size)         :: time
  CHARACTER(len=zone_size)         :: zone
  CHARACTER(len=time_size)         :: dummy
!
!-----Get current data and time and output title line.
!
 
  CALL date_and_time(date_all,time,zone,time_date)
  ihr  = time_date(hour_index)
  imin = time_date(min_index)
  isec = time_date(sec_index)
  ihun = time_date(tenth_index)
!
!-----Satisfy Lahey Compiler warning messages
!
  dummy(1:date_all_size) = date_all
  date_all = dummy(1:date_all_size)
  dummy(1:time_size) = time
  time = dummy(1:time_size)
  dummy(1:zone_size) = zone
  zone = dummy(1:zone_size)
 
END SUBROUTINE gettim