C*********************************************************************** C PROPATH V10.1 ----- Peng-Robinson Equation (PRMX-SS.EXE) * C by K.KAWAKITA (Oct.1994) * C*********************************************************************** INTEGER J,KPA,MESS,KSTAN,KAS,NL,NM,JT,JP,JZ,NCOM1,KOMBI REAL QNM CHARACTER UPT(0:3)*6,UA(0:1)*4,COMP1(1:3)*5,COMP2(1:16)*20, & CSTAN(1:2)*16,DTAFIL*11,FNAME*40,CHA COMMON/PR01/JT,JP,JZ,KOMBI,NCOM1 COMMON/PR03/KPA,MESS,KSTAN,KAS COMMON/PR04/COMP1,COMP2 DATA CSTAN/' Ideal Gas State',' IIR '/ DATA UPT /' Pa, K','bar, C','bar, K',' Pa, C'/ DATA UA /'kmol',' kg '/ CALL PRUNIT C ***** Initial Set ***** DTAFIL='prmx-ss.dat' OPEN(2,FILE=DTAFIL) READ(2,'(A7,I4)') CHA,KPA READ(2,'(A7,I4)') CHA,MESS READ(2,'(A7,I4)') CHA,KSTAN READ(2,'(A7,I4)') CHA,KAS READ(2,'(A7,I4)') CHA,JP READ(2,'(A7,I4)') CHA,JT READ(2,'(A7,I4)') CHA,JZ READ(2,'(A7,I4)') CHA,KOMBI READ(2,'(A7,I4)') CHA,NL IF(NL.EQ.1)READ(2,'(A40)') FNAME CLOSE(2) IF(KOMBI.LE.2) THEN NCOM1=KOMBI ELSE IF(KOMBI.EQ.3) THEN NCOM1=2 ELSE NCOM1=3 ENDIF ENDIF 111 CALL FMENU(NL,FNAME,DTAFIL) OPEN(2,FILE=DTAFIL) WRITE(2,10) KPA WRITE(2,20) MESS WRITE(2,30) KSTAN WRITE(2,40) KAS WRITE(2,50) JP WRITE(2,60) JT WRITE(2,70) JZ WRITE(2,80) KOMBI WRITE(2,90) NL IF(NL.EQ.1)WRITE(2,'(A)')FNAME CLOSE(2) IF(NCOM1.EQ.0) GOTO 999 1000 CALL SMENU(6) 1111 WRITE(6,'(1X,A)')'Input No.' READ(5,*) QNM NM=IFIX(QNM) IF(NM*(NM-10).LT.0) THEN CALL KPAMES(KPA,MESS) CALL STNKAS(KSTAN,KAS) CALL START1(J,KOMBI) GOTO(100,200,300,400,500,600,700,800,900),NM ENDIF IF(NM.EQ.0) GOTO 999 IF(NM.EQ.99) GOTO 111 IF(NM.NE.10) THEN WRITE(6,'(1X,A)')'***** Invalid No. *****' GOTO 1111 ENDIF CALL MUNIT(UPT,UA,CSTAN) OPEN(2,FILE=DTAFIL) WRITE(2,10) KPA WRITE(2,20) MESS WRITE(2,30) KSTAN WRITE(2,40) KAS WRITE(2,50) JP WRITE(2,60) JT WRITE(2,70) JZ WRITE(2,80) KOMBI WRITE(2,90) NL IF(NL.EQ.1)WRITE(2,'(A)')FNAME CLOSE(2) GOTO 1000 100 CALL M100(NL) GOTO 1000 200 CALL M200(NL) GOTO 1000 300 CALL M300(NL) GOTO 1000 400 CALL M400(NL) GOTO 1000 500 CALL M500(NL) GOTO 1000 600 CALL M600(NL) GOTO 1000 700 CALL M700(NL) GOTO 1000 800 CALL M800(NL) GOTO 1000 900 CALL M900(NL) GOTO 1000 999 CONTINUE WRITE(6,'(/A)')' ***** See You Again ! *****' IF(NL.EQ.1) CLOSE(1) 10 FORMAT('KPA =',I4) 20 FORMAT('MESS =',I4) 30 FORMAT('KSTAN =',I4) 40 FORMAT('KAS =',I4) 50 FORMAT('JP =',I4) 60 FORMAT('JT =',I4) 70 FORMAT('JZ =',I4) 80 FORMAT('KOMBI =',I4) 90 FORMAT('NL =',I4) STOP END C ***** SET UNIT OF ENTHALPY AND ENTROPY ***** INTEGER FUNCTION LUHS(A,JZ) INTEGER JZ,JU REAL A IF(ABS(A).GE.1.0E3) THEN A=A*1.0E-3 JU=JZ+2 ELSE JU=JZ ENDIF LUHS=JU C RETURN END C ***** SET UNIT OF PRESSURE ***** INTEGER FUNCTION LUPP(P,JP) INTEGER JP,JPP REAL P IF(JP.EQ.1) THEN JPP=JP IF(P.GT.1.0E6) THEN JPP=JP+3 P=P*1.0E-6 ELSEIF(P.GT.1.0E3) THEN JPP=JP+2 P=P*1.0E-3 ENDIF ELSE JPP=JP ENDIF LUPP=JPP C RETURN END C ***** FIRST MENU ***** SUBROUTINE FMENU(NL,FNAME,DTAFIL) INTEGER NL,N,I,KOMBI,NCM,NCOM1,KPA,MESS,KSTAN,KAS,JT,JP,JZ REAL QN,QNL,QCM CHARACTER FNAME*40,HLP(16)*45,GKEY,COMP1(1:3)*5,COMP2(1:16)*20 & ,DTAFIL*11 COMMON/PR01/JT,JP,JZ,KOMBI,NCOM1 COMMON/PR03/KPA,MESS,KSTAN,KAS COMMON/PR04/COMP1,COMP2 DATA HLP/' This is help for this program (PRMX-SS.EXE)', &' Nomenclature ', &' ==== First Charactor ==== ', &' H : Enthalpy ', &' P : Pressure ', &' S : Entropy ', &' T : Temperature ', &' V : Volume ', &' X : Component1 Composition of Liquid ', &' Y : Component1 Composition of Vapor ', &' Z : Total Composition of Component1 ', &' ==== Second Charactor ==== ', &' B : Bubble Point ', &' D : Dew Point ', &' L : Liquid ', &' V : Vapor '/ 1000 WRITE(6,10)'====================================================== &==================', &'| Single Shot Program for Peng-Robinson Equation, ','|', &'| an Application Program by F-PROPATH Ver.12.1 ','|', &'| Thermophysical Properties of Binary Mixtures ','|', &'|---------------------------------------------------------------- &------|', &'| ## First Menu ## ','|', &'| No. Current ','|', &'| 1 --> Go to Second Menu ','|', &'| 2 --> Select Mixture (Component1 - Component2) ','|', &'|',COMP1(NCOM1),' - ',COMP2(KOMBI),'|', &'| 3 --> Read Help ','|' IF(NL.EQ.2) WRITE(6,'(1X,A,40X,A)')'| 4 --> Set Logfile [OFF &]','|' IF(NL.EQ.1) WRITE(6,'(1X,3A)')'| 4 --> Set Logfile [ON] ' &,FNAME,'|' WRITE(6,50)'| 0 --> Quit & |' WRITE(6,50)'====================================================== &==================' 111 WRITE(6,50)'Input No.' READ(5,*) QN N=IFIX(QN) IF(N*(N-5).LT.0) GOTO(100,200,300,400),N IF(N.EQ.0) THEN NCOM1=0 IF(NL.EQ.1) CLOSE(1) GOTO 999 ENDIF WRITE(6,50)'***** Invalid No. *****' GOTO 111 100 IF(NL.EQ.1) THEN OPEN(1,FILE=FNAME) WRITE(1,20)'====================================================== &=========', &'| Single Shot Program for Peng-Robinson Equation, |', &'| an Application Program by F-PROPATH Ver.12.1 |', &'| Thermophysical Properties of Binary Mixtures |', &'===============================================================' WRITE(1,30) (HLP(I),I=1,16) CALL SMENU(1) ENDIF GOTO 999 200 WRITE(6,50)'=====================================' WRITE(6,50)'| No.| Component1 - Component2 |' WRITE(6,50)'|----|------------------------------|' WRITE(6,40)'| ',1,' | ',COMP1(1),' - ',COMP2(1),' |' DO 210 I=2,3 WRITE(6,40)'| ',I,' | ',COMP1(2),' - ',COMP2(I),' |' 210 CONTINUE DO 220 I=4,16 WRITE(6,40)'| ',I,' | ',COMP1(3),' - ',COMP2(I),' |' 220 CONTINUE WRITE(6,50)'=====================================' 222 WRITE(6,50)'Input No.' READ(5,*) QCM NCM=IFIX(QCM) IF(NCM*(NCM-17).LT.0) THEN KOMBI=NCM IF(KOMBI.LE.2) THEN NCOM1=KOMBI ELSE IF(KOMBI.EQ.3) THEN NCOM1=2 ELSE NCOM1=3 ENDIF ENDIF GOTO 1000 ENDIF WRITE(6,50)'***** Invalid No. *****' GOTO 222 300 WRITE(6,30) (HLP(I),I=1,16) WRITE(6,'(A)')' ----- Hit RETURN Key -----' READ(5,'(A)') GKEY GOTO 1000 400 IF(NL.EQ.1) CLOSE(1) WRITE(6,'(/,1X,A)') ' 1: Logfile ON' WRITE(6,50) ' 2: Logfile OFF' 444 WRITE(6,50)'Input No.' READ(5,*) QNL NL=IFIX(QNL) IF(NL*(NL-3).LT.0) GOTO(410,420),NL WRITE(6,50)'***** Invalid No. *****' GOTO 444 410 WRITE(6,50) 'Input Filename' READ(5,'(A40)') FNAME IF(FNAME.EQ.DTAFIL) THEN WRITE(6,50) 'Sorry, This filename is used as DATA filename. Ple &ase input another filename.' GOTO 410 ENDIF 420 GOTO 1000 10 FORMAT(1X,A/,3(1X,A,12X,A/),1X,A/,4(1X,A,12X,A/),1X,A,25X,A,A,A, &17X,A/,1X,A,12X,A) 20 FORMAT(4(1X,A,/),1X,A) 30 FORMAT(/,16(1X,A,/)) 40 FORMAT(1X,A,I2,5A) 50 FORMAT(1X,A) C 999 RETURN END C ***** SECOND MENU ***** SUBROUTINE SMENU(NF) INTEGER NF WRITE(NF,10)'===================================================== &==========', &'| ## Second Menu ## |', &'| |', &'| No. Input Output |', &'| 1 --(P,T,Z)--> H HL HV S SL SV V VL VV X Y QUALITY |', &'| 2 --(P,Z,H)--> T HL HV S SL SV V VL VV X Y QUALITY |', &'| 3 --(P,Z,S)--> T H HL HV SL SV V VL VV X Y QUALITY |', &'| 4 --(P,Z,V)--> T H HL HV S SL SV VL VV X Y QUALITY |', &'|-------------------------------------------------------------|', &'| |', &'| 5 --(P,Z)----> X=Z : TB HB SB VB Y=Z : TD HD SD VD |' WRITE(NF,10)'| 6 --(T,Z)----> X=Z : PB HB SB VB Y=Z : PD HD SD &VD |', &'| 7 --(P,T)----> Coexisting Phases: X Y HL HV SL SV VL VV |', &'|-------------------------------------------------------------|', &'| 8 -----------> Fundamental Constants |', &'| 9 -----------> Conversion of Composition and Relative |', &'| Molcular Mass of Mixture |', &'|10 -----------> Change System of Unit, and Standard Values of|', &'| Enthalpy and Entropy |', &'|99 -----------> Return to First Menu |', &'| 0 -----------> Quit |', &'===============================================================' 10 FORMAT(10(1X,A,/),1X,A) RETURN END C ***** No.1 SECOND MENU ***** SUBROUTINE M100(NL) INTEGER J,NL,JT,JP,JZ,KOMBI,NCOM1 REAL T,P,Z,H,S,V CHARACTER LUP(4)*13,LUT(2)*13,LUZ(2)*13,LUH(4)*13,LUS(4)*13, & LUV(2)*13 COMMON/PR01/JT,JP,JZ,KOMBI,NCOM1 COMMON/PR02/LUT,LUP,LUZ,LUH,LUS,LUV WRITE(6,'(/A)')' ==============================' WRITE(6,'(A)') ' (P,T,Z) --> H, S, V, QUALITY' WRITE(6,'(A)') ' X, HL, SL, VL' WRITE(6,'(A)') ' Y, HV, SV, VV' WRITE(6,'(A)') ' ==============================' 100 WRITE(6,10) 'Input P',LUP(JP),' (P=0 : Second Menu)' READ(5,*) P IF(P.LE.0.) RETURN WRITE(6,20) 'Input T',LUT(JT) READ(5,*) T WRITE(6,20) 'Input Z',LUZ(JZ) READ(5,*) Z CALL SUBMIX(1,J,T,P,Z,V,H,S) IF(J.NE.0) THEN J=0 GOTO 100 ENDIF IF(NL.EQ.1) THEN WRITE(1,'(A)')'==============================' WRITE(1,'(A)')' (P,T,Z) --> H, S, V, QUALITY' WRITE(1,'(A)')' X, HL, SL, VL' WRITE(1,'(A)')' Y, HV, SV, VV' WRITE(1,'(A)')'==============================' ENDIF CALL OUTPUT(NL,T,P,Z,V,H,S) GOTO 100 10 FORMAT(1X,3A) 20 FORMAT(1X,2A) END C ***** No.2 SECOND MENU ***** SUBROUTINE M200(NL) INTEGER J,NL,JT,JP,JZ,KOMBI,NCOM1 REAL T,P,Z,H,S,V CHARACTER LUP(4)*13,LUT(2)*13,LUZ(2)*13,LUH(4)*13,LUS(4)*13, & LUV(2)*13 COMMON/PR01/JT,JP,JZ,KOMBI,NCOM1 COMMON/PR02/LUT,LUP,LUZ,LUH,LUS,LUV WRITE(6,'(/A)')' ==============================' WRITE(6,'(A)') ' (P,Z,H) --> T, S, V, QUALITY' WRITE(6,'(A)') ' X, HL, SL, VL' WRITE(6,'(A)') ' Y, HV, SV, VV' WRITE(6,'(A)') ' ==============================' 100 WRITE(6,10) 'Input P',LUP(JP),' (P=0 : Second Menu)' READ(5,*) P IF(P.LE.0.) RETURN WRITE(6,20) 'Input Z',LUZ(JZ) READ(5,*) Z WRITE(6,20) 'Input H',LUH(JZ+2) READ(5,*) H H=H*1.0E3 CALL SUBMIX(2,J,T,P,Z,V,H,S) IF(J.NE.0) THEN J=0 GOTO 100 ENDIF IF(NL.EQ.1) THEN WRITE(1,'(A)')'==============================' WRITE(1,'(A)')' (P,Z,H) --> T, S, V, QUALITY' WRITE(1,'(A)')' X, HL, SL, VL' WRITE(1,'(A)')' Y, HV, SV, VV' WRITE(1,'(A)')'==============================' ENDIF CALL OUTPUT(NL,T,P,Z,V,H,S) GOTO 100 10 FORMAT(1X,3A) 20 FORMAT(1X,2A) END C ***** No.3 SECOND MENU ***** SUBROUTINE M300(NL) INTEGER J,NL,JT,JP,JZ,KOMBI,NCOM1 REAL T,P,Z,H,S,V CHARACTER LUP(4)*13,LUT(2)*13,LUZ(2)*13,LUH(4)*13,LUS(4)*13, & LUV(2)*13 COMMON/PR01/JT,JP,JZ,KOMBI,NCOM1 COMMON/PR02/LUT,LUP,LUZ,LUH,LUS,LUV WRITE(6,'(/A)')' ==============================' WRITE(6,'(A)') ' (P,Z,S) --> T, H, V, QUALITY' WRITE(6,'(A)') ' X, HL, SL, VL' WRITE(6,'(A)') ' Y, HV, SV, VV' WRITE(6,'(A)') ' ==============================' 100 WRITE(6,10) 'Input P',LUP(JP),' (P=0 : Second Menu)' READ(5,*) P IF(P.LE.0.) RETURN WRITE(6,20) 'Input Z',LUZ(JZ) READ(5,*) Z WRITE(6,20) 'Input S',LUS(JZ+2) READ(5,*) S S=S*1.0E3 CALL SUBMIX(3,J,T,P,Z,V,H,S) IF(J.NE.0) THEN J=0 GOTO 100 ENDIF IF(NL.EQ.1) THEN WRITE(1,'(A)')'==============================' WRITE(1,'(A)')' (P,Z,S) --> T, H, V, QUALITY' WRITE(1,'(A)')' X, HL, SL, VL' WRITE(1,'(A)')' Y, HV, SV, VV' WRITE(1,'(A)')'==============================' ENDIF CALL OUTPUT(NL,T,P,Z,V,H,S) GOTO 100 10 FORMAT(1X,3A) 20 FORMAT(1X,2A) END C ***** No.4 SECOND MENU ***** SUBROUTINE M400(NL) INTEGER J,NL,JT,JP,JZ,KOMBI,NCOM1 REAL T,P,Z,H,S,V CHARACTER LUP(4)*13,LUT(2)*13,LUZ(2)*13,LUH(4)*13,LUS(4)*13, & LUV(2)*13 COMMON/PR01/JT,JP,JZ,KOMBI,NCOM1 COMMON/PR02/LUT,LUP,LUZ,LUH,LUS,LUV WRITE(6,'(/A)')' ==============================' WRITE(6,'(A)') ' (P,Z,V) --> T, H, S, QUALITY' WRITE(6,'(A)') ' X, HL, SL, VL' WRITE(6,'(A)') ' Y, HV, SV, VV' WRITE(6,'(A)') ' ==============================' 100 WRITE(6,10) 'Input P',LUP(JP),' (P=0 : Second Menu)' READ(5,*) P IF(P.LE.0.) RETURN WRITE(6,20) 'Input Z',LUZ(JZ) READ(5,*) Z WRITE(6,20) 'Input V',LUV(JZ) READ(5,*) V CALL SUBMIX(4,J,T,P,Z,V,H,S) IF(J.NE.0) THEN J=0 GOTO 100 ENDIF IF(NL.EQ.1) THEN WRITE(1,'(A)')'==============================' WRITE(1,'(A)')' (P,Z,V) --> T, H, S, QUALITY' WRITE(1,'(A)')' X, HL, SL, VL' WRITE(1,'(A)')' Y, HV, SV, VV' WRITE(1,'(A)')'==============================' ENDIF CALL OUTPUT(NL,T,P,Z,V,H,S) GOTO 100 10 FORMAT(1X,3A) 20 FORMAT(1X,2A) END C ***** No.5 SECOND MENU ***** SUBROUTINE M500(NL) INTEGER J,NL,JT,JP,JZ,JPP,JHB,JHD,JSB,JSD,LUPP,LUHS,KOMBI,NCOM1 REAL TB,TD,P,Z,HB,HD,SB,SD,VB,VD CHARACTER LUP(4)*13,LUT(2)*13,LUZ(2)*13,LUH(4)*13,LUS(4)*13, & LUV(2)*13,COMP1(1:3)*5,COMP2(1:16)*20 COMMON/PR01/JT,JP,JZ,KOMBI,NCOM1 COMMON/PR02/LUT,LUP,LUZ,LUH,LUS,LUV COMMON/PR04/COMP1,COMP2 WRITE(6,'(/A)')' ================================' WRITE(6,'(A)') ' (P,Z) --> X=Z : TB, HB, SB, VB' WRITE(6,'(A)') ' Y=Z : TD, HD, SD, VD' WRITE(6,'(A)') ' ================================' 100 WRITE(6,10) 'Input P',LUP(JP),' (P=0 : Second Menu)' READ(5,*) P IF(P.LE.0.) RETURN WRITE(6,20) 'Input Z',LUZ(JZ) READ(5,*) Z CALL SUBTB(J,TB,P,Z,VB,HB,SB) IF(J.NE.0) THEN J=0 GOTO 100 ENDIF CALL SUBTD(J,TD,P,Z,VD,HD,SD) IF(J.NE.0) THEN J=0 GOTO 100 ENDIF JPP=LUPP(P,JP) JHB=LUHS(HB,JZ) JHD=LUHS(HD,JZ) JSB=LUHS(SB,JZ) JSD=LUHS(SD,JZ) WRITE(6,30) P,LUP(JPP),Z,LUZ(JZ) WRITE(6,40) TB,LUT(JT),TD,LUT(JT) WRITE(6,50) HB,LUH(JHB),HD,LUH(JHD) WRITE(6,60) SB,LUS(JSB),SD,LUS(JSD) WRITE(6,70) VB,LUV(JZ),VD,LUV(JZ) IF(NL.EQ.1) THEN WRITE(1,'(A)')'================================' WRITE(1,'(A)')' (P,Z) --> X=Z : TB, HB, SB, VB' WRITE(1,'(A)')' Y=Z : TD, HD, SD, VD' WRITE(1,'(A)')'================================' WRITE(1,80) COMP1(NCOM1),COMP2(KOMBI) WRITE(1,30) P,LUP(JPP),Z,LUZ(JZ) WRITE(1,40) TB,LUT(JT),TD,LUT(JT) WRITE(1,50) HB,LUH(JHB),HD,LUH(JHD) WRITE(1,60) SB,LUS(JSB),SD,LUS(JSD) WRITE(1,70) VB,LUV(JZ),VD,LUV(JZ) ENDIF GOTO 100 10 FORMAT(1X,3A) 20 FORMAT(1X,2A) 30 FORMAT(' P = ',F16.8,A,'Z = ',F16.8,A) 40 FORMAT(' TB = ',F16.8,A,'TD = ',F16.8,A) 50 FORMAT(' HB = ',F16.8,A,'HD = ',F16.8,A) 60 FORMAT(' SB = ',F16.8,A,'SD = ',F16.8,A) 70 FORMAT(' VB = ',E16.8,A,'VD = ',E16.8,A/) 80 FORMAT(A,' - ',A) END C ***** No.6 SECOND MENU ***** SUBROUTINE M600(NL) INTEGER J,NL,JT,JP,JPB,JPD,JZ,JHB,JHD,JSB,JSD,LUPP,LUHS,KOMBI, & NCOM1 REAL T,PB,PD,Z,HB,HD,SB,SD,VB,VD CHARACTER LUP(4)*13,LUT(2)*13,LUZ(2)*13,LUH(4)*13,LUS(4)*13, & LUV(2)*13,COMP1(1:3)*5,COMP2(1:16)*20 COMMON/PR01/JT,JP,JZ,KOMBI,NCOM1 COMMON/PR02/LUT,LUP,LUZ,LUH,LUS,LUV COMMON/PR04/COMP1,COMP2 WRITE(6,'(/A)')' ================================' WRITE(6,'(A)') ' (T,Z) --> X=Z : PB, HB, SB, VB' WRITE(6,'(A)') ' Y=Z : PD, HD, SD, VD' WRITE(6,'(A)') ' ================================' 100 WRITE(6,10) 'Input Z',LUZ(JZ),' (Z < 0 : Second Menu)' READ(5,*) Z IF(Z.LT.0.) RETURN WRITE(6,20) 'Input T',LUT(JT) READ(5,*) T CALL SUBPB(J,T,PB,Z,VB,HB,SB) IF(J.NE.0) THEN J=0 GOTO 100 ENDIF CALL SUBPD(J,T,PD,Z,VD,HD,SD) IF(J.NE.0) THEN J=0 GOTO 100 ENDIF JPB=LUPP(PB,JP) JPD=LUPP(PD,JP) JHB=LUHS(HB,JZ) JHD=LUHS(HD,JZ) JSB=LUHS(SB,JZ) JSD=LUHS(SD,JZ) WRITE(6,30) T,LUT(JT),Z,LUZ(JZ) WRITE(6,40) PB,LUP(JPB),PD,LUP(JPD) WRITE(6,50) HB,LUH(JHB),HD,LUH(JHD) WRITE(6,60) SB,LUS(JSB),SD,LUS(JSD) WRITE(6,70) VB,LUV(JZ),VD,LUV(JZ) IF(NL.EQ.1) THEN WRITE(1,'(A)')'================================' WRITE(1,'(A)')' (T,Z) --> X=Z : PB, HB, SB, VB' WRITE(1,'(A)')' Y=Z : PD, HD, SD, VD' WRITE(1,'(A)')'================================' WRITE(1,80) COMP1(NCOM1),COMP2(KOMBI) WRITE(1,30) T,LUT(JT),Z,LUZ(JZ) WRITE(1,40) PB,LUP(JPB),PD,LUP(JPD) WRITE(1,50) HB,LUH(JHB),HD,LUH(JHD) WRITE(1,60) SB,LUS(JSB),SD,LUS(JSD) WRITE(1,70) VB,LUV(JZ),VD,LUV(JZ) ENDIF GOTO 100 10 FORMAT(1X,3A) 20 FORMAT(1X,2A) 30 FORMAT(' T = ',F16.8,A,'Z = ',F16.8,A) 40 FORMAT(' PB = ',F16.8,A,'PD = ',F16.8,A) 50 FORMAT(' HB = ',F16.8,A,'HD = ',F16.8,A) 60 FORMAT(' SB = ',F16.8,A,'SD = ',F16.8,A) 70 FORMAT(' VB = ',E16.8,A,'VD = ',E16.8,A/) 80 FORMAT(A,' - ',A) END C ***** No.7 SECOND MENU ***** SUBROUTINE M700(NL) INTEGER J,NL,JT,JZ,JP,JPP,JHL,JHV,JSL,JSV,LUPP,LUHS,KOMBI,NCOM1 REAL T,P,HL,HV,SL,SV,VL,VV,X,Y CHARACTER LUP(4)*13,LUT(2)*13,LUZ(2)*13,LUH(4)*13,LUS(4)*13, & LUV(2)*13,COMP1(1:3)*5,COMP2(1:16)*20 COMMON/PR01/JT,JP,JZ,KOMBI,NCOM1 COMMON/PR02/LUT,LUP,LUZ,LUH,LUS,LUV COMMON/PR04/COMP1,COMP2 WRITE(6,'(/A)')' =============================' WRITE(6,'(A)') ' (P,T) --> Coexisting Phases' WRITE(6,'(A)') ' X, HL, SL, VL' WRITE(6,'(A)') ' Y, HV, SV, VV' WRITE(6,'(A)') ' =============================' 100 WRITE(6,10) 'Input P',LUP(JP),' (P=0 : Second Menu)' READ(5,*) P IF(P.LE.0.) RETURN WRITE(6,20) 'Input T',LUT(JT) READ(5,*) T CALL SUBXY(J,T,P,X,Y,VL,VV,HL,HV,SL,SV) IF(J.NE.0) THEN J=0 GOTO 100 ENDIF JPP=LUPP(P,JP) JHL=LUHS(HL,JZ) JHV=LUHS(HV,JZ) JSL=LUHS(SL,JZ) JSV=LUHS(SV,JZ) WRITE(6,30) T,LUT(JT),P,LUP(JPP) WRITE(6,40) X,LUZ(JZ),Y,LUZ(JZ) WRITE(6,50) HL,LUH(JHL),HV,LUH(JHV) WRITE(6,60) SL,LUS(JSL),SV,LUS(JSV) WRITE(6,70) VL,LUV(JZ),VV,LUV(JZ) IF(NL.EQ.1) THEN WRITE(1,'(A)')'==============================' WRITE(1,'(A)')' (P,T) --> Coexisting Phases' WRITE(1,'(A)')' X, HL, SL, VL' WRITE(1,'(A)')' Y, HV, SV, VV' WRITE(1,'(A)')' =============================' WRITE(1,80) COMP1(NCOM1),COMP2(KOMBI) WRITE(1,30) T,LUT(JT),P,LUP(JPP) WRITE(1,40) X,LUZ(JZ),Y,LUZ(JZ) WRITE(1,50) HL,LUH(JHL),HV,LUH(JHV) WRITE(1,60) SL,LUS(JSL),SV,LUS(JSV) WRITE(1,70) VL,LUV(JZ),VV,LUV(JZ) ENDIF GOTO 100 10 FORMAT(1X,3A) 20 FORMAT(1X,2A) 30 FORMAT(' T = ',F16.8,A,'P = ',F16.8,A) 40 FORMAT(' X = ',F16.8,A,'Y = ',F16.8,A) 50 FORMAT(' HL = ',F16.8,A,'HV = ',F16.8,A) 60 FORMAT(' SL = ',F16.8,A,'SV = ',F16.8,A) 70 FORMAT(' VL = ',E16.8,A,'VV = ',E16.8,A/) 80 FORMAT(A,' - ',A) END C ***** No.8 SECOND MENU ***** SUBROUTINE M800(NL) INTEGER NL,JT,JZ,JP,KPA,MESS,KSTAN,KAS,NCOM1,KOMBI REAL MC1,MC2,RC1,RC2,TCC1,TCC2,TKC1,TKC2,PC1,PC2,VGC1,VGC2,VMC1, & VMC2,EC1,EC2,FCM CHARACTER LUP(4)*13,LUT(2)*13,LUZ(2)*13,LUH(4)*13,LUS(4)*13, & LUV(2)*13,COMP1(1:3)*5,COMP2(1:16)*20,GKEY COMMON/PR01/JT,JP,JZ,KOMBI,NCOM1 COMMON/PR02/LUT,LUP,LUZ,LUH,LUS,LUV COMMON/PR03/KPA,MESS,KSTAN,KAS COMMON/PR04/COMP1,COMP2 WRITE(6,'(/A)')' =======================' WRITE(6,'(A)')' Fundamental Constants' WRITE(6,'(A)')' =======================' CALL KPAMES(1,1) CALL STNKAS(1,1) MC1=FCM(1,'M') RC1=FCM(1,'R') TCC1=FCM(1,'T') PC1=FCM(1,'P') VGC1=FCM(1,'V') MC2=FCM(2,'M') RC2=FCM(2,'R') TCC2=FCM(2,'T') PC2=FCM(2,'P') VGC2=FCM(2,'V') CALL KPAMES(0,1) CALL STNKAS(1,0) TKC1=FCM(1,'T') VMC1=FCM(1,'V') EC1=FCM(1,'E') TKC2=FCM(2,'T') VMC2=FCM(2,'V') EC2=FCM(2,'E') IF(KOMBI.GE.12) WRITE(6,30)'',COMP1(NCOM1),' ]','[ ', & COMP2(KOMBI) IF(KOMBI.LE.11) WRITE(6,31)'',COMP1(NCOM1),' ]','[ ', & COMP2(KOMBI) WRITE(6,40)MC1,MC2 WRITE(6,50)RC1,RC2,LUS(2) WRITE(6,60)TKC1,TKC2,LUT(1) WRITE(6,61)TCC1,TCC2,LUT(2) WRITE(6,70)PC1,PC2,LUP(2) WRITE(6,80)VMC1,VMC2,LUV(1) WRITE(6,81)VGC1,VGC2,LUV(2) WRITE(6,90)EC1,EC2 IF(NL.EQ.1) THEN WRITE(1,'(A)')'=======================' WRITE(1,'(A)')' Fundamental Constants' WRITE(1,'(A)')'=======================' IF(KOMBI.GE.12) WRITE(1,30)'',COMP1(NCOM1),' ]','[ ' & ,COMP2(KOMBI) IF(KOMBI.LE.11) WRITE(1,31)'',COMP1(NCOM1),' ]','[ ' & ,COMP2(KOMBI) WRITE(1,40)MC1,MC2 WRITE(1,50)RC1,RC2,LUS(2) WRITE(1,60)TKC1,TKC2,LUT(1) WRITE(1,61)TCC1,TCC2,LUT(2) WRITE(1,70)PC1,PC2,LUP(2) WRITE(1,80)VMC1,VMC2,LUV(1) WRITE(1,81)VGC1,VGC2,LUV(2) WRITE(1,90)EC1,EC2 ENDIF WRITE(6,'(A)')' ----- Hit RETURN Key -----' READ(5,'(A)') GKEY CALL KPAMES(KPA,MESS) CALL STNKAS(KSTAN,KAS) RETURN 10 FORMAT(1X,3A) 20 FORMAT(1X,2A) 30 FORMAT(5X,A,16X,2A,4X,2A) 31 FORMAT(5X,A,16X,2A,12X,2A) 40 FORMAT(' Relative Molecular Mass ',F16.8,F21.8,' [kg/kmol]') 50 FORMAT(' Gas Constants ',F16.8,F21.8,2X,A) 60 FORMAT(' Critical Temperature ',F16.8,F21.8,2X,A) 61 FORMAT(26X,F16.8,F21.8,2X,A) 70 FORMAT(' Critical Pressure ',F16.8,F21.8,2X,A) 80 FORMAT(' Critical Volume ',E16.8,E21.8,2X,A) 81 FORMAT(26X,E16.8,E21.8,2X,A) 90 FORMAT(' Acentric Factor ',E16.8,E21.8,2X,'[-]',/) END C ***** No.9 SECOND MENU ***** SUBROUTINE M900(NL) INTEGER NL,JT,JZ,JP,NZ,KOMBI,NCOM1 REAL NC1,NC2,NMIX,Z,ZZ,QNZ,FCM,AKG,AKMOL CHARACTER LUP(4)*13,LUT(2)*13,LUZ(2)*13,LUH(4)*13,LUS(4)*13, & LUV(2)*13,COMP1(1:3)*5,COMP2(1:16)*20 COMMON/PR01/JT,JP,JZ,KOMBI,NCOM1 COMMON/PR02/LUT,LUP,LUZ,LUH,LUS,LUV COMMON/PR04/COMP1,COMP2 NC1=FCM(1,'M') NC2=FCM(2,'M') WRITE(6,'(/A)')' ================================================= &=================' WRITE(6,'(A)') ' Conversion of Composition and Relative Molecular & Mass of Mixture' WRITE(6,'(A)') ' ================================================= &=================' 100 WRITE(6,'(/A)')' 1: [kmol/kmol] --> [kg/kg] and Relative Mole &cular Mass of Mixture' WRITE(6,'(A)') ' 2: [kg/kg] --> [kmol/kmol] and Relative Mole &cular Mass of Mixture' WRITE(6,'(A)') ' 0: Return to Second Menu' WRITE(6,'(1X,A)') 'Input No.' READ(5,*) QNZ NZ=IFIX(QNZ) IF(NZ*(NZ-3).GT.0) GOTO 100 IF(NZ.EQ.0) RETURN WRITE(6,10) 'Input Z',LUZ(NZ) READ(5,*) Z IF(NZ.EQ.1) THEN ZZ=AKG(Z) NMIX=NC1*Z+NC2*(1-Z) ENDIF IF(NZ.EQ.2) THEN ZZ=AKMOL(Z) NMIX=NC1*ZZ+NC2*(1-ZZ) ENDIF WRITE(6,20) Z,LUZ(NZ) WRITE(6,20) ZZ,LUZ(2-NZ/2) WRITE(6,30) NMIX WRITE(6,40) COMP1(NCOM1),NC1 WRITE(6,50) COMP2(KOMBI),NC2 IF(NL.EQ.1) THEN WRITE(1,'(A)')'================================================ &==================' WRITE(1,'(A)')' Conversion of Composition and Relative Molecula &r Mass of Mixture' WRITE(1,'(A)')'================================================ &==================' WRITE(1,20) Z,LUZ(NZ) WRITE(1,20) ZZ,LUZ(2-NZ/2) WRITE(1,30) NMIX WRITE(1,40) COMP1(NCOM1),NC1 WRITE(1,50) COMP2(KOMBI),NC2 ENDIF GOTO 100 10 FORMAT(1X,2A) 20 FORMAT(1X,' Z = ',F12.8,A) 30 FORMAT(1X,' Relative Molecular Mass of Mixture = ',F16.8, & '[kg/kmol]') 40 FORMAT(1X,' Relative Molecular Mass of ',A,' ]',/,F16.8, &'[kg/kmol]') 50 FORMAT(1X,' Relative Molecular Mass of ','[ ',A/,F16.8, &'[kg/kmol]',/) END C ***** No.10 SECOND MENU ***** SUBROUTINE MUNIT(UPT,UA,CSTAN) INTEGER JT,JZ,JP,KPA,MESS,KSTAN,KAS,KOMBI,NCOM1,NU,NSTAN,NPA,NAS REAL QNU,QSTAN,QPA,QAS CHARACTER LUP(4)*13,LUT(2)*13,LUZ(2)*13,LUH(4)*13,LUS(4)*13, & LUV(2)*13,UPT(0:3)*6,UA(0:1)*4,CSTAN(1:2)*16 COMMON/PR01/JT,JP,JZ,KOMBI,NCOM1 COMMON/PR02/LUT,LUP,LUZ,LUH,LUS,LUV COMMON/PR03/KPA,MESS,KSTAN,KAS 100 WRITE(6,*)' ' WRITE(6,10) WRITE(6,20) WRITE(6,10) WRITE(6,30) UPT(KPA) WRITE(6,40) UA(KAS) WRITE(6,50) KSTAN+1,CSTAN(KSTAN+1) WRITE(6,60) WRITE(6,10) 200 WRITE(6,'(1X,A)')'Input No.' READ(5,*) QNU NU=IFIX(QNU) IF(NU*(NU-4).LT.0) GOTO(110,120,130),NU IF(NU.EQ.0) RETURN WRITE(6,'(1X,A)')'***** Invalid No. *****' GOTO 200 110 WRITE(6,'(/A)')' ===============================' WRITE(6,'(A)') ' No. ' WRITE(6,'(A)') ' ===============================' WRITE(6,'(A)') ' 1 --> Pa K ' WRITE(6,'(A)') ' 2 --> bar C ' WRITE(6,'(A)') ' 3 --> bar K ' WRITE(6,'(A)') ' 4 --> Pa C ' WRITE(6,'(A)') ' ===============================' 111 WRITE(6,'(1X,A)')'Input No.' READ(5,*) QPA NPA=IFIX(QPA) IF(NPA*(NPA-5).GE.0) THEN WRITE(6,'(1X,A)')'***** Invalid No. *****' GOTO 111 ENDIF KPA=NPA-1 IF(KPA.EQ.0.OR.KPA.EQ.3) JP=1 IF(KPA.EQ.1.OR.KPA.EQ.2) JP=2 IF(KPA.EQ.0.OR.KPA.EQ.2) JT=1 IF(KPA.EQ.1.OR.KPA.EQ.3) JT=2 GOTO 100 120 WRITE(6,'(/A)')' ===========================' WRITE(6,'(A)') ' No. Amount of Substance' WRITE(6,'(A)') ' 1 --> kmol' WRITE(6,'(A)') ' 2 --> kg' WRITE(6,'(A)') ' ===========================' 121 WRITE(6,'(1H ,A)')'Input No.' READ(5,*) QAS NAS=IFIX(QAS) IF(NAS*(NAS-3).GE.0) THEN WRITE(6,'(1X,A)')'***** Invalid No. *****' GOTO 121 ENDIF KAS=NAS-1 JZ=NAS GOTO 100 130 WRITE(6,'(/A)')' ================================================' WRITE(6,'(A)') ' No. Standard States and Values of h and s' WRITE(6,'(A)') ' 1 --> Ideal Gas State of Pure Components' WRITE(6,'(A)') ' h=0.0[kJ/kg], s=0.0[kJ/(kg*K)]' WRITE(6,'(A)') ' Pure Ideal Gases at 0[C], 1.0[bar]' WRITE(6,'(A)') ' 2 --> Convention of International Institute of' WRITE(6,'(A)') ' Refrigeration(IIR):' WRITE(6,'(A)') ' h=200[kJ/kg], s=1.0[kJ/(kg*K)]' WRITE(6,'(A)') ' Saturated Pure Liquids at 0[C]' WRITE(6,'(A)') ' ================================================' 131 WRITE(6,'(1X,A)')'Input No.' READ(5,*) QSTAN NSTAN=IFIX(QSTAN) IF(NSTAN*(NSTAN-3).GT.0) THEN WRITE(6,'(1X,A)')'***** Invalid No. *****' GOTO 131 ENDIF KSTAN=NSTAN-1 GOTO 100 10 FORMAT(' =======================================================') 20 FORMAT(' No. current') 30 FORMAT(' 1 --> Pressure and Temperature ','[',A,']') 40 FORMAT(' 2 --> Amount of Substance ','[',A,']') 50 FORMAT(' 3 --> Standard Values of h and s ' & ,'[',I1,']',A) 60 FORMAT(' 0 --> Return to Second Menu') END C ***** UNIT DATA ***** SUBROUTINE PRUNIT INTEGER I CHARACTER LUP(4)*13,LUT(2)*13,LUZ(2)*13,LUH(4)*13,LUS(4)*13, & LUV(2)*13,LLUP(4)*13,LLUT(2)*13,LLUZ(2)*13,LLUH(4)*13, & LLUS(4)*13,LLUV(2)*13,CCOMP1(1:3)*5,CCOMP2(1:16)*20, & COMP1(1:3)*5,COMP2(1:16)*20 COMMON/PR02/LUT,LUP,LUZ,LUH,LUS,LUV COMMON/PR04/COMP1,COMP2 DATA LLUP /'[Pa] ','[bar] ' & ,'[kPa] ','[MPa] '/ DATA LLUT /'[K] ','[C] '/ DATA LLUZ /'[kmol/kmol] ','[kg/kg] '/ DATA LLUH /'[J/kmol] ','[J/kg] ','[kJ/kmol] ' & ,'[kJ/kg] '/ DATA LLUS /'[J/(kmol*K)] ','[J/(kg*K)] ','[kJ/(kmol*K)]' & ,'[kJ/(kg*K)] '/ DATA LLUV /'[m**3/kmol] ','[m**3/kg] '/ DATA CCOMP1/'[ R22','[ R32','[ CH4'/ DATA CCOMP2/'R123 ]','R125 ]','R134a ]','C2H4 ]','C2H6 ]','C3H6 ]' & ,'C3H8 ]','i-C4H10 ]','n-C4H10 ]','i-C5H12 ]','n-C5H12 ]', & 'C6H14(n-Hexane) ]','C6H6(Benzene) ]','C6H12(Cyclohexane) ]', & 'C7H16(n-Heptan) ]','C8H18(n-Octane) ]'/ DO 10 I=1,2 LUT(I)=LLUT(I) LUZ(I)=LLUZ(I) LUV(I)=LLUV(I) 10 CONTINUE DO 20 I=1,4 LUP(I)=LLUP(I) LUH(I)=LLUH(I) LUS(I)=LLUS(I) 20 CONTINUE DO 30 I=1,3 COMP1(I)=CCOMP1(I) 30 CONTINUE DO 40 I=1,16 COMP2(I)=CCOMP2(I) 40 CONTINUE RETURN END C ***** OUTPUT ***** SUBROUTINE OUTPUT(NL,T,P,Z,V,H,S) INTEGER J,JT,JP,JPP,JZ,JH,JHL,JHV,JS,JSL,JSV,IP,IPHASE,LUPP,LUHS, & KOMBI,NCOM1 REAL T,P,Z,H,HL,HV,S,SL,SV,V,VL,VV,X,Y,QALTY,P0,TS CHARACTER LUP(4)*13,LUT(2)*13,LUZ(2)*13,LUV(2)*13 & ,LUH(4)*13,LUS(4)*13,COMP1(1:3)*5,COMP2(1:16)*20 COMMON/PR01/JT,JP,JZ,KOMBI,NCOM1 COMMON/PR02/LUT,LUP,LUZ,LUH,LUS,LUV COMMON/PR04/COMP1,COMP2 P0=P IF (Z.EQ.1.0.OR.Z.EQ.0.0) THEN CALL SUBTB(J,TS,P,Z,VL,HL,SL) CALL SUBTD(J,TS,P,Z,VV,HV,SV) IF (J.EQ.0) THEN IF (H.GT.HL.AND.H.LT.HV) THEN IP = 2 ELSEIF (H.LE.HL) THEN IP = 1 ELSEIF (H.GE.HV) THEN IP = 3 ENDIF ELSE IP=IPHASE(T,P,Z) ENDIF ELSE IP = IPHASE(T, P, Z) ENDIF JPP=LUPP(P0,JP) JH=LUHS(H,JZ) JS=LUHS(S,JZ) WRITE(6,10) T,LUT(JT),P0,LUP(JPP) WRITE(6,20) Z,LUZ(JZ),H,LUH(JH) WRITE(6,30) S,LUS(JS),V,LUV(JZ) IF(IP.EQ.4) WRITE(6,'(A/)') ' Supercritical Region' IF(IP.EQ.3) WRITE(6,'(A/)') ' Vapor Region' IF(IP.EQ.1) WRITE(6,'(A/)') ' Liquid Region' IF(IP.LT.0) WRITE(6,'(A/)') ' ?????????????' IF(NL.EQ.1) THEN WRITE(1,90) COMP1(NCOM1),COMP2(KOMBI) WRITE(1,10) T,LUT(JT),P0,LUP(JPP) WRITE(1,20) Z,LUZ(JZ),H,LUH(JH) WRITE(1,30) S,LUS(JS),V,LUV(JZ) IF(IP.EQ.4) WRITE(1,'(A/)') ' Supercritical Region' IF(IP.EQ.3) WRITE(1,'(A/)') ' Vapor Region' IF(IP.EQ.1) WRITE(1,'(A/)') ' Liquid Region' IF(IP.LT.0) WRITE(1,'(A/)') ' ?????????????' ENDIF IF(IP.EQ.2) THEN IF (Z.NE.0.0.AND.Z.NE.1.0) THEN CALL SUBXY(J,T,P,X,Y,VL,VV,HL,HV,SL,SV) IF(J.NE.0) THEN J=0 WRITE(1,'(A/)')'***** OUT OF RANGE AT SUBXY *****' GOTO 999 ENDIF ENDIF JHL=LUHS(HL,JZ) JHV=LUHS(HV,JZ) JSL=LUHS(SL,JZ) JSV=LUHS(SV,JZ) WRITE(6,40) X,LUZ(JZ),Y,LUZ(JZ) WRITE(6,50) HL,LUH(JHL),HV,LUH(JHV) WRITE(6,60) SL,LUS(JSL),SV,LUS(JSV) WRITE(6,70) VL,LUV(JZ),VV,LUV(JZ) IF (Z.EQ.0.0.OR.Z.EQ.1.0) THEN QALTY = (H - HL)/(HV - HL) ELSE QALTY=(Z-X)/(Y-X) ENDIF WRITE(6,80) QALTY,LUZ(JZ) IF(NL.EQ.1) THEN WRITE(1,40) X,LUZ(JZ),Y,LUZ(JZ) WRITE(1,50) HL,LUH(JHL),HV,LUH(JHV) WRITE(1,60) SL,LUS(JSL),SV,LUS(JSV) WRITE(1,70) VL,LUV(JZ),VV,LUV(JZ) WRITE(1,80) QALTY,LUZ(JZ) ENDIF ENDIF 999 CONTINUE 10 FORMAT(' T = ',F16.8,A,'P = ',F16.8,A) 20 FORMAT(' Z = ',F16.8,A,'H = ',F16.8,A) 30 FORMAT(' S = ',F16.8,A,'V = ',E16.8,A) 40 FORMAT(' X = ',F16.8,A,'Y = ',F16.8,A) 50 FORMAT(' HL = ',F16.8,A,'HV = ',F16.8,A) 60 FORMAT(' SL = ',F16.8,A,'SV = ',F16.8,A) 70 FORMAT(' VL = ',E16.8,A,'VV = ',E16.8,A) 80 FORMAT(' QUALITY =',F16.8,A/) 90 FORMAT(A,' - ',A) RETURN END