C ***************************************** C * I-PROPATH VERSION 1.3 C * FOR PROPATH VERSION 10.2 C ***************************************** C * CODED BY C * TOMOHIRO HONDA C * FUKUOKA UNIVERSITY C * FUKUAOKA 814-80, JAPAN C ***************************************** C * January, 1998 C ***************************************** C * KPA Pressure Temperature C * 0 Pa K C * 1 bar C C * 2 bar K C * 3 Pa C C * others Pa K C ***************************************** C * C ***************************************** C * KMOL = 0 ---> per kmol C * = others ---> per kg C ***************************************** C C modified by R. Akasaka, May 7, 2001 C - return value of IDENTI: 10.1 -> 12.1 C C ***** C * SUBROUTINES FOR I-PROPATH USERS C ***** C *** INITIALIZING SUBROUTINE SUBROUTINE IPINIT(K1,K2,K3,KGAS,GASC) INTEGER K1,K2,K3,KGAS,KPA,KMOL,MESS REAL GASC,GASCON,GAS0 COMMON /UNIT/KPA,KMOL,MESS COMMON /CNST/GASCON DATA GAS0/8.31451E+03/ IF (K1 .NE. 0) THEN KPA=K1 ELSE KPA=0 ENDIF IF (K2 .NE. 0) THEN KMOL=K2 ELSE KMOL=0 ENDIF IF (K3 .NE. 0) THEN MESS=K3 ELSE MESS=0 ENDIF IF (KGAS .NE. 0 .AND. 1 ABS(GASC/GAS0-1.0E+00) .LT. 1.0E-04) 1 THEN GASCON=GASC ELSE GASCON=GAS0 ENDIF RETURN END C ***** SUBROUTINE MIXCMM(IERR,ITRNS,ISUBNO,ISUB,X,Y) INTEGER IERR,ITRNS,ISUBNO,ISUB(1:ISUBNO) REAL X(1:ISUBNO),Y(1:ISUBNO) IF (ITRNS .EQ. 0) THEN CALL SIP004(IERR,ITRNS,ISUBNO,ISUB,X,Y) ELSE CALL SIP004(IERR,ITRNS,ISUBNO,ISUB,Y,X) ENDIF IF (IERR .EQ. -3) THEN DO 90 J=1,ISUBNO,1 IF (ITRNS .EQ. 0) THEN Y(J)=-1.0E+30 ELSE X(J)=-1.0E+30 ENDIF 90 CONTINUE ENDIF RETURN END C ***** SUBROUTINE IDGCMM(IERR,ITRNS,ISUB,X,Y) INTEGER IERR,ITRNS,ISUB REAL X,Y IF (ITRNS .EQ. 0) THEN CALL SIP003(IERR,ITRNS,ISUB,X,Y) ELSE CALL SIP003(IERR,ITRNS,ISUB,Y,X) ENDIF IF (IERR .EQ. -3) THEN IF (ITRNS .EQ. 0) THEN Y=-1.0E+30 ELSE X=-1.0E+30 ENDIF ENDIF RETURN END C ***** SUBROUTINE IDGFND(IERR,ISUB,C,ANAME) INTEGER IERR,ISUB,KPA,KMOL REAL C(1:10) REAL TC,PBAR CHARACTER*25 ANAME COMMON /UNIT/KPA,KMOL,MESS CALL SIP001(IERR,ISUB,C,ANAME) IF (IERR .EQ. 0) THEN IF (KPA .EQ. 1 .OR. KPA .EQ. 3) THEN TC=273.15 C(2)=C(2)-TC C(8)=C(8)-TC C(9)=C(9)-TC ENDIF IF (KPA .EQ. 1 .OR. KPA .EQ. 2) THEN PBAR=1.0E+05 C(3)=C(3)/PBAR ENDIF IF (KMOL .EQ. 1) THEN AMM=C(1) DO 10 J=4,7,1 C(J)=C(J)/AMM 10 CONTINUE ENDIF ENDIF RETURN END C *** IDEAL GAS AT PREF=0.1 MPA SUBROUTINE IDGT(IERR,ISUB,TI,A,ANAME) INTEGER IERR,ISUB,KPA,KMOL REAL TI,A(1:4),A02(1:3),T,TLH(1:2) REAL C(1:10) CHARACTER*25 ANAME COMMON /UNIT/KPA,KMOL,MESS COMMON /CNST/GASCON CALL SIP001(IERR,ISUB,C,ANAME) IF (IERR .EQ. -3) THEN DO 10 I=1,4,1 A(I)=-1.0E+30 10 CONTINUE ELSE T=FIPG99(TI) CALL SIP002(IERR,ISUB,T,A02,TLH) A(1)=A02(1) A(2)=A02(2) A(3)=A02(2)-A02(3)/T A(4)=A02(3) IF (KMOL .EQ. 1) THEN AMM=C(1) DO 20 J=1,4,1 A(J)=A(J)/AMM 20 CONTINUE ENDIF ENDIF IF (IERR .EQ. -2) THEN CALL SIP992('IDGT ',ANAME) ENDIF RETURN END C *** AIR PROPERTIES AT T [K/C] AND P[PA/BAR] SUBROUTINE AIRTP(IERR,AMM,TI,PI,V,CP,CV,W,U,H,S) INTEGER IERR,KPA,KMOL,MESS,J INTEGER ISUBNO,ISUB(1:3) REAL AMM,TI,PI,A(1:4),T,P REAL AM(1:3) REAL V,CP,CV,W,U,H,S CHARACTER*25 ANAME COMMON /UNIT/KPA,KMOL,MESS COMMON /CNST/GASCON DATA ISUBNO/3/ DATA ISUB(1),ISUB(2),ISUB(3)/1,7,23/ DATA AM(1),AM(2),AM(3)/0.7803,0.2099,0.0098/ ANAME='AIR' IF (PI .LE. 0) THEN IERR=-2 GOTO 9 ENDIF T=FIPG99(TI) P=FIPG98(PI) CALL SIP005(IERR,ISUBNO,ISUB,AM,AMM,T,P,A) 9 IF (IERR .EQ. -2) THEN CALL SIP992('AIRTP ',ANAME) DO 5 J=1,4,1 A(J)=-1.0E+20 5 CONTINUE V=-1.0E+20 CV=-1.0E+20 W=-1.0E+20 ELSE V=GASCON*T/P CP=A(1) CV=CP-GASCON W=SQRT(CP/CV*GASCON/AMM*T) IF (IERR .EQ. 0 .AND. KMOL .EQ. 1) THEN DO 10 J=1,4,1 A(J)=A(J)/AMM 10 CONTINUE V=V/AMM CV=CV/AMM ENDIF ENDIF CP=A(1) U=A(2) H=A(3) S=A(4) RETURN END C ***** IDEAL GAS PROPERTIES AT T AND P SUBROUTINE IDGTP(IERR,ISUB,TI,PI,V,CP,CV,WS,U,H,S,ANAME) INTEGER IERR,ISUB,KPA,KMOL REAL TI,PI,A(1:6),T,P,TLH(1:2),A02(1:3) REAL C(1:10) REAL CP,CV,WS,U,H,S CHARACTER*25 ANAME COMMON /UNIT/KPA,KMOL,MESS COMMON /CNST/GASCON CALL SIP001(IERR,ISUB,C,ANAME) IF (IERR .EQ. -3) THEN DO 10 I=1,6,1 A(I)=-1.0E+30 10 CONTINUE WS=-1.0E+30 ELSEIF (PI .LE. 0) THEN IERR=-2 CALL SIP992('IDGTP ',ANAME) DO 15 I=1,6,1 A(I)=-1.0E+20 15 CONTINUE WS=-1.0E+20 ELSE PREF=1.0E+05 P=FIPG98(PI) T=FIPG99(TI) CALL SIP002(IERR,ISUB,T,A02,TLH) IF (IERR .EQ. -2) THEN CALL SIP992('IDGTP ',ANAME) DO 20 I=1,6,1 A(I)=-1.0E+20 20 CONTINUE WS=-1.0E+20 ELSE A(2)=A02(2)-GASCON*LOG(P/PREF) A(3)=A02(3)-GASCON*T A(4)=A02(3) A(5)=GASCON*T/P A(1)=A02(1) A(6)=A(1)-GASCON WS=SQRT(A(1)/A(6)*GASCON/C(1)*T) IF (KMOL .EQ. 1) THEN AMM=C(1) DO 30 J=1,6,1 A(J)=A(J)/AMM 30 CONTINUE ENDIF ENDIF ENDIF CP=A(1) U=A(3) H=A(4) S=A(2) V=A(5) CV=A(6) RETURN END C *** MIXTURE PROPERTIES AT T AND P SUBROUTINE MIXTP(IERR,ISUBNO,ISUB,AM,AMM,TI,PI,V,CP,CV,W,U,H,S) INTEGER IERR,ISUBNO,ISUB(1:ISUBNO),KPA,KMOL REAL AM(1:ISUBNO),AMM,TI,PI,A(1:4) REAL T,P REAL CP,U,H,S CHARACTER*25 ANAME COMMON /UNIT/KPA,KMOL,MESS COMMON /CNST/GASCON ANAME='MIXTURE' IF (PI .LE. 0) THEN IERR=-2 GOTO 9 ENDIF T=FIPG99(TI) P=FIPG98(PI) CALL SIP005(IERR,ISUBNO,ISUB,AM,AMM,T,P,A) 9 IF (IERR .EQ. -2) THEN CALL SIP992('MIXTP ',ANAME) DO 5 J=1,4,1 A(J)=-1.0E+20 5 CONTINUE V=-1.0E+20 CV=-1.0E+20 W=-1.0E+20 ELSE V=GASCON*T/P CV=A(1)-GASCON W=SQRT(CP/CV*GASCON/AMM*T) IF (IERR .EQ. 0 .AND. KMOL .EQ. 1) THEN DO 10 J=1,4,1 A(J)=A(J)/AMM 10 CONTINUE V=V/AMM CV=CV/AMM ENDIF ENDIF CP=A(1) U=A(2) H=A(3) S=A(4) RETURN END C *** VALUES OF COMBUSTION PRODUCT FOR GAS TABLES C * C_XC H_XH O_XO + AIR SUBROUTINE CHOTBL(IERR,XC,XH,XO,EXCESS,AMM,TI,HH,PR,UU,VR,S0) INTEGER IERR,KPA,KMOL INTEGER ISUBNO,ISUB(1:5) CHARACTER*25 ANAME REAL AMM,TI,A(1:4),AR(1:4),T,PREF REAL AK(1:6) REAL AM(1:5),AM0(1:5) REAL EXCESS,HH,PR,UU,VR,S0 COMMON /UNIT/KPA,KMOL,MESS COMMON /CNST/GASCON DATA ISUBNO/5/ DATA ISUB/1,7,23,9,2/ DATA AM0/0.7803,0.2099,0.0098, 1 0.0,0.0/ ANAME='CxHyOz COMBUSTION PRODUCT' IF (EXCESS .LT. 1) THEN IERR=-2 GOTO 9 ENDIF DO 2 I=1,5,1 AM(I)=AM0(I) 2 CONTINUE XXO=XC+XH/4-XO/2 C : CO2 AM(4)=XC*AM(2) C : H2O AM(5)=XH*AM(2)/2 C : N2 AM(1)=EXCESS*XXO*AM(1) C : O2 AM(2)=(EXCESS-1.0)*XXO*AM(2) C : AR AM(3)=EXCESS*XXO*AM(3) TMOL=AM(1)+AM(2)+AM(3)+AM(4)+AM(5) DO 5 I=1,5,1 AM(I)=AM(I)/TMOL 5 CONTINUE PREF=1.0E+05 TREF=298.15 T=FIPG99(TI) CALL SIP005(IERR,ISUBNO,ISUB,AM,AMM,T,PREF,A) 9 IF (IERR .EQ. -2) THEN CALL SIP992('CHOTBL',ANAME) IERR=-2 DO 20 J=1,6,1 AK(J)=-1.0E+20 20 CONTINUE ELSE CALL SIP005(IERR,ISUBNO,ISUB,AM,AMM,TREF,PREF,AR) AK(1)=A(3)-AR(3) AK(2)=EXP((A(4)-AR(4))/GASCON) AK(3)=AK(1)-GASCON*T AK(4)=GASCON*T/AK(2)*1.0E-06 AK(5)=A(4) AK(6)=AMM IF(KMOL .EQ. 1) THEN AK(1)=AK(1)/AMM AK(3)=AK(3)/AMM AK(5)=AK(5)/AMM ENDIF ENDIF AMM=AK(6) HH=AK(1) PR=AK(2) UU=AK(3) VR=AK(4) S0=AK(5) RETURN END C *** VALUES OF COMBUSTION PRODUCT FOR GAS TABLES C * C_1+H_2 SUBROUTINE CH2TBL(IERR,EXCESS,AMM,TI,HH,PR,UU,VR,S0) INTEGER IERR,KPA,KMOL INTEGER ISUBNO,ISUB(1:5) REAL AMM,TI,A(1:4),AR(1:4),T,PREF REAL AK(1:6) REAL AM(1:5),AM0(1:5) REAL EXCESS,HH,PR,UU,VR,S0 CHARACTER*25 ANAME COMMON /UNIT/KPA,KMOL,MESS COMMON /CNST/GASCON DATA ISUBNO/5/ DATA ISUB/1,7,23,9,2/ DATA AM0/0.7803,0.2099,0.0098, 1 0.0,0.0/ ANAME='(CH2)n COMBUSTION PRODUCT' IF (EXCESS .LT. 1) THEN IERR=-2 GOTO 9 ENDIF DO 2 I=1,5,1 AM(I)=AM0(I) 2 CONTINUE C : CO2 AM(4)=2*AM(2)/3 C : H2O AM(5)=2*AM(2)/3 C : N2 AM(1)=EXCESS*AM(1) C : O2 AM(2)=(EXCESS-1.0)*AM(2) C : AR AM(3)=EXCESS*AM(3) TMOL=AM(1)+AM(2)+AM(3)+AM(4)+AM(5) DO 5 I=1,5,1 AM(I)=AM(I)/TMOL 5 CONTINUE PREF=1.0E+05 TREF=298.15 T=FIPG99(TI) CALL SIP005(IERR,ISUBNO,ISUB,AM,AMM,T,PREF,A) 9 IF (IERR .EQ. -2) THEN IERR=-2 CALL SIP992('CH2TBL',ANAME) DO 20 J=1,6,1 AK(J)=-1.0E+20 20 CONTINUE ELSE CALL SIP005(IERR,ISUBNO,ISUB,AM,AMM,TREF,PREF,AR) AK(1)=A(3)-AR(3) AK(2)=EXP((A(4)-AR(4))/GASCON) AK(3)=AK(1)-GASCON*T AK(4)=GASCON*T/AK(2)*1.0E-06 AK(5)=A(4) AK(6)=AMM IF(KMOL .EQ. 1) THEN AK(1)=AK(1)/AMM AK(3)=AK(3)/AMM AK(5)=AK(5)/AMM ENDIF ENDIF AMM=AK(6) HH=AK(1) PR=AK(2) UU=AK(3) VR=AK(4) S0=AK(5) RETURN END C *** VALUES OF IDEAL GAS FOR GAS TABLE SUBROUTINE IDGTBL(IERR,ISUB,TI,HB,PR,UB,VR,FAI) INTEGER IERR,KPA,KMOL,MESS REAL AMM,TI,T,C(1:10),AG(1:3),AGR(1:3),TLH(1:2) REAL AK(1:5) REAL HB,PR,UB,VR,FAI CHARACTER*25 ANAME COMMON /UNIT/KPA,KMOL,MESS COMMON /CNST/GASCON CALL SIP001(IERR,ISUB,C,ANAME) IF (IERR .EQ. -3) THEN DO 1 I=1,5,1 AK(I)=-1.0E-30 1 CONTINUE ELSE T=FIPG99(TI) TREF=298.15 CALL SIP002(IERR,ISUB,T,AG,TLH) IF (IERR .EQ. -2) THEN CALL SIP992('IDGTBL',ANAME) DO 2 I=1,5,1 AK(I)=-1.0E-20 2 CONTINUE ELSE AMM=C(1) CALL SIP002(IERR,ISUB,TREF,AGR,TLH) AK(1)=AG(3)-AGR(3) AK(3)=AK(1)-GASCON*T AK(5)=AG(2)-AGR(2) AK(2)=EXP(AK(5)/GASCON) AK(5)=AK(5)+AGR(2) AK(4)=GASCON*T/AK(2)*1.0E-6 IF(KMOL .EQ. 1) THEN AK(1)=AK(1)/AMM AK(3)=AK(3)/AMM AK(5)=AK(5)/AMM ENDIF ENDIF ENDIF HB=AK(1) PR=AK(2) UB=AK(3) VR=AK(4) FAI=AK(5) RETURN END C ***** C * FUNCTIONS FOR I-PROPATH USERS C ***** C * IDENTIFY IPROPATH VERSION OR SUBSTANCE CHARACTER*25 FUNCTION IDENTI(ISUB,A) CHARACTER*1 A INTEGER ISUB,IP CHARACTER*25 ANAME IF (A .EQ. 'S') THEN CALL SIP000(ISUB,IP,ANAME) IDENTI=ANAME ELSE IDENTI='I-PROPATH VERSION 12.1' ENDIF RETURN END C *** REAL FUNCTION AKM2KG(ISUB,Z) INTEGER IERR,ISUB REAL Z,YKG CALL SIP003(IERR,0,ISUB,Z,YKG) AKM2KG=YKG RETURN END C *** REAL FUNCTION AKG2KM(ISUB,Z) INTEGER IERR,ISUB REAL Z,XKMOL CALL SIP003(IERR,1,ISUB,XKMOL,Z) AKG2KM=XKMOL RETURN END C *** P(T,S) FOR AIR REAL FUNCTION PTSAIR(TI,SS) REAL TI,SS,T CHARACTER*25 ANAME INTEGER IERR,KPA,KMOL,MESS COMMON /UNIT/KPA,KMOL,MESS COMMON /CNST/GASCON ANAME='AIR' PREF=1.0E+05 T=FIPG99(TI) KPA1=KPA KMOL1=KMOL KPA=0 KMOL=0 IF (T .LT. 100 .OR. T .GT. 1500) THEN PTSAIR=-1.0E+20 CALL SIP992('PTSAIR',ANAME) ELSE CALL AIRTP(IERR,AMM,T,PREF,V,CP,CV,W,U,H,SR) IF (KMOL1 .EQ. 1) THEN S=SS*AMM ELSE S=SS ENDIF P=PREF*EXP((SR-S)/GASCON) IF (KPA1 .EQ. 1 .OR. KPA1 .EQ. 2) THEN PTSAIR=P/1.0E+05 ELSE PTSAIR=P ENDIF ENDIF KPA=KPA1 KMOL=KMOL1 RETURN END C *** P(T,S) FOR AN IDEAL GAS REAL FUNCTION PTSIDG(ISUB,TI,SS) INTEGER IERR,ISUB,KPA,KMOL REAL A(1:3),TLH(1:2),C(1:10) REAL TI,T,SS,S CHARACTER*25 ANAME COMMON /UNIT/KPA,KMOL,MESS COMMON /CNST/GASCON CALL SIP001(IERR,ISUB,C,ANAME) IF (IERR .EQ. -3) THEN PTSIDG=-1.0E+30 ELSE T=FIPG99(TI) IF (T .LT. C(8) .OR. T .GT. C(9)) THEN PTSIDG=-1.0E+20 CALL SIP992('PTSIDG',ANAME) ELSE IF (KMOL .EQ. 1) THEN S=SS*C(1) ELSE S=SS ENDIF CALL SIP002(IERR,ISUB,T,A,TLH) P=1.0E+05*EXP((A(2)-S)/GASCON) IF (KPA .EQ. 1 .OR. KPA .EQ. 2) THEN PTSIDG=P/1.0E+05 ELSE PTSIDG=P ENDIF ENDIF ENDIF RETURN END C *** P(T,V) FOR AIR REAL FUNCTION PTVAIR(TI,VV) INTEGER IERR,KPA,KMOL REAL TI,T,VV,V,P CHARACTER*25 ANAME COMMON /UNIT/KPA,KMOL,MESS COMMON /CNST/GASCON ANAME='AIR' T=FIPG99(TI) IF (T .LT. 100 .OR. T .GT. 1500) THEN PTVAIR=-1.0E+20 CALL SIP992('PTVAIR',ANAME) ELSE KPA1=KPA KMOL1=KMOL KPA=0 KMOL=0 PREF=1.0E+05 CALL AIRTP(IERR,AMM,T,PREF,V,CP,CV,W,U,H,S) KPA=KPA1 KMOL=KMOL1 IF (KMOL .EQ. 1) THEN V=VV*AMM ELSE V=VV ENDIF P=GASCON*T/V IF (KPA .EQ. 1 .OR. KPA .EQ. 2) THEN PTVAIR=P/1.0E+05 ELSE PTVAIR=P ENDIF ENDIF RETURN END C *** P(T,V) FOR AN IDEAL GAS REAL FUNCTION PTVIDG(ISUB,TI,VV) INTEGER IERR,ISUB,KPA,KMOL REAL C(1:10) REAL TI,T,VV,V,P CHARACTER*25 ANAME COMMON /UNIT/KPA,KMOL,MESS COMMON /CNST/GASCON CALL SIP001(IERR,ISUB,C,ANAME) IF (IERR .EQ. -3) THEN PTVIDG=-1.0E+30 ELSE T=FIPG99(TI) IF (T .LT. C(8) .OR. T .GT. C(9)) THEN PTVIDG=-1.0E+20 CALL SIP992('PTVIDG',ANAME) ELSE IF (KMOL .EQ. 1) THEN V=VV*C(1) ELSE V=VV ENDIF P=GASCON*T/V IF (KPA .EQ. 1 .OR. KPA .EQ. 2) THEN PTVIDG=P/1.0E+05 ELSE PTVIDG=P ENDIF ENDIF ENDIF RETURN END C *** T(H) FOR AIR REAL FUNCTION THAIR(HH) INTEGER IERR,KPA,KMOL,MESS REAL HH,H,H1,H2,HM,T1,T2,TM CHARACTER*25 ANAME COMMON /UNIT/KPA,KMOL,MESS COMMON /CNST/GASCON ANAME='AIR' KPA1=KPA KMOL1=KMOL KPA=0 KMOL=0 PREF=1.0E+05 T1=100.0 T2=1500.0 CALL AIRTP(IERR,AMM,T1,PREF,V1,CP1,CV1,W1,U1,H1,S1) CALL AIRTP(IERR,AMM,T2,PREF,V2,CP2,CV2,W2,U2,H2,S2) IF (KMOL1 .EQ. 1) THEN H=HH*AMM ELSE H=HH ENDIF IF ((H-H1)*(H-H2) .GT. 0.0) THEN THAIR=-1.0E+20 CALL SIP992('THAIR ',ANAME) ELSE 20 TM=(T1+T2)/2 IF (ABS(T1-T2) .GT. 1.0E-03) THEN CALL AIRTP(IERR,AMM,T1,PREF,V1,CP1,CV1,W1,U1,H1,S1) CALL AIRTP(IERR,AMM,T2,PREF,V2,CP2,CV2,W2,U2,H2,S2) CALL AIRTP(IERR,AMM,TM,PREF,VM,CPM,CVM,WM,UM,HM,SM) IF ( (H-HM)*(H-H1) .LE. 0.0) THEN T1=T1 T2=TM ELSEIF ((H-HM)*(H-H2) .LE. 0.0) THEN T1=TM T2=T2 ENDIF GOTO 20 ELSE IF (KPA1 .EQ. 1 .OR. KPA1 .EQ. 3) THEN THAIR=TM-273.15 ELSE THAIR=TM ENDIF ENDIF ENDIF KPA=KPA1 KMOL=KMOL1 RETURN END C *** T(H) FOR AN IDEAL GAS REAL FUNCTION THIDG(ISUB,HH) INTEGER IERR,ISUB,KPA,KMOL REAL HH,H,H1,H2,HM,T1,T2,TM REAL A(1:3),TLH(1:2) REAL C(1:10) CHARACTER*25 ANAME COMMON /UNIT/KPA,KMOL,MESS COMMON /CNST/GASCON CALL SIP001(IERR,ISUB,C,ANAME) IF (IERR .EQ. -3) THEN THIDG=-1.0E+30 ELSE IF (KMOL .EQ. 1) THEN H=HH*C(1) ELSE H=HH ENDIF T1=C(8) T2=C(9) CALL SIP002(IERR,ISUB,T1,A,TLH) H1=A(3) CALL SIP002(IERR,ISUB,T2,A,TLH) H2=A(3) IF ( (H-H1)*(H-H2) .GT. 0) THEN THIDG=-1.0E+20 CALL SIP992('THIDG ',ANAME) ELSE 20 TM=(T1+T2)/2 IF (ABS(T1-T2) .GT. 1.0E-03) THEN CALL SIP002(IERR,ISUB,T1,A,TLH) H1=A(3) CALL SIP002(IERR,ISUB,T2,A,TLH) H2=A(3) CALL SIP002(IERR,ISUB,TM,A,TLH) HM=A(3) IF ( (H-HM)*(H-H1) .LE. 0.0) THEN T1=T1 T2=TM ELSEIF ((H-HM)*(H-H2) .LE. 0.0) THEN T1=TM T2=T2 ENDIF GOTO 20 ELSE IF (KPA .EQ. 1 .OR. KPA .EQ. 3) THEN THIDG=TM-273.15 ELSE THIDG=TM ENDIF ENDIF ENDIF ENDIF RETURN END C *** T(P,S) FOR AIR REAL FUNCTION TPSAIR(PI,SS) REAL PI,SS REAL T1,T2,TM CHARACTER*25 ANAME INTEGER IERR,KPA,KMOL COMMON /UNIT/KPA,KMOL,MESS ANAME='AIR' IF (PI .LE. 0) THEN TPSAIR=-1.0E+20 CALL SIP992('TPSAIR',ANAME) RETURN ENDIF P=FIPG98(PI) KPA1=KPA KMOL1=KMOL KPA=0 KMOL=0 T1=100.0 T2=1500.0 CALL AIRTP(IERR,AMM,T1,P,V1,CP1,CV1,W1,U1,H1,S1) CALL AIRTP(IERR,AMM,T2,P,V2,CP2,CV2,W2,U2,H2,S2) IF (KMOL1 .EQ. 1) THEN S=SS*AMM ELSE S=SS ENDIF IF ((S-S1)*(S-S2) .GT. 0.0) THEN TPSAIR=-1.0E+20 CALL SIP992('TPSAIR',ANAME) ELSE 20 TM=(T1+T2)/2 CALL AIRTP(IERR,AMM,TM,P,VM,CPM,CVM,WM,UM,HM,SM) IF (ABS((S-SM)/S) .GT. 1.0E-06) THEN CALL AIRTP(IERR,AMM,T1,P,V1,CP1,CV1,W1,U1,H1,S1) CALL AIRTP(IERR,AMM,T2,P,V2,CP2,CV2,W2,U2,H2,S2) IF ((S-SM)*(S-S1) .LE. 0.0) THEN T1=T1 T2=TM ELSEIF ((S-SM)*(S-S2) .LT. 0.0) THEN T1=TM T2=T2 ENDIF GOTO 20 ELSE IF (KPA1 .EQ. 1 .OR. KPA1 .EQ. 3) THEN TPSAIR=TM-273.15 ELSE TPSAIR=TM ENDIF ENDIF ENDIF KPA=KPA1 KMOL=KMOL1 RETURN END C *** T(P,S) FOR AN IDEAL GAS REAL FUNCTION TPSIDG(ISUB,PI,SS) INTEGER IERR,ISUB,KPA,KMOL REAL A(1:3),TLH(1:2) REAL C(1:10),T1,T2 CHARACTER*25 ANAME COMMON /UNIT/KPA,KMOL,MESS COMMON /CNST/GASCON CALL SIP001(IERR,ISUB,C,ANAME) IF (IERR .EQ. -3) THEN TPSIDG=-1.0E+30 ELSEIF (PI .LE. 0) THEN TPSIDG=-1.0E+20 CALL SIP992('TPSIDG',ANAME) ELSE P=FIPG98(PI) IF (KMOL .EQ. 1) THEN S=SS*C(1) ELSE S=SS ENDIF FAI=S+GASCON*LOG(P/1.0E+05) T1=C(8) T2=C(9) CALL SIP002(IERR,ISUB,T1,A,TLH) FAI1=A(2) CALL SIP002(IERR,ISUB,T2,A,TLH) FAI2=A(2) IF ( (FAI-FAI1)*(FAI-FAI2) .GT. 0) THEN TPSIDG=-1.0E+20 CALL SIP992('TPSIDG',ANAME) ELSE 20 TM=(T1+T2)/2 IF (ABS(T1-T2) .GT. 1.0E-03) THEN CALL SIP002(IERR,ISUB,T1,A,TLH) FAI1=A(2) CALL SIP002(IERR,ISUB,T2,A,TLH) FAI2=A(2) CALL SIP002(IERR,ISUB,TM,A,TLH) FAIM=A(2) IF ( (FAI-FAIM)*(FAI-FAI1) .LE. 0.0) THEN T1=T1 T2=TM ELSEIF ((FAI-FAIM)*(FAI-FAI2) .LE. 0.0) THEN T1=TM T2=T2 ENDIF GOTO 20 ELSE IF (KPA .EQ. 1 .OR. KPA .EQ. 3) THEN TPSIDG=TM-273.15 ELSE TPSIDG=TM ENDIF ENDIF ENDIF ENDIF RETURN END C *** T(P,V) FOR AIR REAL FUNCTION TPVAIR(PI,VV) INTEGER IERR,KPA,KMOL REAL PI,P,VV,V,T,T1,T2 CHARACTER*25 ANAME COMMON /UNIT/KPA,KMOL,MESS COMMON /CNST/GASCON ANAME='AIR' P=FIPG98(PI) KPA1=KPA KMOL1=KMOL KPA=0 KMOL=0 IF (PI .LE. 0) THEN TPVAIR=-1.0E+20 CALL SIP992('TPVAIR',ANAME) RETURN ENDIF TREF=298.15 CALL AIRTP(IERR,AMM,TREF,P,V1,CP1,CV1,W1,U1,H1,S1) IF (KMOL1 .EQ. 1) THEN V=VV*AMM ELSE V=VV ENDIF T=P*V/GASCON T1=100 T2=1500 IF (T .LT. T1 .OR. T .GT. T2) THEN TPVAIR=-1.0E+20 CALL SIP992('TPVAIR',ANAME) ELSE IF (KPA1 .EQ. 1 .OR. KPA1 .EQ. 3) THEN TPVAIR=T-273.15 ELSE TPVAIR=T ENDIF ENDIF KPA=KPA1 KMOL=KMOL1 RETURN END C *** T(P,V) FOR AN IDEAL GAS REAL FUNCTION TPVIDG(ISUB,PI,VV) INTEGER IERR,ISUB,KPA,KMOL REAL PI,P,VV,V,T,T1,T2 REAL C(1:10) CHARACTER*25 ANAME COMMON /UNIT/KPA,KMOL,MESS COMMON /CNST/GASCON CALL SIP001(IERR,ISUB,C,ANAME) IF (IERR .EQ. -3) THEN TPVIDG=-1.0E+30 ELSEIF (PI .LE. 0) THEN TPVIDG=-1.0E+20 CALL SIP992('TPVIDG',ANAME) ELSE P=FIPG98(PI) IF (KMOL .EQ. 1) THEN V=VV*C(1) ELSE V=VV ENDIF T=P*V/GASCON T1=C(8) T2=C(9) IF (T .LT. T1 .OR. T .GT. T2) THEN TPVIDG=-1.0E+20 CALL SIP992('TPVIDG',ANAME) ELSE IF (KPA .EQ. 1 .OR. KPA .EQ. 3) THEN TPVIDG=T-273.15 ELSE TPVIDG=T ENDIF ENDIF ENDIF RETURN END C *** T(V,S) FOR AIR REAL FUNCTION TVSAIR(VV,SS) REAL VV,SS INTEGER KPA,KMOL,MESS REAL TREF,PREF CHARACTER*25 ANAME COMMON /UNIT/KPA,KMOL,MESS COMMON /CNST/GASCON KPA1=KPA KMOL1=KMOL KPA=0 KMOL=0 PREF=1.0E+05 TREF=298.15 CALL AIRTP(IERR,AMM,TREF,PREF,V1,CP1,CV1,W1,U1,H1,S1) IF (KMOL1 .NE. 0) THEN V=VV*AMM S=SS*AMM ELSE V=VV S=SS ENDIF T1=100.0 P1=GASCON*T1/V T2=1500.0 P2=GASCON*T2/V CALL AIRTP(IERR,AMM,T1,P1,V1,CP1,CV1,W1,U1,H1,S1) CALL AIRTP(IERR,AMM,T2,P2,V2,CP2,CV2,W2,U2,H2,S2) IF ((S-S1)*(S-S2) .GT. 0.0) THEN TVSAIR=-1.0E+20 CALL SIP992('TVSAIR',ANAME) ELSE 20 TM=(T1+T2)/2 PM=GASCON*TM/V CALL AIRTP(IERR,AMM,TM,PM,VM,CPM,CVM,WM,UM,HM,SM) IF (ABS((S-SM)/S) .GT. 1.0E-06) THEN CALL AIRTP(IERR,AMM,T1,P1,V1,CP1,CV1,W1,U1,H1,S1) CALL AIRTP(IERR,AMM,T2,P2,V2,CP2,CV2,W2,U2,H2,S2) IF ((S-SM)*(S-S1) .LE. 0.0) THEN T1=T1 T2=TM P1=GASCON*T1/V P2=GASCON*T2/V ELSEIF ((S-SM)*(S-S2) .LT. 0.0) THEN T1=TM T2=T2 P1=GASCON*T1/V P2=GASCON*T2/V ENDIF GOTO 20 ELSE IF (KPA1 .EQ. 1 .OR. KPA1 .EQ. 3) THEN TVSAIR=TM-273.15 ELSE TVSAIR=TM ENDIF ENDIF ENDIF KPA=KPA1 KMOL=KMOL1 RETURN END C *** T(V,S) FOR AN IDEAL GAS REAL FUNCTION TVSIDG(ISUB,VV,SS) INTEGER IERR,ISUB,KPA,KMOL REAL C(1:10),A(1:3),TLH(1:2) REAL V,S,T1,T2,TM,S1,S2,SM CHARACTER*25 ANAME COMMON /UNIT/KPA,KMOL,MESS COMMON /CNST/GASCON CALL SIP001(IERR,ISUB,C,ANAME) IF (IERR .EQ. -3) THEN TVSIDG=-1.0E+30 ELSE IF (KMOL .EQ. 1) THEN V=VV*C(1) S=SS*C(1) ELSE V=VV S=SS ENDIF T1=C(8) T2=C(9) CALL SIP002(IERR,ISUB,T1,A,TLH) S1=A(2)-GASCON*LOG(GASCON*T1/V/1.0E+05) CALL SIP002(IERR,ISUB,T2,A,TLH) S2=A(2)-GASCON*LOG(GASCON*T2/V/1.0E+05) IF ( (S-S1)*(S-S2) .GT. 0) THEN TVSIDG=-1.0E+20 CALL SIP992('TVSIDG',ANAME) ELSE ILOOP=0 20 ILOOP=ILOOP+1 IF (ILOOP .GT. 1001) THEN TVSIDG=-1.0E+10 CALL SIP991('TVSIDG') ELSE TM=(T1+T2)/2 IF (ABS(T1-T2) .GT. 1.0E-03) THEN CALL SIP002(IERR,ISUB,T1,A,TLH) S1=A(2)-GASCON*LOG(GASCON*T1/V/1.0E+05) CALL SIP002(IERR,ISUB,T2,A,TLH) S2=A(2)-GASCON*LOG(GASCON*T2/V/1.0E+05) CALL SIP002(IERR,ISUB,TM,A,TLH) SM=A(2)-GASCON*LOG(GASCON*TM/V/1.0E+05) IF ( (S-SM)*(S-S1) .LE. 0.0) THEN T1=T1 T2=TM ELSEIF ((S-SM)*(S-S2) .LE. 0.0) THEN T1=TM T2=T2 ENDIF GOTO 20 ELSE IF (KPA .EQ. 1 .OR. KPA .EQ. 3) THEN TVSIDG=TM-273.15 ELSE TVSIDG=TM ENDIF ENDIF ENDIF ENDIF ENDIF RETURN END C *** T(U) FOR AIR REAL FUNCTION TUAIR(UU) INTEGER IERR,KPA,KMOL,MESS REAL UU,U,U1,U2,UM,T1,T2,TM CHARACTER*25 ANAME COMMON /UNIT/KPA,KMOL,MESS COMMON /CNST/GASCON ANAME='AIR' KPA1=KPA KMOL1=KMOL KPA=0 KMOL=0 PREF=1.0E+05 T1=100.0 T2=1500.0 CALL AIRTP(IERR,AMM,T1,PREF,V1,CP1,CV1,W1,U1,H1,S1) CALL AIRTP(IERR,AMM,T2,PREF,V2,CP2,CV2,W2,U2,H2,S2) IF (KMOL1 .EQ. 1) THEN U=UU*AMM ELSE U=UU ENDIF IF ((U-U1)*(U-U2) .GT. 0.0) THEN THAIR=-1.0E+20 CALL SIP992('TUAIR ',ANAME) ELSE 20 TM=(T1+T2)/2 IF (ABS(T1-T2) .GT. 1.0E-03) THEN CALL AIRTP(IERR,AMM,T1,PREF,V1,CP1,CV1,W1,U1,H1,S1) CALL AIRTP(IERR,AMM,T2,PREF,V2,CP2,CV2,W2,U2,H2,S2) CALL AIRTP(IERR,AMM,TM,PREF,VM,CPM,CVM,WM,UM,HM,SM) IF ( (U-UM)*(U-U1) .LE. 0.0) THEN T1=T1 T2=TM ELSEIF ((U-UM)*(U-U2) .LE. 0.0) THEN T1=TM T2=T2 ENDIF GOTO 20 ELSE IF (KPA1 .EQ. 1 .OR. KPA1 .EQ. 3) THEN TUAIR=TM-273.15 ELSE TUAIR=TM ENDIF ENDIF ENDIF KPA=KPA1 KMOL=KMOL1 RETURN END C ***** T(U) FOR AN IDEAL GAS REAL FUNCTION TUIDG(ISUB,UU) INTEGER IERR,ISUB,KPA,KMOL REAL UU,U,U1,U2,UM,T1,T2,TM REAL A(1:3),TLH(1:2) REAL C(1:10) CHARACTER*25 ANAME COMMON /UNIT/KPA,KMOL,MESS COMMON /CNST/GASCON CALL SIP001(IERR,ISUB,C,ANAME) IF (IERR .EQ. -3) THEN TUIDG=-1.0E+30 ELSE IF (KMOL .EQ. 1) THEN U=UU*C(1) ELSE U=UU ENDIF T1=C(8) T2=C(9) CALL SIP002(IERR,ISUB,T1,A,TLH) U1=A(3)-GASCON*T1 CALL SIP002(IERR,ISUB,T2,A,TLH) U2=A(3)-GASCON*T2 IF ( (U-U1)*(U-U2) .GT. 0) THEN TUIDG=-1.0E+20 CALL SIP992('TUIDG ',ANAME) ELSE 20 TM=(T1+T2)/2 IF (ABS(T1-T2) .GT. 1.0E-03) THEN CALL SIP002(IERR,ISUB,T1,A,TLH) U1=A(3)-GASCON*T1 CALL SIP002(IERR,ISUB,T2,A,TLH) U2=A(3)-GASCON*T2 CALL SIP002(IERR,ISUB,TM,A,TLH) UM=A(3)-GASCON*TM IF ( (U-UM)*(U-U1) .LE. 0.0) THEN T1=T1 T2=TM ELSEIF ((U-UM)*(U-U2) .LE. 0.0) THEN T1=TM T2=T2 ENDIF GOTO 20 ELSE IF (KPA .EQ. 1 .OR. KPA .EQ. 3) THEN TUIDG=TM-273.15 ELSE TUIDG=TM ENDIF ENDIF ENDIF ENDIF RETURN END C ***** C * CLOSED SUBPROGRAMS C ***** C ******************************************** C * FUNCTIONS FOR CP EQUATIONS C ******************************************** C * CP, S0, AND H BASED ON EQUATION (100) C * REAL FUNCTION FIP0CP(ACP,T) REAL ACP(1:6),T FIP0CP=ACP(1)+(ACP(2)+(ACP(3)+(ACP(4)+ACP(5)*T)*T)*T)*T RETURN END REAL FUNCTION FIP0H(ACP,T) REAL ACP(1:6),T FIP0H=(ACP(1)+(ACP(2)/2.0+(ACP(3)/3.0+(ACP(4)/4.0 1 +ACP(5)/5.0*T)*T)*T)*T)*T RETURN END REAL FUNCTION FIP0S(ACP,T) REAL ACP(1:6),T FIP0S=ACP(1)*LOG(T)+(ACP(2)+(ACP(3)/2.0+(ACP(4)/3.0 1 +ACP(5)/4.0*T)*T)*T)*T RETURN END C ***** C * CP, S0, AND H BASED ON EQUATION (107) C * REAL FUNCTION FIP7CP(ACP,T) REAL ACP(1:6),T,TT TT=ACP(3)/T FIP7CP=ACP(1)+ACP(2)*(TT/SINH(TT))**2 TT=ACP(5)/T FIP7CP=FIP7CP+ACP(4)*(TT/COSH(TT))**2 RETURN END REAL FUNCTION FIP7H(ACP,T) REAL ACP(1:6),T FIP7H=ACP(1)*T+ACP(2)*ACP(3)/TANH(ACP(3)/T) 1 -ACP(4)*ACP(5)*TANH(ACP(5)/T) RETURN END REAL FUNCTION FIP7S(ACP,T) REAL ACP(1:6),T,TT TT=ACP(3)/T FIP7S=ACP(1)*LOG(T)+ACP(2)*(TT/TANH(TT)-LOG(SINH(TT))) TT=ACP(5)/T FIP7S=FIP7S-ACP(4)*(TT*TANH(TT)-LOG(COSH(TT))) RETURN END C *** FUNCTION FOR SETTING UNITS **** C G98 *** PRESSURE --> PA REAL FUNCTION FIPG98(P) REAL PBAR,P INTEGER KPA,KMOL COMMON /UNIT/KPA,KMOL,MESS C * KPA=1 AND 2, CONVERT BAR TO PA IF(KPA.EQ.1 .OR. KPA.EQ.2) THEN PBAR=1.0E+05 ELSE PBAR=1.0 END IF FIPG98=P*PBAR RETURN END C G99 *** TEMPERATURE --> K REAL FUNCTION FIPG99(T) REAL T0K,T INTEGER KPA,KMOL COMMON /UNIT/KPA,KMOL,MESS C * KPA=1 AND 3, CONVERT C TO K IF(KPA.EQ.1 .OR. KPA.EQ.3) THEN T0K=273.15 ELSE T0K=0.0 END IF FIPG99=T+T0K RETURN END C ******* SUBROUTINE FOR ERROR MESSAGE ******* C *** LEVEL 1 ERROR MESSAGE -- SUBROUTINE SIP991(FUN) CHARACTER*6 FUN INTEGER KPA,KMOL,MESS COMMON /UNIT/KPA,KMOL,MESS IF (MESS.NE.0) THEN WRITE(6,100) FUN 100 FORMAT(1H ,'*** NO CONVERGENCE AT ',A6,' ***'/) ENDIF RETURN END C *** LEVEL 2 ERROR MESSAGE -- SUBROUTINE SIP992(FUN,ANAME) CHARACTER*6 FUN CHARACTER*25 ANAME INTEGER KPA,KMOL,MESS COMMON /UNIT/KPA,KMOL,MESS IF (MESS.NE.0) THEN WRITE(6,1000) FUN,ANAME 1000 FORMAT(1H ,'*** OUT OF RANGE AT ',A6,' FOR ',A25,' ***'/) ENDIF RETURN END C *** LEVEL 3 ERROR MESSAGE -- SUBROUTINE SIP993(ISUB) INTEGER ISUB,KPA,KMOL,MESS COMMON /UNIT/KPA,KMOL,MESS IF (MESS.NE.0) THEN WRITE(6,100) ISUB 100 FORMAT(1H ,' *** SUBSTANCE INDEX * ISUB = ', 1 I3,' * IS NOT INCLUDED IN I-PROPATH ***'/) ENDIF RETURN END C ************************************ C * BASIC PROGRAM SIP005 (S05IPR) * C * FOR MIXTURE (SIPMIX) * C ************************************ SUBROUTINE SIP005(IERR,ISUBNO,ISUB,AM,AMM,T,P,A) INTEGER IERR,ISUBNO,ISUB(1:ISUBNO),I,J REAL AM(1:ISUBNO),AMM,T,P,A(1:4),TLH(1:2) REAL C(1:10),AP(1:3) CHARACTER*25 ANAME DATA GASCON/8.314510E+03/ DATA PREF/1.0E+05/ AMM=0.0 DO 5 I=1,4,1 A(I)=0.0 5 CONTINUE DO 10 I=1,ISUBNO,1 CALL SIP001(IERR,ISUB(I),C,ANAME) IF (IERR .EQ. -3) THEN AMM=-1.0E+30 DO 91 J=1,4,1 A(J)=-1.0E+30 91 CONTINUE RETURN ENDIF CALL SIP002(IERR,ISUB(I),T,AP,TLH) IF (IERR .EQ. -2 .OR. P .LE. 0.0) THEN AMM=-1.0E+20 DO 92 J=1,4,1 A(J)=-1.0E+20 92 CONTINUE RETURN ENDIF AMI=AM(I) IF (ABS(AMI) .GT. 1.0E-06) THEN AMM=AMM+AMI*C(1) A(1)=A(1)+AMI*AP(1) A(3)=A(3)+AMI*AP(3) A(4)=A(4)+AMI*(AP(2)-GASCON*LOG(P/PREF)-GASCON*LOG(AMI)) ENDIF 10 CONTINUE A(2)=A(3)-GASCON*T RETURN END C ********************************************** C * BASIC SUBPROGRAM SIP004 (S02IPR) * C * FOR CONVRSION OF MOLAR-MASS FRACTIONS * C * OF MULTI COMPONENT GAS >>> MIXCMM (COMPOS) * C ********************************************** SUBROUTINE SIP004(IERR,ITRNS,ISUBNO,ISUB,XMOLF,YMASSF) INTEGER IERR,ITRNS,ISUBNO,ISUB(1:ISUBNO) REAL XMOLF(1:ISUBNO),YMASSF(1:ISUBNO) REAL C(1:10),RXMOL(1:20),AMOLM(1:20) INTEGER IERR0(1:20) CHARACTER*25 ANAME COMMON /UNIT/KPA,KMOL,MESS IE=0 DO 10 I=1,ISUBNO,1 CALL SIP001(IERR,ISUB(I),C,ANAME) IF (IERR .EQ. 0) THEN AMOLM(I)=C(1) ELSE IE=IE+1 IERR0(IE)=I ENDIF 10 CONTINUE IF (IE .NE. 0) THEN IERR=-3 RETURN ENDIF IF (ITRNS .EQ. 0) THEN ALLM=0.0 DO 11 I=1,ISUBNO,1 ALLM=ALLM+XMOLF(I) 11 CONTINUE RM=0.0 DO 21 I=1,ISUBNO,1 RXMOL(I)=XMOLF(I)/ALLM RM=RM+RXMOL(I)*AMOLM(I) 21 CONTINUE DO 22 I=1,ISUBNO,1 YMASSF(I)=RXMOL(I)*AMOLM(I)/RM 22 CONTINUE ELSE YM=0.0 DO 31 I=1,ISUBNO,1 YM=YM+YMASSF(I)/AMOLM(I) 31 CONTINUE DO 32 I=1,ISUBNO,1 XMOLF(I)=YMASSF(I)/AMOLM(I)/YM 32 CONTINUE ENDIF IERR=0 RETURN END C ******************************************* C * BASIC SUBPROGRAM SIP003 (S01IPR) * C * FOR CONVERSION OF MOLAR-MASS * C * OF PURE SUBSTANCE >>> SIPCMG (KMOLKG) * C ******************************************* SUBROUTINE SIP003(IERR,ITRNS,ISUB,XKMOL,YKG) CHARACTER*25 ANAME REAL C(1:10) REAL XKMOL,YKG INTEGER IERR,ITRNS,ISUB,IP CALL SIP000(ISUB,IP,ANAME) IF (IP .EQ. -1) THEN IERR=-3 IF (ITRNS .EQ. 0) THEN YKG=-1.0E+30 ELSE XKMOL=-1.0E-30 ENDIF ELSE IERR=0 CALL SIP001(IERR,ISUB,C,ANAME) AMOL=C(1) IF (ITRNS .EQ. 0) THEN YKG=XKMOL*AMOL ELSE XKMOL=YKG/AMOL ENDIF ENDIF RETURN END C ***************************************** C * FUNDAMENTAL CONSTANTS AND EQUATIONS C * ARE DEFINED IN THE FOLLOWING C * THREE SUBROUTINES C * C * 1 : SUBROUTINE SIP000 C * 2 : SUBROUTINE SIP001 C * 3 : SUBROUTINE SIP002 C ***************************************** SUBROUTINE SIP000(ISUB,IPFUN,ANAME) INTEGER ISUB,IPFUN,IPDIM(1:54),IPEND CHARACTER*25 ANAME,ANAMEP(1:100) COMMON /UNIT/KPA,KMOL,MESS DATA IPEND/54/ DATA IPDIM/ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 1 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 1 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 1 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 1 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 1 51, 52, 53, 54/ DATA ANAMEP(1)/'NITROGEN N2'/ DATA ANAMEP(2)/'WATER H20'/ DATA ANAMEP(3)/'HYDROGEN H2'/ DATA ANAMEP(4)/'NITRIC MONOXIDE NO'/ DATA ANAMEP(5)/'NITROGEN DIOXIDE NO2'/ DATA ANAMEP(6)/'DINITROGEN MONOXIDE N2O'/ DATA ANAMEP(7)/'OXYGEN O2'/ DATA ANAMEP(8)/'CARBON MONOXIDE CO'/ DATA ANAMEP(9)/'CARBON DIOXIDE CO2'/ DATA ANAMEP(10)/'METHANE CH4'/ DATA ANAMEP(11)/'PROPANE C3H8'/ DATA ANAMEP(12)/'ETHYLENE C2H4'/ DATA ANAMEP(13)/'CHLORINE CL2'/ DATA ANAMEP(14)/'AMMONIA H3N (NH3)'/ DATA ANAMEP(15)/'SULFUR DIOXIDE O2S (SO2)'/ DATA ANAMEP(16)/'NEON NE'/ DATA ANAMEP(17)/'OZONE O3'/ DATA ANAMEP(18)/'CARBON C'/ DATA ANAMEP(19)/'HYDROGEN CHLORIDE HCL'/ DATA ANAMEP(20)/'FLUORINE F2'/ DATA ANAMEP(21)/'HYDROGEN IODIDE HI'/ DATA ANAMEP(22)/'HELIUM-4 HE'/ DATA ANAMEP(23)/'ARGON AR'/ DATA ANAMEP(24)/'HCFC22 CHCLF2'/ DATA ANAMEP(25)/'CFC13 CCLF3'/ DATA ANAMEP(26)/'CHLOROFORM CHCL3'/ DATA ANAMEP(27)/'HCFC21 CHCL2F'/ DATA ANAMEP(28)/'CFC12 CCL2F2'/ DATA ANAMEP(29)/'METHYLENE CLORIDE CH2CL2'/ DATA ANAMEP(30)/'CARBON TETRAFLUORIDE CF4'/ DATA ANAMEP(31)/'METHANOL CH3-OH'/ DATA ANAMEP(32)/'HCFC142B CH3-CCLF2'/ DATA ANAMEP(33)/'ETHYL CHLORIDE C2H5CL'/ DATA ANAMEP(34)/'CFC114 CCLF2-CCLF2'/ DATA ANAMEP(35)/'HFC152A CH3-CHF2'/ DATA ANAMEP(36)/'ACETYLENE C2H2'/ DATA ANAMEP(37)/'ETHANE C2H6'/ DATA ANAMEP(38)/'n-BUTANE C4H10'/ DATA ANAMEP(39)/'ISOBUTANE C4H10'/ DATA ANAMEP(40)/'ISOPENTANE C5H12'/ DATA ANAMEP(41)/'METHYL CHLORIDE CH3CL'/ DATA ANAMEP(42)/'ACETALDEHYDE C2H4O'/ DATA ANAMEP(43)/'ACETIC ACID C2H4O2'/ DATA ANAMEP(44)/'ETHANOL C2H6O'/ DATA ANAMEP(45)/'PROPYLENE C3H6'/ DATA ANAMEP(46)/'ACETONE C3H6O'/ DATA ANAMEP(47)/'n-PENTANE C5H12'/ DATA ANAMEP(48)/'BENZENE C6H6'/ DATA ANAMEP(49)/'n-HEXANE C6H14'/ DATA ANAMEP(50)/'TOLUENE C7H8'/ DATA ANAMEP(51)/'n-HEPTANE C7H16'/ DATA ANAMEP(52)/'n-OCTANE C8H18'/ DATA ANAMEP(53)/'ISO-OCTANE C8H18'/ DATA ANAMEP(54)/'NAPHTHALENE C10H8'/ I=0 10 I=I+1 IF (I .LE. IPEND) THEN IF (ISUB .EQ. IPDIM(I)) THEN IPFUN=I ANAME=ANAMEP(I) RETURN ELSE GOTO 10 ENDIF ELSE IPFUN=-1 ANAME='********************' CALL SIP993(ISUB) RETURN ENDIF END C *************************************** C * * BASIC SUBROUTINE SIP001 * * C * * C * TMIN=C(8), TMAX=C(9) * C *************************************** SUBROUTINE SIP001(IERR,ISUB,C,ANAME) CHARACTER*25 ANAME REAL C(1:10),TLH(1:2),AREF(1:3) REAL AMM(1:100),CC(1:3,1:100),RR(1:3,1:100),CS(1:100) INTEGER IERR,ISUB,IP C *** NITROGEN N2 >> IP=1 DATA AMM(1),CC(1,1),CC(2,1),CC(3,1) 1 /28.014,126.10,3.3944E+06,0.09010/ DATA RR(1,1),RR(2,1),RR(3,1) 1 /0.0,0.0,1.9150E+05/ DATA CS(1)/10/ C *** WATER H20 >> IP=2 DATA AMM(2),CC(1,2),CC(2,2),CC(3,2) 1 /18.015,647.13,2.2055E+07,0.05595/ DATA RR(1,2),RR(2,2),RR(3,2) 1 /-2.4181E+08,-2.2859E+08,1.8872E+05/ DATA CS(2)/11/ C *** HIDROGEN H2 >> IP=3 DATA AMM(3),CC(1,3),CC(2,3),CC(3,3) 1 /2.016,33.18,1.3130E+06,0.06415/ DATA RR(1,3),RR(2,3),RR(3,3) 1 /0.0,0.0,1.3057E+05/ DATA CS(3)/10/ C *** NITRIC OXIDE NO >> IP=4 DATA AMM(4),CC(1,4),CC(2,4),CC(3,4) 1 /30.006,180.15,6.4848E+06,0.05770/ DATA RR(1,4),RR(2,4),RR(3,4) 1 /9.0249E+07,8.6567E+07,2.1060E+05/ DATA CS(4)/11/ C *** NITROGEN DIOXIDE NO2 >> IP=5 DATA AMM(5),CC(1,5),CC(2,5),CC(3,5) 1 /46.005,431.35,1.0133E+07,0.08249/ DATA RR(1,5),RR(2,5),RR(3,5) 1 /3.3095E+07,5.1241E+07,2.3992E+05/ DATA CS(5)/11/ C *** NITROUS OXIDE N2O >> IP=6 DATA AMM(6),CC(1,6),CC(2,6),CC(3,6) 1 /44.013,309.57,7.2447E+06,0.09737/ DATA RR(1,6),RR(2,6),RR(3,6) 1 /8.2048E+07,1.0417E+08,2.1985E+05/ DATA CS(6)/11/ C *** OXYGEN O2 >> IP=7 DATA AMM(7),CC(1,7),CC(2,7),CC(3,7) 1 /31.999,154.58,5.0430E+06,0.07340/ DATA RR(1,7),RR(2,7),RR(3,7) 1 /0.0,0.0,2.0504E+05/ DATA CS(7)/10/ C *** CARBON MONOXIDE CO >> IP=8 DATA AMM(8),CC(1,8),CC(2,8),CC(3,8) 1 /28.010,132.92,3.4988E+06,0.09310/ DATA RR(1,8),RR(2,8),RR(3,8) 1 /-1.1053E+08,-1.3716E+08,1.9754E+05/ DATA CS(8)/11/ C *** CARBON DIOXIDE CO2 >> IP=9 DATA AMM(9),CC(1,9),CC(2,9),CC(3,9) 1 /44.010,304.19,7.3815E+06,0.09400/ DATA RR(1,9),RR(2,9),RR(3,9) 1 /-3.9352E+08,-3.9441E+08,2.1369E+05/ DATA CS(9)/11/ C *** METHANE CH4 >> IP=10 DATA AMM(10),CC(1,10),CC(2,10),CC(3,10) 1 /16.043,190.56,4.5990E+06,0.09860/ DATA RR(1,10),RR(2,10),RR(3,10) 1 /-7.4520E+07,-5.0490E+07,1.8627E+05/ DATA CS(10)/11/ C *** PROPANE C3H8 >> IP=11 DATA AMM(11),CC(1,11),CC(2,11),CC(3,11) 1 /44.096,369.83,4.2480E+06,0.20000/ DATA RR(1,11),RR(2,11),RR(3,11) 1 /-1.0468E+08,-2.4390E+07,2.7020E+05/ DATA CS(11)/19/ C *** ETHYLENE C2H4 >> IP=12 DATA AMM(12),CC(1,12),CC(2,12),CC(3,12) 1 /28.054,282.36,5.0318E+06,0.12907/ DATA RR(1,12),RR(2,12),RR(3,12) 1 /5.2283E+07,6.8124E+07,2.1945E+05/ DATA CS(12)/11/ C *** CHLORINE CL2 >> IP=13 DATA AMM(13),CC(1,13),CC(2,13),CC(3,13) 1 /70.905,417.15,7.7108E+06,0.12375/ DATA RR(1,13),RR(2,13),RR(3,13) 1 /0.0,0.0,2.2297E+05/ DATA CS(13)/10/ C *** AMMONIA H3N (NH3) >> IP=14 DATA AMM(14),CC(1,14),CC(2,14),CC(3,14) 1 /17.031,405.65,1.1278E+07,0.07247/ DATA RR(1,14),RR(2,14),RR(3,14) 1 /-4.5898E+07,-1.6401E+07,1.9267E+05/ DATA CS(14)/11/ C *** SULFUR DIOXIDE O2S (SO2) >> IP=15 DATA AMM(15),CC(1,15),CC(2,15),CC(3,15) 1 /64.065,430.75,7.8841E+06,0.12200/ DATA RR(1,15),RR(2,15),RR(3,15) 1 /-2.9684E+08,-3.0016E+08,2.4811E+05/ DATA CS(15)/11/ C *** NEON NE >> IP=16 DATA AMM(16),CC(1,16),CC(2,16),CC(3,16) 1 /20.180,44.40,2.6530E+06,0.04170/ DATA RR(1,16),RR(2,16),RR(3,16) 1 /0.0,0.0,1.4621E+05/ DATA CS(16)/10/ C *** OZONE O3 >> IP=17 DATA AMM(17),CC(1,17),CC(2,17),CC(3,17) 1 /47.998,261.00,5.5729E+06,0.08900/ DATA RR(1,17),RR(2,17),RR(3,17) 1 /1.4267E+08,1.6318E+08,2.3882E+05/ DATA CS(17)/11/ C *** CARBON C >> IP=18 DATA AMM(18),CC(1,18),CC(2,18),CC(3,18) 1 /12.011,6810.00,2.2300E+08,0.01880/ DATA RR(1,18),RR(2,18),RR(3,18) 1 /7.1668E+08,6.7128E+08,1.5799E+05/ DATA CS(18)/11/ C *** HYDROGEN CHLORIDE CLH >> IP=19 DATA AMM(19),CC(1,19),CC(2,19),CC(3,19) 1 /36.461,324.65,8.3087E+06,0.08102/ DATA RR(1,19),RR(2,19),RR(3,19) 1 /-9.2312E+07,-9.5303E+07,1.8680E+05/ DATA CS(19)/11/ C *** FLUORINE F2 >> IP=20 DATA AMM(20),CC(1,20),CC(2,20),CC(3,20) 1 /37.997,144.31,5.2152E+06,0.06620/ DATA RR(1,20),RR(2,20),RR(3,20) 1 /0.0,0.0,2.0269E+05/ DATA CS(20)/10/ C *** HYDROGEN IODIDE HI >> IP=21 DATA AMM(21),CC(1,21),CC(2,21),CC(3,21) 1 /127.912,423.85,8.3100E+06,0.12194/ DATA RR(1,21),RR(2,21),RR(3,21) 1 /2.6359E+07,1.5732E+06,2.0649E+05/ DATA CS(21)/19/ C *** HELIUM-4 HE >> IP=22 DATA AMM(22),CC(1,22),CC(2,22),CC(3,22) 1 /4.003,5.20,2.2750E+05,0.05730/ DATA RR(1,22),RR(2,22),RR(3,22) 1 /0.0,0.0,1.2604E+05/ DATA CS(22)/10/ C *** ARGON AR >> IP=23 DATA AMM(23),CC(1,23),CC(2,23),CC(3,23) 1 /39.948,150.86,4.8981E+06,0.07459/ DATA RR(1,23),RR(2,23),RR(3,23) 1 /0.0,0.0,1.5473E+05/ DATA CS(23)/10/ C *** HCFC-22 CHCLF2 >> IP=24 DATA AMM(24),CC(1,24),CC(2,24),CC(3,24) 1 /86.468,369.30,4.9710E+06,0.16600/ DATA RR(1,24),RR(2,24),RR(3,24) 1 /-4.8158E+08,-4.5057E+08,2.8086E+05/ DATA CS(24)/11/ C *** CFC-13 CCLF3 >> IP=25 DATA AMM(25),CC(1,25),CC(2,25),CC(3,25) 1 /104.459,301.96,3.9460E+06,0.18028/ DATA RR(1,25),RR(2,25),RR(3,25) 1 /-7.0793E+08,-6.6739E+08,2.8524E+05/ DATA CS(25)/11/ C *** CHLOROFORM CHCL3 IP=26 DATA AMM(26),CC(1,26),CC(2,26),CC(3,26) 1 /119.377,536.40,5.4716E+06,0.23900/ DATA RR(1,26),RR(2,26),RR(3,26) 1 /-1.0318E+08,-7.0408E+07,2.9551E+05/ DATA CS(26)/11/ C *** HCFC-21 CHCL2F >> IP=27 DATA AMM(27),CC(1,27),CC(2,27),CC(3,27) 1 /102.923,451.58,5.1838E+06,0.19600/ DATA RR(1,27),RR(2,27),RR(3,27) 1 /-2.8326E+08,-2.5281E+08,2.9317E+05/ DATA CS(27)/11/ C *** CFC-12 CCL2F2 >> IP=28 DATA AMM(28),CC(1,28),CC(2,28),CC(3,28) 1 /120.913,384.95,4.1249E+06,0.21700/ DATA RR(1,28),RR(2,28),RR(3,28) 1 /-4.9162E+08,-4.5272E+08,3.0088E+05/ DATA CS(28)/11/ C *** METHYLENE CLORIDE CH2CL2 >> IP=29 DATA AMM(29),CC(1,29),CC(2,29),CC(3,29) 1 /84.932,510.00,6.0800E+06,0.18500/ DATA RR(1,29),RR(2,29),RR(3,29) 1 /-9.5520E+07,-6.8960E+07,2.7018E+05/ DATA CS(29)/11/ C *** CARBON TETRAFLUORIDE CF4 >> IP=30 DATA AMM(30),CC(1,30),CC(2,30),CC(3,30) 1 /88.005,227.50,3.7400E+06,0.14000/ DATA RR(1,30),RR(2,30),RR(3,30) 1 /-9.3315E+08,-8.8849E+08,2.6131E+05/ DATA CS(30)/11/ C *** METHANOL CH4O >> IP=31 DATA AMM(31),CC(1,31),CC(2,31),CC(3,31) 1 /32.042,512.64,8.0970E+06,0.11800/ DATA RR(1,31),RR(2,31),RR(3,31) 1 /-2.0094E+08,-1.6232E+08,2.3988E+05/ DATA CS(31)/19/ C *** HCFC-142B C2H3CLF2 >> IP=32 DATA AMM(32),CC(1,32),CC(2,32),CC(3,32) 1 /100.495,410.20,4.1239E+06,0.23100/ DATA RR(1,32),RR(2,32),RR(3,32) 1 /-4.8700E+08,-4.2300E+08,3.0686E+05/ DATA CS(32)/19/ C *** ETHYL CHLORIDE C2H5CL >> IP=33 DATA AMM(33),CC(1,33),CC(2,33),CC(3,33) 1 /64.514,460.35,5.2700E+06,0.20000/ DATA RR(1,33),RR(2,33),RR(3,33) 1 /-1.1226E+08,-6.0499E+07,2.7578E+05/ DATA CS(33)/19/ C *** CFC-114 C2CL2F4 >> IP=34 DATA AMM(34),CC(1,34),CC(2,34),CC(3,34) 1 /170.921,418.55,3.2600E+06,0.29400/ DATA RR(1,34),RR(2,34),RR(3,34) 1 /-9.1630E+08,-8.3410E+08,3.6410E+05/ DATA CS(34)/19/ C *** HFC-152A C2H4F2 >> IP=35 DATA AMM(35),CC(1,35),CC(2,35),CC(3,35) 1 /66.051,386.60,4.4988E+06,0.18100/ DATA RR(1,35),RR(2,35),RR(3,35) 1 /-4.9371E+08,-4.3622E+08,2.8242E+05/ DATA CS(35)/19/ C *** ACETYLENE C2H2 >> IP=36 DATA AMM(36),CC(1,36),CC(2,36),CC(3,36) 1 /26.038,308.32,6.1391E+06,0.11296/ DATA RR(1,36),RR(2,36),RR(3,36) 1 /2.2675E+08,2.0920E+08,2.0082E+05/ DATA CS(36)/11/ C *** ETHANE C2H6 >> IP=37 DATA AMM(37),CC(1,37),CC(2,37),CC(3,37) 1 /30.070,305.32,4.8720E+06,0.14550/ DATA RR(1,37),RR(2,37),RR(3,37) 1 /-8.3820E+07,-3.1920E+07,2.2912E+05/ DATA CS(37)/19/ C *** n-BUTANE C4H10 >> IP=38 DATA AMM(38),CC(1,38),CC(2,38),CC(3,38) 1 /58.123,425.12,3.7960E+06,0.25500/ DATA RR(1,38),RR(2,38),RR(3,38) 1 /-1.2579E+08,-1.6700E+07,3.0991E+05/ DATA CS(38)/19/ C *** ISOBUTANE C4H10 >> IP=39 DATA AMM(39),CC(1,39),CC(2,39),CC(3,39) 1 /58.123,408.14,3.6480E+06,0.26270/ DATA RR(1,39),RR(2,39),RR(3,39) 1 /-1.3418E+08,-2.0760E+07,2.9539E+05/ DATA CS(39)/19/ C *** ISOPENTANE C5H12 >> IP=40 DATA AMM(40),CC(1,40),CC(2,40),CC(3,40) 1 /72.150,460.43,3.3812E+06,0.30583/ DATA RR(1,40),RR(2,40),RR(3,40) 1 /-1.5297E+08,-1.3300E+07,3.4363E+05/ DATA CS(40)/19/ C *** METHYL CHLORIDE CH3CL >> IP=41 DATA AMM(41),CC(1,41),CC(2,41),CC(3,41) 1 /50.488,416.25,6.6800E+06,0.14300/ DATA RR(1,41),RR(2,41),RR(3,41) 1 /-8.1960E+07,-5.8400E+07,2.3418E+05/ DATA CS(41)/11/ C *** ACETALDEHYDE C2H4O >> IP=42 DATA AMM(42),CC(1,42),CC(2,42),CC(3,42) 1 /44.053,461.00,5.5500E+06,0.15700/ DATA RR(1,42),RR(2,42),RR(3,42) 1 /-1.6619E+08,-1.2891E+08,2.5020E+05/ DATA CS(42)/19/ C *** ACETIC ACID C2H4O2 >> IP=43 DATA AMM(43),CC(1,43),CC(2,43),CC(3,43) 1 /60.053,591.95,5.7860E+06,0.17970/ DATA RR(1,43),RR(2,43),RR(3,43) 1 /-4.3280E+08,-3.7460E+08,2.8250E+05/ DATA CS(43)/19/ C *** ETHANOL C2H6O >> IP=44 DATA AMM(44),CC(1,44),CC(2,44),CC(3,44) 1 /46.069,513.92,6.1480E+06,0.16700/ DATA RR(1,44),RR(2,44),RR(3,44) 1 /-2.3495E+08,-1.6785E+08,2.8064E+05/ DATA CS(44)/19/ C *** PROPYLENE C3H6 >> IP=45 DATA AMM(45),CC(1,45),CC(2,45),CC(3,45) 1 /42.081,364.76,4.6126E+06,0.18100/ DATA RR(1,45),RR(2,45),RR(3,45) 1 / 1.9710E+07, 6.2140E+07,2.6660E+05/ DATA CS(45)/19/ C *** ACETONE C3H6O >> IP=46 DATA AMM(46),CC(1,46),CC(2,46),CC(3,46) 1 /58.080,508.20,4.7015E+06,0.20900/ DATA RR(1,46),RR(2,46),RR(3,46) 1 /-2.1715E+08,-1.5272E+08,2.9535E+05/ DATA CS(46)/19/ C *** n-PENTANE C5H12 >> IP=47 DATA AMM(47),CC(1,47),CC(2,47),CC(3,47) 1 /72.150,469.70,3.3700E+06,0.31300/ DATA RR(1,47),RR(2,47),RR(3,47) 1 /-1.4676E+08,-8.8130E+06,3.4945E+05/ DATA CS(47)/19/ C *** BENZENE C6H6 >> IP=48 DATA AMM(48),CC(1,48),CC(2,48),CC(3,48) 1 /78.114,562.16,4.8980E+06,0.25894/ DATA RR(1,48),RR(2,48),RR(3,48) 1 / 8.2927E+07, 1.2966E+08,2.6920E+05/ DATA CS(48)/19/ C *** n-HEXANE C6H14 >> IP=49 DATA AMM(49),CC(1,49),CC(2,49),CC(3,49) 1 /86.177,507.60,3.0250E+06,0.37100/ DATA RR(1,49),RR(2,49),RR(3,49) 1 /-1.6694E+08,-6.6340E+04,3.8874E+05/ DATA CS(49)/19/ C *** TOLUENE C7H8 >> IP=50 DATA AMM(50),CC(1,50),CC(2,50),CC(3,50) 1 /92.141,591.79,4.1086E+06,0.31579/ DATA RR(1,50),RR(2,50),RR(3,50) 1 / 4.9999E+07, 1.2229E+08,3.1974E+05/ DATA CS(50)/19/ C *** n-HEPTANE C7H16 >> IP=51 DATA AMM(51),CC(1,51),CC(2,51),CC(3,51) 1 /100.204,540.20,2.7400E+06,0.42800/ DATA RR(1,51),RR(2,51),RR(3,51) 1 /-1.8765E+08, 8.1650E+06,4.2798E+05/ DATA CS(51)/19/ C *** n-OCTANE C8H18 >> IP=52 DATA AMM(52),CC(1,52),CC(2,52),CC(3,52) 1 /114.231,568.70,2.4900E+06,0.48600/ DATA RR(1,52),RR(2,52),RR(3,52) 1 /-2.0875E+08, 1.6000E+07,4.6723E+05/ DATA CS(52)/19/ C *** ISO-OCTANE C8H18 >> IP=53 DATA AMM(53),CC(1,53),CC(2,53),CC(3,53) 1 /114.231,559.64,2.4845E+06,0.48800/ DATA RR(1,53),RR(2,53),RR(3,53) 1 /-2.1535E+08, 1.1670E+07,4.5957E+05/ DATA CS(53)/19/ C *** NAPHTHALENE C10H8 >> IP=54 DATA AMM(54),CC(1,54),CC(2,54),CC(3,54) 1 /128.174,748.35,4.0510E+06,0.41300/ DATA RR(1,54),RR(2,54),RR(3,54) 1 / 1.5058E+08, 2.2410E+08,3.3315E+05/ DATA CS(54)/19/ CALL SIP000(ISUB,IP,ANAME) IF (IP .EQ. -1) THEN IERR=-3 DO 10 I=1,10 C(I)=-1.0E+30 10 CONTINUE ELSE IERR=0 C(1)=AMM(IP) DO 20 I=1,3 C(I+1)=CC(I,IP) 20 CONTINUE C(5)=RR(3,IP) C(6)=RR(1,IP) C(7)=RR(2,IP) CALL SIP002(IERR,ISUB,298.15,AREF,TLH) C(8)=TLH(1) C(9)=TLH(2) C(10)=CS(IP) ENDIF RETURN END C *************************************** C * * BASIC SUBROUTINE SIP002 * * C * CP=A(1), S0=A(2), H=A(3) * C * TMIN=TLH(1), TMAX=TLH(2) * C *************************************** SUBROUTINE SIP002(IERR,ISUB,T,A,TLH) CHARACTER*25 ANAME REAL A(1:3),ACP(1:6),TLH(1:2) INTEGER IERR,ISUB,IE REAL TRANGE(1:2,1:100),AC(1:6,1:100) INTEGER IEQ(1:100) C *** NITROGEN N2 >> IP=1 DATA IEQ(1)/107/ DATA AC(1,1),AC(2,1),AC(3,1),AC(4,1),AC(5,1) 1/2.9105E+04,8.6149E+03,1.7016E+03,1.0347E+02,9.0979E+02/ DATA AC(6,1)/1.9150E+05/ DATA TRANGE(1,1),TRANGE(2,1)/50.00,1500.00/ C *** WATER H20 >> IP=2 DATA IEQ(2)/107/ DATA AC(1,2),AC(2,2),AC(3,2),AC(4,2),AC(5,2) 1/3.3363E+04,2.6790E+04,2.6105E+03,8.8960E+03,1.1690E+03/ DATA AC(6,2)/1.8872E+05/ DATA TRANGE(1,2),TRANGE(2,2)/100.00,2273.15/ C *** HIDROGEN H2 >> IP=3 DATA IEQ(3)/107/ DATA AC(1,3),AC(2,3),AC(3,3),AC(4,3),AC(5,3) 1/2.7617E+04,9.5600E+03,2.4660E+03,3.7600E+03,5.6760E+02/ DATA AC(6,3)/1.3057E+05/ DATA TRANGE(1,3),TRANGE(2,3)/250.00,1500.00/ C *** NITRIC OXIDE NO >> IP=4 DATA IEQ(4)/100/ DATA AC(1,4),AC(2,4),AC(3,4),AC(4,4),AC(5,4) 1/3.3227E+04,-2.3626E+01,5.3156E-02,-3.7858E-05,9.1197E-09/ DATA AC(6,4)/2.1060E+05/ DATA TRANGE(1,4),TRANGE(2,4)/50.00,1500.00/ C *** NITROGEN DIOXIDE NO2 >> IP=5 DATA IEQ(5)/107/ DATA AC(1,5),AC(2,5),AC(3,5),AC(4,5),AC(5,5) 1/3.3460E+04,3.0160E+04,1.3210E+03,1.5250E+04,6.3200E+02/ DATA AC(6,5)/2.3992E+05/ DATA TRANGE(1,5),TRANGE(2,5)/50.00,1500.00/ C *** NITROUS OXIDE N2O >> IP=6 DATA IEQ(6)/107/ DATA AC(1,6),AC(2,6),AC(3,6),AC(4,6),AC(5,6) 1/2.9338E+04,3.2360E+04,1.1238E+03,2.1770E+04,4.7940E+02/ DATA AC(6,6)/2.1985E+05/ DATA TRANGE(1,6),TRANGE(2,6)/100.00,1500.00/ C *** OXYGEN O2 >> IP=7 DATA IEQ(7)/107/ DATA AC(1,7),AC(2,7),AC(3,7),AC(4,7),AC(5,7) 1/2.9103E+04,1.0040E+04,2.5265E+03,9.3560E+03,1.1538E+03/ DATA AC(6,7)/2.0504E+05/ DATA TRANGE(1,7),TRANGE(2,7)/50.00,1500.00/ C *** CARBON MONOXIDE CO >> IP=8 DATA IEQ(8)/107/ DATA AC(1,8),AC(2,8),AC(3,8),AC(4,8),AC(5,8) 1/2.9108E+04,8.7730E+03,3.0851E+03,8.4553E+03,1.5382E+03/ DATA AC(6,8)/1.9754E+05/ DATA TRANGE(1,8),TRANGE(2,8)/60.00,1500.00/ C *** CARBON DIOXIDE CO2 >> IP=9 DATA IEQ(9)/107/ DATA AC(1,9),AC(2,9),AC(3,9),AC(4,9),AC(5,9) C 1/2.9370E+04,3.4540E+04,-1.4280E+03,2.6400E+04,5.8800E+02/ 1/2.9370E+04,3.4540E+04,1.4280E+03,2.6400E+04,5.8800E+02/ DATA AC(6,9)/2.1369E+05/ DATA TRANGE(1,9),TRANGE(2,9)/50.00,5000.00/ C *** METHANE CH4 >> IP=10 DATA IEQ(10)/107/ DATA AC(1,10),AC(2,10),AC(3,10),AC(4,10),AC(5,10) 1/3.3298E+04,7.9933E+04,2.0869E+03,4.1602E+04,9.9196E+02/ DATA AC(6,10)/1.8627E+05/ DATA TRANGE(1,10),TRANGE(2,10)/50.00,1500.00/ C *** PROPANE C3H8 >> IP=11 DATA IEQ(11)/107/ DATA AC(1,11),AC(2,11),AC(3,11),AC(4,11),AC(5,11) 1/5.1920E+04,1.9245E+05,1.6265E+03,1.1680E+05,7.2360E+02/ DATA AC(6,11)/2.7020E+05/ DATA TRANGE(1,11),TRANGE(2,11)/200.00,1500.00/ C *** ETHYLENE C2H4 >> IP=12 DATA IEQ(12)/107/ DATA AC(1,12),AC(2,12),AC(3,12),AC(4,12),AC(5,12) 1/3.3380E+04,9.4790E+04,1.5960E+03,5.5100E+04,7.4080E+02/ DATA AC(6,12)/2.1945E+05/ DATA TRANGE(1,12),TRANGE(2,12)/60.00,1500.00/ C *** CHLORINE CL2 >> IP=13 DATA IEQ(13)/107/ DATA AC(1,13),AC(2,13),AC(3,13),AC(4,13),AC(5,13) 1/2.9142E+04,9.1760E+03,9.4900E+02,1.0030E+04,4.2500E+02/ DATA AC(6,13)/2.2297E+05/ DATA TRANGE(1,13),TRANGE(2,13)/50.00,1500.00/ C *** AMMONIA H3N (NH3) >> IP=14 DATA IEQ(14)/107/ DATA AC(1,14),AC(2,14),AC(3,14),AC(4,14),AC(5,14) 1/3.3480E+04,4.8200E+04,9.5189E+02,-3.0100E+04,1.0560E+03/ DATA AC(6,14)/1.9267E+05/ DATA TRANGE(1,14),TRANGE(2,14)/100.00,1500.00/ C *** SULFUR DIOXIDE O2S (SO2) >> IP=15 DATA IEQ(15)/107/ DATA AC(1,15),AC(2,15),AC(3,15),AC(4,15),AC(5,15) 1/3.3375E+04,2.5864E+04,9.3280E+02,1.0880E+04,4.2370E+02/ DATA AC(6,15)/2.4811E+05/ DATA TRANGE(1,15),TRANGE(2,15)/100.00,1500.00/ C *** NEON NE >> IP=16 DATA IEQ(16)/100/ DATA AC(1,16),AC(2,16),AC(3,16),AC(4,16),AC(5,16) 1/2.0786E+04,0,0,0,0/ DATA AC(6,16)/1.4621E+05/ DATA TRANGE(1,16),TRANGE(2,16)/100.00,1500.00/ C *** OZONE O3 >> IP=17 DATA IEQ(17)/107/ DATA AC(1,17),AC(2,17),AC(3,17),AC(4,17),AC(5,17) 1/3.3420E+04,2.9720E+04,1.3330E+03,2.3900E+04,6.3640E+02/ DATA AC(6,17)/2.3882E+05/ DATA TRANGE(1,17),TRANGE(2,17)/50.00,1500.00/ C *** CARBON C >> IP=18 DATA IEQ(18)/107/ DATA AC(1,18),AC(2,18),AC(3,18),AC(4,18),AC(5,18) 1/2.0733E+04,3.6800E+03,6.5820E+03,2.3000E+02,4.5000E+02/ DATA AC(6,18)/1.5799E+05/ DATA TRANGE(1,18),TRANGE(2,18)/298.00,6000.00/ C *** HYDROGEN CHLORIDE CLH >> IP=19 DATA IEQ(19)/107/ DATA AC(1,19),AC(2,19),AC(3,19),AC(4,19),AC(5,19) 1/2.9157E+04,9.0480E+03,2.0938E+03,-1.0700E+02,1.2000E+02/ DATA AC(6,19)/1.8680E+05/ DATA TRANGE(1,19),TRANGE(2,19)/50.00,1500.00/ C *** FLUORINE F2 >> IP=20 DATA IEQ(20)/107/ DATA AC(1,20),AC(2,20),AC(3,20),AC(4,20),AC(5,20) 1/2.9123E+04,9.5918E+03,1.4192E+03,9.3630E+03,6.6330E+02/ DATA AC(6,20)/2.0269E+05/ DATA TRANGE(1,20),TRANGE(2,20)/100.00,1500.00/ C *** HYDROGEN IODIDE HI >> IP=21 DATA IEQ(21)/107/ DATA AC(1,21),AC(2,21),AC(3,21),AC(4,21),AC(5,21) 1/2.9117E+04,9.2013E+03,1.6894E+03,4.5140E+02,9.8000E+02/ DATA AC(6,21)/2.0649E+05/ DATA TRANGE(1,21),TRANGE(2,21)/100.00,1500.00/ C *** HELIUM-4 HE >> IP=22 DATA IEQ(22)/100/ DATA AC(1,22),AC(2,22),AC(3,22),AC(4,22),AC(5,22) 1/2.0786E+04,0,0,0,0/ DATA AC(6,22)/1.2604E+05/ DATA TRANGE(1,22),TRANGE(2,22)/100.00,1500.00/ C *** ARGON AR >> IP=23 DATA IEQ(23)/100/ DATA AC(1,23),AC(2,23),AC(3,23),AC(4,23),AC(5,23) 1/2.0786E+04,0,0,0,0/ DATA AC(6,23)/1.5473E+05/ DATA TRANGE(1,23),TRANGE(2,23)/100.00,1500.00/ C *** HCFC-22 CHCLF2 >> IP=24 DATA IEQ(24)/107/ DATA AC(1,24),AC(2,24),AC(3,24),AC(4,24),AC(5,24) 1/3.4600E+04,7.0840E+04,9.8750E+02,4.3500E+04,4.3500E+02/ DATA AC(6,24)/2.8086E+05/ DATA TRANGE(1,24),TRANGE(2,24)/100.00,1500.00/ C *** CFC-13 CCLF3 >> IP=25 DATA IEQ(25)/107/ DATA AC(1,25),AC(2,25),AC(3,25),AC(4,25),AC(5,25) 1/3.4106E+04,7.3926E+04,7.4655E+02,4.6160E+04,3.4244E+02/ DATA AC(6,25)/2.8524E+05/ DATA TRANGE(1,25),TRANGE(2,25)/100.00,1500.00/ C *** CHLOROFORM CHCL3 IP=26 DATA IEQ(26)/107/ DATA AC(1,26),AC(2,26),AC(3,26),AC(4,26),AC(5,26) 1/3.9420E+04,6.5730E+04,9.2800E+02,4.9300E+04,3.9960E+02/ DATA AC(6,26)/2.9551E+05/ DATA TRANGE(1,26),TRANGE(2,26)/100.00,1500.00/ C *** HCFC-21 CHCL2F >> IP=27 DATA IEQ(27)/107/ DATA AC(1,27),AC(2,27),AC(3,27),AC(4,27),AC(5,27) 1/4.5070E+04,6.1624E+04,1.2775E+03,5.0740E+04,5.8140E+02/ DATA AC(6,27)/2.9317E+05/ DATA TRANGE(1,27),TRANGE(2,27)/100.00,1500.00/ C *** CFC-12 CCL2F2 >> IP=28 DATA IEQ(28)/107/ DATA AC(1,28),AC(2,28),AC(3,28),AC(4,28),AC(5,28) 1/3.4210E+04,7.3840E+04,6.2080E+02,4.4000E+04,2.7600E+02/ DATA AC(6,28)/3.0088E+05/ DATA TRANGE(1,28),TRANGE(2,28)/99.82,1500.00/ C *** METHYLENE CLORIDE CH2CL2 >> IP=29 DATA IEQ(29)/107/ DATA AC(1,29),AC(2,29),AC(3,29),AC(4,29),AC(5,29) 1/3.6280E+04,6.8040E+04,1.2560E+03,4.2750E+04,5.4800E+02/ DATA AC(6,29)/2.7018E+05/ DATA TRANGE(1,29),TRANGE(2,29)/100.00,1500.00/ C *** CARBON TETRAFLUORIDE CF4 >> IP=30 DATA IEQ(30)/107/ DATA AC(1,30),AC(2,30),AC(3,30),AC(4,30),AC(5,30) 1/3.3540E+04,7.4333E+04,8.0932E+02,4.0931E+04,3.8483E+02/ DATA AC(6,30)/2.6131E+05/ DATA TRANGE(1,30),TRANGE(2,30)/50.00,1500.00/ C *** METHANOL CH4O >> IP=31 DATA IEQ(31)/107/ DATA AC(1,31),AC(2,31),AC(3,31),AC(4,31),AC(5,31) 1/3.9252E+04,8.7900E+04,1.9165E+03,5.3654E+04,8.9670E+02/ DATA AC(6,31)/2.3988E+05/ DATA TRANGE(1,31),TRANGE(2,31)/200.00,1500.00/ C *** HCFC-142B C2H3CLF2 >> IP=32 DATA IEQ(32)/107/ DATA AC(1,32),AC(2,32),AC(3,32),AC(4,32),AC(5,32) 1/6.3567E+04,1.1339E+05,1.5742E+03,9.5170E+04,7.0330E+02/ DATA AC(6,32)/3.0686E+05/ DATA TRANGE(1,32),TRANGE(2,32)/200.00,1500.00/ C *** ETHYL CHLORIDE C2H5CL >> IP=33 DATA IEQ(33)/107/ DATA AC(1,33),AC(2,33),AC(3,33),AC(4,33),AC(5,33) 1/4.5680E+04,1.2967E+05,1.5992E+03,8.5900E+04,7.0880E+02/ DATA AC(6,33)/2.7578E+05/ DATA TRANGE(1,33),TRANGE(2,33)/100.00,1500.00/ C *** CFC-114 C2CL2F4 >> IP=34 DATA IEQ(34)/107/ DATA AC(1,34),AC(2,34),AC(3,34),AC(4,34),AC(5,34) 1/8.7120E+04,9.3062E+04,1.0620E+03,8.4800E+04,5.6700E+02/ DATA AC(6,34)/3.6410E+05/ DATA TRANGE(1,34),TRANGE(2,34)/273.15,1500.00/ C *** HFC-152A C2H4F2 >> IP=35 DATA IEQ(35)/107/ DATA AC(1,35),AC(2,35),AC(3,35),AC(4,35),AC(5,35) 1/4.8320E+04,1.2685E+05,1.4934E+03,8.4900E+04,-6.6700E+02/ DATA AC(6,35)/2.8242E+05/ DATA TRANGE(1,35),TRANGE(2,35)/100.00,1500.00/ C *** ACETYLENE C2H2 >> IP=36 DATA IEQ(36)/107/ DATA AC(1,36),AC(2,36),AC(3,36),AC(4,36),AC(5,36) 1/3.6760E+04,4.8290E+04,1.7965E+03,3.7220E+04,7.0807E+02/ DATA AC(6,36)/2.0082E+05/ DATA TRANGE(1,36),TRANGE(2,36)/200.00,1500.00/ C *** ETHANE C2H6 >> IP=37 DATA IEQ(37)/107/ DATA AC(1,37),AC(2,37),AC(3,37),AC(4,37),AC(5,37) 1/4.0326E+04,1.3422E+05,1.6555E+03,7.3223E+04,7.5287E+02/ DATA AC(6,37)/2.2912E+05/ DATA TRANGE(1,37),TRANGE(2,37)/200.00,1500.00/ C *** n-BUTANE C4H10 >> IP=38 DATA IEQ(38)/107/ DATA AC(1,38),AC(2,38),AC(3,38),AC(4,38),AC(5,38) 1/7.1340E+04,2.4300E+05,1.6300E+03,1.5033E+05,7.3042E+02/ DATA AC(6,38)/3.0991E+05/ DATA TRANGE(1,38),TRANGE(2,38)/200.00,1500.00/ C *** ISOBUTANE C4H10 >> IP=39 DATA IEQ(39)/107/ DATA AC(1,39),AC(2,39),AC(3,39),AC(4,39),AC(5,39) 1/6.5490E+04,2.4776E+05,1.5870E+03,1.5750E+05,-7.0699E+02/ DATA AC(6,39)/2.9539E+05/ DATA TRANGE(1,39),TRANGE(2,39)/200.00,1500.00/ C *** ISOPENTANE C5H12 >> IP=40 DATA IEQ(40)/107/ DATA AC(1,40),AC(2,40),AC(3,40),AC(4,40),AC(5,40) 1/7.6400E+04,3.3030E+05,1.6190E+03,2.0100E+05,-6.9040E+02/ DATA AC(6,40)/3.4363E+05/ DATA TRANGE(1,40),TRANGE(2,40)/200.00,1500.00/ C *** METHYL CHLORIDE CH3CL >> IP=41 DATA IEQ(41)/107/ DATA AC(1,41),AC(2,41),AC(3,41),AC(4,41),AC(5,41) 1/3.4090E+04,7.2460E+04,1.7230E+03,4.4800E+04,7.8050E+02/ DATA AC(6,41)/2.3418E+05/ DATA TRANGE(1,41),TRANGE(2,41)/150.00,1500.00/ C *** ACETALDEHYDE C2H4O >> IP=42 DATA IEQ(42)/107/ DATA AC(1,42),AC(2,42),AC(3,42),AC(4,42),AC(5,42) 1/4.0880E+04,1.0790E+05,1.4000E+03,5.2000E+04,6.1150E+02/ DATA AC(6,42)/2.5020E+05/ DATA TRANGE(1,42),TRANGE(2,42)/100.00,1500.00/ C *** ACETIC ACID C2H4O2 >> IP=43 DATA IEQ(43)/107/ DATA AC(1,43),AC(2,43),AC(3,43),AC(4,43),AC(5,43) 1/4.0200E+04,1.3675E+05,1.2620E+03,7.0030E+04,5.6970E+02/ DATA AC(6,43)/2.8250E+05/ DATA TRANGE(1,43),TRANGE(2,43)/50.00,1500.00/ C *** ETHANOL C2H6O >> IP=44 DATA IEQ(44)/107/ DATA AC(1,44),AC(2,44),AC(3,44),AC(4,44),AC(5,44) 1/4.9200E+04,1.4577E+05,1.6628E+03,9.3900E+04,7.4470E+02/ DATA AC(6,44)/2.8064E+05/ DATA TRANGE(1,44),TRANGE(2,44)/200.00,1500.00/ C *** PROPYLENE C3H6 >> IP=45 DATA IEQ(45)/107/ DATA AC(1,45),AC(2,45),AC(3,45),AC(4,45),AC(5,45) 1/4.1300E+04,1.5250E+05,1.3520E+03,7.4400E+04,5.7800E+02/ DATA AC(6,45)/2.6660E+05/ DATA TRANGE(1,45),TRANGE(2,45)/90.00,1500.00/ C *** ACETONE C3H6O >> IP=46 DATA IEQ(46)/107/ DATA AC(1,46),AC(2,46),AC(3,46),AC(4,46),AC(5,46) 1/4.8120E+04,1.6440E+05,1.2500E+03,7.1700E+04,-5.2440E+02/ DATA AC(6,46)/2.9535E+05/ DATA TRANGE(1,46),TRANGE(2,46)/100.00,1500.00/ C *** n-PENTANE C5H12 >> IP=47 DATA IEQ(47)/107/ DATA AC(1,47),AC(2,47),AC(3,47),AC(4,47),AC(5,47) 1/8.8050E+04,3.0110E+05,1.6502E+03,1.8920E+05,7.4760E+02/ DATA AC(6,47)/3.4945E+05/ DATA TRANGE(1,47),TRANGE(2,47)/200.00,1500.00/ C *** BENZENE C6H6 >> IP=48 DATA IEQ(48)/107/ DATA AC(1,48),AC(2,48),AC(3,48),AC(4,48),AC(5,48) 1/4.4420E+04,2.3205E+05,1.4946E+03,1.7213E+05,-6.7815E+02/ DATA AC(6,48)/2.6920E+05/ DATA TRANGE(1,48),TRANGE(2,48)/200.00,1500.00/ C *** n-HEXANE C6H14 >> IP=49 DATA IEQ(49)/107/ DATA AC(1,49),AC(2,49),AC(3,49),AC(4,49),AC(5,49) 1/1.0440E+05,3.5230E+05,1.6946E+03,2.3690E+05,7.6160E+02/ DATA AC(6,49)/3.8874E+05/ DATA TRANGE(1,49),TRANGE(2,49)/200.00,1500.00/ C *** TOLUENE C7H8 >> IP=50 DATA IEQ(50)/107/ DATA AC(1,50),AC(2,50),AC(3,50),AC(4,50),AC(5,50) 1/5.8140E+04,2.8630E+05,1.4406E+03,1.8980E+05,-6.5043E+02/ DATA AC(6,50)/3.1974E+05/ DATA TRANGE(1,50),TRANGE(2,50)/200.00,1500.00/ C *** n-HEPTANE C7H16 >> IP=51 DATA IEQ(51)/107/ DATA AC(1,51),AC(2,51),AC(3,51),AC(4,51),AC(5,51) 1/1.2015E+05,4.0010E+05,1.6766E+03,2.7400E+05,7.5640E+02/ DATA AC(6,51)/4.2798E+05/ DATA TRANGE(1,51),TRANGE(2,51)/200.00,1500.00/ C *** n-OCTANE C8H18 >> IP=52 DATA IEQ(52)/107/ DATA AC(1,52),AC(2,52),AC(3,52),AC(4,52),AC(5,52) 1/1.3554E+05,4.4310E+05,1.6356E+03,3.0540E+05,7.4640E+02/ DATA AC(6,52)/4.6723E+05/ DATA TRANGE(1,52),TRANGE(2,52)/200.00,1500.00/ C *** ISO-OCTANE C8H18 >> IP=53 DATA IEQ(53)/107/ DATA AC(1,53),AC(2,53),AC(3,53),AC(4,53),AC(5,53) 1/1.2215E+05,4.7270E+05,1.5866E+03,3.1650E+05,6.9960E+02/ DATA AC(6,53)/4.5957E+05/ DATA TRANGE(1,53),TRANGE(2,53)/200.00,1500.00/ C *** NAPHTHALENE C10H8 >> IP=54 DATA IEQ(54)/107/ DATA AC(1,54),AC(2,54),AC(3,54),AC(4,54),AC(5,54) 1/8.0315E+04,3.4293E+05,1.5289E+03,2.6608E+05,7.0780E+02/ DATA AC(6,54)/3.3315E+05/ DATA TRANGE(1,54),TRANGE(2,54)/50.00,1500.00/ C *** CALL SIP000(ISUB,IP,ANAME) IF (IP .EQ. -1) THEN IERR=-3 DO 31 I=1,3 A(I)=-1.0E+30 31 CONTINUE ELSE TMIN=TRANGE(1,IP) TMAX=TRANGE(2,IP) TLH(1)=TMIN TLH(2)=TMAX IF (T .GE. TMIN .AND. T .LE. TMAX) THEN IERR=0 IE=IEQ(IP) DO 10 I=1,6,1 ACP(I)=AC(I,IP) 10 CONTINUE IF (IE .EQ. 107) THEN A(1)=FIP7CP(ACP,T) A(2)=FIP7S(ACP,T)-FIP7S(ACP,298.15)+ACP(6) A(3)=FIP7H(ACP,T)-FIP7H(ACP,298.15) ELSEIF (IE .EQ. 100) THEN A(1)=FIP0CP(ACP,T) A(2)=FIP0S(ACP,T)-FIP0S(ACP,298.15)+ACP(6) A(3)=FIP0H(ACP,T)-FIP0H(ACP,298.15) ENDIF ELSE IERR=-2 DO 21 I=1,3,1 A(I)=-1.0E+20 21 CONTINUE ENDIF ENDIF RETURN END C *** COMBUSTION-BY-AIR PRODUCT COMPOSIOTION OF MIXED FUELS C * (C_XC H_XH O_XO)i (I=1,IN) + MOIST AIR C * A(1,I) : MOLE FRACTION of I-th FUEL C * A(2,I) : XC of I-th FUEL C * A(3,I) : XH of I-th FUEL C * A(4,I) : XO of I-th FUEL C * AF : AIR FACTOR C * XW : ABSOLUTE HUMIDITY OF MOIST AIR KG/(KG OF DRY AIR) C * XC : MOLE FRACTION OF CO2 IN COMBUSTION PRODUCT C * XH : MOLE FRACTION OF H2O IN COMBUSTION PRODUCT C * XN : MOLE FRACTION OF N2 IN COMBUSTION PRODUCT C * XO : MOLE FRACTION OF O2 IN COMBUSTION PRODUCT SUBROUTINE FUELML(IERR,A,IR,AF,XW,XC,XH,XN,XO) INTEGER IERR,KPA,KMOL REAL AF,A(4,IR) REAL XC,XH,XO,XN COMMON /UNIT/KPA,KMOL,MESS COMMON /CNST/GASCON IF (AF .LT. 1 .OR. XW .LT. 0.0) THEN IERR=-2 XC=-1.-E+20 XH=-1.-E+20 XN=-1.-E+20 XO=-1.-E+20 RETURN ENDIF XC=0.0 XH=0.0 XN=0.0 XO=0.0 DO 10 I=1,IR XIMOL=A(1,I) XCHO=A(2,I)+0.25*A(3,I)-0.5*A(4,I) XC=XC+XIMOL*A(2,I) XH=XH+XIMOL*(0.5*A(3,I)+7.674*AF*XW*XCHO) XNO=XNO+XIMOL*XCHO 10 CONTINUE XN=3.773*AF*XNO XO=(AF-1.0)*XNO XMOL=XC+XH+XN+XO XC=XC/XMOL XH=XH/XMOL XN=XN/XMOL XO=XO/XMOL RETURN END