C *****
C  This propram calculates properties of ideal gases
C  in order to produce a JANAF style gas table
      CHARACTER*25 ANAME,IDENTI
      INTEGER IERR,ISUB
      REAL T
      REAL C(1:10)
      REAL A(1:4)
      COMMON /UNIT/KPA,KGM,MESS
      COMMON /CNST/GASCON
      CHARACTER*25 AANAME(54)
      INTEGER IP(54)
      ISUBNO=54
      IDISP=40
      WRITE(6,2200)
 2200 FORMAT(1H ,' Do you need ERROR MESSAGES ? NO->0 : YES->1 = ')
      READ(5,*) IM
      CALL IPINIT(0,0,IM,0,0.0)
      DO 10 I=1,ISUBNO
      IP(I)=I
      AANAME(I)=IDENTI(I,'S')
   10 CONTINUE
  100 WRITE(6,2100) ISUBNO
 2100 FORMAT(1H ,' This program can calculate properties of ',
     1 'the following ',I2,' ideal gases.'//
     2 1h ,1X,'ISUB : Name of substance',10X,
     3      '| ISUB : Name of substance')
      DO 20 I=1,IDISP,2
      WRITE(6,2110) IP(I),AANAME(I),IP(I+1),AANAME(I+1)
 2110 FORMAT(1H ,2X,I3,' : ',A25,'  |  ',I3,' : ',A25)
   20 CONTINUE
      WRITE(6,2120) IDISP
 2120 FORMAT(1H ,3X,'98 : other substances'
     1/3X,'Select one of ISUBs (1-',I2,') or (98) = ')
      READ(5,*) ISUB
      IF (ISUB .LT. 1 .OR. ISUB .GT. IDISP) THEN
      WRITE(6,2140)
 2140 FORMAT(2X,'ISUB : Name of substance',10X,
     1      '| ISUB : Name of substance')
      DO 30 I=IDISP+1,ISUBNO,2
      WRITE(6,2110) IP(I),AANAME(I),IP(I+1),AANAME(I+1)
   30 CONTINUE
      WRITE(6,2160) IDISP+1,ISUBNO
 2160 FORMAT(1H ,3X,'98 : other substances',11X,
     1 '|   99 : Stop.'/
     2 3X,'Select one of ISUBs (',I2,'-',I2,') or (98-99) = ')
      READ(5,*) ISUB
      ENDIF
      ANAME=IDENTI(ISUB,'S')
      IF (ISUB .LT. 1 .OR. ISUB .GT. ISUBNO) THEN
        IF (ISUB .EQ. 98) THEN
          GOTO 100
        ELSE
          STOP
        ENDIF
      ENDIF
      WRITE(6,2000) ANAME
 2000 FORMAT(1H , ' Name of Substance : ',A25)
      CALL IDGFND(IERR,ISUB,C,ANAME)
      AMM=C(1)
      WRITE(6,2300) AMM,C(2),C(3),C(4)
      AKF=-C(7)/(298.15*GASCON)/ALOG(10.0)
      WRITE(6,2320) C(5),C(6),C(7),ANAME,AKF
 2300 FORMAT(3X,'  Molecular weight     = ', F13.4/
     1 3X,'  Critical temperature = ',F13.3, '[K]'/
     2 3X,'  Critical pressure    = ',E13.5, '[Pa]'/
     3 3X,'  Critical volume      = ',E13.5, '[m**3/kmol]')
 2320 FORMAT(1H ,' At reference state of 0.1MPa and 298.15 K'/
     1 3X,'  Absolute entropy          = ',E13.5,'[J/(kmol*K)]'/
     1 3X,'  Enthalpy of formation     = ',E13.5,'[J/kmol]'/
     1 3X,'  Gibbs energy of formation = ',E13.5,'[J/kmol]'/
     1 3X,'  Logarithm of the equilibrium constant of the reaction '/
     1 3X,'  for the formation of ',A25/
     1 3X,'  from the elements:log(Kf) = ',F10.4/)
  200 WRITE(6,*) ' INPUT T [K] = '
      READ(5,*) T
      CALL IDGT(IERR,ISUB,T,A,ANAME)
      CP=A(1)
      CV=CP-GASCON
      WSOUND=SQRT(CP/CV*GASCON/AMM*T)
      S=A(2)
      GREF=A(3)
      H=A(4)
      U=H-GASCON*T
      WRITE(6,1000) ANAME,T,CP,S,GREF,H,CV,WSOUND
 1000 FORMAT(1H ,' Substance : ',A25/
     1 3X,'                    T  = ',F12.3,'[K]'/
     2 3X,'                 CP(T) = ',E12.6,'[J/(kmol*K)]'/
     2 3X,'                 S0(T) = ',E12.6,'[J/(kmol*K)]'/
     3 3X,'-(G0(T)-H0(298.15K))/T = ',E12.6,'[J/(kmol*K)]'/
     4 3X,'      H(T)-H(298.15K)  = ',E12.6,'[J/kmol]'/
     5 3X,'                 CV(T) = ',E12.6,'[J/(kmol*K)]'/
     6 3X,'                 W     = ',E12.6,'[m/s]'/
     7 3X,'-----------------------------------------------')
      WRITE(6,*) ' 1:CONTINUE  |  2:SELECT SUBSTANCE  |  3:STOP '
      WRITE(6,*) ' What do you wish to do next ? Input (1-3) =  '
      READ(5,*) INUM
      IF (INUM .EQ. 1) THEN
        GOTO 200
      ELSEIF (INUM .EQ. 2) THEN
        GOTO 100
      ENDIF
      STOP
      END