C *****
C     PROGRAM COMBUS(IERR,TI,AMM,A)
C     A(1) H     kJ/KG
C     A(2) PR
C     A(3) U     kJ/KG
C     A(4) VR
C     A(5) FAI   kJ/KG*K
C     A(6) CP    J/KG*K
      PROGRAM KEENAN
      INTEGER IERR,KPA,KMOL,J
      REAL AMM,TI,PI,A(1:4),AR(1:4),T,P
      REAL C(1:10),AG(1:4),AGR(1:4)
      REAL AK(1:6)
      REAL CP,U,H,S
      CHARACTER*25 ANAME,IDENTI
      CHARACTER*3 TUNIT
      CHARACTER*3 PVUNIT
      CHARACTER*12 RUNIT
      CHARACTER*8 HUNIT
      COMMON /UNIT/KPA,KMOL,MESS
      COMMON /CNST/GASCON
      WRITE(6,9711)
 9711 FORMAT(1H ,' Do you need ERROR MESSAGES ? NO->0 : YES->1 = ')
      READ(5,*) IM
      CALL IPINIT(0,0,IM,0,0.0)
   20 WRITE(6,1210)
 1210 FORMAT(1H ,' This program can calculate properties for',
     1 ' Gas Tables (SI version)'/'  by Keenan, Chao, and Kaye.'/
     2 '  You can select one of the following 4 type of calculation.'/
     3 '   1 : Air at Low pressures'/
     4 '   2 : Complete combustion-by-air product -',
     5 ' 400% Theoretical Air'/
     6 '   3 : Complete combustion-by-air product -',
     7 ' 200% Theoretical Air'/
     8 '   4 : Complete combustion-by-air product -',
     9 ' 100% Theoretical Air')
      WRITE(6,*) ' Select one type of calculation do you need (1-4) = '
      READ(5,*) IPROG
      IF (IPROG .LT. 1 .OR. IPROG .GT. 4) THEN
        GOTO 20
      ENDIF
      PREF=1.0E+05
      TREF=300.00
      TUNIT='[K]'
      IF (IPROG .EQ. 1) THEN
        KMOL=1
        RUNIT='[kJ/(kg*K)]'
        HUNIT='[kJ/kg]'
      ELSE
        KMOL=0
        RUNIT='[J/(mol*K)]'
        HUNIT='[J/mol]'
        IF (IPROG .EQ. 2) THEN
          EXCESS=4.0
        ELSEIF (IPROG .EQ. 3) THEN
          EXCESS=2.0
        ELSEIF (IPROG .EQ. 4) THEN
          EXCESS=1.0
        ENDIF
      ENDIF
      PVUNIT='[-]'
   10 WRITE(6,*) ' INPUT T ',TUNIT,' = '
      READ(5,*) T
      IF (IPROG .EQ. 1) THEN
      CALL AIRTP(IERR,AMM,T,PREF,V,CP,CV,W,U,H,S)
      ELSE
      CALL CHOTBL(IERR,1.0,2.0,0.0,EXCESS,AMM,T,H,PR,U,VR,S)
      ENDIF
      IF (IERR .EQ. -2) THEN
        IERR=-2
        DO 15 J=1,6,1
        AK(J)=-1.0E+20
   15   CONTINUE
      ELSE
      IF (IPROG .EQ. 1) THEN
      CALL AIRTP(IERR,AMM,TREF,PREF,VR,CPR,CVR,WR,UR,HR,SR)
      ELSE
      CALL CHOTBL(IERR,1.0,2.0,0.0,EXCESS,AMM,TREF,HR,PRR,UR,VRR,SR)
      ENDIF
        IF (IPROG .EQ. 4) THEN
          HREF=8956.5*1.0E+03
          FAIREF=193.86*1.0E+03
          PRREF=1.3376
          VRREF=1.8648
        ELSEIF (IPROG .EQ. 3) THEN
          HREF=8833.8*1.0E+03
          FAIREF=193.99*1.0E+03
          PRREF=1.3580
          VRREF=1.8368
        ELSEIF (IPROG .EQ. 2) THEN
          HREF=8769.3*1.0E+03
          FAIREF=194.06*1.0E+03
          PRREF=1.3688
          VRREF=1.8223
        ELSEIF (IPROG .EQ. 1) THEN
          HREF=300.43*1.0E+03
          FAIREF=5.7016*1.0E+03
          PRREF=1.3801
          VRREF=62.393
        ENDIF
        IF (KMOL .EQ. 1) THEN
          AMC=AMM
        ELSE
          AMC=1.0
        ENDIF
        AK(1)=(H-HR)+HREF
        AK(3)=AK(1)-GASCON/AMC*T
        AK(5)=S-SR+FAIREF
        AK(2)=EXP((AK(5)-FAIREF)/(GASCON/AMC)+LOG(PRREF))
        AK(4)=EXP((FAIREF-AK(5))/(GASCON/AMC)+LOG(T/TREF)
     1   +LOG(VRREF))
          AK(1)=AK(1)/1000
          AK(3)=AK(3)/1000
          AK(5)=AK(5)/1000
      ENDIF
      WRITE(6,1000) T,TUNIT,AMM,AK(1),HUNIT,AK(2),PVUNIT,
     1    AK(3),HUNIT,AK(4),PVUNIT,AK(5),RUNIT
 1000 FORMAT(3X,'T  =',F13.3,A3/
     1 3X,'M  =',E13.6,'[kg/kmol]'/
     2 3X,'H  =',E13.6,A8,6X,'PR =',E13.6,A3/
     3 3X,'U  =',E13.6,A8,6X,'VR =',E13.6,A3/
     4 3X,'FAI=',E13.6,A12)
      WRITE(6,2003)
 2003 FORMAT(1H /
     1       '   1 : CONTINUE               ',
     2   1H ,' 2 : SELECT TABLE TYPE   '/
     4       '   3 : STOP')
      WRITE(6,*) ' What do you wish to do next ? Input (1-3) = '
      READ(5,*) INUM
      IF (INUM .EQ. 1) THEN
        GOTO 10
      ELSEIF (INUM .EQ. 2) THEN
        GOTO 20
      ENDIF
      STOP
      END