C ***** Properties of Ideal Gases
C     PROGRAM IPROP
      CHARACTER*25 ANAME,AANAME(54),IDENTI
      CHARACTER*5 PUNIT
      CHARACTER*3 TUNIT
      CHARACTER*12 RUNIT
      CHARACTER*8 HUNIT
      CHARACTER*10 VUNIT
      INTEGER IP(54)
      INTEGER IDISP,ISUBNO,IERR,ISUB
      REAL P,T
      REAL C(1:10)
      COMMON /UNIT/KPA,KMOL,MESS
      COMMON /CNST/GASCON
      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/)
  200 WRITE(6,2210)
 2210 FORMAT(1H ,'   KPA  PRESSURE  TEMPERATURE'/
     1       1H ,'    0      Pa         K'/
     2       1H ,'    1      bar        C'/
     3       1H ,'    2      bar        K'/
     4       1H ,'    3      Pa         C'/
     5       1H ,'  others   Pa         K'/
     6       1H ,' -----------------------------')
      WRITE(6,*) '  Select one set of units ',
     1 'for pressure and temperature : KPA = '
      READ(5,*) KPA
      IF (KPA .EQ. 1) THEN
        PUNIT='[bar]'
        TUNIT='[C]'
      ELSEIF (KPA .EQ. 2) THEN
        PUNIT='[bar]'
        TUNIT='[K]'
      ELSEIF (KPA .EQ. 3) THEN
        PUNIT='[Pa] '
        TUNIT='[C]'
      ELSE
        PUNIT='[Pa] '
        TUNIT='[K]'
      ENDIF
      WRITE(6,2220)
 2220 FORMAT(1H ,'  KMOL    Amount of Substance'/
     1       1H ,'    0         kmol'/
     2       1H ,'    1         kg'/
     3       1H ,'  others      kmol'/
     4       1H ,' -----------------------------')
      WRITE(6,*) ' Select kmol or kg for amount of substance : KMOL = '
      READ(5,*) KMOL
      IF (KMOL .EQ. 1) THEN
        RUNIT='[J/(kg*K)]  '
        HUNIT='[J/kg]  '
        VUNIT='[m^3/kg]  '
      ELSE
        RUNIT='[J/(kmol*K)]'
        HUNIT='[J/kmol]'
        VUNIT='[m^3/kmol]'
      ENDIF
  300 WRITE(6,2300)
 2300 FORMAT(1H ,' You can select one from the following ',
     1           '8 patterns of calculation'/
     2       1H ,' 1 : (P,T) >>> V, CP, H, S, etc | ',
     3       1H ,' 2 : (P,V) >>> T, CP, H, S, etc'/
     4       1H ,' 3 : (T,V) >>> P, CP, H, S, etc | ',
     5       1H ,' 4 : (P,S) >>> T, V, CP, H, etc'/
     6       1H ,' 5 : (T,S) >>> P, V, CP, H, etc | ',
     7       1H ,' 6 : (V,S) >>> P, T, CP, H, etc'/
     8       1H ,' 7 : (P,H) >>> T, V, CP, S, etc | ',
     9       1H ,' 8 : (P,U) >>> T, V, CP, S, etc ')
      WRITE(6,*) ' Input INDEX for pattern of calculation (1-8) = '
      READ(5,*) ITYPE
  400 WRITE(6,2000) ANAME
      IF (ITYPE .EQ. 1 .OR. ITYPE .EQ. 2 .OR.
     1    ITYPE .EQ. 4 .OR. ITYPE .EQ. 7 .OR. ITYPE .EQ.8) THEN
      WRITE(6,*) ' INPUT P',PUNIT,' = '
      READ(5,*) P
      ENDIF
      IF (ITYPE .EQ. 1 .OR. ITYPE .EQ. 3 .OR. ITYPE .EQ. 5) THEN
      WRITE(6,*) ' INPUT T',TUNIT,' = '
      READ(5,*) T
      ENDIF
      IF (ITYPE .EQ. 2 .OR. ITYPE .EQ. 3 .OR. ITYPE .EQ. 6) THEN
      WRITE(6,*) ' INPUT V',VUNIT,' = '
      READ(5,*) V
        IF (ITYPE .EQ. 2) THEN
          T=TPVIDG(ISUB,P,V)
        ELSEIF (ITYPE .EQ. 3) THEN
          P=PTVIDG(ISUB,T,V)
        ENDIF
      ENDIF
      IF (ITYPE .EQ. 4 .OR. ITYPE .EQ. 5 .OR. ITYPE .EQ. 6) THEN
      WRITE(6,*) ' INPUT S',RUNIT,' = '
      READ(5,*) S
        IF (ITYPE .EQ. 4) THEN
          T=TPSIDG(ISUB,P,S)
        ELSEIF (ITYPE .EQ. 5) THEN
          P=PTSIDG(ISUB,T,S)
        ELSEIF (ITYPE .EQ. 6) THEN
          T=TVSIDG(ISUB,V,S)
          P=PTVIDG(ISUB,T,V)
        ENDIF
      ENDIF
      IF (ITYPE .EQ. 7) THEN
      WRITE(6,*) ' INPUT H',HUNIT,' = '
      READ(5,*) H
      T=THIDG(ISUB,H)
      ENDIF
      IF (ITYPE .EQ. 8) THEN
      WRITE(6,*) ' INPUT U',HUNIT,' = '
      READ(5,*) U
      T=TUIDG(ISUB,U)
      ENDIF
      CALL IDGFND(IERR,ISUB,C,ANAME)
      AMM=C(1)
      CALL IDGTP(IERR,ISUB,T,P,V,CP,CV,WSOUND,U,H,S,ANAME)
      WRITE(6,2400) AMM,T,TUNIT,P,PUNIT,
     1 V,VUNIT,CP,RUNIT,CV,RUNIT,WSOUND,S,RUNIT,H,HUNIT,U,HUNIT
 2400 FORMAT(
     1 3X,'AMM=',F12.5,'[kg/kmol]',4X,'T  =',F12.3,A3/
     2 3X,'P  =',E12.5,A5,8X,'V  =',E12.5,A10/
     3 3X,'CP =',E12.5,A12,1X,'CV =',E12.5,A12/
     4 3X,'W  =',E12.5,'[m/s]',8X,'S  =',E12.5,A12/
     5 3X,'H  =',E12.5,A8,5X,'U  =',E12.5,A8/
     6 3x,'---------------------------------------------------------')
      WRITE(6,2500)
 2500 FORMAT(1H ,
     1       '  1 : CONTINUE               ',
     1   1H ,' 2 : SELECT PATTERN OF CALCULATION'/
     2       '   3 : SELECT SYSTEM OF UNITS ',
     2   1H ,' 4 : SELECT SUBSTANCE'/
     3       '   5 : STOP')
      WRITE(6,*) ' What do you wish to do next ? Input (1-5) = '
      READ(5,*) INUM
      IF (INUM .EQ. 1) THEN
        GOTO 400
      ELSEIF (INUM .EQ. 2) THEN
        GOTO 300
      ELSEIF (INUM .EQ. 3) THEN
        GOTO 200
      ELSEIF (INUM .EQ. 4) THEN
        GOTO 100
      ENDIF
      STOP
      END