*======PC3H6V91=======1994.12.15======================================*
*======PAC3H6=========1997. 3.10======================================*
C====================================================================
C     May 2, 2001: modified by Ryo Akasaka for ver.12.1
C       The following 18 functions were added but not implemented.
C       AKPD(8A), AKPDD(8B), AKTD(8C), AKTDD(8D), CVPD(7A), CVTD(7B),
C       EPSPD(2A), EPSPDD(2B), EPSTD(2C), EPSTDD(2D), GAMPD(9A),
C       GAMTD(9B), TPH2(6H), TPS2(6S), WPD(8E), WPDD(8F), WTD(8G),
C       WTDD(8H)
C
C-------------------------------------------------  F8A = AKPD
      REAL FUNCTION AKPD(P)
      CHARACTER FUN*6
      COMMON/UNIT/KPA,MESS
      FUN='AKPD'
      IF (MESS.NE.0) CALL S99PPL(FUN)
      AKPD=-1.0E+30
      RETURN
      END
C-------------------------------------------------  F8B = AKPDD
      REAL FUNCTION AKPDD(P)
      CHARACTER FUN*6
      COMMON/UNIT/KPA,MESS
      FUN='AKPDD'
      IF (MESS.NE.0) CALL S99PPL(FUN)
      AKPDD=-1.0E+30
      RETURN
      END
C-------------------------------------------------  F8C = AKTD
      REAL FUNCTION AKTD(T)
      CHARACTER FUN*6
      COMMON/UNIT/KPA,MESS
      FUN='AKTD'
      IF (MESS.NE.0) CALL S99PPL(FUN)
      AKTD=-1.0E+30
      RETURN
      END
C-------------------------------------------------  F8D = AKTDD
      REAL FUNCTION AKTDD(T)
      CHARACTER FUN*6
      COMMON/UNIT/KPA,MESS
      FUN='AKTDD'
      IF (MESS.NE.0) CALL S99PPL(FUN)
      AKTDD=-1.0E+30
      RETURN
      END
C-------------------------------------------------  F7A = CVPD
      REAL FUNCTION CVPD(P)
      CHARACTER FUN*6
      COMMON/UNIT/KPA,MESS
      FUN='CVPD'
      IF (MESS.NE.0) CALL S99PPL(FUN)
      CVPD=-1.0E+30
      RETURN
      END
C-------------------------------------------------  F7B = CVTD
      REAL FUNCTION CVTD(T)
      CHARACTER FUN*6
      COMMON/UNIT/KPA,MESS
      FUN='CVTD'
      IF (MESS.NE.0) CALL S99PPL(FUN)
      CVTD=-1.0E+30
      RETURN
      END
C-------------------------------------------------  F2A = EPSPD
      REAL FUNCTION EPSPD(P)
      CHARACTER FUN*6
      COMMON/UNIT/KPA,MESS
      FUN='EPSPD'
      IF (MESS.NE.0) CALL S99PPL(FUN)
      EPSPD=-1.0E+30
      RETURN
      END
C-------------------------------------------------  F2B = EPSPDD
      REAL FUNCTION EPSPDD(P)
      CHARACTER FUN*6
      COMMON/UNIT/KPA,MESS
      FUN='EPSPDD'
      IF (MESS.NE.0) CALL S99PPL(FUN)
      EPSPDD=-1.0E+30
      RETURN
      END
C-------------------------------------------------  F2C = EPSTD
      REAL FUNCTION EPSTD(T)
      CHARACTER FUN*6
      COMMON/UNIT/KPA,MESS
      FUN='EPSTD'
      IF (MESS.NE.0) CALL S99PPL(FUN)
      EPSTD=-1.0E+30
      RETURN
      END
C-------------------------------------------------  F2D = EPSTDD
      REAL FUNCTION EPSTDD(T)
      CHARACTER FUN*6
      COMMON/UNIT/KPA,MESS
      FUN='EPSTDD'
      IF (MESS.NE.0) CALL S99PPL(FUN)
      EPSTDD=-1.0E+30
      RETURN
      END
C-------------------------------------------------  F9A = GAMPD
      REAL FUNCTION GAMPD(P)
      CHARACTER FUN*6
      COMMON/UNIT/KPA,MESS
      FUN='GAMPD'
      IF (MESS.NE.0) CALL S99PPL(FUN)
      GAMPD=-1.0E+30
      RETURN
      END
C-------------------------------------------------  F9B = GAMTD
      REAL FUNCTION GAMTD(T)
      CHARACTER FUN*6
      COMMON/UNIT/KPA,MESS
      FUN='GAMTD'
      IF (MESS.NE.0) CALL S99PPL(FUN)
      GAMTD=-1.0E+30
      RETURN
      END
C-------------------------------------------------  F6H = TPH2
      REAL FUNCTION TPH2(P,H)
      CHARACTER FUN*6
      COMMON/UNIT/KPA,MESS
      FUN='TPH2'
      IF (MESS.NE.0) CALL S99PPL(FUN)
      TPH2=-1.0E+30
      RETURN
      END
C-------------------------------------------------  F6S = TPS2
      REAL FUNCTION TPS2(P,S)
      CHARACTER FUN*6
      COMMON/UNIT/KPA,MESS
      FUN='TPS2'
      IF (MESS.NE.0) CALL S99PPL(FUN)
      TPS2=-1.0E+30
      RETURN
      END
C-------------------------------------------------  F8E = WPD
      REAL FUNCTION WPD(P)
      CHARACTER FUN*6
      COMMON/UNIT/KPA,MESS
      FUN='WPD'
      IF (MESS.NE.0) CALL S99PPL(FUN)
      WPD=-1.0E+30
      RETURN
      END
C-------------------------------------------------  F8F = WPDD
      REAL FUNCTION WPDD(P)
      CHARACTER FUN*6
      COMMON/UNIT/KPA,MESS
      FUN='WPDD'
      IF (MESS.NE.0) CALL S99PPL(FUN)
      WPDD=-1.0E+30
      RETURN
      END
C-------------------------------------------------  F8G = WTD
      REAL FUNCTION WTD(T)
      CHARACTER FUN*6
      COMMON/UNIT/KPA,MESS
      FUN='WTD'
      IF (MESS.NE.0) CALL S99PPL(FUN)
      WTD=-1.0E+30
      RETURN
      END
C-------------------------------------------------  F8H = WTDD
      REAL FUNCTION WTDD(T)
      CHARACTER FUN*6
      COMMON/UNIT/KPA,MESS
      FUN='WTDD'
      IF (MESS.NE.0) CALL S99PPL(FUN)
      WTDD=-1.0E+30
      RETURN
      END
C
C====================================================================
*-------------------------------------------------  F1PPL = AIPPT
      REAL FUNCTION AIPPT(P,T)
      REAL P,PI,T,TI
      PI=P
      TI=T
      CALL S99PPL('AIPPT')
      AIPPT=-1.0E+30
      RETURN
      END
*-------------------------------------------------  F2PPL = ALAPP
      REAL FUNCTION ALAPP(P)
      REAL P,PI
      PI=P
      CALL S99PPL('ALAPP')
      ALAPP=-1.0E+30
      RETURN
      END
*-------------------------------------------------  F3PPL = ALAPT
      REAL FUNCTION ALAPT(T)
      REAL T,TI
      TI=T
      CALL S99PPL('ALAPT')
      ALAPT=-1.0E+30
      RETURN
      END
*-------------------------------------------------  F4PPL = ALHP
      REAL FUNCTION ALHP(P)
      REAL P,PI
      INTEGER KPA
      COMMON/UNIT/KPA,MESS
      PI=P*1.0E-05
      PI=G98PPL(KPA,P)
      ALHP=F4PPL(PI)
      IF(ALHP.EQ.-1.0E+10) THEN
        CALL S97PPL('ALHP')
        ALHP=-1.0E+10
      ELSE IF(ALHP.EQ.-1.0E+20) THEN
        CALL S98PPL(1,P,P,'P','P','ALHP')
        ALHP=-1.0E+20
      END IF
      RETURN
      END
*-------------------------------------------------  F5PPL = ALHT
      REAL FUNCTION ALHT(T)
      REAL T,TI
      INTEGER KPA
      COMMON/UNIT/KPA,MESS
      TI=G99PPL(KPA,T)
      ALHT=F5PPL(TI)
      IF(ALHT.EQ.-1.0E+10) THEN
        CALL S97PPL('ALHT')
        ALHT=-1.0E+10
      ELSE IF(ALHT.EQ.-1.0E+20) THEN
        CALL S98PPL(2,T,T,'T','T','ALHT')
        ALHT=-1.0E+20
      END IF
      RETURN
      END
*-------------------------------------------------  F6PPL = ALMPD
      REAL FUNCTION ALMPD(P)
      REAL P,PI
      PI=P
      CALL S99PPL('ALMPD')
      ALMPD=-1.0E+30
      RETURN
      END
*-------------------------------------------------  F7PPL = ALMPDD
      REAL FUNCTION ALMPDD(P)
      REAL P,PI
      PI=P
      CALL S99PPL('ALMPDD')
      ALMPDD=-1.0E+30
      RETURN
      END
*-------------------------------------------------  F8PPL = ALMPT
      REAL FUNCTION ALMPT(P,T)
      REAL P,PI,T,TI
      PI=P
      TI=T
      CALL S99PPL('ALMPT')
      ALMPT=-1.0E+30
      RETURN
      END
*-------------------------------------------------  F9PPL = ALMTD
      REAL FUNCTION ALMTD(T)
      REAL T,TI
      TI=T
      CALL S99PPL('ALMTD')
      ALMTD=-1.0E+30
      RETURN
      END
*-------------------------------------------------  F10PPL = ALMTDD
      REAL FUNCTION ALMTDD(T)
      REAL T,TI
      TI=T
      CALL S99PPL('ALMTDD')
      ALMTDD=-1.0E+30
      RETURN
      END
*-------------------------------------------------  F11PPL = AMUPD
      REAL FUNCTION AMUPD(P)
      REAL P,PI
      PI=P
      CALL S99PPL('AMUPD')
      AMUPD=-1.0E+30
      RETURN
      END
*-------------------------------------------------  F12PPL = AMUPDD
      REAL FUNCTION AMUPDD(P)
      REAL P,PI
      PI=P
      CALL S99PPL('AMUPDD')
      AMUPDD=-1.0E+30
      RETURN
      END
*-------------------------------------------------  F13PPL = AMUPT
      REAL FUNCTION AMUPT(P,T)
      REAL P,PI,T,TI
      PI=P
      TI=T
      CALL S99PPL('AMUPT')
      AMUPT=-1.0E+30
      RETURN
      END
*-------------------------------------------------  F14PPL = AMUTD
      REAL FUNCTION AMUTD(T)
      REAL T,TI
      TI=T
      CALL S99PPL('AMUTD')
      AMUTD=-1.0E+30
      RETURN
      END
*-------------------------------------------------  F15PPL = AMUTDD
      REAL FUNCTION AMUTDD(T)
      REAL T,TI
      TI=T
      CALL S99PPL('AMUTDD')
      AMUTDD=-1.0E+30
      RETURN
      END
*-------------------------------------------------  F16PPL = CPPD
      REAL FUNCTION CPPD(P)
      REAL P,PI
      INTEGER KPA
      COMMON/UNIT/KPA,MESS
      PI=G98PPL(KPA,P)
      CPPD=F16PPL(PI)
      IF(CPPD.EQ.-1.0E+10) THEN
        CALL S97PPL('CPPD')
        CPPD=-1.0E+10
      ELSE IF(CPPD.EQ.-1.0E+20) THEN
        CALL S98PPL(1,P,P,'P','P','CPPD')
        CPPD=-1.0E+20
      END IF
      RETURN
      END
*-------------------------------------------------  F17PPL = CPPDD
      REAL FUNCTION CPPDD(P)
      REAL P,PI
      INTEGER KPA
      COMMON/UNIT/KPA,MESS
      PI=G98PPL(KPA,P)
      CPPDD=F17PPL(PI)
      IF(CPPDD.EQ.-1.0E+10) THEN
        CALL S97PPL('CPPDD')
        CPPDD=-1.0E+10
      ELSE IF(CPPDD.EQ.-1.0E+20) THEN
        CALL S98PPL(1,P,P,'P','P','CPPDD')
        CPPDD=-1.0E+20
      END IF
      RETURN
      END
*-------------------------------------------------  F18PPL = CPPT
      REAL FUNCTION CPPT(P,T)
      REAL P,PI,T,TI
      INTEGER KPA
      COMMON/UNIT/KPA,MESS
      PI=G98PPL(KPA,P)
      TI=G99PPL(KPA,T)
      CPPT=F18PPL(PI,TI)
      IF(CPPT.EQ.-1.0E+10) THEN
        CALL S97PPL('CPPT')
        CPPT=-1.0E+10
      ELSE IF(CPPT.EQ.-1.0E+20) THEN
        CALL S98PPL(3,P,T,'P','T','CPPT')
        CPPT=-1.0E+20
      END IF
      RETURN
      END
*-------------------------------------------------  F19PPL = CPTD
      REAL FUNCTION CPTD(T)
      REAL T,TI
      INTEGER KPA
      COMMON/UNIT/KPA,MESS
      TI=G99PPL(KPA,T)
      CPTD=F19PPL(TI)
      IF(CPTD.EQ.-1.0E+10) THEN
        CALL S97PPL('CPTD')
        CPTD=-1.0E+10
      ELSE IF(CPTD.EQ.-1.0E+20) THEN
        CALL S98PPL(2,T,T,'T','T','CPTD')
        CPTD=-1.0E+20
      END IF
      RETURN
      END
*-------------------------------------------------  F20PPL = CPTDD
      REAL FUNCTION CPTDD(T)
      REAL T,TI
      INTEGER KPA
      COMMON/UNIT/KPA,MESS
      TI=G99PPL(KPA,T)
      CPTDD=F20PPL(TI)
      IF(CPTDD.EQ.-1.0E+10) THEN
        CALL S97PPL('CPTDD')
        CPTDD=-1.0E+10
      ELSE IF(CPTDD.EQ.-1.0E+20) THEN
        CALL S98PPL(2,T,T,'T','T','CPTDD')
        CPTDD=-1.0E+20
      END IF
      RETURN
      END
*-------------------------------------------------  F21PPL = CRP
      REAL FUNCTION CRP(A)
      CHARACTER A*1
      REAL PBAR,T0K,FF
      INTEGER KPA
      COMMON/UNIT/KPA,MESS
      IF(KPA.EQ.1) THEN
        PBAR=1.0
        T0K=0.0
      ELSE IF(KPA.EQ.2) THEN
        PBAR=1.0
        T0K=273.15
      ELSE IF(KPA.EQ.3) THEN
        PBAR=1.0E-05
        T0K=0.0
      ELSE
        PBAR=1.0E-05
        T0K=273.15
      END IF
      FF=F21PPL(A)
      IF(FF.EQ.-1.0E+20) THEN
        WRITE(6,2000) A
 2000   FORMAT(1H ,5X,'****  OUT OF RANGE AT CRP FOR PROPYLENE',
     -         ' WHEN  A =',A,'  ****')
        FF=-1.0E+20
      END IF
      IF(A.EQ.'T') THEN
        IF((FF.EQ.-1.0E+10).OR.(FF.EQ.-1.0E+20)) T0K=0.0
        FF=FF+T0K
      ELSE IF(A.EQ.'P') THEN
        IF((FF.EQ.-1.0E+10).OR.(FF.EQ.-1.0E+20)) PBAR=1.0
        FF=FF/PBAR
      END IF
      CRP=FF
      RETURN
      END
*-------------------------------------------------  F22PPL = EPSPT
      REAL FUNCTION EPSPT(P,T)
      REAL P,PI,T,TI
      PI=P
      TI=T
      CALL S99PPL('EPSPT')
      EPSPT=-1.0E+30
      RETURN
      END
C-------------------------------------------------  F89 = FC
C************************************************
C     FUNCTION FOR FUNDDAMENTAL CONSTANTS
C     PROPATH VER.7.1, MAY 8, 1990
C     USAGE:  B=FC(A)
C     A, B :  CHARACTER TYPE VALIABLES
C             B='42.0804'  WHEN A='M'
C             B='197.582' WHEN A='R'
C************************************************
      REAL FUNCTION FC(A)
      CHARACTER A*1,MSG*120
      COMMON/UNIT/KPA,MESS
      IF (A.EQ.'M') THEN
        FC=42.0804
      ELSE IF (A.EQ.'R') THEN
        FC=197.582
      ELSE
        FC=-1.E+20
        IF (MESS.NE.0) THEN
          MSG='**** OUT OF RANGE AT FC FOR PROPYLENE WHEN A='''
     &    //A//''' ****'
          WRITE(6,'(1H ,A)') MSG
        END IF
      END IF
      RETURN
      END
*-------------------------------------------------  F23PPL = HPD
      REAL FUNCTION HPD(P)
      REAL P,PI
      INTEGER KPA
      COMMON/UNIT/KPA,MESS
      PI=G98PPL(KPA,P)
      HPD=F23PPL(PI)
      IF(HPD.EQ.-1.0E+10) THEN
        CALL S97PPL('HPD')
        HPD=-1.0E+10
      ELSE IF(HPD.EQ.-1.0E+20) THEN
        CALL S98PPL(1,P,P,'P','P','HPD')
        HPD=-1.0E+20
      END IF
      RETURN
      END
*-------------------------------------------------  F24PPL = HPDD
      REAL FUNCTION HPDD(P)
      REAL P,PI
      INTEGER KPA
      COMMON/UNIT/KPA,MESS
      PI=G98PPL(KPA,P)
      HPDD=F24PPL(PI)
      IF(HPDD.EQ.-1.0E+10) THEN
        CALL S97PPL('HPDD')
        HPDD=-1.0E+10
      ELSE IF(HPDD.EQ.-1.0E+20) THEN
        CALL S98PPL(1,P,P,'P','P','HPDD')
        HPDD=-1.0E+20
      END IF
      RETURN
      END
*-------------------------------------------------  F25PPL = HPT
      REAL FUNCTION HPT(P,T)
      REAL P,PI,T,TI
      INTEGER KPA
      COMMON/UNIT/KPA,MESS
      PI=G98PPL(KPA,P)
      TI=G99PPL(KPA,T)
      HPT=F25PPL(PI,TI)
      IF(HPT.EQ.-1.0E+10) THEN
        CALL S97PPL('HPT')
        HPT=-1.0E+10
      ELSE IF(HPT.EQ.-1.0E+20) THEN
        CALL S98PPL(3,P,T,'P','T','HPT')
        HPT=-1.0E+20
      END IF
      RETURN
      END
*-------------------------------------------------  F26PPL = HPX
      REAL FUNCTION HPX(P,X)
      REAL P,PI,X
      INTEGER KPA
      COMMON/UNIT/KPA,MESS
      PI=G98PPL(KPA,P)
      HPX=F26PPL(PI,X)
      IF(HPX.EQ.-1.0E+10) THEN
        CALL S97PPL('HPX')
        HPX=-1.0E+10
      ELSE IF(HPX.EQ.-1.0E+20) THEN
        WRITE(6,2000) P,X
 2000   FORMAT(1H ,5X,'****  OUT OF RANGE AT HPX FOR PROPYLENE',
     -         ' WHEN  P =',1PE14.7,' AND   X=',1PE14.7,'  ****')
        HPX=-1.0E+20
      END IF
      RETURN
      END
*-------------------------------------------------  F27PPL = HTD
      REAL FUNCTION HTD(T)
      REAL T,TI
      INTEGER KPA
      COMMON/UNIT/KPA,MESS
      TI=G99PPL(KPA,T)
      HTD=F27PPL(TI)
      IF(HTD.EQ.-1.0E+10) THEN
        CALL S97PPL('HTD')
        HTD=-1.0E+10
      ELSE IF(HTD.EQ.-1.0E+20) THEN
        CALL S98PPL(2,T,T,'T','T','HTD')
        HTD=-1.0E+20
      END IF
      RETURN
      END
*-------------------------------------------------  F28PPL = HTDD
      REAL FUNCTION HTDD(T)
      REAL T,TI
      INTEGER KPA
      COMMON/UNIT/KPA,MESS
      TI=G99PPL(KPA,T)
      HTDD=F28PPL(TI)
      IF(HTDD.EQ.-1.0E+10) THEN
        CALL S97PPL('HTDD')
        HTDD=-1.0E+10
      ELSE IF(HTDD.EQ.-1.0E+20) THEN
        CALL S98PPL(2,T,T,'T','T','HTDD')
        HTDD=-1.0E+20
      END IF
      RETURN
      END
*-------------------------------------------------  F29PPL = HTX
      REAL FUNCTION HTX(T,X)
      REAL T,TI,X
      INTEGER KPA
      COMMON/UNIT/KPA,MESS
      TI=G99PPL(KPA,T)
      HTX=F29PPL(TI,X)
      IF(HTX.EQ.-1.0E+10) THEN
        CALL S97PPL('HTX')
        HTX=-1.0E+10
      ELSE IF(HTX.EQ.-1.0E+20) THEN
        WRITE(6,2000) T,X
 2000   FORMAT(1H ,5X,'****  OUT OF RANGE AT HTX FOR PROPYLENE',
     -         ' WHEN  T =',1PE14.7,' AND   X=',1PE14.7,'  ****')
        HTX=-1.0E+20
      END IF
      RETURN
      END
*-------------------------------------------------  F84PPL = IDENTF
C************************************************
C     FUNCTION FOR IDENTIFICATION OF SUBSTANCE
C     PROPATH VER.12.1, MAY 2, 2001
C     USAGE:  B=IDENTF(A)
C     A, B :  CHARACTER TYPE VALIABLES
C             B='PROPYLENE'  WHEN A='S'
C             B='C3H6'  WHEN A='C'
C             B='12.1'  WHEN A='V'
C************************************************
      CHARACTER*20 FUNCTION IDENTF(A)
      CHARACTER A*1,MSG*120
      COMMON/UNIT/KPA,MESS
      IF (A.EQ.'S') THEN
        IDENTF='PROPYLENE'
      ELSE IF (A.EQ.'C') THEN
        IDENTF='C3H6'
      ELSE IF (A.EQ.'V') THEN
        IDENTF='12.1'
      ELSE
        IDENTF='????????????????????'
        IF (MESS.NE.0) THEN
        MSG='**** OUT OF RANGE AT IDENTF FOR PROPYLENE WHEN A='''
     &    //A//''' ****'
          WRITE(6,'(1H ,A)') MSG
        END IF
      END IF
      RETURN
      END
*-------------------------------------------------  F30PPL = PST
      REAL FUNCTION PST(T)
      REAL TI,T
      INTEGER KPA
      COMMON/UNIT/KPA,MESS
      TI=G99PPL(KPA,T)
      PST=F30PPL(TI)
      IF(PST.EQ.-1.0E+10) THEN
        CALL S97PPL('PST')
        PST=-1.0E+10
        RETURN
      ELSE IF(PST.EQ.-1.0E+20) THEN
        CALL S98PPL(2,T,T,'T','T','PST')
        PST=-1.0E+20
        RETURN
      END IF
      IF((KPA.EQ.1).OR.(KPA.EQ.2)) RETURN
      PST=PST*1.0E+05
      RETURN
      END
*-------------------------------------------------  F31PPL = SIGP
      REAL FUNCTION SIGP(P)
      REAL P,PI
      PI=P
      CALL S99PPL('SIGP')
      SIGP=-1.0E+30
      RETURN
      END
*-------------------------------------------------  F32PPL = SIGT
      REAL FUNCTION SIGT(T)
      REAL T,TI
      TI=T
      CALL S99PPL('SIGT')
      SIGT=-1.0E+30
      RETURN
      END
*-------------------------------------------------  F33PPL = SPD
      REAL FUNCTION SPD(P)
      REAL P,PI
      INTEGER KPA
      COMMON/UNIT/KPA,MESS
      PI=G98PPL(KPA,P)
      SPD=F33PPL(PI)
      IF(SPD.EQ.-1.0E+10) THEN
        CALL S97PPL('SPD')
        SPD=-1.0E+10
      ELSE IF(SPD.EQ.-1.0E+20) THEN
        CALL S98PPL(1,P,P,'P','P','SPD')
        SPD=-1.0E+20
      END IF
      RETURN
      END
*-------------------------------------------------  F34PPL = SPDD
      REAL FUNCTION SPDD(P)
      REAL P,PI
      INTEGER KPA
      COMMON/UNIT/KPA,MESS
      PI=G98PPL(KPA,P)
      SPDD=F34PPL(PI)
      IF(SPDD.EQ.-1.0E+10) THEN
        CALL S97PPL('SPDD')
        SPDD=-1.0E+10
      ELSE IF(SPDD.EQ.-1.0E+20) THEN
        CALL S98PPL(1,P,P,'P','P','SPDD')
        SPDD=-1.0E+20
      END IF
      RETURN
      END
*-------------------------------------------------  F35PPL = SPT
      REAL FUNCTION SPT(P,T)
      REAL P,PI,T,TI
      INTEGER KPA
      COMMON/UNIT/KPA,MESS
      PI=G98PPL(KPA,P)
      TI=G99PPL(KPA,T)
      SPT=F35PPL(PI,TI)
      IF(SPT.EQ.-1.0E+10) THEN
        CALL S97PPL('SPT')
        SPT=-1.0E+10
      ELSE IF(SPT.EQ.-1.0E+20) THEN
        CALL S98PPL(3,P,T,'P','T','SPT')
        SPT=-1.0E+20
      END IF
      RETURN
      END
*-------------------------------------------------  F36PPL = SPX
      REAL FUNCTION SPX(P,X)
      REAL P,PI,X
      INTEGER KPA
      COMMON/UNIT/KPA,MESS
      PI=G98PPL(KPA,P)
      SPX=F36PPL(PI,X)
      IF(SPX.EQ.-1.0E+10) THEN
        CALL S97PPL('SPX')
        SPX=-1.0E+10
      ELSE IF(SPX.EQ.-1.0E+20) THEN
        WRITE(6,2000) P,X
 2000   FORMAT(1H ,5X,'****  OUT OF RANGE AT SPX FOR PROPYLENE',
     -         ' WHEN  P =',1PE14.7,' AND   X=',1PE14.7,'  ****')
        SPX=-1.0E+20
      END IF
      RETURN
      END
*-------------------------------------------------  F37PPL = STD
      REAL FUNCTION STD(T)
      REAL T,TI
      INTEGER KPA
      COMMON/UNIT/KPA,MESS
      TI=G99PPL(KPA,T)
      STD=F37PPL(TI)
      IF(STD.EQ.-1.0E+10) THEN
        CALL S97PPL('STD')
        STD=-1.0E+10
      ELSE IF(STD.EQ.-1.0E+20) THEN
        CALL S98PPL(2,T,T,'T','T','STD')
        STD=-1.0E+20
      END IF
      RETURN
      END
*-------------------------------------------------  F38PPL = STDD
      REAL FUNCTION STDD(T)
      REAL T,TI
      INTEGER KPA
      COMMON/UNIT/KPA,MESS
      TI=G99PPL(KPA,T)
      STDD=F38PPL(TI)
      IF(STDD.EQ.-1.0E+10) THEN
        CALL S97PPL('STDD')
        STDD=-1.0E+10
      ELSE IF(STDD.EQ.-1.0E+20) THEN
        CALL S98PPL(2,T,T,'T','T','STDD')
        STDD=-1.0E+20
      END IF
      RETURN
      END
*-------------------------------------------------  F39PPL = STX
      REAL FUNCTION STX(T,X)
      REAL T,TI,X
      INTEGER KPA
      COMMON/UNIT/KPA,MESS
      TI=G99PPL(KPA,T)
      STX=F39PPL(TI,X)
      IF(STX.EQ.-1.0E+10) THEN
        CALL S97PPL('STX')
        STX=-1.0E+10
      ELSE IF(STX.EQ.-1.0E+20) THEN
        WRITE(6,2000) T,X
 2000   FORMAT(1H ,5X,'****  OUT OF RANGE AT STX FOR PROPYLENE',
     -         ' WHEN  T =',1PE14.7,' AND   X=',1PE14.7,'  ****')
        STX=-1.0E+20
      END IF
      RETURN
      END
*-------------------------------------------------  F40PPL = TSP
      REAL FUNCTION TSP(P)
      REAL P,PI
      INTEGER KPA
      COMMON/UNIT/KPA,MESS
      PI=G98PPL(KPA,P)
      TSP=F40PPL(PI)
      IF(TSP.EQ.-1.0E+10) THEN
        CALL S97PPL('TSP')
        TSP=-1.0E+10
        RETURN
      ELSE IF(TSP.EQ.-1.0E+20) THEN
        CALL S98PPL(1,P,P,'P','P','TSP')
        TSP=-1.0E+20
        RETURN
      END IF
      IF((KPA.EQ.1).OR.(KPA.EQ.3)) RETURN
      TSP=TSP+273.15
      RETURN
      END
*-------------------------------------------------  F41PPL = TRPL
      REAL FUNCTION TRPL(A)
      CHARACTER A*1
      REAL PBAR,T0K,FF
      INTEGER KPA
      COMMON/UNIT/KPA,MESS
      IF(KPA.EQ.1) THEN
        PBAR=1.0
        T0K=0.0
      ELSE IF(KPA.EQ.2) THEN
        PBAR=1.0
        T0K=273.15
      ELSE IF(KPA.EQ.3) THEN
        PBAR=1.0E-05
        T0K=0.0
      ELSE
        PBAR=1.0E-05
        T0K=273.15
      END IF
      FF=F41PPL(A)
      IF(FF.EQ.-1.0E+20) THEN
        WRITE(6,2000) A
 2000   FORMAT(1H ,5X,'****  OUT OF RANGE AT TRPL FOR PROPYLENE',
     -         ' WHEN  A =',A,'  ****')
        FF=-1.0E+20
      END IF
      IF(A.EQ.'T') THEN
        IF((FF.EQ.-1.0E+10).OR.(FF.EQ.-1.0E+20)) T0K=0.0
        FF=FF+T0K
      ELSE IF(A.EQ.'P') THEN
        IF((FF.EQ.-1.0E+10).OR.(FF.EQ.-1.0E+20)) PBAR=1.0
        FF=FF/PBAR
      END IF
      TRPL=FF
      RETURN
      END
*-------------------------------------------------  F42PPL = UPD
      REAL FUNCTION UPD(P)
      REAL P,PI
      INTEGER KPA
      COMMON/UNIT/KPA,MESS
      PI=G98PPL(KPA,P)
      UPD=F42PPL(PI)
      IF(UPD.EQ.-1.0E+10) THEN
        CALL S97PPL('UPD')
        UPD=-1.0E+10
      ELSE IF(UPD.EQ.-1.0E+20) THEN
        CALL S98PPL(1,P,P,'P','P','UPD')
        UPD=-1.0E+20
      END IF
      RETURN
      END
*-------------------------------------------------  F43PPL = UPDD
      REAL FUNCTION UPDD(P)
      REAL P,PI
      INTEGER KPA
      COMMON/UNIT/KPA,MESS
      PI=G98PPL(KPA,P)
      UPDD=F43PPL(PI)
      IF(UPDD.EQ.-1.0E+10) THEN
        CALL S97PPL('UPDD')
        UPDD=-1.0E+10
      ELSE IF(UPDD.EQ.-1.0E+20) THEN
        CALL S98PPL(1,P,P,'P','P','UPDD')
        UPDD=-1.0E+20
      END IF
      RETURN
      END
*-------------------------------------------------  F44PPL = UPT
      REAL FUNCTION UPT(P,T)
      REAL P,PI,T,TI
      INTEGER KPA
      COMMON/UNIT/KPA,MESS
      PI=G98PPL(KPA,P)
      TI=G99PPL(KPA,T)
      UPT=F44PPL(PI,TI)
      IF(UPT.EQ.-1.0E+10) THEN
        CALL S97PPL('UPT')
        UPT=-1.0E+10
      ELSE IF(UPT.EQ.-1.0E+20) THEN
        CALL S98PPL(1,P,T,'P','T','UPT')
        UPT=-1.0E+20
      END IF
      RETURN
      END
*-------------------------------------------------  F45PPL = UPX
      REAL FUNCTION UPX(P,X)
      REAL P,PI,X
      INTEGER KPA
      COMMON/UNIT/KPA,MESS
      PI=G98PPL(KPA,P)
      UPX=F45PPL(PI,X)
      IF(UPX.EQ.-1.0E+10) THEN
        CALL S97PPL('UPX')
        UPX=-1.0E+10
      ELSE IF(UPX.EQ.-1.0E+20) THEN
        WRITE(6,2000) P,X
 2000   FORMAT(1H ,5X,'****  OUT OF RANGE AT UPX FOR PROPYLENE',
     -         ' WHEN  P =',1PE14.7,' AND   X=',1PE14.7,'  ****')
        UPX=-1.0E+20
      END IF
      RETURN
      END
*-------------------------------------------------  F46PPL = UTD
      REAL FUNCTION UTD(T)
      REAL T,TI
      INTEGER KPA
      COMMON/UNIT/KPA,MESS
      TI=G99PPL(KPA,T)
      UTD=F46PPL(TI)
      IF(UTD.EQ.-1.0E+10) THEN
        CALL S97PPL('UTD')
        UTD=-1.0E+10
      ELSE IF(UTD.EQ.-1.0E+20) THEN
        CALL S98PPL(2,T,T,'T','T','UTD')
        UTD=-1.0E+20
      END IF
      RETURN
      END
*-------------------------------------------------  F47PPL = UTDD
      REAL FUNCTION UTDD(T)
      REAL T,TI
      INTEGER KPA
      COMMON/UNIT/KPA,MESS
      TI=G99PPL(KPA,T)
      UTDD=F47PPL(TI)
      IF(UTDD.EQ.-1.0E+10) THEN
        CALL S97PPL('UTDD')
        UTDD=-1.0E+10
      ELSE IF(UTDD.EQ.-1.0E+20) THEN
        CALL S98PPL(2,T,T,'T','T','UTDD')
        UTDD=-1.0E+20
      END IF
      RETURN
      END
*-------------------------------------------------  F48PPL = UTX
      REAL FUNCTION UTX(T,X)
      REAL T,TI,X
      INTEGER KPA
      COMMON/UNIT/KPA,MESS
      TI=G99PPL(KPA,T)
      UTX=F48PPL(TI,X)
      IF(UTX.EQ.-1.0E+10) THEN
        CALL S97PPL('UTX')
        UTX=-1.0E+10
      ELSE IF(UTX.EQ.-1.0E+20) THEN
        WRITE(6,2000) T,X
 2000   FORMAT(1H ,5X,'****  OUT OF RANGE AT UTX FOR PROPYLENE',
     -         ' WHEN  T =',1PE14.7,' AND   X=',1PE14.7,'  ****')
        UTX=-1.0E+20
      END IF
      RETURN
      END
*-------------------------------------------------  F49PPL = VPD
      REAL FUNCTION VPD(P)
      REAL P,PI
      INTEGER KPA
      COMMON/UNIT/KPA,MESS
      PI=G98PPL(KPA,P)
      VPD=F49PPL(PI)
      IF(VPD.EQ.-1.0E+10) THEN
        CALL S97PPL('VPD')
        VPD=-1.0E+10
      ELSE IF(VPD.EQ.-1.0E+20) THEN
        CALL S98PPL(1,P,P,'P','P','VPD')
        VPD=-1.0E+20
      END IF
      RETURN
      END
*-------------------------------------------------  F50PPL = VPDD
      REAL FUNCTION VPDD(P)
      REAL P,PI
      INTEGER KPA
      COMMON/UNIT/KPA,MESS
      PI=G98PPL(KPA,P)
      VPDD=F50PPL(PI)
      IF(VPDD.EQ.-1.0E+10) THEN
        CALL S97PPL('VPDD')
        VPDD=-1.0E+10
      ELSE IF(VPDD.EQ.-1.0E+20) THEN
        CALL S98PPL(1,P,P,'P','P','VPDD')
        VPDD=-1.0E+20
      END IF
      RETURN
      END
*-------------------------------------------------  F51PPL = VPT
      REAL FUNCTION VPT(P,T)
      REAL P,PI,T,TI
      INTEGER KPA
      COMMON/UNIT/KPA,MESS
      PI=G98PPL(KPA,P)
      TI=G99PPL(KPA,T)
      VPT=F51PPL(PI,TI)
      IF(VPT.EQ.-1.0E+10) THEN
        CALL S97PPL('VPT')
        VPT=-1.0E+10
      ELSE IF(VPT.EQ.-1.0E+20) THEN
        CALL S98PPL(3,P,T,'P','T','VPT')
        VPT=-1.0E+20
      END IF
      RETURN
      END
*-------------------------------------------------  F52PPL = VPX
      REAL FUNCTION VPX(P,X)
      REAL P,PI,X
      INTEGER KPA
      COMMON/UNIT/KPA,MESS
      PI=G98PPL(KPA,P)
      VPX=F52PPL(PI,X)
      IF(VPX.EQ.-1.0E+10) THEN
        CALL S97PPL('VPX')
        VPX=-1.0E+10
      ELSE IF(VPX.EQ.-1.0E+20) THEN
        WRITE(6,2000) P,X
 2000   FORMAT(1H ,5X,'****  OUT OF RANGE AT VPX FOR PROPYLENE',
     -         ' WHEN  P =',1PE14.7,' AND   X=',1PE14.7,'  ****')
        VPX=-1.0E+20
      END IF
      RETURN
      END
*-------------------------------------------------  F53PPL = VTD
      REAL FUNCTION VTD(T)
      REAL T,TI
      INTEGER KPA
      COMMON/UNIT/KPA,MESS
      TI=G99PPL(KPA,T)
      VTD=F53PPL(TI)
      IF(VTD.EQ.-1.0E+10) THEN
        CALL S97PPL('VTD')
        VTD=-1.0E+10
      ELSE IF(VTD.EQ.-1.0E+20) THEN
        CALL S98PPL(2,T,T,'T','T','VTD')
        VTD=-1.0E+20
      END IF
      RETURN
      END
*-------------------------------------------------  F54PPL = VTDD
      REAL FUNCTION VTDD(T)
      REAL T,TI
      INTEGER KPA
      COMMON/UNIT/KPA,MESS
      TI=G99PPL(KPA,T)
      VTDD=F54PPL(TI)
      IF(VTDD.EQ.-1.0E+10) THEN
        CALL S97PPL('VTDD')
        VTDD=-1.0E+10
      ELSE IF(VTDD.EQ.-1.0E+20) THEN
        CALL S98PPL(2,T,T,'T','T','VTDD')
        VTDD=-1.0E+20
      END IF
      RETURN
      END
*-------------------------------------------------  F55PPL = VTX
      REAL FUNCTION VTX(T,X)
      REAL T,TI,X
      INTEGER KPA
      COMMON/UNIT/KPA,MESS
      TI=G99PPL(KPA,T)
      VTX=F55PPL(TI,X)
      IF(VTX.EQ.-1.0E+10) THEN
        CALL S97PPL('VTX')
        VTX=-1.0E+10
      ELSE IF(VTX.EQ.-1.0E+20) THEN
        WRITE(6,2000) T,X
 2000   FORMAT(1H ,5X,'****  OUT OF RANGE AT VTX FOR PROPYLENE',
     -         ' WHEN  T =',1PE14.7,' AND   X=',1PE14.7,'  ****')
        VTX=-1.0E+20
      END IF
      RETURN
      END
*-------------------------------------------------  F56PPL = XPH
      REAL FUNCTION XPH(P,H)
      REAL P,PI,H
      INTEGER KPA
      COMMON/UNIT/KPA,MESS
      PI=G98PPL(KPA,P)
      XPH=F56PPL(PI,H)
      IF(XPH.EQ.-1.0E+10) THEN
        CALL S97PPL('XPH')
        XPH=-1.0E+10
      ELSE IF(XPH.EQ.-1.0E+20) THEN
        WRITE(6,2000) P,H
 2000   FORMAT(1H ,5X,'****  OUT OF RANGE AT XPH FOR PROPYLENE',
     -    ' WHEN  P =',1PE14.7,' AND   H=',1PE14.7,'  ****')
        XPH=-1.0E+20
      END IF
      RETURN
      END
*-------------------------------------------------  F57PPL = XPS
      REAL FUNCTION XPS(P,S)
      REAL P,PI,S
      INTEGER KPA
      COMMON/UNIT/KPA,MESS
      PI=G98PPL(KPA,P)
      XPS=F57PPL(PI,S)
      IF(XPS.EQ.-1.0E+10) THEN
        CALL S97PPL('XPS')
        XPS=-1.0E+10
      ELSE IF(XPS.EQ.-1.0E+20) THEN
        WRITE(6,2000) P,S
 2000   FORMAT(1H ,5X,'****  OUT OF RANGE AT XPS FOR PROPYLENE',
     -         ' WHEN  P =',1PE14.7,' AND   S=',1PE14.7,'  ****')
        XPS=-1.0E+20
      END IF
      RETURN
      END
*-------------------------------------------------  F58PPL = XPU
      REAL FUNCTION XPU(P,U)
      REAL P,PI,U
      INTEGER KPA
      COMMON/UNIT/KPA,MESS
      PI=G98PPL(KPA,P)
      XPU=F58PPL(PI,U)
      IF(XPU.EQ.-1.0E+10) THEN
        CALL S97PPL('XPU')
        XPU=-1.0E+10
      ELSE IF(XPU.EQ.-1.0E+20) THEN
        WRITE(6,2000) P,U
 2000   FORMAT(1H ,5X,'****  OUT OF RANGE AT XPU FOR PROPYLENE',
     -         ' WHEN  P =',1PE14.7,' AND   U=',1PE14.7,'  ****')
        XPU=-1.0E+20
      END IF
      RETURN
      END
*-------------------------------------------------  F59PPL = XPV
      REAL FUNCTION XPV(P,V)
      REAL P,PI,V
      INTEGER KPA
      COMMON/UNIT/KPA,MESS
      PI=G98PPL(KPA,P)
      XPV=F59PPL(PI,V)
      IF(XPV.EQ.-1.0E+10) THEN
        CALL S97PPL('XPV')
        XPV=-1.0E+10
      ELSE IF(XPV.EQ.-1.0E+20) THEN
        WRITE(6,2000) P,V
 2000   FORMAT(1H ,5X,'****  OUT OF RANGE AT XPV FOR PROPYLENE',
     -         ' WHEN  P =',1PE14.7,' AND   V=',1PE14.7,'  ****')
        XPV=-1.0E+20
      END IF
      RETURN
      END
*-------------------------------------------------  F60PPL = XTH
      REAL FUNCTION XTH(T,H)
      REAL T,TI,H
      INTEGER KPA
      COMMON/UNIT/KPA,MESS
      TI=G99PPL(KPA,T)
      XTH=F60PPL(TI,H)
      IF(XTH.EQ.-1.0E+10) THEN
        CALL S97PPL('XTH')
        XTH=-1.0E+10
      ELSE IF(XTH.EQ.-1.0E+20) THEN
        WRITE(6,2000) T,H
 2000   FORMAT(1H ,5X,'****  OUT OF RANGE AT XTH FOR PROPYLENE',
     -         ' WHEN  T =',1PE14.7,' AND   H=',1PE14.7,'  ****')
        XTH=-1.0E+20
      END IF
      RETURN
      END
*-------------------------------------------------  F61PPL = XTS
      REAL FUNCTION XTS(T,S)
      REAL T,TI,S
      INTEGER KPA
      COMMON/UNIT/KPA,MESS
      TI=G99PPL(KPA,T)
      XTS=F61PPL(TI,S)
      IF(XTS.EQ.-1.0E+10) THEN
        CALL S97PPL('XTS')
        XTS=-1.0E+10
      ELSE IF(XTS.EQ.-1.0E+20) THEN
        WRITE(6,2000) T,S
 2000   FORMAT(1H ,5X,'****  OUT OF RANGE AT XTS FOR PROPYLENE',
     -         ' WHEN  T =',1PE14.7,' AND   S=',1PE14.7,'  ****')
        XTS=-1.0E+20
      END IF
      RETURN
      END
*-------------------------------------------------  F62PPL = XTU
      REAL FUNCTION XTU(T,U)
      REAL T,TI,U
      INTEGER KPA
      COMMON/UNIT/KPA,MESS
      TI=G99PPL(KPA,T)
      XTU=F62PPL(TI,U)
      IF(XTU.EQ.-1.0E+10) THEN
        CALL S97PPL('XTU')
        XTU=-1.0E+10
      ELSE IF(XTU.EQ.-1.0E+20) THEN
        WRITE(6,2000) T,U
 2000   FORMAT(1H ,5X,'****  OUT OF RANGE AT XTU FOR PROPYLENE',
     -         ' WHEN  T =',1PE14.7,' AND   U=',1PE14.7,'  ****')
        XTU=-1.0E+20
      END IF
      RETURN
      END
*-------------------------------------------------  F63PPL = XTV
      REAL FUNCTION XTV(T,V)
      REAL T,TI,V
      INTEGER KPA
      COMMON/UNIT/KPA,MESS
      TI=G99PPL(KPA,T)
      XTV=F63PPL(TI,V)
      IF(XTV.EQ.-1.0E+10) THEN
        CALL S97PPL('XTV')
        XTV=-1.0E+10
      ELSE IF(XTV.EQ.-1.0E+20) THEN
        WRITE(6,2000) T,V
 2000   FORMAT(1H ,5X,'****  OUT OF RANGE AT XTV FOR PROPYLENE',
     -         ' WHEN  T =',1PE14.7,' AND   V=',1PE14.7,'  ****')
        XTV=-1.0E+20
      END IF
      RETURN
      END
*-------------------------------------------------  F64PPL = TPH
      REAL FUNCTION TPH(P,H)
      REAL P,PI,H
      INTEGER KPA
      COMMON/UNIT/KPA,MESS
      PI=G98PPL(KPA,P)
      TPH=F64PPL(PI,H)
      IF(TPH.EQ.-1.0E+10) THEN
        CALL S97PPL('TPH')
        TPH=-1.0E+10
        RETURN
      ELSE IF(TPH.EQ.-1.0E+20) THEN
        WRITE(6,2000) P,H
 2000   FORMAT(1H ,5X,'****  OUT OF RANGE AT TPH FOR PROPYLENE',
     -         ' WHEN  P =',1PE14.7,' AND   H=',1PE14.7,'  ****')
        TPH=-1.0E+20
        RETURN
      END IF
      IF((KPA.EQ.1).OR.(KPA.EQ.3)) RETURN
      TPH=TPH+273.15
      RETURN
      END
*-------------------------------------------------  F65PPL = TPS
      REAL FUNCTION TPS(P,S)
      REAL P,PI,S
      INTEGER KPA
      COMMON/UNIT/KPA,MESS
      PI=G98PPL(KPA,P)
      TPS=F65PPL(PI,S)
      IF(TPS.EQ.-1.0E+10) THEN
        CALL S97PPL('TPS')
        TPS=-1.0E+10
        RETURN
      ELSE IF(TPS.EQ.-1.0E+20) THEN
        WRITE(6,2000) P,S
 2000   FORMAT(1H ,5X,'****  OUT OF RANGE AT TPS FOR PROPYLENE',
     -         ' WHEN  P =',1PE14.7,' AND   S=',1PE14.7,'  ****')
        TPS=-1.0E+20
        RETURN
      END IF
      IF((KPA.EQ.1).OR.(KPA.EQ.3)) RETURN
      TPS=TPS+273.15
      RETURN
      END
*-------------------------------------------------  F66PPL = PLDT
      REAL FUNCTION PLDT(T)
      REAL T,TI
      TI=T
      CALL S99PPL('PLDT')
      PLDT=-1.0E+30
      RETURN
      END
*-------------------------------------------------  F67PPL = TLDP
      REAL FUNCTION TLDP(P)
      REAL P,PI
      PI=P
      CALL S99PPL('TLDP')
      TLDP=-1.0E+30
      RETURN
      END
*-------------------------------------------------  F68PPL = PMLT
      REAL FUNCTION PMLT(T)
      REAL T,TI
      INTEGER KPA
      COMMON/UNIT/KPA,MESS
      TI=G99PPL(KPA,T)
      PMLT=F68PPL(TI)
      IF(PMLT.EQ.-1.0E+10) THEN
        CALL S97PPL('PMLT')
        PMLT=-1.0E+10
        RETURN
      ELSE IF(PMLT.EQ.-1.0E+20) THEN
        CALL S98PPL(2,T,T,'T','T','PMLT')
        PMLT=-1.0E+20
        RETURN
      END IF
      IF((KPA.EQ.1).OR.(KPA.EQ.2)) RETURN
      PMLT=PMLT*1.0E+05
      RETURN
      END
*-------------------------------------------------  F69PPL = TMLP
      REAL FUNCTION TMLP(P)
      REAL P,PI
      INTEGER KPA
      COMMON/UNIT/KPA,MESS
      PI=G98PPL(KPA,P)
      TMLP=F69PPL(PI)
      IF(TMLP.EQ.-1.0E+10) THEN
        CALL S97PPL('TMLP')
        TMLP=-1.0E+10
        RETURN
      ELSE IF(TMLP.EQ.-1.0E+20) THEN
        CALL S98PPL(1,P,P,'P','P','TMLP')
        TMLP=-1.0E+20
        RETURN
      END IF
      IF((KPA.EQ.1).OR.(KPA.EQ.3)) RETURN
      TMLP=TMLP+273.15
      RETURN
      END
*-------------------------------------------------  F70PPL = TPV
      REAL FUNCTION TPV(P,V)
      REAL P,PI,V
      INTEGER KPA
      COMMON/UNIT/KPA,MESS
      PI=G98PPL(KPA,P)
      TPV=F70PPL(PI,V)
      IF(TPV.EQ.-1.0E+10) THEN
        CALL S97PPL('TPV')
        TPV=-1.0E+10
        RETURN
      ELSE IF(TPV.EQ.-1.0E+20) THEN
        WRITE(6,2000) P,V
 2000   FORMAT(1H ,5X,'****  OUT OF RANGE AT TPV FOR PROPYLENE',
     -         ' WHEN  P =',1PE14.7,' AND   V=',1PE14.7,'  ****')
        TPV=-1.0E+20
        RETURN
      END IF
      IF((KPA.EQ.1).OR.(KPA.EQ.3)) RETURN
      TPV=TPV+273.15
      RETURN
      END
*-------------------------------------------------  F71PPL = HPS
      REAL FUNCTION HPS(P,S)
      REAL P,PI,S
      INTEGER KPA
      COMMON/UNIT/KPA,MESS
      PI=G98PPL(KPA,P)
      HPS=F71PPL(PI,S)
      IF(HPS.EQ.-1.0E+10) THEN
        CALL S97PPL('HPS')
        HPS=-1.0E+10
      ELSE IF(HPS.EQ.-1.0E+20) THEN
        WRITE(6,2000) P,S
 2000   FORMAT(1H ,5X,'****  OUT OF RANGE AT HPS FOR PROPYLENE',
     -         ' WHEN  P =',1PE14.7,' AND   S=',1PE14.7,'  ****')
        HPS=-1.0E+20
      END IF
      RETURN
      END
*-------------------------------------------------  F72PPL = PSTD
      REAL FUNCTION PSTD(T)
      REAL T,TI
      TI=T
      CALL S99PPL('PSTD')
      PSTD=-1.0E+30
      RETURN
      END
*-------------------------------------------------  F73PPL = PSTDD
      REAL FUNCTION PSTDD(T)
      REAL T,TI
      TI=T
      CALL S99PPL('PSTDD')
      PSTDD=-1.0E+30
      RETURN
      END
*-------------------------------------------------  F74PPL = TSPD
      REAL FUNCTION TSPD(P)
      REAL P,PI
      PI=P
      CALL S99PPL('TSPD')
      TSPD=-1.0E+30
      RETURN
      END
*-------------------------------------------------  F75PPL = TSPDD
      REAL FUNCTION TSPDD(P)
      REAL P,PI
      PI=P
      CALL S99PPL('TSPDD')
      TSPDD=-1.0E+30
      RETURN
      END
*-------------------------------------------------  F76PPL = CVPDD
      REAL FUNCTION CVPDD(P)
      REAL P,PI
      INTEGER KPA
      COMMON/UNIT/KPA,MESS
      PI=G98PPL(KPA,P)
      CVPDD=F76PPL(PI)
      IF(CVPDD.EQ.-1.0E+10) THEN
        CALL S97PPL('CVPDD')
        CVPDD=-1.0E+10
      ELSE IF(CVPDD.EQ.-1.0E+20) THEN
        CALL S98PPL(1,P,P,'P','P','CVPDD')
        CVPDD=-1.0E+20
      END IF
      RETURN
      END
*-------------------------------------------------  F77PPL = CVPT
      REAL FUNCTION CVPT(P,T)
      REAL P,PI,T,TI
      INTEGER KPA
      COMMON/UNIT/KPA,MESS
      PI=G98PPL(KPA,P)
      TI=G99PPL(KPA,T)
      CVPT=F77PPL(PI,TI)
      IF(CVPT.EQ.-1.0E+10) THEN
        CALL S97PPL('CVPT')
        CVPT=-1.0E+10
      ELSE IF(CVPT.EQ.-1.0E+20) THEN
        CALL S98PPL(3,P,T,'P','T','CVPT')
        CVPT=-1.0E+20
      END IF
      RETURN
      END
*-------------------------------------------------  F78PPL = CVTDD
      REAL FUNCTION CVTDD(T)
      REAL T,TI
      INTEGER KPA
      COMMON/UNIT/KPA,MESS
      TI=G99PPL(KPA,T)
      CVTDD=F78PPL(TI)
      IF(CVTDD.EQ.-1.0E+10) THEN
        CALL S97PPL('CVTDD')
        CVTDD=-1.0E+10
      ELSE IF(CVTDD.EQ.-1.0E+20) THEN
        CALL S98PPL(2,T,T,'T','T','CVTDD')
        CVTDD=-1.0E+20
      END IF
      RETURN
      END
*-------------------------------------------------  F79PPL = UPS
      REAL FUNCTION UPS(P,S)
      REAL P,PI,S
      INTEGER KPA
      COMMON/UNIT/KPA,MESS
      PI=G98PPL(KPA,P)
      UPS=F79PPL(PI,S)
      IF(UPS.EQ.-1.0E+10) THEN
        CALL S97PPL('UPS')
        TPS=-1.0E+10
        RETURN
      ELSE IF(UPS.EQ.-1.0E+20) THEN
        WRITE(6,2000) P,S
 2000   FORMAT(1H ,5X,'****  OUT OF RANGE AT UPS FOR PROPYLENE',
     -         ' WHEN  P =',1PE14.7,' AND   S=',1PE14.7,'  ****')
        UPS=-1.0E+20
        RETURN
      END IF
      RETURN
      END
*-------------------------------------------------  F80PPL = VPS
      REAL FUNCTION VPS(P,S)
      REAL P,PI,S
      INTEGER KPA
      COMMON/UNIT/KPA,MESS
      PI=G98PPL(KPA,P)
      VPS=F80PPL(PI,S)
      IF(VPS.EQ.-1.0E+10) THEN
        CALL S97PPL('VPS')
        VPS=-1.0E+10
        RETURN
      ELSE IF(VPS.EQ.-1.0E+20) THEN
        WRITE(6,2000) P,S
 2000   FORMAT(1H ,5X,'****  OUT OF RANGE AT VPS FOR PROPYLENE',
     -         ' WHEN  P =',1PE14.7,' AND   S=',1PE14.7,'  ****')
        VPS=-1.0E+20
        RETURN
      END IF
      RETURN
      END
*-------------------------------------------------  F81PPL = PRPT
      REAL FUNCTION PRPT(P,T)
      REAL P,PI,T,TI
      PI=P
      TI=T
      CALL S99PPL('PRPT')
      PRPT=-1.0E+30
      RETURN
      END
*-------------------------------------------------  F82PPL = AKPT
      REAL FUNCTION AKPT(P,T)
      REAL P,PI,T,TI
      INTEGER KPA
      COMMON/UNIT/KPA,MESS
      PI=G98PPL(KPA,P)
      TI=G99PPL(KPA,T)
      AKPT=F82PPL(PI,TI)
      IF(AKPT.EQ.-1.0E+10) THEN
        CALL S97PPL('AKPT')
        AKPT=-1.0E+10
      ELSE IF(AKPT.EQ.-1.0E+20) THEN
        CALL S98PPL(3,P,T,'P','T','AKPT')
        AKPT=-1.0E+20
      END IF
      RETURN
      END
*-------------------------------------------------  F83PPL = WPT
      REAL FUNCTION WPT(P,T)
      REAL P,PI,T,TI
      INTEGER KPA
      COMMON/UNIT/KPA,MESS
      PI=G98PPL(KPA,P)
      TI=G99PPL(KPA,T)
      WPT=F83PPL(PI,TI)
      IF(WPT.EQ.-1.0E+10) THEN
        CALL S97PPL('WPT')
        WPT=-1.0E+10
      ELSE IF(WPT.EQ.-1.0E+20) THEN
        CALL S98PPL(3,P,T,'P','T','WPT')
        WPT=-1.0E+20
      END IF
      RETURN
      END
*-------------------------------------------------  F85PPL = PRPD
      REAL FUNCTION PRPD(P)
      REAL P,PI
      PI=P
      CALL S99PPL('PRPD')
      PRPD=-1.0E+30
      RETURN
      END
*-------------------------------------------------  F86PPL = PRPDD
      REAL FUNCTION PRPDD(P)
      REAL P,PI
      PI=P
      CALL S99PPL('PRPDD')
      PRPDD=-1.0E+30
      RETURN
      END
*-------------------------------------------------  F87PPL = PRTD
      REAL FUNCTION PRTD(T)
      REAL T,TI
      TI=T
      CALL S99PPL('PRTD')
      PRTD=-1.0E+30
      RETURN
      END
*-------------------------------------------------  F88PPL = PRTDD
      REAL FUNCTION PRTDD(T)
      REAL T,TI
      TI=T
      CALL S99PPL('PRTDD')
      PRTDD=-1.0E+30
      RETURN
      END
*-------------------------------------------------  F90PPL = BSPT
      REAL FUNCTION BSPT(P,T)
      REAL P,PI,T,TI
      PI=P
      TI=T
      CALL S99PPL('BSPT')
      BSPT=-1.0E+30
      RETURN
      END
*-------------------------------------------------  F91PPL = BTPT
      REAL FUNCTION BTPT(P,T)
      REAL P,PI,T,TI
      PI=P
      TI=T
      CALL S99PPL('BTPT')
      BTPT=-1.0E+30
      RETURN
      END
*-------------------------------------------------  F92PPL = BPPT
      REAL FUNCTION BPPT(P,T)
      REAL P,PI,T,TI
      PI=P
      TI=T
      CALL S99PPL('BPPT')
      BPPT=-1.0E+30
      RETURN
      END
*-------------------------------------------------  F93PPL = BVPT
      REAL FUNCTION BVPT(P,T)
      REAL P,PI,T,TI
      PI=P
      TI=T
      CALL S99PPL('BVPT')
      BVPT=-1.0E+30
      RETURN
      END
*-------------------------------------------------  F94PPL = AJTPT
      REAL FUNCTION AJTPT(P,T)
      REAL P,PI,T,TI
      PI=P
      TI=T
      CALL S99PPL('AJTPT')
      AJTPT=-1.0E+30
      RETURN
      END
*-------------------------------------------------  F95PPL = GAMPT
      REAL FUNCTION GAMPT(P,T)
      REAL P,PI,T,TI
      PI=P
      TI=T
      CALL S99PPL('GAMPT')
      GAMPT=-1.0E+30
      RETURN
      END
*-------------------------------------------------  F96PPL = GAMPDD
      REAL FUNCTION GAMPDD(P)
      REAL P,PI
      PI=P
      CALL S99PPL('GAMPDD')
      GAMPDD=-1.0E+30
      RETURN
      END
*-------------------------------------------------  F97PPL = GAMTDD
      REAL FUNCTION GAMTDD(T)
      REAL T,TI
      TI=T
      CALL S99PPL('GAMTDD')
      GAMTDD=-1.0E+30
      RETURN
      END
*-------------------------------------------------  F98PPL = TPSEUP
      REAL FUNCTION TPSEUP(P)
      REAL P,PI
      INTEGER KPA
      COMMON/UNIT/KPA,MESS
      PI=G98PPL(KPA,P)
      TPSEUP=F98PPL(PI)
      IF(TPSEUP.EQ.-1.0E+10) THEN
        CALL S97PPL('TPSEUP')
        TPSEUP=-1.0E+10
        RETURN
      ELSE IF(TPSEUP.EQ.-1.0E+20) THEN
        CALL S98PPL(1,P,P,'P','P','TPSEUP')
        TPSEUP=-1.0E+20
        RETURN
      END IF
      IF((KPA.EQ.1).OR.(KPA.EQ.3)) RETURN
      TPSEUP=TPSEUP+273.15
      RETURN
      END
*-------------------------------------------------  F99PPL = PSBT
      REAL FUNCTION PSBT(T)
      REAL T,TI
      TI=T
      CALL S99PPL('PSBT')
      PSBT=-1.0E+30
      RETURN
      END
*-------------------------------------------------  F100PPL = TSBP
      REAL FUNCTION TSBP(P)
      REAL P,PI
      PI=P
      CALL S99PPL('TSBP')
      TSBP=-1.0E+30
      RETURN
      END
***** PROPATH V51:PROPYLENE FUNCTIONS **********************************
      REAL FUNCTION F4PPL(FP)
***** FP=INPUT PRESSURE IN BAR *****
      IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z)
      PARAMETER(PCR=4.6646D+06,AKGMOL=4.20804D-02)
      F4PPL=-1.0E+20
      IF ((FP.LT.0.954E-08).OR.(FP.GT.4.6646E+01)) RETURN
      F4PPL=-1.0E+10
      PI=DBLE(FP)*1.0D+05/PCR
      CALL S4PPL(PI,OMEGAL,OMEGAG,TAUS)
       IF (OMEGAL.LE.-1.0D+10) RETURN
      CALL S13PPL(TAUS,OMEGAL,HL)
      CALL S13PPL(TAUS,OMEGAG,HG)
      ALHP=(HG-HL)/AKGMOL
      F4PPL=REAL(ALHP)
      RETURN
      END
      REAL FUNCTION F5PPL(FT)
***** FT=INPUT TEMPERATURE IN C(DEGREE CELSIUS) *****
      IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z)
      PARAMETER(TCR=365.57D+00,AKGMOL=4.20804D-02)
      F5PPL=-1.0E+20
      IF ((FT.LT.-185.261).OR.(FT.GT.92.42)) RETURN
      F5PPL=-1.0E+10
      TAU=TCR/(DBLE(FT)+273.15D0)
      CALL S3PPL(TAU,OMEGAL,OMEGAG,PIS)
       IF (OMEGAL.LE.-1.0D+10) RETURN
      CALL S13PPL(TAU,OMEGAL,HL)
      CALL S13PPL(TAU,OMEGAG,HG)
      ALHT=(HG-HL)/AKGMOL
      F5PPL=REAL(ALHT)
      RETURN
      END
      REAL FUNCTION F16PPL(FP)
      IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z)
      PARAMETER(PCR=4.6646D+06,AKGMOL=4.20804D-02)
      F16PPL=-1.0E+20
      IF ((FP.LT.0.60788E-05).OR.(FP.GT.4.6646E+01)) RETURN
      F16PPL=-1.0E+10
      PI=DBLE(FP)*1.0D+05/PCR
      CALL S4PPL(PI,OMEGAL,OMEGAG,TAUS)
       IF (OMEGAL.LE.-1.0D+10) RETURN
      CALL S15PPL(TAUS,OMEGAL,CPL)
      CPPD=CPL/AKGMOL
      F16PPL=REAL(CPPD)
      RETURN
      END
      REAL FUNCTION F17PPL(FP)
      IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z)
      PARAMETER(PCR=4.6646D+06,AKGMOL=4.20804D-02)
      F17PPL=-1.0E+20
      IF ((FP.LT.0.954E-08).OR.(FP.GT.4.6646E+01)) RETURN
      F17PPL=-1.0E+10
      PI=DBLE(FP)*1.0D+05/PCR
      CALL S4PPL(PI,OMEGAL,OMEGAG,TAUS)
       IF (OMEGAG.LE.-1.0D+10) RETURN
      CALL S15PPL(TAUS,OMEGAG,CPG)
      CPPDD=CPG/AKGMOL
      F17PPL=REAL(CPPDD)
      RETURN
      END
      REAL FUNCTION F18PPL(FP,FT)
      IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z)
      PARAMETER(PCR=4.6646D+06,TCR=365.57D+00,AKGMOL=4.20804D-02)
      F18PPL=-1.0E+20
      CALL S91PPL(FP,FT,ILL91)
       IF (ILL91.NE.0) RETURN
      F18PPL=-1.0E+10
      PI=DBLE(FP)*1.0D+05/PCR
      TAU=TCR/(DBLE(FT)+273.15D0)
      CALL S5PPL(PI,TAU,OMEGA)
       IF (OMEGA.LE.-1.0D+10) RETURN
      CALL S15PPL(TAU,OMEGA,CP)
      CPPT=CP/AKGMOL
      F18PPL=REAL(CPPT)
      RETURN
      END
      REAL FUNCTION F19PPL(FT)
      IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z)
      PARAMETER(TCR=365.57D+00,AKGMOL=4.20804D-02)
      F19PPL=-1.0E+20
      IF ((FT.LT.-163.16).OR.(FT.GT.92.42)) RETURN
      F19PPL=-1.0E+10
      TAU=TCR/(DBLE(FT)+273.15D0)
      CALL S3PPL(TAU,OMEGAL,OMEGAG,PIS)
       IF (OMEGAL.LE.-1.0D+10) RETURN
      CALL S15PPL(TAU,OMEGAL,CPL)
      CPTD=CPL/AKGMOL
      F19PPL=REAL(CPTD)
      RETURN
      END
      REAL FUNCTION F20PPL(FT)
      IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z)
      PARAMETER(TCR=365.57D+00,AKGMOL=4.20804D-02)
      F20PPL=-1.0E+20
      IF ((FT.LT.-185.261).OR.(FT.GT.92.42)) RETURN
      F20PPL=-1.0E+10
      TAU=TCR/(DBLE(FT)+273.15D0)
      CALL S3PPL(TAU,OMEGAL,OMEGAG,PIS)
       IF (OMEGAG.LE.-1.0D+10) RETURN
      CALL S15PPL(TAU,OMEGAG,CPG)
      CPTDD=CPG/AKGMOL
      F20PPL=REAL(CPTDD)
      RETURN
      END
      REAL FUNCTION F21PPL(A)
      CHARACTER*1 A,B(1:5)
      DOUBLE PRECISION CRP(1:5),HCR,SCR
      PARAMETER(AKGMOL=4.20804D-02)
      DATA B(1)/'H'/,B(2)/'P'/,B(3)/'S'/,B(4)/'T'/,B(5)/'V'/
      CALL S13PPL(1.0D0,1.0D0,HCR)
      CALL S11PPL(1.0D0,1.0D0,SCR)
      CRP(1)=HCR/AKGMOL
      CRP(2)=4.6646D+01
      CRP(3)=SCR/AKGMOL
      CRP(4)=92.42D+00
      CRP(5)=(1.0D0/5.3086D+03)/AKGMOL
      DO 10 I=1,5
       F21PPL=REAL(CRP(I))
        IF(A.EQ.B(I)) RETURN
   10 CONTINUE
      F21PPL=-1.0E+20
      RETURN
      END
      REAL FUNCTION F23PPL(FP)
      IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z)
      PARAMETER(PCR=4.6646D+06,AKGMOL=4.20804D-02)
      F23PPL=-1.0E+20
      IF ((FP.LT.0.954E-08).OR.(FP.GT.4.6646E+01)) RETURN
      F23PPL=-1.0E+10
      PI=DBLE(FP)*1.0D+05/PCR
      CALL S4PPL(PI,OMEGAL,OMEGAG,TAUS)
       IF (OMEGAL.LE.-1.0D+10) RETURN
      CALL S13PPL(TAUS,OMEGAL,HL)
      HPD=HL/AKGMOL
      F23PPL=REAL(HPD)
      RETURN
      END
      REAL FUNCTION F24PPL(FP)
      IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z)
      PARAMETER(PCR=4.6646D+06,AKGMOL=4.20804D-02)
      F24PPL=-1.0E+20
      IF ((FP.LT.0.954E-08).OR.(FP.GT.4.6646E+01)) RETURN
      F24PPL=-1.0E+10
      PI=DBLE(FP)*1.0D+05/PCR
      CALL S4PPL(PI,OMEGAL,OMEGAG,TAUS)
       IF (OMEGAG.LE.-1.0D+10) RETURN
      CALL S13PPL(TAUS,OMEGAG,HG)
      HPDD=HG/AKGMOL
      F24PPL=REAL(HPDD)
      RETURN
      END
      REAL FUNCTION F25PPL(FP,FT)
      IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z)
      PARAMETER(PCR=4.6646D+06,TCR=365.57D+00,AKGMOL=4.20804D-02)
      F25PPL=-1.0E+20
      CALL S90PPL(FP,FT,ILL90)
       IF (ILL90.NE.0) RETURN
      F25PPL=-1.0E+10
      PI=DBLE(FP)*1.0D+05/PCR
      TAU=TCR/(DBLE(FT)+273.15D0)
      CALL S5PPL(PI,TAU,OMEGA)
       IF (OMEGA.LE.-1.0D+10) RETURN
      CALL S13PPL(TAU,OMEGA,H)
      HPT=H/AKGMOL
      F25PPL=REAL(HPT)
      RETURN
      END
      REAL FUNCTION F26PPL(FP,FX)
      IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z)
      PARAMETER(PCR=4.6646D+06,AKGMOL=4.20804D-02)
      F26PPL=-1.0E+20
      IF ((FP.LT.0.954E-08).OR.(FP.GT.4.6646E+01).OR.
     -    (FX.LT.0.0).OR.(FX.GT.1.0)) RETURN
      F26PPL=-1.0E+10
      PI=DBLE(FP)*1.0D+05/PCR
      X=DBLE(FX)
      CALL S4PPL(PI,OMEGAL,OMEGAG,TAUS)
       IF (OMEGAL.LE.-1.0D+10) RETURN
      CALL S13PPL(TAUS,OMEGAL,HL)
      CALL S13PPL(TAUS,OMEGAG,HG)
      HPX=(HL+X*(HG-HL))/AKGMOL
      F26PPL=REAL(HPX)
      RETURN
      END
      REAL FUNCTION F27PPL(FT)
      IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z)
      PARAMETER(TCR=365.57D+00,AKGMOL=4.20804D-02)
      F27PPL=-1.0E+20
      IF ((FT.LT.-185.261).OR.(FT.GT.92.42)) RETURN
      F27PPL=-1.0E+10
      TAU=TCR/(DBLE(FT)+273.15D0)
      CALL S3PPL(TAU,OMEGAL,OMEGAG,PIS)
       IF (OMEGAL.LE.-1.0D+10) RETURN
      CALL S13PPL(TAU,OMEGAL,HL)
      HTD=HL/AKGMOL
      F27PPL=REAL(HTD)
      RETURN
      END
      REAL FUNCTION F28PPL(FT)
      IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z)
      PARAMETER(TCR=365.57D+00,AKGMOL=4.20804D-02)
      F28PPL=-1.0E+20
      IF ((FT.LT.-185.261).OR.(FT.GT.92.42)) RETURN
      F28PPL=-1.0E+10
      TAU=TCR/(DBLE(FT)+273.15D0)
      CALL S3PPL(TAU,OMEGAL,OMEGAG,PIS)
       IF (OMEGAG.LE.-1.0D+10) RETURN
      CALL S13PPL(TAU,OMEGAG,HG)
      HTDD=HG/AKGMOL
      F28PPL=REAL(HTDD)
      RETURN
      END
      REAL FUNCTION F29PPL(FT,FX)
      IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z)
      PARAMETER(TCR=365.57D+00,AKGMOL=4.20804D-02)
      F29PPL=-1.0E+20
      IF ((FT.LT.-185.261).OR.(FT.GT.92.42).OR.
     -    (FX.LT.0.0).OR.(FX.GT.1.0)) RETURN
      F29PPL=-1.0E+10
      TAU=TCR/(DBLE(FT)+273.15D0)
      X=DBLE(FX)
      CALL S3PPL(TAU,OMEGAL,OMEGAG,PIS)
       IF (OMEGAL.LE.-1.0D+10) RETURN
      CALL S13PPL(TAU,OMEGAL,HL)
      CALL S13PPL(TAU,OMEGAG,HG)
      HTX=(HL+X*(HG-HL))/AKGMOL
      F29PPL=REAL(HTX)
      RETURN
      END
      REAL FUNCTION F30PPL(FT)
      IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z)
      PARAMETER(TCR=365.57D+00,PCR=4.6646D+06)
      F30PPL=-1.0E+20
      IF ((FT.LT.-185.261).OR.(FT.GT.92.42)) RETURN
      F30PPL=-1.0E+10
      TAU=TCR/(DBLE(FT)+273.15D0)
      CALL S3PPL(TAU,OMEGAL,OMEGAG,PIS)
       IF (OMEGAL.LE.-1.0D+10) RETURN
      PST=PIS*PCR
      F30PPL=REAL(PST*1.0D-05)
      RETURN
      END
      REAL FUNCTION F33PPL(FP)
      IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z)
      PARAMETER(PCR=4.6646D+06,AKGMOL=4.20804D-02)
      F33PPL=-1.0E+20
      IF ((FP.LT.0.954E-08).OR.(FP.GT.4.6646E+01)) RETURN
      F33PPL=-1.0E+10
      PI=DBLE(FP)*1.0D+05/PCR
      CALL S4PPL(PI,OMEGAL,OMEGAG,TAUS)
       IF (OMEGAL.LE.-1.0D+10) RETURN
      CALL S11PPL(TAUS,OMEGAL,SL)
      SPD=SL/AKGMOL
      F33PPL=REAL(SPD)
      RETURN
      END
      REAL FUNCTION F34PPL(FP)
      IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z)
      PARAMETER(PCR=4.6646D+06,AKGMOL=4.20804D-02)
      F34PPL=-1.0E+20
      IF ((FP.LT.0.954E-08).OR.(FP.GT.4.6646E+01)) RETURN
      F34PPL=-1.0E+10
      PI=DBLE(FP)*1.0D+05/PCR
      CALL S4PPL(PI,OMEGAL,OMEGAG,TAUS)
       IF (OMEGAG.LE.-1.0D+10) RETURN
      CALL S11PPL(TAUS,OMEGAG,SG)
      SPDD=SG/AKGMOL
      F34PPL=REAL(SPDD)
      RETURN
      END
      REAL FUNCTION F35PPL(FP,FT)
      IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z)
      PARAMETER(PCR=4.6646D+06,TCR=365.57D+00,AKGMOL=4.20804D-02)
      F35PPL=-1.0E+20
      CALL S90PPL(FP,FT,ILL90)
       IF (ILL90.NE.0) RETURN
      F35PPL=-1.0E+10
      PI=DBLE(FP)*1.0D+05/PCR
      TAU=TCR/(DBLE(FT)+273.15D0)
      CALL S5PPL(PI,TAU,OMEGA)
       IF (OMEGA.LE.-1.0D+10) RETURN
      CALL S11PPL(TAU,OMEGA,S)
      SPT=S/AKGMOL
      F35PPL=REAL(SPT)
      RETURN
      END
      REAL FUNCTION F36PPL(FP,FX)
      IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z)
      PARAMETER(PCR=4.6646D+06,AKGMOL=4.20804D-02)
      F36PPL=-1.0E+20
      IF ((FP.LT.0.954E-08).OR.(FP.GT.4.6646E+01).OR.
     -    (FX.LT.0.0).OR.(FX.GT.1.0)) RETURN
      F36PPL=-1.0E+10
      PI=DBLE(FP)*1.0D+05/PCR
      X=DBLE(FX)
      CALL S4PPL(PI,OMEGAL,OMEGAG,TAUS)
       IF (OMEGAL.LE.-1.0D+10) RETURN
      CALL S11PPL(TAUS,OMEGAL,SL)
      CALL S11PPL(TAUS,OMEGAG,SG)
      SPX=(SL+X*(SG-SL))/AKGMOL
      F36PPL=REAL(SPX)
      RETURN
      END
      REAL FUNCTION F37PPL(FT)
      IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z)
      PARAMETER(TCR=365.57D+00,AKGMOL=4.20804D-02)
      F37PPL=-1.0E+20
      IF ((FT.LT.-185.261).OR.(FT.GT.92.42)) RETURN
      F37PPL=-1.0E+10
      TAU=TCR/(DBLE(FT)+273.15D0)
      CALL S3PPL(TAU,OMEGAL,OMEGAG,PIS)
       IF (OMEGAL.LE.-1.0D+10) RETURN
      CALL S11PPL(TAU,OMEGAL,SL)
      STD=SL/AKGMOL
      F37PPL=REAL(STD)
      RETURN
      END
      REAL FUNCTION F38PPL(FT)
      IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z)
      PARAMETER(TCR=365.57D+00,AKGMOL=4.20804D-02)
      F38PPL=-1.0E+20
      IF ((FT.LT.-185.261).OR.(FT.GT.92.42)) RETURN
      F38PPL=-1.0E+10
      TAU=TCR/(DBLE(FT)+273.15D0)
      CALL S3PPL(TAU,OMEGAL,OMEGAG,PIS)
       IF (OMEGAG.LE.-1.0D+10) RETURN
      CALL S11PPL(TAU,OMEGAG,SG)
      STDD=SG/AKGMOL
      F38PPL=REAL(STDD)
      RETURN
      END
      REAL FUNCTION F39PPL(FT,FX)
      IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z)
      PARAMETER(TCR=365.57D+00,AKGMOL=4.20804D-02)
      F39PPL=-1.0E+20
      IF ((FT.LT.-185.261).OR.(FT.GT.92.42).OR.
     -    (FX.LT.0.0).OR.(FX.GT.1.0)) RETURN
      F39PPL=-1.0E+10
      TAU=TCR/(DBLE(FT)+273.15D0)
      X=DBLE(FX)
      CALL S3PPL(TAU,OMEGAL,OMEGAG,PIS)
       IF (OMEGAL.LE.-1.0D+10) RETURN
      CALL S11PPL(TAU,OMEGAL,SL)
      CALL S11PPL(TAU,OMEGAG,SG)
      STX=(SL+X*(SG-SL))/AKGMOL
      F39PPL=REAL(STX)
      RETURN
      END
      REAL FUNCTION F40PPL(FP)
      IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z)
      PARAMETER(PCR=4.6646D+06,TCR=365.57D+00)
      F40PPL=-1.0E+20
      IF ((FP.LT.0.954E-08).OR.(FP.GT.4.6646E+01)) RETURN
      F40PPL=-1.0E+10
      PI=DBLE(FP)*1.0D+05/PCR
      CALL S4PPL(PI,OMEGAL,OMEGAG,TAUS)
       IF (OMEGAL.LE.-1.0D+10) RETURN
      TSP=TCR/TAUS
      F40PPL=REAL(TSP-273.15D0)
      RETURN
      END
      REAL FUNCTION F41PPL(A)
***** TRIPLE POINT FROM TABLE 6 & 7 ON PAGES 396 AND 397.          *****
      CHARACTER*1 A,B(1:2)
      DOUBLE PRECISION TRPL(1:2)
      DATA B(1)/'P'/,B(2)/'T'/
      TRPL(1)=0.95402D-08
      TRPL(2)=-185.26D+00
      DO 10 I=1,2
       F41PPL=REAL(TRPL(I))
        IF(A.EQ.B(I)) RETURN
   10 CONTINUE
      F41PPL=-1.0E+20
      RETURN
      END
      REAL FUNCTION F42PPL(FP)
      IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z)
      PARAMETER(PCR=4.6646D+06,AKGMOL=4.20804D-02)
      F42PPL=-1.0E+20
      IF ((FP.LT.0.954E-08).OR.(FP.GT.4.6646E+01)) RETURN
      F42PPL=-1.0E+10
      PI=DBLE(FP)*1.0D+05/PCR
      CALL S4PPL(PI,OMEGAL,OMEGAG,TAUS)
       IF (OMEGAL.LE.-1.0D+10) RETURN
      CALL S12PPL(TAUS,OMEGAL,UL)
      UPD=UL/AKGMOL
      F42PPL=REAL(UPD)
      RETURN
      END
      REAL FUNCTION F43PPL(FP)
      IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z)
      PARAMETER(PCR=4.6646D+06,AKGMOL=4.20804D-02)
      F43PPL=-1.0E+20
      IF ((FP.LT.0.954E-08).OR.(FP.GT.4.6646E+01)) RETURN
      F43PPL=-1.0E+10
      PI=DBLE(FP)*1.0D+05/PCR
      CALL S4PPL(PI,OMEGAL,OMEGAG,TAUS)
       IF (OMEGAG.LE.-1.0D+10) RETURN
      CALL S12PPL(TAUS,OMEGAG,UG)
      UPDD=UG/AKGMOL
      F43PPL=REAL(UPDD)
      RETURN
      END
      REAL FUNCTION F44PPL(FP,FT)
      IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z)
      PARAMETER(PCR=4.6646D+06,TCR=365.57D+00,AKGMOL=4.20804D-02)
      F44PPL=-1.0E+20
      CALL S90PPL(FP,FT,ILL90)
       IF (ILL90.NE.0) RETURN
      F44PPL=-1.0E+10
      PI=DBLE(FP)*1.0D+05/PCR
      TAU=TCR/(DBLE(FT)+273.15D0)
      CALL S5PPL(PI,TAU,OMEGA)
       IF (OMEGA.LE.-1.0D+10) RETURN
      CALL S12PPL(TAU,OMEGA,U)
      UPT=U/AKGMOL
      F44PPL=REAL(UPT)
      RETURN
      END
      REAL FUNCTION F45PPL(FP,FX)
      IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z)
      PARAMETER(PCR=4.6646D+06,AKGMOL=4.20804D-02)
      F45PPL=-1.0E+20
      IF ((FP.LT.0.954E-08).OR.(FP.GT.4.6646E+01).OR.
     -    (FX.LT.0.0).OR.(FX.GT.1.0)) RETURN
      F45PPL=-1.0E+10
      PI=DBLE(FP)*1.0D+05/PCR
      X=DBLE(FX)
      CALL S4PPL(PI,OMEGAL,OMEGAG,TAUS)
       IF (OMEGAL.LE.-1.0D+10) RETURN
      CALL S12PPL(TAUS,OMEGAL,UL)
      CALL S12PPL(TAUS,OMEGAG,UG)
      UPX=(UL+X*(UG-UL))/AKGMOL
      F45PPL=REAL(UPX)
      RETURN
      END
      REAL FUNCTION F46PPL(FT)
      IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z)
      PARAMETER(TCR=365.57D+00,AKGMOL=4.20804D-02)
      F46PPL=-1.0E+20
      IF ((FT.LT.-185.261).OR.(FT.GT.92.42)) RETURN
      F46PPL=-1.0E+10
      TAU=TCR/(DBLE(FT)+273.15D0)
      CALL S3PPL(TAU,OMEGAL,OMEGAG,PIS)
       IF (OMEGAL.LE.-1.0D+10) RETURN
      CALL S12PPL(TAU,OMEGAL,UL)
      UTD=UL/AKGMOL
      F46PPL=REAL(UTD)
      RETURN
      END
      REAL FUNCTION F47PPL(FT)
      IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z)
      PARAMETER(TCR=365.57D+00,AKGMOL=4.20804D-02)
      F47PPL=-1.0E+20
      IF ((FT.LT.-185.261).OR.(FT.GT.92.42)) RETURN
      F47PPL=-1.0E+10
      TAU=TCR/(DBLE(FT)+273.15D0)
      CALL S3PPL(TAU,OMEGAL,OMEGAG,PIS)
       IF (OMEGAG.LE.-1.0D+10) RETURN
      CALL S12PPL(TAU,OMEGAG,UG)
      UTDD=UG/AKGMOL
      F47PPL=REAL(UTDD)
      RETURN
      END
      REAL FUNCTION F48PPL(FT,FX)
      IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z)
      PARAMETER(TCR=365.57D+00,AKGMOL=4.20804D-02)
      F48PPL=-1.0E+20
      IF ((FT.LT.-185.261).OR.(FT.GT.92.42).OR.
     -    (FX.LT.0.0).OR.(FX.GT.1.0)) RETURN
      F48PPL=-1.0E+10
      TAU=TCR/(DBLE(FT)+273.15D0)
      X=DBLE(FX)
      CALL S3PPL(TAU,OMEGAL,OMEGAG,PIS)
       IF (OMEGAL.LE.-1.0D+10) RETURN
      CALL S12PPL(TAU,OMEGAL,UL)
      CALL S12PPL(TAU,OMEGAG,UG)
      UTX=(UL+X*(UG-UL))/AKGMOL
      F48PPL=REAL(UTX)
      RETURN
      END
      REAL FUNCTION F49PPL(FP)
      IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z)
      PARAMETER(PCR=4.6646D+06,ROHCR=5.3086D+03,AKGMOL=4.20804D-02)
      F49PPL=-1.0E+20
      IF ((FP.LT.0.954E-08).OR.(FP.GT.4.6646E+01)) RETURN
      F49PPL=-1.0E+10
      PI=DBLE(FP)*1.0D+05/PCR
      CALL S4PPL(PI,OMEGAL,OMEGAG,TAUS)
       IF (OMEGAL.LE.-1.0D+10) RETURN
      VPD=(1.0D0/(OMEGAL*ROHCR))/AKGMOL
      F49PPL=REAL(VPD)
      RETURN
      END
      REAL FUNCTION F50PPL(FP)
      IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z)
      PARAMETER(PCR=4.6646D+06,ROHCR=5.3086D+03,AKGMOL=4.20804D-02)
      F50PPL=-1.0E+20
      IF ((FP.LT.0.954E-08).OR.(FP.GT.4.6646E+01)) RETURN
      F50PPL=-1.0E+10
      PI=DBLE(FP)*1.0D+05/PCR
      CALL S4PPL(PI,OMEGAL,OMEGAG,TAUS)
       IF (OMEGAG.LE.-1.0D+10) RETURN
      VPDD=(1.0D0/(OMEGAG*ROHCR))/AKGMOL
      F50PPL=REAL(VPDD)
      RETURN
      END
      REAL FUNCTION F51PPL(FP,FT)
      IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z)
      PARAMETER(PCR=4.6646D+06,TCR=365.57D+00,ROHCR=5.3086D+03,
     -          AKGMOL=4.20804D-02)
      F51PPL=-1.0E+20
      CALL S90PPL(FP,FT,ILL90)
       IF (ILL90.NE.0) RETURN
      F51PPL=-1.0E+10
      PI=DBLE(FP)*1.0D+05/PCR
      TAU=TCR/(DBLE(FT)+273.15D0)
      CALL S5PPL(PI,TAU,OMEGA)
       IF (OMEGA.LE.-1.0D+10) RETURN
      VPT=(1.0D0/(OMEGA*ROHCR))/AKGMOL
      F51PPL=REAL(VPT)
      RETURN
      END
      REAL FUNCTION F52PPL(FP,FX)
      IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z)
      PARAMETER(PCR=4.6646D+06,ROHCR=5.3086D+03,AKGMOL=4.20804D-02)
      F52PPL=-1.0E+20
      IF ((FP.LT.0.954E-08).OR.(FP.GT.4.6646E+01).OR.
     -    (FX.LT.0.0).OR.(FX.GT.1.0)) RETURN
      F52PPL=-1.0E+10
      PI=DBLE(FP)*1.0D+05/PCR
      X=DBLE(FX)
      CALL S4PPL(PI,OMEGAL,OMEGAG,TAUS)
       IF (OMEGAL.LE.-1.0D+10) RETURN
      VL=1.0D0/(OMEGAL*ROHCR)
      VG=1.0D0/(OMEGAG*ROHCR)
      VPX=(VL+X*(VG-VL))/AKGMOL
      F52PPL=REAL(VPX)
      RETURN
      END
      REAL FUNCTION F53PPL(FT)
      IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z)
      PARAMETER(TCR=365.57D+00,ROHCR=5.3086D+03,AKGMOL=4.20804D-02)
      F53PPL=-1.0E+20
      IF ((FT.LT.-185.261).OR.(FT.GT.92.42)) RETURN
      F53PPL=-1.0E+10
      TAU=TCR/(DBLE(FT)+273.15D0)
      CALL S3PPL(TAU,OMEGAL,OMEGAG,PIS)
       IF (OMEGAL.LE.-1.0D+10) RETURN
      VTD=(1.0D0/(OMEGAL*ROHCR))/AKGMOL
      F53PPL=REAL(VTD)
      RETURN
      END
      REAL FUNCTION F54PPL(FT)
      IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z)
      PARAMETER(TCR=365.57D+00,ROHCR=5.3086D+03,AKGMOL=4.20804D-02)
      F54PPL=-1.0E+20
      IF ((FT.LT.-185.261).OR.(FT.GT.92.42)) RETURN
      F54PPL=-1.0E+10
      TAU=TCR/(DBLE(FT)+273.15D0)
      CALL S3PPL(TAU,OMEGAL,OMEGAG,PIS)
       IF (OMEGAG.LE.-1.0D+10) RETURN
      VTDD=(1.0D0/(OMEGAG*ROHCR))/AKGMOL
      F54PPL=REAL(VTDD)
      RETURN
      END
      REAL FUNCTION F55PPL(FT,FX)
      IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z)
      PARAMETER(TCR=365.57D+00,ROHCR=5.3086D+03,AKGMOL=4.20804D-02)
      F55PPL=-1.0E+20
      IF ((FT.LT.-185.261).OR.(FT.GT.92.42).OR.
     -    (FX.LT.0.0).OR.(FX.GT.1.0)) RETURN
      F55PPL=-1.0E+10
      TAU=TCR/(DBLE(FT)+273.15D0)
      X=DBLE(FX)
      CALL S3PPL(TAU,OMEGAL,OMEGAG,PIS)
       IF (OMEGAL.LE.-1.0D+10) RETURN
      VL=1.0D0/(OMEGAL*ROHCR)
      VG=1.0D0/(OMEGAG*ROHCR)
      VTX=(VL+X*(VG-VL))/AKGMOL
      F55PPL=REAL(VTX)
      RETURN
      END
      REAL FUNCTION F56PPL(FP,FH)
      IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z)
      PARAMETER(PCR=4.6646D+06,AKGMOL=4.20804D-02)
      F56PPL=-1.0E+20
      IF ((FP.LT.0.954E-08).OR.(FP.GT.4.6646E+01)) RETURN
      F56PPL=-1.0E+10
      PI=DBLE(FP)*1.0D+05/PCR
      H=DBLE(FH)
      CALL S4PPL(PI,OMEGAL,OMEGAG,TAUS)
       IF (OMEGAL.LE.-1.0D+10) RETURN
      CALL S13PPL(TAUS,OMEGAL,HL)
      CALL S13PPL(TAUS,OMEGAG,HG)
      HPD=HL/AKGMOL
      HPDD=HG/AKGMOL
      HMIN=HPD-ABS(HPD)*1.0D-05
      HMAX=HPDD+ABS(HPDD)*1.0D-05
      IF ((H.LT.HMIN).OR.(H.GT.HMAX)) THEN
       XPH=-1.0D+20
      ELSE
       XPH=(H-HPD)/(HPDD-HPD)
       IF (XPH.LT.0.0D0) XPH=0.0D0
       IF (XPH.GT.1.0D0) XPH=1.0D0
      END IF
      F56PPL=REAL(XPH)
      RETURN
      END
      REAL FUNCTION F57PPL(FP,FS)
      IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z)
      PARAMETER(PCR=4.6646D+06,AKGMOL=4.20804D-02)
      F57PPL=-1.0E+20
      IF ((FP.LT.0.954E-08).OR.(FP.GT.4.6646E+01)) RETURN
      F57PPL=-1.0E+10
      PI=DBLE(FP)*1.0D+05/PCR
      S=DBLE(FS)
      CALL S4PPL(PI,OMEGAL,OMEGAG,TAUS)
       IF (OMEGAL.LE.-1.0D+10) RETURN
      CALL S11PPL(TAUS,OMEGAL,SL)
      CALL S11PPL(TAUS,OMEGAG,SG)
      SPD=SL/AKGMOL
      SPDD=SG/AKGMOL
      SMIN=SPD-ABS(SPD)*1.0D-05
      SMAX=SPDD+ABS(SPDD)*1.0D-05
      IF ((S.LT.SMIN).OR.(S.GT.SMAX)) THEN
       XPS=-1.0D+20
      ELSE
       XPS=(S-SPD)/(SPDD-SPD)
       IF (XPS.LT.0.0D0) XPS=0.0D0
       IF (XPS.GT.1.0D0) XPS=1.0D0
      END IF
      F57PPL=REAL(XPS)
      RETURN
      END
      REAL FUNCTION F58PPL(FP,FU)
      IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z)
      PARAMETER(PCR=4.6646D+06,AKGMOL=4.20804D-02)
      F58PPL=-1.0E+20
      IF ((FP.LT.0.954E-08).OR.(FP.GT.4.6646E+01)) RETURN
      F58PPL=-1.0E+10
      PI=DBLE(FP)*1.0D+05/PCR
      U=DBLE(FU)
      CALL S4PPL(PI,OMEGAL,OMEGAG,TAUS)
       IF (OMEGAL.LE.-1.0D+10) RETURN
      CALL S12PPL(TAUS,OMEGAL,UL)
      CALL S12PPL(TAUS,OMEGAG,UG)
      UPD=UL/AKGMOL
      UPDD=UG/AKGMOL
      UMIN=UPD-ABS(UPD)*1.0D-05
      UMAX=UPDD+ABS(UPDD)*1.0D-05
      IF ((U.LT.UMIN).OR.(U.GT.UMAX)) THEN
       XPU=-1.0D+20
      ELSE
       XPU=(U-UPD)/(UPDD-UPD)
       IF (XPU.LT.0.0D0) XPU=0.0D0
       IF (XPU.GT.1.0D0) XPU=1.0D0
      END IF
      F58PPL=REAL(XPU)
      RETURN
      END
      REAL FUNCTION F59PPL(FP,FV)
      IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z)
      PARAMETER(PCR=4.6646D+06,ROHCR=5.3086D+03,AKGMOL=4.20804D-02)
      F59PPL=-1.0E+20
      IF ((FP.LT.0.954E-08).OR.(FP.GT.4.6646E+01)) RETURN
      F59PPL=-1.0E+10
      PI=DBLE(FP)*1.0D+05/PCR
      V=DBLE(FV)
      CALL S4PPL(PI,OMEGAL,OMEGAG,TAUS)
       IF (OMEGAL.LE.-1.0D+10) RETURN
      VPD=(1.0D0/(OMEGAL*ROHCR))/AKGMOL
      VPDD=(1.0D0/(OMEGAG*ROHCR))/AKGMOL
      VMIN=VPD*0.99999D0
      VMAX=VPDD*1.00001D0
      IF ((V.LT.VMIN).OR.(V.GT.VMAX)) THEN
       XPV=-1.0D+20
      ELSE
       XPV=(V-VPD)/(VPDD-VPD)
       IF (XPV.LT.0.0D0) XPV=0.0D0
       IF (XPV.GT.1.0D0) XPV=1.0D0
      END IF
      F59PPL=REAL(XPV)
      RETURN
      END
      REAL FUNCTION F60PPL(FT,FH)
      IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z)
      PARAMETER(TCR=365.57D+00,AKGMOL=4.20804D-02)
      F60PPL=-1.0E+20
      IF ((FT.LT.-185.261).OR.(FT.GT.92.42)) RETURN
      F60PPL=-1.0E+10
      TAU=TCR/(DBLE(FT)+273.15D0)
      H=DBLE(FH)
      CALL S3PPL(TAU,OMEGAL,OMEGAG,PIS)
       IF (OMEGAL.LE.-1.0D+10) RETURN
      CALL S13PPL(TAU,OMEGAL,HL)
      CALL S13PPL(TAU,OMEGAG,HG)
      HTD=HL/AKGMOL
      HTDD=HG/AKGMOL
      HMIN=HTD-ABS(HTD)*1.0D-05
      HMAX=HTDD+ABS(HTDD)*1.0D-05
      IF ((H.LT.HMIN).OR.(H.GT.HMAX)) THEN
       XTH=-1.0D+20
      ELSE
       XTH=(H-HTD)/(HTDD-HTD)
       IF (XTH.LT.0.0D0) XTH=0.0D0
       IF (XTH.GT.1.0D0) XTH=1.0D0
      END IF
      F60PPL=REAL(XTH)
      RETURN
      END
      REAL FUNCTION F61PPL(FT,FS)
      IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z)
      PARAMETER(TCR=365.57D+00,AKGMOL=4.20804D-02)
      F61PPL=-1.0E+20
      IF ((FT.LT.-185.261).OR.(FT.GT.92.42)) RETURN
      F61PPL=-1.0E+10
      TAU=TCR/(DBLE(FT)+273.15D0)
      S=DBLE(FS)
      CALL S3PPL(TAU,OMEGAL,OMEGAG,PIS)
       IF (OMEGAL.LE.-1.0D+10) RETURN
      CALL S11PPL(TAU,OMEGAL,SL)
      CALL S11PPL(TAU,OMEGAG,SG)
      STD=SL/AKGMOL
      STDD=SG/AKGMOL
      SMIN=STD-ABS(STD)*1.0D-05
      SMAX=STDD+ABS(STDD)*1.0D-05
      IF ((S.LT.SMIN).OR.(S.GT.SMAX)) THEN
       XTS=-1.0D+20
      ELSE
       XTS=(S-STD)/(STDD-STD)
       IF (XTS.LT.0.0D0) XTS=0.0D0
       IF (XTS.GT.1.0D0) XTS=1.0D0
      END IF
      F61PPL=REAL(XTS)
      RETURN
      END
      REAL FUNCTION F62PPL(FT,FU)
      IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z)
      PARAMETER(TCR=365.57D+00,AKGMOL=4.20804D-02)
      F62PPL=-1.0E+20
      IF ((FT.LT.-185.261).OR.(FT.GT.92.42)) RETURN
      F62PPL=-1.0E+10
      TAU=TCR/(DBLE(FT)+273.15D0)
      U=DBLE(FU)
      CALL S3PPL(TAU,OMEGAL,OMEGAG,PIS)
       IF (OMEGAL.LE.-1.0D+10) RETURN
      CALL S12PPL(TAU,OMEGAL,UL)
      CALL S12PPL(TAU,OMEGAG,UG)
      UTD=UL/AKGMOL
      UTDD=UG/AKGMOL
      UMIN=UTD-ABS(UTD)*1.0D-05
      UMAX=UTDD+ABS(UTDD)*1.0D-05
      IF ((U.LT.UMIN).OR.(U.GT.UMAX)) THEN
       XTU=-1.0D+20
      ELSE
       XTU=(U-UTD)/(UTDD-UTD)
       IF (XTU.LT.0.0D0) XTU=0.0D0
       IF (XTU.GT.1.0D0) XTU=1.0D0
      END IF
      F62PPL=REAL(XTU)
      RETURN
      END
      REAL FUNCTION F63PPL(FT,FV)
      IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z)
      PARAMETER(TCR=365.57D+00,ROHCR=5.3086D+03,AKGMOL=4.20804D-02)
      F63PPL=-1.0E+20
      IF ((FT.LT.-185.261).OR.(FT.GT.92.42)) RETURN
      F63PPL=-1.0E+10
      TAU=TCR/(DBLE(FT)+273.15D0)
      V=DBLE(FV)
      CALL S3PPL(TAU,OMEGAL,OMEGAG,PIS)
       IF (OMEGAL.LE.-1.0D+10) RETURN
      VTD=(1.0D0/(OMEGAL*ROHCR))/AKGMOL
      VTDD=(1.0D0/(OMEGAG*ROHCR))/AKGMOL
      VMIN=VTD*0.99999D0
      VMAX=VTDD*1.00001D0
      IF ((V.LT.VMIN).OR.(V.GT.VMAX)) THEN
       XTV=-1.0D+20
      ELSE
       XTV=(V-VTD)/(VTDD-VTD)
       IF (XTV.LT.0.0D0) XTV=0.0D0
       IF (XTV.GT.1.0D0) XTV=1.0D0
      END IF
      F63PPL=REAL(XTV)
      RETURN
      END
      REAL FUNCTION F64PPL(FP,FH)
      IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z)
      PARAMETER(PCR=4.6646D+06,TCR=365.57D+00,AKGMOL=4.20804D-02)
      F64PPL=-1.0E+20
      IF ((FP.GE.36.9584E+01).AND.(FP.LE.1000.01E+01))THEN
       FTMIN=F69PPL(FP)
       FHMIN=F25PPL(FP,FTMIN)
       FHMAX=F25PPL(FP,201.85)
      ELSE IF ((FP.GT.10.0E+01).AND.(FP.LT.36.9584E+01)) THEN
       FHMIN=F25PPL(FP,-183.15)
       FHMAX=F25PPL(FP,201.85)
      ELSE IF ((FP.GT.0.954E-08).AND.(FP.LE.10.0E+01)) THEN
       FHMIN=F25PPL(FP,-183.15)
       FHMAX=F25PPL(FP,301.85)
      ELSE
       RETURN
      END IF
      IF ((FHMIN.LE.-1.0E+10).OR.(FHMAX.LE.-1.0E+10)) RETURN
      FHMIN=FHMIN-ABS(FHMIN)*1.0E-03
      FHMAX=FHMAX+ABS(FHMAX)*1.0E-03
      IF ((FH.LT.FHMIN).OR.(FH.GT.FHMAX)) RETURN
      F64PPL=-1.0E+10
      PI=DBLE(FP)*1.0D+05/PCR
      H=DBLE(FH)*AKGMOL
      CALL S13PPL(1.0D0,1.0D0,HCR)
      IF ((ABS(PI-1.0D0).LT.1.0D-05).AND.(ABS(H/HCR-1.0D0).LT.1.0D-05))
     -   THEN
       F64PPL=REAL(TCR-273.15D0)
       RETURN
      END IF
      IF (PI.GE.1.0D0) THEN
       TAU0=1.0D0
       CALL S5PPL(PI,TAU0,OMEGA0)
        IF (OMEGA0.LE.-1.0D+10) RETURN
       CALL S13PPL(TAU0,OMEGA0,H0)
       CALL S15PPL(TAU0,OMEGA0,CP0)
      ELSE
       CALL S4PPL(PI,OMEGAL,OMEGAG,TAUS)
        IF (OMEGAL.LE.-1.0D+10) RETURN
       CALL S13PPL(TAUS,OMEGAL,HL)
       CALL S13PPL(TAUS,OMEGAG,HG)
       IF ((H.GE.HL).AND.(H.LE.HG)) THEN
        F64PPL=REAL(TCR/TAUS-273.15D0)
        RETURN
       END IF
       IF (H.GT.HG) THEN
        CALL S15PPL(TAUS,OMEGAG,CPG)
        TAU0=TAUS
        H0=HG
        CP0=CPG
       ELSE IF (H.LT.HL) THEN
        CALL S15PPL(TAUS,OMEGAL,CPL)
        TAU0=TAUS
        H0=HL
        CP0=CPL
       END IF
      END IF
      TAU1=1.0D0/(1.0D0/TAU0+(H-H0)/(CP0*TCR))
      CALL S5PPL(PI,TAU1,OMEGA1)
       IF (OMEGA1.LE.-1.0D+10) RETURN
      CALL S13PPL(TAU1,OMEGA1,H1)
      TH0=1.0D0/TAU0
      TH1=1.0D0/TAU1
      CALL S40PPL(1,PI,H,TH0,TH1,H0,H1,THW)
       IF (THW.LE.-1.0D+10) RETURN
      TAUW=1.0D0/THW
      TPH=TCR/TAUW
      F64PPL=REAL(TPH-273.15D0)
      RETURN
      END
      REAL FUNCTION F65PPL(FP,FS)
      IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z)
      PARAMETER(PCR=4.6646D+06,TCR=365.57D+00,AKGMOL=4.20804D-02)
      F65PPL=-1.0E+20
      IF ((FP.GE.36.9584E+01).AND.(FP.LE.1000.01E+01))THEN
       FTMIN=F69PPL(FP)
       FSMIN=F35PPL(FP,FTMIN)
       FSMAX=F35PPL(FP,201.85)
      ELSE IF ((FP.GT.10.0E+01).AND.(FP.LT.36.9584E+01)) THEN
       FSMIN=F35PPL(FP,-183.15)
       FSMAX=F35PPL(FP,201.85)
      ELSE IF ((FP.GT.0.954E-08).AND.(FP.LE.10.0E+01)) THEN
       FSMIN=F35PPL(FP,-183.15)
       FSMAX=F35PPL(FP,301.85)
      ELSE
       RETURN
      END IF
      IF ((FSMIN.LE.-1.0E+10).OR.(FSMAX.LE.-1.0E+10)) RETURN
      FSMIN=FSMIN-ABS(FSMIN)*1.0E-03
      FSMAX=FSMAX+ABS(FSMAX)*1.0E-03
      IF ((FS.LT.FSMIN).OR.(FS.GT.FSMAX)) RETURN
      F65PPL=-1.0E+10
      PI=DBLE(FP)*1.0D+05/PCR
      S=DBLE(FS)*AKGMOL
      CALL S11PPL(1.0D0,1.0D0,SCR)
      IF ((ABS(PI-1.0D0).LT.1.0D-05).AND.(ABS(S/SCR-1.0D0).LT.1.0D-05))
     -   THEN
       F65PPL=REAL(TCR-273.15D0)
       RETURN
      END IF
      IF (PI.GE.1.0D0) THEN
       TAU0=1.0D0
       CALL S5PPL(PI,TAU0,OMEGA0)
        IF (OMEGA0.LE.-1.0D+10) RETURN
       CALL S11PPL(TAU0,OMEGA0,S0)
       CALL S15PPL(TAU0,OMEGA0,CP0)
      ELSE
       CALL S4PPL(PI,OMEGAL,OMEGAG,TAUS)
        IF (OMEGAL.LE.-1.0D+10) RETURN
       CALL S11PPL(TAUS,OMEGAL,SL)
       CALL S11PPL(TAUS,OMEGAG,SG)
       IF ((S.GE.SL).AND.(S.LE.SG)) THEN
        F65PPL=REAL(TCR/TAUS-273.15D0)
        RETURN
       END IF
       IF (S.GT.SG) THEN
        CALL S15PPL(TAUS,OMEGAG,CPG)
        TAU0=TAUS
        S0=SG
        CP0=CPG
       ELSE IF (S.LT.SL) THEN
        CALL S15PPL(TAUS,OMEGAL,CPL)
        TAU0=TAUS
        S0=SL
        CP0=CPL
       END IF
      END IF
      TAU1=TAU0/EXP((S-S0)/CP0)
      CALL S5PPL(PI,TAU1,OMEGA1)
       IF (OMEGA1.LE.-1.0D+10) RETURN
      CALL S11PPL(TAU1,OMEGA1,S1)
      TH0=1.0D0/TAU0
      TH1=1.0D0/TAU1
      CALL S40PPL(2,PI,S,TH0,TH1,S0,S1,THW)
       IF (THW.LE.-1.0D+10) RETURN
      TAUW=1.0D0/THW
      TPS=TCR/TAUW
      F65PPL=REAL(TPS-273.15D0)
      RETURN
      END
      REAL FUNCTION F68PPL(FT)
      IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z)
      F68PPL=-1.0E+20
      IF ((FT.LT.-185.261).OR.(FT.GT.-128.14)) RETURN
      T=DBLE(FT)+273.15D0
      CALL S1PPL(T,PMELT)
      PMLT=PMELT*1.0D-05
      F68PPL=REAL(PMLT)
      RETURN
      END
      REAL FUNCTION F69PPL(FP)
      IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z)
      F69PPL=-1.0E+20
      IF ((FP.LT.0.954E-08).OR.(FP.GT.1000.01E+01)) RETURN
      F69PPL=-1.0E+10
      P=DBLE(FP)*1.0D+05
      CALL S2PPL(P,TMELT)
       IF (TMELT.LE.-1.0D+10) RETURN
      TMLP=TMELT
      F69PPL=REAL(TMLP-273.15D0)
      RETURN
      END
      REAL FUNCTION F70PPL(FP,FV)
      IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z)
      PARAMETER(PCR=4.6646D+06,ROHCR=5.3086D+03,TCR=365.57D+00,
     -          AKGMOL=4.20804D-02)
      DATA FMIN/0.9998/,FMAX/1.002/
      F70PPL=-1.0E+20
      IF ((FP.GE.36.9584E+01).AND.(FP.LE.1000.01E+01))THEN
       FTMIN=F69PPL(FP)
       FVMIN=F51PPL(FP,FTMIN)
       FVMAX=F51PPL(FP,201.85)
      ELSE IF ((FP.GT.10.0E+01).AND.(FP.LT.36.9584E+01)) THEN
       FVMIN=F51PPL(FP,-183.15)
       FVMAX=F51PPL(FP,201.85)
      ELSE IF ((FP.GT.0.954E-08).AND.(FP.LE.10.0E+01)) THEN
       FVMIN=F51PPL(FP,-183.15)
       FVMAX=F51PPL(FP,301.85)
      ELSE
       RETURN
      END IF
      IF ((FVMIN.LE.-1.0E+10).OR.(FVMAX.LE.-1.0E+10)) RETURN
      IF ((FV.LT.FVMIN*FMIN).OR.(FV.GT.FVMAX*FMAX)) RETURN
      F70PPL=-1.0E+10
      PI=DBLE(FP)*1.0D+05/PCR
      OMEGA=1.0D0/(DBLE(FV)*AKGMOL*ROHCR)
      IF (PI.GE.1.0D0) THEN
       CALL S6PPL(PI,OMEGA,TAU)
        IF (TAU.LE.-1.0D+10) RETURN
       TAUW=TAU
      ELSE
       CALL S4PPL(PI,OMEGAL,OMEGAG,TAUS)
        IF (OMEGAL.LE.-1.0D+10) RETURN
       IF ((OMEGA.GE.OMEGAG).AND.(OMEGA.LE.OMEGAL)) THEN
        TAUW=TAUS
       ELSE
        CALL S6PPL(PI,OMEGA,TAU)
         IF (TAU.LE.-1.0D+10) RETURN
        TAUW=TAU
       END IF
      END IF
      TPV=TCR/TAUW
      F70PPL=REAL(TPV-273.15D0)
      RETURN
      END
      REAL FUNCTION F71PPL(FP,FS)
      IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z)
      PARAMETER(PCR=4.6646D+06,TCR=365.57D+00,AKGMOL=4.20804D-02)
      F71PPL=-1.0E+20
      IF ((FP.GE.36.9584E+01).AND.(FP.LE.1000.01E+01))THEN
       FTMIN=F69PPL(FP)
       FSMIN=F35PPL(FP,FTMIN)
       FSMAX=F35PPL(FP,201.85)
      ELSE IF ((FP.GT.10.0E+01).AND.(FP.LT.36.9584E+01)) THEN
       FSMIN=F35PPL(FP,-183.15)
       FSMAX=F35PPL(FP,201.85)
      ELSE IF ((FP.GT.0.954E-08).AND.(FP.LE.10.0E+01)) THEN
       FSMIN=F35PPL(FP,-183.15)
       FSMAX=F35PPL(FP,301.85)
      ELSE
       RETURN
      END IF
      IF ((FSMIN.LE.-1.0E+10).OR.(FSMAX.LE.-1.0E+10)) RETURN
      FSMIN=FSMIN-ABS(FSMIN)*1.0E-03
      FSMAX=FSMAX+ABS(FSMAX)*1.0E-03
      IF ((FS.LT.FSMIN).OR.(FS.GT.FSMAX)) RETURN
      F71PPL=-1.0E+10
      PI=DBLE(FP)*1.0D+05/PCR
      S=DBLE(FS)*AKGMOL
      CALL S11PPL(1.0D0,1.0D0,SCR)
      IF ((ABS(PI-1.0D0).LT.1.0D-05).AND.(ABS(S/SCR-1.0D0).LT.1.0D-05))
     -   THEN
       CALL S13PPL(1.0D0,1.0D0,HCR)
       F71PPL=REAL(HCR/AKGMOL)
       RETURN
      END IF
      IF (PI.GE.1.0D0) THEN
       TAU0=1.0D0
       CALL S5PPL(PI,TAU0,OMEGA0)
        IF (OMEGA0.LE.-1.0D+10) RETURN
       CALL S11PPL(TAU0,OMEGA0,S0)
       CALL S15PPL(TAU0,OMEGA0,CP0)
      ELSE
       CALL S4PPL(PI,OMEGAL,OMEGAG,TAUS)
        IF (OMEGAL.LE.-1.0D+10) RETURN
       CALL S11PPL(TAUS,OMEGAL,SL)
       CALL S11PPL(TAUS,OMEGAG,SG)
       IF ((S.GE.SL).AND.(S.LE.SG)) THEN
        XPS=(S-SL)/(SG-SL)
        CALL S13PPL(TAUS,OMEGAL,HL)
        CALL S13PPL(TAUS,OMEGAG,HG)
        HPS=(HL+XPS*(HG-HL))/AKGMOL
        F71PPL=REAL(HPS)
        RETURN
       END IF
       IF (S.GT.SG) THEN
        CALL S15PPL(TAUS,OMEGAG,CPG)
        TAU0=TAUS
        S0=SG
        CP0=CPG
       ELSE IF (S.LT.SL) THEN
        CALL S15PPL(TAUS,OMEGAL,CPL)
        TAU0=TAUS
        S0=SL
        CP0=CPL
       END IF
      END IF
      TAU1=TAU0/EXP((S-S0)/CP0)
      CALL S5PPL(PI,TAU1,OMEGA1)
       IF (OMEGA1.LE.-1.0D+10) RETURN
      CALL S11PPL(TAU1,OMEGA1,S1)
      TH0=1.0D0/TAU0
      TH1=1.0D0/TAU1
      CALL S40PPL(2,PI,S,TH0,TH1,S0,S1,THW)
       IF (THW.LE.-1.0D+10) RETURN
      TAUW=1.0D0/THW
      CALL S5PPL(PI,TAUW,OMEGAW)
       IF (OMEGAW.LE.-1.0D+10) RETURN
      CALL S13PPL(TAUW,OMEGAW,HW)
      HPS=HW/AKGMOL
      F71PPL=REAL(HPS)
      RETURN
      END
      REAL FUNCTION F76PPL(FP)
      IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z)
      PARAMETER(PCR=4.6646D+06,AKGMOL=4.20804D-02)
      F76PPL=-1.0E+20
      IF ((FP.LT.0.954E-08).OR.(FP.GT.4.6646E+01)) RETURN
      F76PPL=-1.0E+10
      PI=DBLE(FP)*1.0D+05/PCR
      CALL S4PPL(PI,OMEGAL,OMEGAG,TAUS)
       IF (OMEGAG.LE.-1.0D+10) RETURN
      CALL S14PPL(TAUS,OMEGAG,CVG)
      CVPDD=CVG/AKGMOL
      F76PPL=REAL(CVPDD)
      RETURN
      END
      REAL FUNCTION F77PPL(FP,FT)
      IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z)
      PARAMETER(PCR=4.6646D+06,TCR=365.57D+00,AKGMOL=4.20804D-02)
      F77PPL=-1.0E+20
      CALL S91PPL(FP,FT,ILL91)
       IF (ILL91.NE.0) RETURN
      F77PPL=-1.0E+10
      PI=DBLE(FP)*1.0D+05/PCR
      TAU=TCR/(DBLE(FT)+273.15D0)
      CALL S5PPL(PI,TAU,OMEGA)
       IF (OMEGA.LE.-1.0D+10) RETURN
      CALL S14PPL(TAU,OMEGA,CV)
      CVPT=CV/AKGMOL
      F77PPL=REAL(CVPT)
      RETURN
      END
      REAL FUNCTION F78PPL(FT)
      IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z)
      PARAMETER(TCR=365.57D+00,AKGMOL=4.20804D-02)
      F78PPL=-1.0E+20
      IF ((FT.LT.-185.261).OR.(FT.GT.92.42)) RETURN
      F78PPL=-1.0E+10
      TAU=TCR/(DBLE(FT)+273.15D0)
      CALL S3PPL(TAU,OMEGAL,OMEGAG,PIS)
       IF (OMEGAG.LE.-1.0D+10) RETURN
      CALL S14PPL(TAU,OMEGAG,CVG)
      CVTDD=CVG/AKGMOL
      F78PPL=REAL(CVTDD)
      RETURN
      END
      REAL FUNCTION F79PPL(FP,S)
      XT=F65PPL(FP,S)
      IF (XT.LT.-1.E+8) GO TO 90
      T=XT
      XT=F44PPL(FP,T)
      IF (XT.LT.-1.E+8) GO TO 90
      U=XT
      F79PPL=U
      RETURN
   90 F79PPL=XT
      RETURN
      END
      REAL FUNCTION F80PPL(FP,S)
      XT=F65PPL(FP,S)
      IF (XT.LT.-1.E+8) GO TO 90
      T=XT
      XT=F51PPL(FP,T)
      IF (XT.LT.-1.E+8) GO TO 90
      V=XT
      F80PPL=V
      RETURN
   90 F80PPL=XT
      RETURN
      END
      REAL FUNCTION F82PPL(FP,FT)
      IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z)
      PARAMETER(PCR=4.6646D+06,TCR=365.57D+00,ROHCR=5.3086D+03,
     -          GASCON=8.31434D+00)
      F82PPL=-1.0E+20
      CALL S91PPL(FP,FT,ILL91)
       IF (ILL91.NE.0) RETURN
      F82PPL=-1.0E+10
      PI=DBLE(FP)*1.0D+05/PCR
      TAU=TCR/(DBLE(FT)+273.15D0)
      CALL S5PPL(PI,TAU,OMEGA)
       IF (OMEGA.LE.-1.0D+10) RETURN
      CALL S15PPL(TAU,OMEGA,CP)
      CALL S14PPL(TAU,OMEGA,CV)
      CALL S21PPL(TAU,OMEGA,SNXR)
      AKPT=(GASCON*ROHCR*TCR/PCR)*(OMEGA/(PI*TAU))*(CP/CV)
     -     *(1.0D0+SNXR)
      F82PPL=REAL(AKPT)
      RETURN
      END
      REAL FUNCTION F83PPL(FP,FT)
      IMPLICIT DOUBLE PRECISION(A-E,G-H,O-Z)
      PARAMETER(PCR=4.6646D+06,TCR=365.57D+00,GASCON=8.31434D+00,
     -          AKGMOL=4.20804D-02)
      F83PPL=-1.0E+20
      CALL S91PPL(FP,FT,ILL91)
       IF (ILL91.NE.0) RETURN
      F83PPL=-1.0E+10
      PI=DBLE(FP)*1.0D+05/PCR
      TAU=TCR/(DBLE(FT)+273.15D0)
      CALL S5PPL(PI,TAU,OMEGA)
       IF (OMEGA.LE.-1.0D+10) RETURN
      CALL S15PPL(TAU,OMEGA,CP)
      CALL S14PPL(TAU,OMEGA,CV)
      CALL S21PPL(TAU,OMEGA,SNXR)
      WPT=SQRT((GASCON*TCR/(AKGMOL*TAU))*(CP/CV)*(1.0D0+SNXR))
      F83PPL=REAL(WPT)
      RETURN
      END
C F98 + PSEUDO BOILING POINT AT P<BAR>
      FUNCTION F98PPL(P)
      DIMENSION T(2),C(2),TL(3),TR(3),CL(3),CR(3)
      P1=F21PPL('P')
      PP=ABS((P-P1)/P1)
      T1=F21PPL('T')
      IF (PP.LT.1.0E-5) THEN
         F98PPL=T1
         RETURN
      ENDIF
      IF (P.LT.P1.OR.P.GT.190.001D00) THEN
         F98PPL=-1.0E+20
         RETURN
      ENDIF
      T2=0.85*T1
      P2=F30PPL(T2)
      TM0=T1+(T1-T2)*(P-P1)/(P1-P2)
C-----TM0 KINJICHI      
      TC=T1
      T(1)=TM0
  150 EPS=1.0E-6
      DEL=T1*0.05D00
      IREP=0
      IREM=5000
      KCONT=0
      ICONT=0
      C(1)=F18PPL(P,T(1))
      T(2)=T(1)-DEL
      C(2)=F18PPL(P,T(2))
 1000 RINC=C(2)-C(1)
      IF(RINC.GT.0.3)THEN
      GOTO 1500
      ELSE
      T(2)=T(1)
      C(2)=C(1)
      T(1)=T(1)-DEL
      C(1)=F18PPL(P,T(1))
      GOTO 1000
      ENDIF
 1500 C(1)=-C(1)
      C(2)=-C(2)
 2000 IREP=IREP+1
      IF(IREP.GT.IREM) GO TO 8000
      TT=T(2)+1.3*(T(2)-T(1))
      CC=-F18PPL(P,TT)
 3000 CONV=ABS((CC-C(2))/CC)
      IF(CONV.LT.EPS) THEN
      F98PPL=TT
      RETURN
      ENDIF
 4000 DEC=C(1)-CC
      ICONT=ICONT+1
      IF(DEC.GE.0.0) THEN
      T(1)=TT
      C(1)=CC
      ELSE
      IF (ICONT.GT.5) GO TO 6000
      TT=(TT+T(2))*0.5
      CC=-F18PPL(P,TT)
      GOTO 4000
      ENDIF
 5000 DEC=C(1)-C(2)
      IF(DEC.LT.0.0) THEN
      TT=T(1)
      CC=C(1)
      T(1)=T(2)
      C(1)=C(2)
      T(2)=TT
      C(2)=CC
      ENDIF
      GOTO 2000
 6000 TA=T(1)
      TB=TT
      IF (TB.LT.TA) THEN
      TA=TT
      TB=T(1)
      ENDIF
      TC=TA+0.5*(TB-TA)
      CA=F18PPL(P,TA)
      CB=F18PPL(P,TB)
 6050 KCONT=KCONT+1
      IF (KCONT.GT.IREM) GO TO 8000
      DELT=ABS((TA-TB)/TA)
      IF (DELT.LT.EPS) GO TO 7000
      CC=F18PPL(P,TC)
      DTA=(TC-TA)*0.3
      TL(1)=TA
      TL(2)=TC-DTA
      TL(3)=TC
      DTB=(TB-TC)*0.3
      TR(1)=TC
      TR(2)=TC+DTB
      TR(3)=TB
      CL(1)=CA
      CL(3)=CC
      CR(1)=CC
      CR(3)=CB
      CL(2)=F18PPL(P,TL(2))
      CR(2)=F18PPL(P,TR(2))
      CMXL=CL(1)
      ML=1
      DO 6120 I=2,3
      IF(CL(I).GT.CMXL) THEN
      CMXL=CL(I)
      ML=I
      ENDIF
 6120 CONTINUE
      CMXR=CR(1)
      MR=1
      DO 6130 I=2,3
      IF(CR(I).GT.CMXR) THEN
      CMXR=CR(I)
      MR=I
      ENDIF
 6130 CONTINUE
      IF(CMXL.GT.CMXR) THEN
         IF(ML.EQ.1) THEN
            TA=TL(1)-DTA
            CA=F18PPL(P,TA)
            ELSE
            TA=TL(ML-1)
            CA=CL(ML-1)
         ENDIF
         IF(ML.EQ.3) THEN
            TB=TR(2)
            CB=CR(2)
            ELSE
            TB=TL(ML+1)
            CB=CL(ML+1)
         ENDIF
      TC=TL(ML)
      CC=CL(ML)
      ELSE
         IF(MR.EQ.1) THEN
            TA=TL(2)
            CA=CL(2)
            ELSE
            TA=TR(MR-1)
            CA=CR(MR-1)
         ENDIF
         IF(MR.EQ.3) THEN
            TB=TR(3)+DTB
            CB=F18PPL(P,TB)
            ELSE
            TB=TR(MR+1)
            CB=CR(MR+1)
         ENDIF
 6135 TC=TR(MR)
      CC=CR(MR)
      ENDIF
      GO TO 6050
 7000 F98PPL=TC
      RETURN
 8000 F98PPL=-1.0E+10
      RETURN
      END
      REAL FUNCTION G98PPL(KPA,P)
      INTEGER KPA
      REAL P,PBAR
      IF (KPA.EQ.1) THEN
        PBAR=1.0E+00
      ELSE IF (KPA.EQ.2) THEN
        PBAR=1.0E+00
      ELSE IF (KPA.EQ.3) THEN
        PBAR=1.0E-05
      ELSE
        PBAR=1.0E-05
      END IF
      G98PPL=P*PBAR
      RETURN
      END
      REAL FUNCTION G99PPL(KPA,T)
      INTEGER KPA
      REAL T,T0K
      IF (KPA.EQ.1) THEN
        T0K=0.0E+00
      ELSE IF (KPA.EQ.2) THEN
        T0K=273.15E+00
      ELSE IF (KPA.EQ.3) THEN
        T0K=0.0E+00
      ELSE
        T0K=273.15E+00
      END IF
      G99PPL=T-T0K
      RETURN
      END
      SUBROUTINE S1PPL(T,PMELT)
***** SUBROUTINE TO CALCULATE THE MELTING PRESSURE CORRESPONDING   *****
***** TO THE INPUT TEMPERATURE. (ON PAGE 46)                       *****
****  INPUT  : T=TEMPERATURE IN (K)
****  OUTPUT : PMELT=MELTING PRESSURE IN (PA)
      IMPLICIT DOUBLE PRECISION(A-H,O-Z)
      PARAMETER(TT1=87.890D+00, TT2=129.84D+00,
     -          PT1=0.95D-03,   PT2=715.0D+06)
      DATA A1/ 6.26340364591D+01/,A2/-4.21745334428D+01/,
     -     A3/ 8.08021018758D+00/
      IF (ABS(T/TT1-1.0).LT.2.0D-06) THEN
       PMELT=0.95402D-03
       RETURN
      END IF
      IF (T.LT.TT2) THEN
       C01=1.0D0/10.0D0
       TH=(ABS(T/TT1-1.0D0))**C01
       PMELT=PT1*EXP((A1+(A2+A3*TH*TH*TH)*TH)*TH)
       RETURN
      ELSE
       PMELT=PT2*EXP(6.1664D0*(SQRT(T/TT2)-1.0D0))
       RETURN
      END IF
      END
      SUBROUTINE S2PPL(P,TMELT)
***** SUBROUTINE TO FIND THE MELTING TEMPERATURE CORRESPONDING TO  *****
***** THE INPUT PRESSURE BY NEWTON METHOD. (ON PAGE 46)            *****
****  INPUT  : P=PRESSURE IN (PA)
****  OUTPUT : TMELT=MELTING TEMPERATURE IN (K)
      IMPLICIT DOUBLE PRECISION(A-H,O-Z)
      PARAMETER(PT1=0.95D-03,   PT2=715.0D+06,
     -          TT1=87.890D+00, TT2=129.84D+00)
      PARAMETER(EPS=1.0D-12,ITMAX=10000)
      DATA A1/ 6.26340364591D+01/,A2/-4.21745334428D+01/,
     -     A3/ 8.08021018758D+00/
      TMELT=TT1
       IF (P.EQ.PT1) RETURN
      IF (P.LT.PT2) THEN
       C01=1.0D0/10.0D0
       THW=(((TT2/TT1-1.0D0)**C01)/LOG(PT2/PT1))*LOG(P/PT1)
       DO 1 IT=1,ITMAX
        F=LOG(P/PT1)-(A1+(A2+A3*THW**3)*THW)*THW
        DF=-(A1+(2.0D0*A2+5.0D0*A3*THW**3)*THW)
        THW=THW-F/DF
        IF (ABS(-F/(DF*THW)).LT.EPS) THEN
         TMELT=TT1*(THW**10+1.0D0)
         RETURN
        END IF
    1  CONTINUE
       TMELT=-1.D+10
       RETURN
      ELSE
       TMELT=TT2*((LOG(P/PT2)/6.1664D0+1.0D0)**2)
       RETURN
      END IF
      END
      SUBROUTINE S3PPL(TAU,OMEGAL,OMEGAG,PIS)
***** SUBROUTINE TO FIND THE LIQUID AND VAPOR DENSITIES            *****
***** CORRESPONDING TO THE INPUT TEMPERATURE BY SOLVING THE MAXWELL*****
***** RELATION (EQ.(25)) USING NEWTON METHOD AND CALCULATE THE     *****
***** SATURATED PRESSURE FROM EQ.(25).                             *****
****  INPUT   : TAU=TCR/T
****  OUTPUT1 : OMEGAL=ROHL/ROHCR
****  OUTPUT2 : OMEGAG=ROHG/ROHCR
****  OUTPUT3 : PIS=PS/PCR
      IMPLICIT DOUBLE PRECISION(A-H,O-Z)
      PARAMETER(GASCON=8.31434D+00,
     -          PCR=4.6646D+06, TCR=365.57D+00, ROHCR=5.3086D+03)
      PARAMETER(ITMAX=10000)
      DATA  C1/-6.74466758958D+00/,  C2/ 1.04170660384D+02/,
     -      C3/-3.61099213639D+02/,  C4/ 5.70399232365D+02/,
     -      C5/-4.39539212314D+02/,  C6/ 1.35508176771D+02/
     -      C7/-1.32311881817D+00/
      DATA  D1/-4.49238845210D+00/,  D2/-2.17978872730D+02/,
     -      D3/-2.27581636393D+01/,  D4/ 1.43832778695D+02/,
     -      D5/ 5.31179421460D+01/,  D6/-1.09855588105D+00/,
     -      D7/ 2.60136526065D+01/,  D8/-2.23581566935D+02/
      OMEGAL=-1.0D+20
      OMEGAG=-1.0D+20
      PIS=-1.0D+20
       IF (TAU.LE.0.0D0) RETURN
      OMEGAL=1.0D0
      OMEGAG=1.0D0
      PIS=1.0D0
       IF (ABS(TAU-1.0D0).LE.2.0D-06) RETURN
***  INITIAL GUESSES FOR OML AND OMG  ***
      TH=ABS((TAU-1.0D0)/TAU)
      SQTH=SQRT(TH)
      IF (TAU.LE.1.0000208D0) THEN
       OMLW=1.0D0/(1.0D0-4.296178D0*SQTH)
       OMGW=1.0D0/(1.0D0+4.397528D0*SQTH)
      ELSE
       TH6=TH**(1.0D0/6.0D0)
       OMLW=EXP((C1+(C2+(C3+(C4+(C5+C6*TH6)*TH6)*TH6)*TH6)*TH6)*SQTH
     -      +C7*TH**(13.0D0/6.0D0))
       OMGW=EXP(((D1+(D2+(D3+D4*SQTH)*SQTH)*SQTH)*SQTH+(D5+(D6
     -     +D7*TH**3.5D0)*TH**1.5D0)*TH**4)/(1.0D0-TH)+D8*LOG(1.0D0-TH))
      END IF
***   NEWTON METHOD  ***
      IF (TAU.GE.1.0071D0) THEN
       EPS=1.0D-14
      ELSE
       EPS=1.0D-10
      END IF
      DO 1 IT=1,ITMAX
       CALL S20PPL(TAU,OMLW,SNXL)
       CALL S20PPL(TAU,OMGW,SNXG)
       CALL S24PPL(TAU,OMLW,SNXUL)
       CALL S24PPL(TAU,OMGW,SNXUG)
       CALL S21PPL(TAU,OMLW,SNXRL)
       CALL S21PPL(TAU,OMGW,SNXRG)
       F=OMLW*(1.0D0+SNXL)-OMGW*(1.0D0+SNXG)
       G=LOG(OMLW/OMGW)+SNXL-SNXG+SNXUL-SNXUG
       DOMLW=(OMLW/(OMLW-OMGW))*(F-G*OMGW)/(1.0D0+SNXRL)
       DOMGW=(OMGW/(OMLW-OMGW))*(F-G*OMLW)/(1.0D0+SNXRG)
       OMLW=OMLW-DOMLW
       OMGW=OMGW-DOMGW
       IF ((ABS(DOMLW).LT.EPS).AND.(ABS(DOMGW).LT.EPS)) THEN
        OMEGAL=OMLW
        OMEGAG=OMGW
        PIS=((GASCON*ROHCR*TCR/PCR)/TAU)
     -      *(OMLW*OMGW/(OMGW-OMLW))*(LOG(OMGW/OMLW)+SNXUG-SNXUL)
        RETURN
       END IF
    1 CONTINUE
      OMEGAL=-1.0D+10
      OMEGAG=-1.0D+10
      PIS=-1.0D+10
      RETURN
      END
      SUBROUTINE S4PPL(PI,OMEGAL,OMEGAG,TAUS)
***** SUBROUTINE TO FIND THE SATURATED TEMPERATURE, LIQUID DENSITY *****
***** AND VAPOR DENSITY CORRESPONDING TO THE INPUT PRESSURE BY     *****
***** SOLVING THE MAXWELL RELATION (EQ.(25)) USING AN ITERATIVE    *****
***** METHOD.                                                      *****
****  INPUT   : PI=P/PCR
****  OUTPUT1 : OMEGAL=ROHL/ROHCR
****  OUTPUT2 : OMEGAG=ROHG/ROHCR
****  OUTPUT3 : TAUS=TCR/TS
      IMPLICIT DOUBLE PRECISION(A-H,O-Z)
      PARAMETER(GASCON=8.31434D+00,
     -          PCR=4.6646D+6, TCR=365.57D+00, ROHCR=5.3086D+03)
      PARAMETER(EPS1=1.0D-12,IT1MAX=10000,IT2MAX=10000)
      DATA  B1/-6.55351750334D+00/,  B2/ 9.57645928738D-01/,
     -      B3/-4.74702637650D+00/,  B4/ 1.93142085086D+00/
      OMEGAL=-1.0D+20
      OMEGAG=-1.0D+20
      TAUS=-1.0D+20
       IF (PI.LE.0.0D0) RETURN
      OMEGAL=1.0D0
      OMEGAG=1.0D0
      TAUS=1.0D0
       IF (ABS(PI-1.0D0).LE.1.6D-05) RETURN
***  INITIAL GUESS FOR TAU ***
      TH=LOG(PI)/(B1+LOG(PI))
      DO 1 IT1=1,IT1MAX
       F=((B1+LOG(PI))+B2*SQRT(TH))*TH+(B3+B4*SQRT(TH))*TH**4-LOG(PI)
       DF=B1+LOG(PI)+1.5D0*B2*SQRT(TH)+(4.0D0*B3+4.5D0*B4*SQRT(TH))
     -    *TH**3
       TH=TH-F/DF
       IF(ABS(-F/(DF*TH)).LT.EPS1) GO TO 10
    1 CONTINUE
      GO TO 1000
   10 TAUSW=1.0D0/(1.0D0-TH)
***  ITERATIVE METHOD ***
      IF (PI.GE.0.98615D0) THEN
       EPS2=1.0D-10
      ELSE
       EPS2=1.0D-12
      END IF
      DO 2 IT2=1,IT2MAX
       CALL S3PPL(TAUSW,OMLW,OMGW,PISW)
       DP=(PI-PISW)*PCR
       IF (ABS(DP/(PI*PCR)).LE.EPS2) THEN
        OMEGAL=OMLW
        OMEGAG=OMGW
        TAUS=TAUSW
        RETURN
       END IF
       CALL S23PPL(TAUSW,OMGW,SNXSG)
       CALL S23PPL(TAUSW,OMLW,SNXSL)
       DPSDT=GASCON*ROHCR*
     -       (OMLW*OMGW/(OMGW-OMLW))*(LOG(OMGW/OMLW)+SNXSG-SNXSL)
       DTSW=DP/DPSDT
       TAUSW=1.0D0/(1.0D0/TAUSW+DTSW/TCR)
    2 CONTINUE
 1000 OMEGAG=-1.0D+10
      OMEGAL=-1.0D+10
      TAUS=-1.0D+10
      RETURN
      END
      SUBROUTINE S5PPL(PI,TAU,OMEGA)
***** SUBROUTINE TO FIND THE DENSITY CORRESPONDING TO THE INPUT    *****
***** PRESSURE AND TEMPERATURE BY SOLVING THE EQUATION OF STATE,   *****
***** EQ.(11) USING NEWTON METHOD.                                 *****
****  INPUT1 : PI= P/PCR
****  INPUT2 : TAU=TCR/T
****  OUTPUT : OMEGA=ROH/ROHCR
      IMPLICIT DOUBLE PRECISION(A-H,N,O-Z)
      PARAMETER(GASCON=8.31434D+00,
     -          PCR=4.6646D+06, TCR=365.57D+00, ROHCR=5.3086D+03)
      PARAMETER(EPS=1.0D-12,ITMAX=10000)
      DIMENSION N(1:21)
      OMEGA=1.0D0
       IF ((ABS(PI-1.0D0).LE.1.0D-05).AND.(ABS(TAU-1.0D0).LE.2.2D-05))
     -    RETURN
      ZCR=PCR/(ROHCR*GASCON*TCR)
***   INITIAL GUESS FOR OMEGA ***
      IF ((PI.GE.0.99985D0).AND.(PI.LE.1.003D0).AND.
     -    (TAU.GE.0.9999D0).AND.(TAU.LE.1.000022D0)) THEN
       OM=0.95D0
       GO TO 10
      END IF
      IF ((PI.GT.2.144D0).AND.(PI.LE.214.5D0).AND.(TAU.LE.1.0D0)) THEN
       PILOG=LOG(PI)
       OM=-0.291572285D0+(1.46573358D0+(-0.2829664D0
     -     +0.0269205574D0*PILOG)*PILOG)*PILOG
      ELSE IF ((PI.LE.2.144D0).AND.(TAU.LE.1.0D0)) THEN
       OM=ZCR*PI*TAU
      ELSE IF ((PI.GE.1.0D0).AND.(TAU.GT.1.0D0)) THEN
       PILOG=LOG(PI)
       OM=3.44342411D0+(1.02690152D-02+(3.33768415D-03
     -    +(-1.01007676D-03+6.52215174D-04*PILOG)*PILOG)*PILOG)*PILOG
      ELSE
       CALL S4PPL(PI,OML,OMG,TAUS)
        IF (OML.LE.-1.0D+10) GO TO 1000
       IF ((PI.LT.1.0D0).AND.(TAU.LE.TAUS)) THEN
        IF (ABS(TAUS/TAU-1.0D0).LT.1.0D-05) THEN
         OMEGA=OMG
         RETURN
        END IF
        OM=OMG
       ELSE IF ((PI.LT.1.0D0).AND.(TAU.GT.TAUS)) THEN
        IF (ABS(TAU/TAUS-1.0D0).LT.1.0D-05) THEN
         OMEGA=OML
         RETURN
        END IF
        OM=3.45D0
       END IF
      END IF
   10 CONTINUE
      CALL S30PPL(N)
      NT1 =(N(1)+(N(2)+N(3)*TAU)*TAU)*TAU
      NT2 =N(4)+(N(5)+N(6)*TAU)*TAU
      NT3 =(N(7)+N(8)*TAU)*TAU*TAU
      NT4 =N(9)/TAU+N(10)+(N(11)+N(12)*TAU*TAU)*TAU
      NT5 =N(13)*TAU*TAU*TAU
      NT6 =N(14)*TAU*TAU*TAU
      NT7 =N(15)*TAU*TAU*TAU
      NT8 =N(16)*TAU**5
      NT9 =N(17)*TAU**5
      NT10=N(18)*TAU**3
      NT11=N(19)*TAU**3
      NT12=N(20)*TAU**3
      NT13=N(21)*TAU**4
      ZCRPT=ZCR*PI*TAU
***   NEWTON METHOD   ***
      DO 1 IT=1,ITMAX
       OM2=OM*OM
       OM2EXP=OM2*EXP(-OM2)
       A=-2.0D0*OM2
       Z=1.0D0+(NT1+(NT2+(NT3+(NT4+(NT5+(NT6+NT7*OM)*OM)*OM)*OM)*OM)*OM)
     -   *OM+OM2EXP*(NT8+(NT9+(NT10+(NT11+(NT12+NT13*OM2*OM2)*OM2)*OM2)
     -   *OM2)*OM2)
       DOMZ=1.0D0+(2.0D0*NT1+(3.0D0*NT2+(4.0D0*NT3+(5.0D0*NT4
     -      +(6.0D0*NT5+(7.0D0*NT6+8.0D0*NT7*OM)*OM)*OM)*OM)*OM)*OM)*OM
     -      +OM2EXP*((3.0D0+A)*NT8+((5.0D0+A)*NT9+((7.0D0+A)*NT10
     -      +((9.0D0+A)*NT11+((11.0D0+A)*NT12+(15.0D0+A)*NT13*OM2*OM2)
     -      *OM2)*OM2)*OM2)*OM2)
       F=ZCRPT-OM*Z
       DF=-DOMZ
       OM=OM-F/DF
       IF (ABS(-F/(DF*OM)).LT.EPS) THEN
        OMEGA=OM
        RETURN
       END IF
    1 CONTINUE
 1000 OMEGA=-1.0D+10
      RETURN
      END
      SUBROUTINE S6PPL(PI,OMEGA,TAU)
***** SUBROUTINE TO FIND THE TEMPERATURE CORRESPONDING TO THE INPUT*****
***** PRESSURE AND DENSITY BY SOLVING THE EQUATION OF STATE,       *****
***** EQ.(11) USING NEWTON METHOD.                                 *****
****  INPUT1 : PI=P/PCR
****  INPUT2 : OMEGA=ROH/ROHCR
****  OUTPUT : TAU=TCR/T
      IMPLICIT DOUBLE PRECISION(A-H,N,O-Z)
      PARAMETER(GASCON=8.31434D+00,
     -          PCR=4.6646D+06, TCR=365.57D+00, ROHCR=5.3086D+03)
      PARAMETER(EPS=1.0D-12,ITMAX=10000)
      DIMENSION N(1:21)
      TAU=1.0D0
       IF ((ABS(PI-1.0D0).LE.1.0D-05).AND.
     -     (ABS(OMEGA-1.0D0).LE.1.0D-05)) RETURN
      ZCR=PCR/(ROHCR*GASCON*TCR)
***   INITIAL GUESS FOR TAU  ***
      IF (PI.GT.2.1439D+06) THEN
       TAUW=TCR/475.0D0
      ELSE IF ((PI.GE.1.0D0).AND.(PI.LE.2.1439D+06)) THEN
       TAUW=TCR/575.0D0
      ELSE
       IF (OMEGA.GT.1.0D0) THEN
        CALL S4PPL(PI,OML,OMG,TAUS)
        TAUW=TAUS
       ELSE
        TAUW=OMEGA/(ZCR*PI)
       END IF
      END IF
      CALL S30PPL(N)
      OM=OMEGA
      OM2=OM*OM
      OM2EXP=OM2*EXP(-OM2)
      NO01=N(9)*OM2*OM2
      NO0 =1.0D0+(N(4)+N(10)*OM2)*OM2
      NO1 =(N(1)+(N(5)+N(11)*OM2)*OM)*OM
      NO2 =(N(2)+(N(6)+N(7)*OM)*OM)*OM
      NO3 =(N(3)+(N(8)+(N(12)+(N(13)+(N(14)+N(15)*OM)*OM)*OM)*OM)*OM2)
     -     *OM+(N(18)+(N(19)+N(20)*OM2)*OM2)*OM2*OM2*OM2EXP
      NO4 =N(21)*OM2**6*OM2EXP
      NO5 =(N(16)+N(17)*OM2)*OM2EXP
      ZCRPOM=ZCR*PI/OM
      DO 1 IT=1,ITMAX
       Z=NO01/TAUW+NO0+(NO1+(NO2+(NO3+(NO4+NO5*TAUW)*TAUW)*TAUW)*TAUW)
     -   *TAUW
       DZTAUW=-(2.0D0*NO01/TAUW+NO0)/(TAUW*TAUW)+NO2+(2.0D0*NO3
     -        +(3.0D0*NO4+4.0D0*NO5*TAUW)*TAUW)*TAUW
       F=ZCRPOM-(Z/TAUW)
       DF=-DZTAUW
       TAUW=TAUW-F/DF
       IF (ABS(-F/(DF*TAUW)).LT.EPS) THEN
        TAU=TAUW
        RETURN
       END IF
    1 CONTINUE
      TAU=-1.0D+10
      RETURN
      END
      SUBROUTINE S7PPL(TAU,OMEGA,PI)
***** SUBROUTINE TO CALCULATE THE PRESSURE CORRESPONDING TO THE    *****
***** INPUT TEMPERATURE AND DENSITY FROM THE EQUATION OF STATE,    *****
***** EQ.(11).                                                     *****
****  INPUT1 : TAU=TCR/T
****  INPUT2 : OMEGA=ROH/ROHCR
****  OUTPUT : PI=P/PCR
      IMPLICIT DOUBLE PRECISION(A-H,O-Z)
      PARAMETER(GASCON=8.31434D+00,
     -          PCR=4.6646D+06, TCR=365.57D+00, ROHCR=5.3086D+03)
      CALL S20PPL(TAU,OMEGA,SNX)
      P=(OMEGA*ROHCR)*GASCON*(TCR/TAU)*(1.0D0+SNX)
      PI=P/PCR
      RETURN
      END
      SUBROUTINE S10PPL(IDSUCV,TAU,SUCV)
***** SUBROUTINE TO CALCULATE THE ENTROPY, INTERNAL ENERGY AND     *****
***** ISOCHORIC HEAT CAPACITY IN THE IDEAL GAS STATE FROM EQ.(2),  *****
***** EQ.(17) AND EQ.(20), RESPECTIVELY.                           *****
****  INPUT1 : IDSUCV=1,2 OR 3
****           IDSUCV=1...SUCV=S :ENTROPY IN (J/(K*MOL))
****           IDSUCV=2...SUCV=U :INTERNAL ENERGY IN (J/MOL)
****           IDSUCV=3...SUCV=CV:ISOCHORIC HEAT CAPACITY IN (J/(K*MOL))
****  INPUT2 : TAU=TCR/T
****  OUTPUT : SUCV
      IMPLICIT DOUBLE PRECISION(A-H,O-Z)
      PARAMETER(GASCON=8.31434D+00, TCR=365.57D+00, T0=298.15D+00)
      DATA F1/ 0.65591381D+00/, F2/ 0.16216554D+02/,
     -     F3/-0.48980633D+01/, F4/ 0.82185468D+00/,
     -     F5/-0.58314808D-01/, F6/ 0.25252519D-01/,
     -     F7/-0.47032420D+01/, F8/ 0.16844944D+01/
      T=TCR/TAU
      UT=F8*TAU
      TAU0=TCR/T0
      UT0=F8*TAU0
      IF (IDSUCV.EQ.1) THEN
      SIDT=F1*LOG(T)+(F2+(F3/2.0D0+(F4/3.0D0+(F5/4.0D0)/TAU)/TAU)/TAU)
     -     /TAU-F6*TAU*TAU/2.0D0
     -     +F7*(UT*EXP(UT)/(EXP(UT)-1.0D0)-LOG(EXP(UT)-1.0D0))
      SIDT0=F1*LOG(T0)+(F2+(F3/2.0D0+(F4/3.0D0+(F5/4.0D0)/TAU0)/TAU0)
     -     /TAU0)/TAU0-F6*TAU0*TAU0/2.0D0
     -     +F7*(UT0*EXP(UT0)/(EXP(UT0)-1.0D0)-LOG(EXP(UT0)-1.0D0))
      SID=GASCON*(SIDT-SIDT0)
       SUCV=SID
      ELSE IF (IDSUCV.EQ.2) THEN
       UIDT=TCR*((F1+(F2/2.0D0+(F3/3.0D0+(F4/4.0D0+(F5/5.0D0)/TAU)
     -      /TAU)/TAU)/TAU)/TAU -F6*TAU+F7*F8/(EXP(UT)-1.0D0))-T
       UIDT0=TCR*((F1+(F2/2.0D0+(F3/3.0D0+(F4/4.0D0+(F5/5.0D0)/TAU0)
     -       /TAU0)/TAU0)/TAU0)/TAU0 -F6*TAU0+F7*F8/(EXP(UT0)-1.0D0))
       UID=GASCON*(UIDT-UIDT0)
       SUCV=UID
      ELSE IF (IDSUCV.EQ.3) THEN
       CVID=GASCON*(F1+(F2+(F3+(F4+F5/TAU)/TAU)/TAU)/TAU+F6*TAU*TAU
     -       +F7*UT*UT*EXP(UT)/(EXP(UT)-1.0D0)**2-1.0D0)
       SUCV=CVID
      END IF
      RETURN
      END
      SUBROUTINE S11PPL(TAU,OMEGA,S)
***** SUBROUTINE TO CALCULATE THE ENTROPY. (EQ.(14))               *****
****  INPUT1 : TAU=TCR/T
****  INPUT2 : OMEGA=ROH/ROHCR
****  OUTPUT : S=ENTROPY IN (J/(K*MOL))
      IMPLICIT DOUBLE PRECISION(A-H,O-Z)
      PARAMETER(GASCON=8.31434D+00, TCR=365.57D+00, ROHCR=5.3086D+03,
     -          PATM=0.101325D+06)
      CALL S10PPL(1,TAU,SID)
      CALL S23PPL(TAU,OMEGA,SNXS)
      CALL S23PPL(TAU,0.0D0,SNXS0)
      S1=-GASCON*(SNXS-SNXS0)
      S=SID-GASCON*LOG(OMEGA*GASCON*ROHCR*TCR/(TAU*PATM))+S1
      RETURN
      END
      SUBROUTINE S12PPL(TAU,OMEGA,U)
***** SUBROUTINE TO CALCULATE THE INTERNAL ENERGY. (EQ.(16))       *****
****  INPUT1 : TAU=TCR/T
****  INPUT2 : OMEGA=ROH/ROHCR
****  OUTPUT : U=INTERNAL ENERGY IN (J/MOL)
      IMPLICIT DOUBLE PRECISION(A-H,O-Z)
      PARAMETER(GASCON=8.31434D+00, TCR=365.57D+00)
      CALL S10PPL(2,TAU,UID)
      CALL S24PPL(TAU,OMEGA,SNXU)
      CALL S24PPL(TAU,0.0D0,SNXU0)
      CALL S23PPL(TAU,OMEGA,SNXS)
      CALL S23PPL(TAU,0.0D0,SNXS0)
      U1=GASCON*(TCR/TAU)*(SNXU-SNXS-(SNXU0-SNXS0))
      U=UID+U1
      RETURN
      END
      SUBROUTINE S13PPL(TAU,OMEGA,H)
***** SUBROUTINE TO CALCULATE THE ENTHALPY. (EQ.(18))              *****
****  INPUT1 : TAU=TCR/T
****  INPUT2 : OMEGA=ROH/ROHCR
****  OUTPUT : H=ENTHALPY IN (J/MOL)
      IMPLICIT DOUBLE PRECISION(A-H,O-Z)
      PARAMETER(PCR=4.6646D+06, ROHCR=5.3086D+03)
      CALL S7PPL(TAU,OMEGA,PI)
      CALL S12PPL(TAU,OMEGA,U)
      H=U+(PI*PCR)/(OMEGA*ROHCR)
      RETURN
      END
      SUBROUTINE S14PPL(TAU,OMEGA,CV)
***** SUBROUTINE TO CALCULATE THE ISOCHORIC HEAT CAPACITY.(EQ.(19))*****
****  INPUT1 : TAU=TCR/T
****  INPUT2 : OMEGA=ROH/ROHCR
****  OUTPUT : CV=ISOCHORIC HEAT CAPACITY IN (J/(K*MOL))
      IMPLICIT DOUBLE PRECISION(A-H,O-Z)
      PARAMETER(GASCON=8.31434D+00)
      CALL S10PPL(3,TAU,CVID)
      CALL S25PPL(TAU,OMEGA,SNXC)
      CALL S25PPL(TAU,0.0D0,SNXC0)
      CV1=-GASCON*(SNXC-SNXC0)
      CV=CVID+CV1
      RETURN
      END
      SUBROUTINE S15PPL(TAU,OMEGA,CP)
***** SUBROUTINE TO CALCULATE THE ISOBARIC HEAT CAPACITY. (EQ.(22))*****
****  INPUT1 : TAU=TCR/T
****  INPUT2 : OMEGA=ROH/ROHCR
****  OUTPUT : CP=ISOBARIC HEAT CAPACITY IN (J/(K*MOL))
      IMPLICIT DOUBLE PRECISION(A-H,O-Z)
      PARAMETER(GASCON=8.31434D+00)
      CALL S14PPL(TAU,OMEGA,CV)
      CALL S21PPL(TAU,OMEGA,SNXR)
      CALL S22PPL(TAU,OMEGA,SNXT)
      CP=CV+GASCON*(1.0D0+SNXT)**2/(1.0D0+SNXR)
      RETURN
      END
      SUBROUTINE S20PPL(TAU,OMEGA,SNX)
***** SUBROUTINE TO CALCULATE THE SUMMATION OF N(I)*X(I)           *****
***** LISTED IN TABLE I ON PAGE 41.                                *****
****  INPUT1 : TAU=TCR/T
****  INPUT2 : OMEGA=ROH/ROHCR
****  OUTPUT : SNX=SUMMATION OF N(I)*X(I)
      IMPLICIT DOUBLE PRECISION(A-H,N,O-Z)
      DIMENSION N(1:21)
      CALL S30PPL(N)
      C1 =(N(1)+(N(2)+N(3)*TAU)*TAU)*TAU
      C2 =N(4)+(N(5)+N(6)*TAU)*TAU
      C3 =(N(7)+N(8)*TAU)*TAU*TAU
      C4 =N(9)/TAU+N(10)+(N(11)+N(12)*TAU*TAU)*TAU
      C5 =N(13)*TAU*TAU*TAU
      C6 =N(14)*TAU*TAU*TAU
      C7 =N(15)*TAU*TAU*TAU
      C8 =N(16)*TAU*TAU
      C9 =N(17)*TAU*TAU
      C10=N(18)
      C11=N(19)
      C12=N(20)
      C13=N(21)*TAU
      OM=OMEGA
      OM2=OMEGA*OMEGA
      SNX=(C1+(C2+(C3+(C4+(C5+(C6+C7*OM)*OM)*OM)*OM)*OM)*OM)*OM
     -    +(C8+(C9+(C10+(C11+(C12+C13*OM2*OM2)*OM2)*OM2)*OM2)*OM2)
     -     *OM2*(TAU*TAU*TAU)*EXP(-OM2)
      RETURN
      END
      SUBROUTINE S21PPL(TAU,OMEGA,SNXR)
***** SUBROUTINE TO CALCULATE THE SUMMATION OF N(I)*XROH(I)        *****
***** LISTED IN TABLE I ON PAGE 41.                                *****
****  INPUT1 : TAU=TCR/T
****  INPUT2 : OMEGA=ROH/ROHCR
****  OUTPUT : SNXR=SUMMATION OF N(I)*XROH(I)
      IMPLICIT DOUBLE PRECISION(A-H,N,O-Z)
      DIMENSION N(1:21)
      CALL S30PPL(N)
      A=-2.0D0*OMEGA*OMEGA
      C1 =2.0D0*((N(1)+(N(2)+N(3)*TAU)*TAU)*TAU)
      C2 =3.0D0*(N(4)+(N(5)+N(6)*TAU)*TAU)
      C3 =4.0D0*((N(7)+N(8)*TAU)*TAU*TAU)
      C4 =5.0D0*(N(9)/TAU+N(10)+(N(11)+N(12)*TAU*TAU)*TAU)
      C5 =6.0D0*N(13)*TAU*TAU*TAU
      C6 =7.0D0*N(14)*TAU*TAU*TAU
      C7 =8.0D0*N(15)*TAU*TAU*TAU
      C8 =N(16)*(3.0D0+A)*TAU*TAU
      C9 =N(17)*(5.0D0+A)*TAU*TAU
      C10=N(18)*(7.0D0+A)
      C11=N(19)*(9.0D0+A)
      C12=N(20)*(11.0D0+A)
      C13=N(21)*(15.0D0+A)*TAU
      OM=OMEGA
      OM2=OMEGA*OMEGA
      SNXR=(C1+(C2+(C3+(C4+(C5+(C6+C7*OM)*OM)*OM)*OM)*OM)*OM)*OM
     -      +(C8+(C9+(C10+(C11+(C12+C13*OM2*OM2)*OM2)*OM2)*OM2)*OM2)
     -      *OM2*(TAU*TAU*TAU)*EXP(-OM2)
      RETURN
      END
      SUBROUTINE S22PPL(TAU,OMEGA,SNXT)
***** SUBROUTINE TO CALCULATE THE SUMMATION OF N(I)*XT(I)          *****
***** LISTED IN TABLE I ON PAGE 41.                                *****
****  INPUT1 : TAU=TCR/T
****  INPUT2 : OMEGA=ROH/ROHCR
****  OUTPUT : SNXT=SUMMATION OF N(I)*XT(I)
      IMPLICIT DOUBLE PRECISION(A-H,N,O-Z)
      DIMENSION N(1:21)
      CALL S30PPL(N)
      C1 =-(N(2)+2.0D0*N(3)*TAU)*TAU*TAU
      C2 =N(4)-N(6)*TAU*TAU
      C3 =-(N(7)+2.0D0*N(8)*TAU)*TAU*TAU
      C4 =2.0D0*N(9)/TAU+N(10)-2.0D0*N(12)*TAU*TAU*TAU
      C5 =-2.0D0*N(13)*TAU*TAU*TAU
      C6 =-2.0D0*N(14)*TAU*TAU*TAU
      C7 =-2.0D0*N(15)*TAU*TAU*TAU
      C8 =-4.0D0*N(16)*TAU*TAU
      C9 =-4.0D0*N(17)*TAU*TAU
      C10=-2.0D0*N(18)
      C11=-2.0D0*N(19)
      C12=-2.0D0*N(20)
      C13=-3.0D0*N(21)*TAU
      OM=OMEGA
      OM2=OMEGA*OMEGA
      SNXT=(C1+(C2+(C3+(C4+(C5+(C6+C7*OM)*OM)*OM)*OM)*OM)*OM)*OM
     -     +(C8+(C9+(C10+(C11+(C12+C13*OM2*OM2)*OM2)*OM2)*OM2)*OM2)
     -      *OM2*(TAU*TAU*TAU)*EXP(-OM2)
      RETURN
      END
      SUBROUTINE S23PPL(TAU,OMEGA,SNXS)
***** SUBROUTINE TO CALCULATE THE SUMMATION OF N(I)*XS(I)          *****
***** LISTED IN TABLE I ON PAGE 41.                                *****
****  INPUT1 : TAU=TCR/T
****  INPUT2 : OMEGA=ROH/ROHCR
****  OUTPUT : SNXS=SUMMATION OF N(I)*XS(I)
      IMPLICIT DOUBLE PRECISION(A-H,N,O-Z)
      DIMENSION N(1:21)
      CALL S30PPL(N)
      OM=OMEGA
      OM2=OMEGA*OMEGA
      A1=1.0D0
      A2=1.0D0+OM2
      A3=2.0D0+(2.0D0+OM2)*OM2
      A4=6.0D0+(6.0D0+(3.0D0+OM2)*OM2)*OM2
      A5=24.0D0+(24.0D0+(12.0D0+(4.0D0+OM2)*OM2)*OM2)*OM2
      A7=720.0D0+(720.0D0+(360.0D0+(120.0D0+(30.0D0+(6.0D0+OM2)
     -   *OM2)*OM2)*OM2)*OM2)*OM2
      C1 =-(N(2)+2.0D0*N(3)*TAU)*TAU*TAU
      C2 =(N(4)-N(6)*TAU*TAU)/2.0D0
      C3 =-((N(7)+2.0D0*N(8)*TAU)*TAU*TAU)/3.0D0
      C4 =(2.0D0*N(9)/TAU+N(10)-2.0D0*N(12)*TAU*TAU*TAU)/4.0D0
      C5 =-2.0D0*N(13)*TAU*TAU*TAU/5.0D0
      C6 =-2.0D0*N(14)*TAU*TAU*TAU/6.0D0
      C7 =-2.0D0*N(15)*TAU*TAU*TAU/7.0D0
      C8 =-4.0D0*N(16)*A1*TAU*TAU
      C9 =-4.0D0*N(17)*A2*TAU*TAU
      C10=-2.0D0*N(18)*A3
      C11=-2.0D0*N(19)*A4
      C12=-2.0D0*N(20)*A5
      C13=-3.0D0*N(21)*A7*TAU
      SNXS=(C1+(C2+(C3+(C4+(C5+(C6+C7*OM)*OM)*OM)*OM)*OM)*OM)*OM
     -     +(C8+C9+C10+C11+C12+C13)*TAU*TAU*TAU*EXP(-OM2)/(-2.0D0)
      RETURN
      END
      SUBROUTINE S24PPL(TAU,OMEGA,SNXU)
***** SUBROUTINE TO CALCULATE THE SUMMATION OF N(I)*XU(I)          *****
***** LISTED IN TABLE I ON PAGE 41.                                *****
****  INPUT1 : TAU=TCR/T
****  INPUT2 : OMEGA=ROH/ROHCR
****  OUTPUT : SNXU=SUMMATION OF N(I)*XU(I)
      IMPLICIT DOUBLE PRECISION(A-H,N,O-Z)
      DIMENSION N(1:21)
      CALL S30PPL(N)
      OM=OMEGA
      OM2=OMEGA*OMEGA
      A1=1.0D0
      A2=1.0D0+OM2
      A3=2.0D0+(2.0D0+OM2)*OM2
      A4=6.0D0+(6.0D0+(3.0D0+OM2)*OM2)*OM2
      A5=24.0D0+(24.0D0+(12.0D0+(4.0D0+OM2)*OM2)*OM2)*OM2
      A7=720.0D0+(720.0D0+(360.0D0+(120.0D0+(30.0D0+(6.0D0+OM2)
     -   *OM2)*OM2)*OM2)*OM2)*OM2
      C1 =(N(1)+(N(2)+N(3)*TAU)*TAU)*TAU
      C2 =(N(4)+(N(5)+N(6)*TAU)*TAU)/2.0D0
      C3 =((N(7)+N(8)*TAU)*TAU*TAU)/3.0D0
      C4 =(N(9)/TAU+N(10)+(N(11)+N(12)*TAU*TAU)*TAU)/4.0D0
      C5 =N(13)*TAU*TAU*TAU/5.0D0
      C6 =N(14)*TAU*TAU*TAU/6.0D0
      C7 =N(15)*TAU*TAU*TAU/7.0D0
      C8 =N(16)*A1*TAU*TAU
      C9 =N(17)*A2*TAU*TAU
      C10=N(18)*A3
      C11=N(19)*A4
      C12=N(20)*A5
      C13=N(21)*A7*TAU
      SNXU=(C1+(C2+(C3+(C4+(C5+(C6+C7*OM)*OM)*OM)*OM)*OM)*OM)*OM
     -     +(C8+C9+C10+C11+C12+C13)*TAU*TAU*TAU*EXP(-OM2)/(-2.0D0)
      RETURN
      END
      SUBROUTINE S25PPL(TAU,OMEGA,SNXC)
***** SUBROUTINE TO CALCULATE THE SUMMATION OF N(I)*XC(I)          *****
***** LISTED IN TABLE I ON PAGE 41.                                *****
****  INPUT1 : TAU=TCR/T
****  INPUT2 : OMEGA=ROH/ROHCR
****  OUTPUT : SNXC=SUMMATION OF N(I)*XC(I)
      IMPLICIT DOUBLE PRECISION(A-H,N,O-Z)
      DIMENSION N(1:21)
      CALL S30PPL(N)
      OM=OMEGA
      OM2=OMEGA*OMEGA
      A1=1.0D0
      A2=1.0D0+OM2
      A3=2.0D0+(2.0D0+OM2)*OM2
      A4=6.0D0+(6.0D0+(3.0D0+OM2)*OM2)*OM2
      A5=24.0D0+(24.0D0+(12.0D0+(4.0D0+OM2)*OM2)*OM2)*OM2
      A7=720.0D0+(720.0D0+(360.0D0+(120.0D0+(30.0D0+(6.0D0+OM2)
     -   *OM2)*OM2)*OM2)*OM2)*OM2
      C1 =(2.0D0*N(2)+6.0D0*N(3)*TAU)*TAU*TAU
      C2 =N(6)*TAU*TAU
      C3 =2.0D0*(N(7)/3.0D0+N(8)*TAU)*TAU*TAU
      C4 =(N(9)/TAU+3.0D0*N(12)*TAU*TAU*TAU)/2.0D0
      C5 =6.0D0*N(13)*TAU*TAU*TAU/5.0D0
      C6 =N(14)*TAU*TAU*TAU
      C7 =6.0D0*N(15)*TAU*TAU*TAU/7.0D0
      C8 =10.0D0*N(16)*A1*TAU*TAU
      C9 =10.0D0*N(17)*A2*TAU*TAU
      C10=3.0D0*N(18)*A3
      C11=3.0D0*N(19)*A4
      C12=3.0D0*N(20)*A5
      C13=6.0D0*N(21)*A7*TAU
      SNXC=(C1+(C2+(C3+(C4+(C5+(C6+C7*OM)*OM)*OM)*OM)*OM)*OM)*OM
     -     +(C8+C9+C10+C11+C12+C13)*TAU*TAU*TAU*EXP(-OM2)/(-1.0D0)
      RETURN
      END
      SUBROUTINE S30PPL(AN)
***** SUBROUTINE TO SUPPLY THE COEFFICIENTS N(I) OF EQ.(10)        *****
***** LISTED IN TABLE H ON PAGE 40.                                *****
****  OUTPUT : AN(I) ( I=1,2...21 )
      IMPLICIT DOUBLE PRECISION(A,N)
      DIMENSION AN(1:21),N(1:21)
      DATA N( 1)/ 1.86248290035D-01/, N( 2)/-1.29261101662D+00/,
     -     N( 3)/-5.41016097415D-02/, N( 4)/ 1.01380340654D+00/,
     -     N( 5)/-2.12122922461D+00/, N( 6)/ 1.52627216648D+00/,
     -     N( 7)/-2.55219915870D-01/, N( 8)/ 1.31478772475D+00/,
     -     N( 9)/-4.56533888809D-02/, N(10)/ 9.26598286408D-02/,
     -     N(11)/ 1.02014965320D-01/, N(12)/-2.29310324048D+00/,
     -     N(13)/ 1.25144776124D+00/, N(14)/-2.81035528699D-01/,
     -     N(15)/ 2.27659849020D-02/, N(16)/-2.35159642461D-01/,
     -     N(17)/ 2.20999857935D-01/, N(18)/ 3.36805009198D-01/,
     -     N(19)/-2.10248541785D-02/, N(20)/ 2.98493529044D-02/,
     -     N(21)/ 2.85153473859D-04/
      DO 1 I=1,21
        AN(I)=N(I)
    1 CONTINUE
      RETURN
      END
      SUBROUTINE S40PPL(IHS,PI,Z,TH1,TH2,Z1,Z2,TH)
***   IHS : IHS=1 FOR F64PPL(FP,FH)
***         IHS=2 FOR F65PPL(FP,FS) AND F71PPL(FP,FS)
***   TH : OUTPUT=T/TCR=1.0D0/TAU
      IMPLICIT DOUBLE PRECISION(A-H,O-Z)
      PARAMETER(EPS=1.0D-07,ITMAX=10000)
      DO 1 IT=1,ITMAX
       DTH=(Z-Z2)*(TH2-TH1)/(Z2-Z1)
       IF (ABS(DTH/TH1).LT.EPS) THEN
        TH=TH2
        RETURN
       END IF
       TH1=TH2
       Z1=Z2
       TH2=TH1+DTH
       TAU2=1.0D0/TH2
       CALL S5PPL(PI,TAU2,OMEGA2)
        IF (OMEGA2.LT.-1.0D+10) GO TO 1000
       IF (IHS.EQ.1) THEN
        CALL S13PPL(TAU2,OMEGA2,Z2)
       ELSE IF (IHS.EQ.2) THEN
        CALL S11PPL(TAU2,OMEGA2,Z2)
       END IF
    1  CONTINUE
 1000  TH=-1.0D+10
       RETURN
       END
      SUBROUTINE S90PPL(FP,FT,ILL)
***** SUBROUTINE TO CHECK IF THE RANGE OF ARGUMENTS:(P,T) IS PROPER*****
***** FOR F25PPL:HPT, F35PPL:SPT, F44PPL:UPT AND F51PPL:VPT.       *****
      IMPLICIT REAL(F)
      ILL=10000
      IF ((FP.LT.0.954E-08).OR.(FT.GT.1000.1E+01)) RETURN
      IF ((FP.GE.0.954E-08).AND.(FP.LE.10.001E+01)) THEN
       FTMIN=-183.16
       FTMAX=301.86
      ELSE IF ((FP.GT.10.001E+01).AND.(FP.LE.36.9585E+01)) THEN
       FTMIN=-183.16
       FTMAX=201.86
      ELSE IF ((FP.GT.36.9585E+01).AND.(FP.LE.1000.1E+01)) THEN
       FTMIN=F69PPL(FP)*0.9999
       FTMAX=201.86
      END IF
      IF ((FT.GT.FTMIN).AND.(FT.LT.FTMAX)) THEN
       ILL=0
      END IF
      RETURN
      END
      SUBROUTINE S91PPL(FP,FT,ILL)
***** SUBROUTINE TO CHECK IF THE RANGE OF ARGUMENTS:(P,T) IS PROPER*****
***** FOR F18PPL:CPPT, F77PPL:CVPT, F82PPL:AKPT AND F83PPL:WPT     *****
      IMPLICIT REAL(F)
      ILL=10000
      IF ((FP.LT.0.954E-08).OR.(FT.GT.1000.1E+01)) RETURN
      IF ((FP.GE.0.954E-08).AND.(FP.LE.0.20530E-07)) THEN
       FTMIN=-183.16
       FTMAX=301.86
      ELSE IF ((FP.GT.0.20530E-07).AND.(FP.LE.0.60789E-05)) THEN
       FTMIN=F40PPL(FP)
       FTMAX=301.86
      ELSE IF ((FP.GT.0.60789E-05).AND.(FP.LE.10.001E+01)) THEN
       FTMIN=-163.16
       FTMAX=301.86
      ELSE IF ((FP.GT.10.001E+01).AND.(FP.LE.342.43E+01)) THEN
       FTMIN=-163.16
       FTMAX=201.86
      ELSE IF ((FP.GT.342.43E+01).AND.(FP.LE.1000.1E+01)) THEN
       FTMIN=F69PPL(FP)*0.9999
       FTMAX=201.86
      END IF
      IF ((FT.GT.FTMIN).AND.(FT.LT.FTMAX)) THEN
       ILL=0
      END IF
      RETURN
      END
      SUBROUTINE S97PPL(FUN)
***   LEVEL 1 ERROR MESSAGE ***
      COMMON/UNIT/KPA,MESS
      CHARACTER FUN*6, MSG*125
      IF (MESS.NE.0) THEN
       MSG='****  NO CONVERGENCE AT '//FUN//' FOR PROPYLENE  ****'
       WRITE(6,1000) MSG
 1000  FORMAT(1H ,5X,A)
      END IF
      RETURN
      END
      SUBROUTINE S98PPL(IPT,P,T,N1,N2,FUN)
***   LEVEL 2 ERROR MESSAGE ***
      COMMON/UNIT/KPA,MESS
      CHARACTER FUN*6, N1*1,N2*1
      IF (MESS.NE.0) THEN
        IF (IPT.EQ.1) THEN
          WRITE(6,2010) FUN,P
        ELSE IF (IPT.EQ.2) THEN
          WRITE(6,2020) FUN,T
        ELSE
          WRITE(6,2030) FUN,N1,P,N2,T
        END IF
      END IF
 2010 FORMAT(1H ,5X,'****  OUT OF RANGE AT ',A6,' FOR PROPYLENE',
     -       ' WHEN P =', 1PE14.7,'  ****')
 2020 FORMAT(1H ,5X,'****  OUT OF RANGE AT ',A6,' FOR PROPYLENE',
     -       ' WHEN T =', 1PE14.7,'  ****')
 2030 FORMAT(1H ,5X,'****  OUT OF RANGE AT ',A6,' FOR PROPYLENE',
     -  ' WHEN  ',A1,' =',1PE14.7,' AND   ',A1,' =',1PE14.7,'  ****')
      RETURN
      END
      SUBROUTINE S99PPL(FUN)
***   LEVEL 3 ERROR MESSAGE ***
      COMMON/UNIT/KPA,MESS
      CHARACTER FUN*6, MSG*125
      IF (MESS.NE.0) THEN
       MSG='****  FUNCTION '//FUN//' UNAVAILABLE FOR PROPYLENE  ****'
       WRITE(6,3000) MSG
 3000  FORMAT(1H ,5X,A)
      END IF
      RETURN
      END
      REAL FUNCTION T90(T)
*     Conversion of temperature scal from IPTS-68 to ITS-90
*     Range -200C<=T68<=630C anf T68>=1064
      REAL T68,T0K
      REAL*8 CA(8)
      INTEGER KPA,MESS
      COMMON/UNIT/KPA,MESS
      DATA CA/-0.14542, -0.26722, 1.06471, 1.131286, -4.25835, 
     +        -1.59924,  7.29176, -3.52573/
      IF((KPA.EQ.1).OR.(KPA.EQ.3)) THEN
        T0K=0.0
      ELSE
        T0K=273.15
      END IF
      T68=T-T0K
* Check of argument range
      IF((-200.0.LE.T68).AND.(T68.LE.630.0)) THEN
        RT68=T68/630.0
        TEMP=T68+RT68*(CA(1)+RT68*(CA(2)+RT68*(CA(3)+RT68*(CA(4)
     +    +RT68*(CA(5)+RT68*(CA(6)+RT68*(CA(7)+RT68*CA(8))))))))
      ELSE IF((1064.0.LE.T68).AND.(T68.LE.3000.0)) THEN
        TEMP=T68-0.25*(T68+273.15)*(T68+273.15)/1337.33/1337.33
      ELSE
        IF(MESS.NE.0) WRITE(6,6020) T
 6020 FORMAT(1H ,5X,'****  OUT OF RANGE AT T90',
     &  ' WHEN  T68 =',1PE14.7,'  ****')
        T90=-1.0E+20
        RETURN
      END IF
      T90=TEMP+T0K
      RETURN
      END
      REAL FUNCTION T68(T)
*     Conversion of temperature scal from ITS-90 to IPTS-68
*     Range -200C<=T68<=630C anf T68>=1064
      T1=T90(T)
      T2=T
      ITER=0
      DT=T-T1
 1000 CONTINUE
      ITER=ITER+1
      IF(ITER.GE.10000) THEN
         WRITE(6,*) ' ITERATION EXCEEDED MAXIMUM '
         T68=-1.0E+10
         RETURN
      END IF
      T2=T2+DT
      T1=T90(T2)
      DT=T-T1
      IF(ABS(DT).GE.1.0E-4) GOTO 1000
      T68=T2
      RETURN
      END
* Subroutine Program Specifying KPA and MESS 
* MS-FORTRAN and MS-C Mixed Langage Programing
* 
      SUBROUTINE KPAMES(KPAC,MESSC)
      COMMON/UNIT/KPA,MESS
      INTEGER KPAC
      INTEGER MESSC
      KPA=KPAC
      MESS=MESSC
      RETURN
      END