* PROPATH Ver.12.1 Application Program * -- Single Shot Program Ver.5.00 -- * Coded by Y. Takata, Kyushu University * 改訂履歴: * *---- first release ------------------------------------------------* * coding:04/10/88:V2.00:PROPATH Ver.6.1 用 * * update:11/09/88:V2.10: 　 * * update:04/25/90:V3.00:PROPATH Ver.7.1 用 * * FC, PRPD, PRPDD, PRTD, PRTDD 追加 * * update:08/05/92:V4.00:PROPATH Ver.8.1 用 * * AJTPT, BPPT, BSPT, BTPT, BVPT, GAMPDD, * * GAMPT, GAMTDD, TPSEUP 追加 * * update:08/06/92:V4.01:PROPATH Ver.8.1 用一応完成 * * update:04/20/93:V4.02:PROPATH Ver.8.1 用 * * TSBP, PSBT, T90, T68 追加 * * update:02/20/95:V5.00:PROPATH Ver.9.1 用 * * bugfix:09/19/96:V5.01:VPSの単位を修正 * * bugfix:10/14/96:V5.01:BVPTの単位を修正 * * update:12/10/96:V5.10:メニューの書き換え * * update:12/10/99:V5.20:メニューの書き換え PROPATH Ver.11.1 用 * * update:02/05/01:V5.30:メニューの書き換え PROPATH Ver.12.1 用 * *-------------------------------------------------------------------* * Type of Calculation *======================================================== * Index Functions *======================================================== * 1: P ---> TSP, AKPD, AKPDD, VPD, VPDD, HPD, HPDD, * SPD, SPDD, UPD, UPDD, ALHP * 2: P ---> TSP, ALAPP, ALMPD, ALMPDD, AMUPD, AMUPDD * 3: P ---> CPPD, CPPDD, CVPD, CVPDD, EPSPD, EPSPDD, * GAMPD, GAMPDD, PRPD, PRPDD, SIGP, WPD, * WPDD * 4: T ---> TSP, TSPD, TSPDD, TLDP, TMLP, TPSEUP, TSBT * 5: T ---> PST, AKTD, AKTDD, VTD, VTDD, HTD, HTDD, * STD, STDD * UTD, UTDD, ALHT * 6: T ---> PST, ALAPT, ALMTD, ALMTDD, AMUTD, AMUTDD * 7: T ---> CPTD, CPTDD, CVTD, CVTDD, EPSTD, EPSTDD, * GAMTD, GAMTDD, PRTD, PRTDD, SIGT, WTD, * WTDD * 8: T ---> PST, PSTD, PSTDD, PLDT, PMLT, PSBT * 9: P, T ---> VPT, HPT, SPT, UPT * 10: P, T ---> ALMPT, AMUPT, CPPT, CVPT, GAMPT, PRPT * 11: P, T ---> AKPT, AJTPT, AIPPT, BPPT, BSPT, BTPT * BVPT, EPSPT, WPT * 12: P, H ---> TPH, TPH2, XPH * 13: P, S ---> HPS, TPS, TPS2, UPS, VPS, XPS * 14: P, U ---> XPU * 15: P, V ---> TPV, XPV * 16: P, X ---> HPX, SPX, UPX, VPX * 17: T, H ---> XTH * 18: T, S ---> XTS * 19: T, U ---> XTU * 20: T, V ---> XTV * 21: T, X ---> HTX, STX, UTX, VTX * 22: A ---> CRP, FC, TRPL *======================================================== * * Opening Message & Data of Substance * COMMON/UNIT/KPA,MESS KPA=0 MESS=1 * Initialization CALL INIT * Main Menu 1010 CALL MENU(ID) IF(ID.EQ.0) THEN PRINT *,'***** See You Again ! *****' STOP ELSE IF(ID.EQ.1) THEN CALL P1 ELSE IF(ID.EQ.2) THEN CALL P2 ELSE IF(ID.EQ.3) THEN CALL P3 ELSE IF(ID.EQ.4) THEN CALL P4 ELSE IF(ID.EQ.5) THEN CALL T1 ELSE IF(ID.EQ.6) THEN CALL T2 ELSE IF(ID.EQ.7) THEN CALL T3 ELSE IF(ID.EQ.8) THEN CALL T4 ELSE IF(ID.EQ.9) THEN CALL PT1 ELSE IF(ID.EQ.10) THEN CALL PT2 ELSE IF(ID.EQ.11) THEN CALL PT3 ELSE IF(ID.EQ.12) THEN CALL PH ELSE IF(ID.EQ.13) THEN CALL PS ELSE IF(ID.EQ.14) THEN CALL PU ELSE IF(ID.EQ.15) THEN CALL PV ELSE IF(ID.EQ.16) THEN CALL PX ELSE IF(ID.EQ.17) THEN CALL TH ELSE IF(ID.EQ.18) THEN CALL TS ELSE IF(ID.EQ.19) THEN CALL TU ELSE IF(ID.EQ.20) THEN CALL TV ELSE IF(ID.EQ.21) THEN CALL TX ELSE IF(ID.EQ.22) THEN CALL A ELSE IF(ID.EQ.23) THEN MESS=0 CALL T9068 MESS=1 ELSE IF(ID.EQ.99) THEN CALL UNITS ELSE PRINT *,'***** Invalid No. *****' GOTO 1010 END IF GOTO 1010 END *SUB_1 ***** Initialization ***** SUBROUTINE INIT IMPLICIT REAL*8 (Z) CHARACTER*14 CP,CT,CE,CS,CV,CC,CVI,CST,CL,CSV,CIP,CX, + CJT,CBP,CBS,CBV COMMON/UNITC/CP(9),CT(4),CE(4),CS(4),CV(3),CC(4),CVI(5),CST(3), + CL(4),CSV(4),CIP,CX,CJT(3),CBP(4),CBS(9),CBV(4) COMMON/UNITZ/ZP(9),ZT(4),ZE(4),ZS(4),ZV(3),ZC(4),ZVI(5),ZST(3), + ZL(4),ZSV(4),ZK(4),ZJT(3) COMMON/UNITJ/JP,JT,JE,JS,JV,JC,JVI,JST,JL,JSV,JJT * --- Opening Message --- PRINT * PRINT *,'+--------------------------------------' + ,'----------------------+' PRINT *,'| PROPATH Version 12.1 ' + ,' |' PRINT *,'| A Program Package for Thermophysical' + ,' Properties of Fluids |' PRINT *,'| ' + ,' |' PRINT *,'| Application Program: |' PRINT *,'| Copyright PROPATH Group, May. 2, 20' + ,'01 |' PRINT *,'+--------------------------------------' + ,'----------------------+' PRINT '(A)','--- Hit RETURN Key ---' PRINT * READ(5,'(A1)') RTN PRINT * PRINT * PRINT * * COMMON VALIABLE Initialization JP=1 JT=1 JE=1 JS=JE JV=1 JC=1 JVI=1 JST=1 JL=1 JSV=1 JJT=1 * Pressure CP(1)='[Pa]' CP(2)='[kPa]' CP(3)='[MPa]' CP(4)='[bar]' CP(5)='[ata]' CP(6)='[atm]' CP(7)='[mmHg]' CP(8)='[lb/in**2]' CP(9)='[lb/ft**2]' ZP(1)=1.0 ZP(2)=1.0D-03 ZP(3)=1.0D-06 ZP(4)=1.0D-05 ZP(5)=1.019716D-05 ZP(6)=0.9869233D-05 ZP(7)=7.500617D-03 ZP(8)=1.450377D-04 ZP(9)=2.089D-02 * Temperature CT(1)='[K]' CT(2)='[C]' CT(3)='[F]' CT(4)='[R]' ZT(1)=1.0 ZT(2)=1.0 ZT(3)=1.8 ZT(4)=1.8 ZK(1)=0.0 ZK(2)=273.15 ZK(3)=459.67 ZK(4)=0.0 * Energy CE(1)='[J/kg]' CE(2)='[kJ/kg]' CE(3)='[kcal/kgf]' CE(4)='[BTU/lbm]' ZE(1)=1.0 ZE(2)=1.0D-03 ZE(3)=2.388459D-04 ZE(4)=4.299226D-04 * Entropy & Specific Heat CS(1)='[J/(kg*K)]' CS(2)='[kJ/(kg*K)]' CS(3)='[kcal/(kgf*K)]' CS(4)='[BTU/(lbm*R)]' ZS(1)=1.0 ZS(2)=1.0D-03 ZS(3)=2.388459D-04 ZS(4)=2.388459D-04 * Specific Volume CV(1)='[m**3/kg]' CV(2)='[in**3/lbm]' CV(3)='[ft**3/lbm]' ZV(1)=1.0 ZV(2)=2.7678D+04 ZV(3)=16.01846 * Thermal Conductivity CC(1)='[W/(m*K)]' CC(2)='[kcal/(m*h*C)]' CC(3)='[BTU/(in*h*F)]' CC(4)='[BTU/(ft*h*F)]' ZC(1)=1.0 ZC(2)=1.0/1.163 ZC(3)=0.04815 ZC(4)=0.5777893 * Viscosity CVI(1)='[Pa*s]' CVI(2)='[kgf*s/m**2]' CVI(3)='[lbf*s/ft**2]' CVI(4)='[lbm/(ft*s)]' CVI(5)='[Poise]' ZVI(1)=1.0 ZVI(2)=0.1019716 ZVI(3)=0.2088543 ZVI(4)=0.6719689 ZVI(5)=1.0D+03 * Surface Tension CST(1)='[N/m]' CST(2)='[kgf/m]' CST(3)='[lbf/ft]' ZST(1)=1.0 ZST(2)=0.1019716 ZST(3)=6.852177D-02 * Laplace Coefficient CL(1)='[m]' CL(2)='[mm]' CL(3)='[in]' CL(4)='[ft]' ZL(1)=1.0 ZL(2)=1.0D+03 ZL(3)=39.37008 ZL(4)=3.280840 * Sonic Velocity CSV(1)='[m/s]' CSV(2)='[km/h]' CSV(3)='[ft/s]' CSV(4)='[mile/h]' ZSV(1)=1.0 ZSV(2)=3.6 ZSV(3)=3.280840 ZSV(4)=2.236936 * Ion Product CIP='[(mol/kg)**2]' * Dryness Fraction and the Other Dimensionless Properties CX='[-]' * Joul-Thomson Coefficient: AJTPT CJT(1)='[K/Pa]' CJT(2)='[K/bar]' CJT(3)='[R/psi]' ZJT(1)=1.0 ZJT(2)=1.0D-05 ZJT(3)=1.241091D+04 * Volmetric Coefficient of Expansion: BPPT CBP(1)='[1/K]' CBP(2)='[1/K]' CBP(3)='[1/R]' CBP(4)='[1/R]' * Compressibilities: BSPT, BTPT CBS(1)='[1/Pa]' CBS(2)='[1/kPa]' CBS(3)='[1/MPa]' CBS(4)='[1/bar]' CBS(5)='[1/ata]' CBS(6)='[1/atm]' CBS(7)='[1/mmHg]' CBS(8)='[in**2/lb]' CBS(9)='[ft**2/lb]' * Pressure Coefficient: BVPT CBV(1)='[1/K]' CBV(2)='[1/K]' CBV(3)='[1/R]' CBV(4)='[1/R]' RETURN END * No.1 SUBROUTINE P1 IMPLICIT REAL*8 (Z) CHARACTER*14 CP,CT,CE,CS,CV,CC,CVI,CST,CL,CSV,CIP,CX, + CJT,CBP,CBS,CBV COMMON/UNITC/CP(9),CT(4),CE(4),CS(4),CV(3),CC(4),CVI(5),CST(3), + CL(4),CSV(4),CIP,CX,CJT(3),CBP(4),CBS(9),CBV(4) COMMON/UNITZ/ZP(9),ZT(4),ZE(4),ZS(4),ZV(3),ZC(4),ZVI(5),ZST(3), + ZL(4),ZSV(4),ZK(4),ZJT(3) COMMON/UNITJ/JP,JT,JE,JS,JV,JC,JVI,JST,JL,JSV,JJT PRINT *,'==========================================' PRINT *,'Calculation of TSP, AKPD, AKPDD, VPD, VPDD,' PRINT *,' HPD, HPDD, SPD, SPDD, UPD, ' PRINT *,' UPDD, ALHP' PRINT *,'==========================================' LP=INDEX(CP(JP),' ') 1010 PRINT '(3A)',' Input P',CP(JP)(1:LP),'( P<0 : Quit ) ====> ' READ(5,*) P IF (P.LT.0.0) RETURN PC=P/ZP(JP) T =TSP(PC)*ZT(JT)-ZK(JT) AKD = AKPD(PC) AKDD = AKPDD(PC) VD =VPD(PC)*ZV(JV) VDD=VPDD(PC)*ZV(JV) HD =HPD(PC)*ZE(JE) HDD=HPDD(PC)*ZE(JE) SD =SPD(PC)*ZS(JS) SDD=SPDD(PC)*ZS(JS) UD =UPD(PC)*ZE(JE) UDD=UPDD(PC)*ZE(JE) ALH=ALHP(PC)*ZE(JE) WRITE(6,600) 'P=',P,CP(JP),'TSP=',T,CT(JT) WRITE(6,600) 'AKPD=',AKD,CX,'AKPDD=',AKDD,CX WRITE(6,600) 'VPD=',VD,CV(JV),'VPDD=',VDD,CV(JV) WRITE(6,600) 'HPD=',HD,CE(JE),'HPDD=',HDD,CE(JE) WRITE(6,600) 'SPD=',SD,CS(JS),'SPDD=',SDD,CS(JS) WRITE(6,600) 'UPD=',UD,CE(JE),'UPDD=',UDD,CE(JE) WRITE(6,600) 'ALHP=',ALH,CE(JE) WRITE(6,*) 600 FORMAT(A10,1PE14.6,1X,A14,A10,1PE14.6,1X,A14) GOTO 1010 END * No.2 SUBROUTINE P2 IMPLICIT REAL*8 (Z) CHARACTER*14 CP,CT,CE,CS,CV,CC,CVI,CST,CL,CSV,CIP,CX, + CJT,CBP,CBS,CBV COMMON/UNITC/CP(9),CT(4),CE(4),CS(4),CV(3),CC(4),CVI(5),CST(3), + CL(4),CSV(4),CIP,CX,CJT(3),CBP(4),CBS(9),CBV(4) COMMON/UNITZ/ZP(9),ZT(4),ZE(4),ZS(4),ZV(3),ZC(4),ZVI(5),ZST(3), + ZL(4),ZSV(4),ZK(4),ZJT(3) COMMON/UNITJ/JP,JT,JE,JS,JV,JC,JVI,JST,JL,JSV,JJT PRINT *,'=======================================================' PRINT *,'Calculation of TSP, ALAPP, ALMPD, ALMPDD, AMUPD, AMUPDD' PRINT *,'=======================================================' LP=INDEX(CP(JP),' ') 1010 PRINT '(3A)',' Input P',CP(JP)(1:LP),'( P<0 : Quit ) ====> ' READ(5,*) P IF (P.LT.0.0) RETURN PC=P/ZP(JP) T =TSP(PC)*ZT(JT)-ZK(JT) ALAP=ALAPP(PC)*ZL(JL) ALMD=ALMPD(PC)*ZC(JC) ALMDD=ALMPDD(PC)*ZC(JC) AMUD=AMUPD(PC)*ZVI(JVI) AMUDD=AMUPDD(PC)*ZVI(JVI) WRITE(6,600) 'P=',P,CP(JP),'TSP=',T,CT(JT) WRITE(6,600) 'ALAPP=',ALAP,CL(JL) WRITE(6,600) 'ALMPD=',ALMD,CC(JC),'ALMPDD=',ALMDD,CC(JC) WRITE(6,600) 'AMUPD=',AMUD,CVI(JVI),'AMUPDD=',AMUDD,CVI(JVI) WRITE(6,*) 600 FORMAT(A10,1PE14.6,1X,A14,A10,1PE14.6,1X,A14) GOTO 1010 END * No.3 SUBROUTINE P3 IMPLICIT REAL*8 (Z) CHARACTER*14 CP,CT,CE,CS,CV,CC,CVI,CST,CL,CSV,CIP,CX, + CJT,CBP,CBS,CBV COMMON/UNITC/CP(9),CT(4),CE(4),CS(4),CV(3),CC(4),CVI(5),CST(3), + CL(4),CSV(4),CIP,CX,CJT(3),CBP(4),CBS(9),CBV(4) COMMON/UNITZ/ZP(9),ZT(4),ZE(4),ZS(4),ZV(3),ZC(4),ZVI(5),ZST(3), + ZL(4),ZSV(4),ZK(4),ZJT(3) COMMON/UNITJ/JP,JT,JE,JS,JV,JC,JVI,JST,JL,JSV,JJT PRINT *,'======================================' PRINT *,'Calculation of TSP, CPPD, CPPDD, CVPD,' PRINT *,' CVPDD, EPSPD, EPSPDD, ' PRINT *,' GAMPD, GAMPDD, PRPD, ' PRINT *,' PRPDD, SIGP, WPD, WPDD ' PRINT *,'======================================' LP=INDEX(CP(JP),' ') 1010 PRINT '(3A)',' Input P',CP(JP)(1:LP),'( P<0 : Quit ) : ' READ(5,*) P IF (P.LT.0.0) RETURN PC=P/ZP(JP) T =TSP(PC)*ZT(JT)-ZK(JT) CPD=CPPD(PC)*ZS(JS) CPDD=CPPDD(PC)*ZS(JS) CVD=CVPD(PC)*ZS(JS) CVDD=CVPDD(PC)*ZS(JS) EPSD=EPSPD(PC) EPSDD=EPSPDD(PC) GAMD=GAMPD(PC) GAMDD=GAMPDD(PC) PRD=PRPD(PC) PRDD=PRPDD(PC) SIG=SIGP(PC)*ZST(JST) WD=WPD(PC)*ZSV(JSV) WDD=WPDD(PC)*ZSV(JSV) WRITE(6,600) 'P=',P,CP(JP),'TSP=',T,CT(JT) WRITE(6,600) 'CPPD=',CPD,CS(JS),'CPPDD=',CPDD,CS(JS) WRITE(6,600) 'CVPD=',CVD,CS(JS),'CVPDD=',CVDD,CS(JS) WRITE(6,600) 'EPSPD=',EPSD,CX,'EPSPDD=',EPSDD,CX WRITE(6,600) 'GAMPD=',GAMD,CX, 'GAMPDD=',GAMDD,CX WRITE(6,600) 'PRPD=',PRD,CX,'PRPDD=',PRDD,CX WRITE(6,600) 'SIGP=',SIG,CST(JST) WRITE(6,600) 'WPD=',WD,CSV(JSV),'WPDD=',WDD,CSV(JSV) 600 FORMAT(A10,1PE14.6,1X,A14,A10,1PE14.6,1X,A14) GOTO 1010 END * No.4 SUBROUTINE P4 IMPLICIT REAL*8 (Z) CHARACTER*14 CP,CT,CE,CS,CV,CC,CVI,CST,CL,CSV,CIP,CX, + CJT,CBP,CBS,CBV COMMON/UNITC/CP(9),CT(4),CE(4),CS(4),CV(3),CC(4),CVI(5),CST(3), + CL(4),CSV(4),CIP,CX,CJT(3),CBP(4),CBS(9),CBV(4) COMMON/UNITZ/ZP(9),ZT(4),ZE(4),ZS(4),ZV(3),ZC(4),ZVI(5),ZST(3), + ZL(4),ZSV(4),ZK(4),ZJT(3) COMMON/UNITJ/JP,JT,JE,JS,JV,JC,JVI,JST,JL,JSV,JJT PRINT *,'===========================', + '==============================' PRINT *,'Calculation of TSP, TSPD, TSPDD,', + ' TLDP, TMLP, TPSEUP, TSBP' PRINT *,'===========================', + '==============================' LP=INDEX(CP(JP),' ') 1010 PRINT '(3A)',' Input P',CP(JP)(1:LP),'( P<0 : Quit ) : ' READ(5,*) P IF (P.LT.0.0) RETURN PC=P/ZP(JP) T =TSP(PC)*ZT(JT)-ZK(JT) TD =TSPD(PC)*ZT(JT)-ZK(JT) TDD=TSPDD(PC)*ZT(JT)-ZK(JT) TLD =TLDP(PC)*ZT(JT)-ZK(JT) TML =TMLP(PC)*ZT(JT)-ZK(JT) TPSEU=TPSEUP(PC)*ZT(JT)-ZK(JT) TSB=TSBP(PC)*ZT(JT)-ZK(JT) WRITE(6,600) 'P=',P,CP(JP),'TSP=',T,CT(JT) WRITE(6,600) 'TSPD=',TD,CT(JT),'TSPDD=',TDD,CT(JT) WRITE(6,600) 'TLDP=',TLD,CT(JT),'TMLP=',TML,CT(JT) WRITE(6,600) 'TPSEUP=',TPSEU,CT(JT),'TSBP=',TSB,CT(JT) WRITE(6,*) 600 FORMAT(A10,1PE14.6,1X,A14,A10,1PE14.6,1X,A14) GOTO 1010 END * No.5 SUBROUTINE T1 IMPLICIT REAL*8 (Z) CHARACTER*14 CP,CT,CE,CS,CV,CC,CVI,CST,CL,CSV,CIP,CX, + CJT,CBP,CBS,CBV COMMON/UNITC/CP(9),CT(4),CE(4),CS(4),CV(3),CC(4),CVI(5),CST(3), + CL(4),CSV(4),CIP,CX,CJT(3),CBP(4),CBS(9),CBV(4) COMMON/UNITZ/ZP(9),ZT(4),ZE(4),ZS(4),ZV(3),ZC(4),ZVI(5),ZST(3), + ZL(4),ZSV(4),ZK(4),ZJT(3) COMMON/UNITJ/JP,JT,JE,JS,JV,JC,JVI,JST,JL,JSV,JJT PRINT *,'===========================================' PRINT *,'Calculation of PST, AKTD, AKTDD, VTD, VTDD,' PRINT *,' HTD, HTDD, STD, STDD, UTD,' PRINT *,' UTDD, ALHT ' PRINT *,'===========================================' LT=INDEX(CT(JT),' ') 1010 PRINT '(3A)',' Input T',CT(JT)(1:LT),'(T<-1000.0 : Quit) : ' READ(5,*) T IF (T.LT.-1000.0) RETURN TC=(T+ZK(JT))/ZT(JT) P =PST(TC)*ZP(JP) AKD = AKTD(TC) AKDD = AKTDD(TC) VD =VTD(TC)*ZV(JV) VDD=VTDD(TC)*ZV(JV) HD =HTD(TC)*ZE(JE) HDD=HTDD(TC)*ZE(JE) SD =STD(TC)*ZS(JS) SDD=STDD(TC)*ZS(JS) UD =UTD(TC)*ZE(JE) UDD=UTDD(TC)*ZE(JE) ALH=ALHT(TC)*ZE(JE) WRITE(6,600) 'T=',T,CT(JT),'PST=',P,CP(JP) WRITE(6,600) 'AKTD=',AKD,CX,'AKTDD=',AKDD,CX WRITE(6,600) 'VTD=',VD,CV(JV),'VTDD=',VDD,CV(JV) WRITE(6,600) 'HTD=',HD,CE(JE),'HTDD=',HDD,CE(JE) WRITE(6,600) 'STD=',SD,CS(JS),'STDD=',SDD,CS(JS) WRITE(6,600) 'UTD=',UD,CE(JE),'UTDD=',UDD,CE(JE) WRITE(6,600) 'ALHT=',ALH,CE(JE) WRITE(6,*) 600 FORMAT(A10,1PE14.6,1X,A14,A10,1PE14.6,1X,A14) GOTO 1010 END * No.6 SUBROUTINE T2 IMPLICIT REAL*8 (Z) CHARACTER*14 CP,CT,CE,CS,CV,CC,CVI,CST,CL,CSV,CIP,CX, + CJT,CBP,CBS,CBV COMMON/UNITC/CP(9),CT(4),CE(4),CS(4),CV(3),CC(4),CVI(5),CST(3), + CL(4),CSV(4),CIP,CX,CJT(3),CBP(4),CBS(9),CBV(4) COMMON/UNITZ/ZP(9),ZT(4),ZE(4),ZS(4),ZV(3),ZC(4),ZVI(5),ZST(3), + ZL(4),ZSV(4),ZK(4),ZJT(3) COMMON/UNITJ/JP,JT,JE,JS,JV,JC,JVI,JST,JL,JSV,JJT PRINT *,'=======================================================' PRINT *,'Calculation of PST, ALAPT, ALMTD, ALMTDD, AMUTD, AMUTDD' PRINT *,'=======================================================' LT=INDEX(CT(JT),' ') 1010 PRINT '(3A)',' Input T',CT(JT)(1:LT),'( T<-1000.0 : Quit) : ' READ(5,*) T IF (T.LT.-1000.0) RETURN TC=(T+ZK(JT))/ZT(JT) P =PST(TC)*ZP(JP) ALAP=ALAPT(TC)*ZL(JL) ALMD=ALMTD(TC)*ZC(JC) ALMDD=ALMTDD(TC)*ZC(JC) AMUD=AMUTD(TC)*ZVI(JVI) AMUDD=AMUTDD(TC)*ZVI(JVI) WRITE(6,600) 'T=',T,CT(JT),'PST=',P,CP(JP) WRITE(6,600) 'ALAPT=',ALAP,CL(JL) WRITE(6,600) 'ALMTD=',ALMD,CC(JC),'ALMTDD=',ALMDD,CC(JC) WRITE(6,600) 'AMUTD=',AMUD,CVI(JVI),'AMUTDD=',AMUDD,CVI(JVI) WRITE(6,*) 600 FORMAT(A10,1PE14.6,1X,A14,A10,1PE14.6,1X,A14) GOTO 1010 END * No.7 SUBROUTINE T3 IMPLICIT REAL*8 (Z) CHARACTER*14 CP,CT,CE,CS,CV,CC,CVI,CST,CL,CSV,CIP,CX, + CJT,CBP,CBS,CBV COMMON/UNITC/CP(9),CT(4),CE(4),CS(4),CV(3),CC(4),CVI(5),CST(3), + CL(4),CSV(4),CIP,CX,CJT(3),CBP(4),CBS(9),CBV(4) COMMON/UNITZ/ZP(9),ZT(4),ZE(4),ZS(4),ZV(3),ZC(4),ZVI(5),ZST(3), + ZL(4),ZSV(4),ZK(4),ZJT(3) COMMON/UNITJ/JP,JT,JE,JS,JV,JC,JVI,JST,JL,JSV,JJT PRINT *,'========================================' PRINT *,'Calculation of PST, CPTD, CPTDD, CVTD, ' PRINT *,' CVTDD, EPSTD, EPSTDD, ' PRINT *,' GAMTD, GAMTDD, SIGT, PRTD,' PRINT *,' PRTDD, WTD, WTDD ' PRINT *,'=========================================' LT=INDEX(CT(JT),' ') 1010 PRINT '(3A)',' Input T',CT(JT)(1:LT),'( T<-1000.0 : Quit) : ' READ(5,*) T IF (T.LT.-1000.0) RETURN TC=(T+ZK(JT))/ZT(JT) P =PST(TC)*ZP(JP) CPD=CPTD(TC)*ZS(JS) CPDD=CPTDD(TC)*ZS(JS) CVD=CVTDD(TC)*ZS(JS) CVDD=CVTDD(TC)*ZS(JS) EPSD=EPSTD(TC) EPSDD=EPSTDD(TC) GAMD=GAMTD(TC) GAMDD=GAMTDD(TC) SIG=SIGT(TC)*ZST(JST) PRD=PRTD(TC) PRDD=PRTDD(TC) WD=WTD(TC)*ZSV(JSV) WDD=WTDD(TC)*ZSV(JSV) WRITE(6,600) 'T=',T,CT(JT),'PST=',P,CP(JP) WRITE(6,600) 'CPTD=',CPD,CS(JS),'CPTDD=',CPDD,CS(JS) WRITE(6,600) 'CVTD=',CVD,CS(JS),'CVTDD=',CVDD,CS(JS) WRITE(6,600) 'EPSTD=',EPSD,CX,'EPSTDD=',EPSDD,CX WRITE(6,600) 'GAMTD=',GAMD,CX, 'GAMTDD=',GAMDD,CX WRITE(6,600) 'SIGP=',SIG,CST(JST) WRITE(6,600) 'PRTD=',PRD,CX,'PRTDD=',PRDD,CX WRITE(6,600) 'WTD=',WD,CSV(JSV),'WTDD=',WDD,CSV(JSV) WRITE(6,*) 600 FORMAT(A10,1PE14.6,1X,A14,A10,1PE14.6,1X,A14) GOTO 1010 END * No.8 SUBROUTINE T4 IMPLICIT REAL*8 (Z) CHARACTER*14 CP,CT,CE,CS,CV,CC,CVI,CST,CL,CSV,CIP,CX, + CJT,CBP,CBS,CBV COMMON/UNITC/CP(9),CT(4),CE(4),CS(4),CV(3),CC(4),CVI(5),CST(3), + CL(4),CSV(4),CIP,CX,CJT(3),CBP(4),CBS(9),CBV(4) COMMON/UNITZ/ZP(9),ZT(4),ZE(4),ZS(4),ZV(3),ZC(4),ZVI(5),ZST(3), + ZL(4),ZSV(4),ZK(4),ZJT(3) COMMON/UNITJ/JP,JT,JE,JS,JV,JC,JVI,JST,JL,JSV,JJT PRINT *,'=================================================' PRINT *,'Calculation of PST, PSTD, PSTDD, PLDT, PMLT, PSBT' PRINT *,'=================================================' LT=INDEX(CT(JT),' ') 1010 PRINT '(3A)',' Input T',CT(JT)(1:LT),'( T<-1000.0 : Quit) : ' READ(5,*) T IF (T.LT.-1000.0) RETURN TC=(T+ZK(JT))/ZT(JT) P =PST(TC)*ZP(JP) PD =PSTD(TC)*ZP(JP) PDD=PSTDD(TC)*ZP(JP) PLD=PLDT(TC)*ZP(JP) PML=PMLT(TC)*ZP(JP) PSB=PSBT(TC)*ZP(JP) WRITE(6,600) 'T=',T,CT(JT),'PST=',P,CP(JP) WRITE(6,600) 'PSTD=',PD,CP(JP),'PSTDD=',PDD,CP(JP) WRITE(6,600) 'PLDT=',PLD,CP(JP),'PMLT=',PML,CP(JP) WRITE(6,600) 'PSBT=',PSB,CP(JP) WRITE(6,*) 600 FORMAT(A10,1PE14.6,1X,A14,A10,1PE14.6,1X,A14) GOTO 1010 END * No.9 SUBROUTINE PT1 IMPLICIT REAL*8 (Z) CHARACTER*14 CP,CT,CE,CS,CV,CC,CVI,CST,CL,CSV,CIP,CX, + CJT,CBP,CBS,CBV COMMON/UNITC/CP(9),CT(4),CE(4),CS(4),CV(3),CC(4),CVI(5),CST(3), + CL(4),CSV(4),CIP,CX,CJT(3),CBP(4),CBS(9),CBV(4) COMMON/UNITZ/ZP(9),ZT(4),ZE(4),ZS(4),ZV(3),ZC(4),ZVI(5),ZST(3), + ZL(4),ZSV(4),ZK(4),ZJT(3) COMMON/UNITJ/JP,JT,JE,JS,JV,JC,JVI,JST,JL,JSV,JJT PRINT *,'=================================' PRINT *,'Calculation of VPT, HPT, SPT, UPT' PRINT *,'=================================' LP=INDEX(CP(JP),' ') LT=INDEX(CT(JT),' ') 1010 PRINT '(5A)',' Input P',CP(JP)(1:LP),'and T',CT(JT)(1:LT), + '( P<0 : Quit) : ' READ(5,*) P,T IF (P.LT.0.0) RETURN PC=P/ZP(JP) TC=(T+ZK(JT))/ZT(JT) V =VPT(PC,TC)*ZV(JV) H =HPT(PC,TC)*ZE(JE) S =SPT(PC,TC)*ZS(JS) U =UPT(PC,TC)*ZE(JE) WRITE(6,600) 'P=',P,CP(JP),'T=',T,CT(JT) WRITE(6,600) 'VPT=',V,CV(JV),'HPT=',H,CE(JE) WRITE(6,600) 'SPT=',S,CS(JS),'UPT=',U,CE(JE) WRITE(6,*) 600 FORMAT(A10,1PE14.6,1X,A14,A10,1PE14.6,1X,A14) GOTO 1010 END * No.10 SUBROUTINE PT2 IMPLICIT REAL*8 (Z) CHARACTER*14 CP,CT,CE,CS,CV,CC,CVI,CST,CL,CSV,CIP,CX, + CJT,CBP,CBS,CBV COMMON/UNITC/CP(9),CT(4),CE(4),CS(4),CV(3),CC(4),CVI(5),CST(3), + CL(4),CSV(4),CIP,CX,CJT(3),CBP(4),CBS(9),CBV(4) COMMON/UNITZ/ZP(9),ZT(4),ZE(4),ZS(4),ZV(3),ZC(4),ZVI(5),ZST(3), + ZL(4),ZSV(4),ZK(4),ZJT(3) COMMON/UNITJ/JP,JT,JE,JS,JV,JC,JVI,JST,JL,JSV,JJT PRINT *,'====================================================' PRINT *,'Calculation of ALMPT, AMUPT, CPPT, CVPT, GAMPT, PRPT' PRINT *,'====================================================' LP=INDEX(CP(JP),' ') LT=INDEX(CT(JT),' ') 1010 PRINT '(5A)',' Input P',CP(JP)(1:LP),'and T',CT(JT)(1:LT), + '( P<0 : Quit) : ' READ(5,*) P,T IF (P.LT.0.0) RETURN PC=P/ZP(JP) TC=(T+ZK(JT))/ZT(JT) ALM=ALMPT(PC,TC)*ZC(JC) AMU=AMUPT(PC,TC)*ZVI(JVI) CPP=CPPT(PC,TC)*ZS(JS) CVV=CVPT(PC,TC)*ZS(JS) GAM=GAMPT(PC,TC) PR=PRPT(PC,TC) WRITE(6,600) 'P=',P,CP(JP),'T=',T,CT(JT) WRITE(6,600) 'ALMPT=',ALM,CC(JC),'AMUPT=',AMU,CVI(JVI) WRITE(6,600) 'CPPT=',CPP,CS(JS),'CVPT=',CVV,CS(JS) WRITE(6,600) 'GAMPT=',GAM,CX,'PRPT=',PR,CX WRITE(6,*) 600 FORMAT(A10,1PE14.6,1X,A14,A10,1PE14.6,1X,A14) GOTO 1010 END * No.11 SUBROUTINE PT3 IMPLICIT REAL*8 (Z) CHARACTER*14 CP,CT,CE,CS,CV,CC,CVI,CST,CL,CSV,CIP,CX, + CJT,CBP,CBS,CBV COMMON/UNITC/CP(9),CT(4),CE(4),CS(4),CV(3),CC(4),CVI(5),CST(3), + CL(4),CSV(4),CIP,CX,CJT(3),CBP(4),CBS(9),CBV(4) COMMON/UNITZ/ZP(9),ZT(4),ZE(4),ZS(4),ZV(3),ZC(4),ZVI(5),ZST(3), + ZL(4),ZSV(4),ZK(4),ZJT(3) COMMON/UNITJ/JP,JT,JE,JS,JV,JC,JVI,JST,JL,JSV,JJT PRINT *,'=============================================' PRINT *,'Calculation of AKPT, AJTPT, AIPPT, BPPT, BSPT' PRINT *,' BTPT, BVPT, EPSPT, WPT' PRINT *,'=============================================' LP=INDEX(CP(JP),' ') LT=INDEX(CT(JT),' ') 1010 PRINT '(5A)',' Input P',CP(JP)(1:LP),'and T',CT(JT)(1:LT), + '( P<0 : Quit) : ' READ(5,*) P,T IF (P.LT.0.0) RETURN PC=P/ZP(JP) TC=(T+ZK(JT))/ZT(JT) AK=AKPT(PC,TC) AJT=AJTPT(PC,TC)*ZJT(JJT) AIP=AIPPT(PC,TC) BP=BPPT(PC,TC)/ZT(JT) BS=BSPT(PC,TC)/ZP(JP) BT=BTPT(PC,TC)/ZP(JP) BV=BVPT(PC,TC)*ZT(JT) EPS=EPSPT(PC,TC) W=WPT(PC,TC)*ZSV(JSV) WRITE(6,600) 'AKPT=',AK,CX,'AJTPT=',AJT,CJT(JJT) WRITE(6,600) 'AIPPT=',AIP,CIP,'BPPT=',BP,CBP(JT) WRITE(6,600) 'BSPT=',BS,CBS(JP),'BTPT=',BT,CBS(JP) WRITE(6,600) 'BVPT=',BV,CBV(JT),'EPSPT=',EPS,CX WRITE(6,600) 'WPT=',W,CSV(JSV) WRITE(6,*) 600 FORMAT(A10,1PE14.6,1X,A14,A10,1PE14.6,1X,A14) GOTO 1010 END * No.12 SUBROUTINE PH IMPLICIT REAL*8 (Z) CHARACTER*14 CP,CT,CE,CS,CV,CC,CVI,CST,CL,CSV,CIP,CX, + CJT,CBP,CBS,CBV COMMON/UNITC/CP(9),CT(4),CE(4),CS(4),CV(3),CC(4),CVI(5),CST(3), + CL(4),CSV(4),CIP,CX,CJT(3),CBP(4),CBS(9),CBV(4) COMMON/UNITZ/ZP(9),ZT(4),ZE(4),ZS(4),ZV(3),ZC(4),ZVI(5),ZST(3), + ZL(4),ZSV(4),ZK(4),ZJT(3) COMMON/UNITJ/JP,JT,JE,JS,JV,JC,JVI,JST,JL,JSV,JJT PRINT *,'=============================' PRINT *,'Calculation of TPH, TPH2, XPH' PRINT *,'=============================' LP=INDEX(CP(JP),' ') LE=INDEX(CE(JE),' ') 1010 PRINT '(5A)',' Input P',CP(JP)(1:LP),'and H',CE(JE)(1:LE), + '( P<0.0 : Quit) : ' READ(5,*) P,H IF (P.LT.0.0) RETURN PC=P/ZP(JP) HC=H/ZE(JE) X =XPH(PC,HC) T =TPH(PC,HC)*ZT(JT)-ZK(JT) T2 =TPH2(PC,HC) IF (T2.GT.-1E10) THEN T2 = T2*ZT(JT)-ZK(JT) END IF WRITE(6,600) 'P=',P,CP(JP),'H=',H,CE(JE) WRITE(6,600) 'XPH=',X,CX,'TPH=',T,CT(JT) WRITE(6,600) 'TPH2=',T2,CT(JT) WRITE(6,*) 600 FORMAT(A10,1PE14.6,1X,A14,A10,1PE14.6,1X,A14) GOTO 1010 END * No.13 SUBROUTINE PS IMPLICIT REAL*8 (Z) CHARACTER*14 CP,CT,CE,CS,CV,CC,CVI,CST,CL,CSV,CIP,CX, + CJT,CBP,CBS,CBV COMMON/UNITC/CP(9),CT(4),CE(4),CS(4),CV(3),CC(4),CVI(5),CST(3), + CL(4),CSV(4),CIP,CX,CJT(3),CBP(4),CBS(9),CBV(4) COMMON/UNITZ/ZP(9),ZT(4),ZE(4),ZS(4),ZV(3),ZC(4),ZVI(5),ZST(3), + ZL(4),ZSV(4),ZK(4),ZJT(3) COMMON/UNITJ/JP,JT,JE,JS,JV,JC,JVI,JST,JL,JSV,JJT PRINT *,'============================================' PRINT *,'Calculation of HPS, TPS, TPS2, UPS, VPS, XPS' PRINT *,'============================================' LP=INDEX(CP(JP),' ') LS=INDEX(CS(JS),' ') 1010 PRINT '(5A)',' Input P',CP(JP)(1:LP),' and S',CS(JS)(1:LS), + '( P<0.0 : Quit) : ' READ(5,*) P,S IF (P.LT.0.0) RETURN PC=P/ZP(JP) SC=S/ZS(JS) X =XPS(PC,SC) T =TPS(PC,SC)*ZT(JT)-ZK(JT) T2 = TPS2(PC,SC) IF (T2.GT.-1E10) THEN T2=T2*ZT(JT)-ZK(JT) END IF H =HPS(PC,SC)*ZE(JE) U =UPS(PC,SC)*ZE(JE) V =VPS(PC,SC)*ZV(JV) WRITE(6,600) 'P=',P,CP(JP),'S=',S,CS(JS) WRITE(6,600) 'HPS=',H,CE(JE),'TPS=',T,CT(JT) WRITE(6,600) 'TPS2=',T2,CT(JT) WRITE(6,600) 'UPS=',U,CE(JE),'VPS=',V,CV(JV) WRITE(6,600) 'XPS=',X,CX WRITE(6,*) 600 FORMAT(A10,1PE14.6,1X,A14,A10,1PE14.6,1X,A14) GOTO 1010 END * No.14 SUBROUTINE PU IMPLICIT REAL*8 (Z) CHARACTER*14 CP,CT,CE,CS,CV,CC,CVI,CST,CL,CSV,CIP,CX, + CJT,CBP,CBS,CBV COMMON/UNITC/CP(9),CT(4),CE(4),CS(4),CV(3),CC(4),CVI(5),CST(3), + CL(4),CSV(4),CIP,CX,CJT(3),CBP(4),CBS(9),CBV(4) COMMON/UNITZ/ZP(9),ZT(4),ZE(4),ZS(4),ZV(3),ZC(4),ZVI(5),ZST(3), + ZL(4),ZSV(4),ZK(4),ZJT(3) COMMON/UNITJ/JP,JT,JE,JS,JV,JC,JVI,JST,JL,JSV,JJT PRINT *,'==================' PRINT *,'Calculation of XPU' PRINT *,'==================' LP=INDEX(CP(JP),' ') LE=INDEX(CE(JE),' ') 1010 PRINT '(5A)',' Input P',CP(JP)(1:LP),'and U',CE(JE)(1:LE), + '( P<0.0 : Quit) : ' READ(5,*) P,U IF (P.LT.0.0) RETURN PC=P/ZP(JP) UC=U/ZE(JE) X =XPU(PC,UC) WRITE(6,600) 'P=',P,CP(JP),'U=',U,CE(JE) WRITE(6,600) 'XPU=',X,CX WRITE(6,*) 600 FORMAT(A10,1PE14.6,1X,A14,A10,1PE14.6,1X,A14) GOTO 1010 END * No.15 SUBROUTINE PV IMPLICIT REAL*8 (Z) CHARACTER*14 CP,CT,CE,CS,CV,CC,CVI,CST,CL,CSV,CIP,CX, + CJT,CBP,CBS,CBV COMMON/UNITC/CP(9),CT(4),CE(4),CS(4),CV(3),CC(4),CVI(5),CST(3), + CL(4),CSV(4),CIP,CX,CJT(3),CBP(4),CBS(9),CBV(4) COMMON/UNITZ/ZP(9),ZT(4),ZE(4),ZS(4),ZV(3),ZC(4),ZVI(5),ZST(3), + ZL(4),ZSV(4),ZK(4),ZJT(3) COMMON/UNITJ/JP,JT,JE,JS,JV,JC,JVI,JST,JL,JSV,JJT PRINT *,'=======================' PRINT *,'Calculation of TPV, XPV' PRINT *,'=======================' LP=INDEX(CP(JP),' ') LV=INDEX(CV(JV),' ') 1010 PRINT '(5A)',' Input P',CP(JP)(1:LP),'and V',CV(JV)(1:LV), + '( P<0.0 : Quit) : ' READ(5,*) P,V IF (P.LT.0.0) RETURN PC=P/ZP(JP) VC=V/ZV(JV) X =XPV(PC,VC) T =TPV(PC,VC)*ZT(JT)-ZK(JT) WRITE(6,600) 'P=',P,CP(JP),'V=',V,CV(JV) WRITE(6,600) 'XPV=',X,CX,'TPV=',T,CT(JT) WRITE(6,*) 600 FORMAT(A10,1PE14.6,1X,A14,A10,1PE14.6,1X,A14) GOTO 1010 END * No.16 SUBROUTINE PX IMPLICIT REAL*8 (Z) CHARACTER*14 CP,CT,CE,CS,CV,CC,CVI,CST,CL,CSV,CIP,CX, + CJT,CBP,CBS,CBV COMMON/UNITC/CP(9),CT(4),CE(4),CS(4),CV(3),CC(4),CVI(5),CST(3), + CL(4),CSV(4),CIP,CX,CJT(3),CBP(4),CBS(9),CBV(4) COMMON/UNITZ/ZP(9),ZT(4),ZE(4),ZS(4),ZV(3),ZC(4),ZVI(5),ZST(3), + ZL(4),ZSV(4),ZK(4),ZJT(3) COMMON/UNITJ/JP,JT,JE,JS,JV,JC,JVI,JST,JL,JSV,JJT PRINT *,'=================================' PRINT *,'Calculation of HPX, SPX, UPX, VPX' PRINT *,'=================================' LP=INDEX(CP(JP),' ') 1010 PRINT '(3A)',' Input P',CP(JP)(1:LP), + 'and X[-] ( P<0 : Quit) : ' READ(5,*) P,X IF (P.LT.0.0) RETURN PC=P/ZP(JP) V =VPX(PC,X)*ZV(JV) H =HPX(PC,X)*ZE(JE) S =SPX(PC,X)*ZS(JS) U =UPX(PC,X)*ZE(JE) WRITE(6,600) 'P=',P,CP(JP),'X=',X,CX WRITE(6,600) 'HPX=',H,CE(JE),'SPX=',S,CS(JS) WRITE(6,600) 'UPX=',U,CE(JE),'VPX=',V,CV(JV) WRITE(6,*) 600 FORMAT(A10,1PE14.6,1X,A14,A10,1PE14.6,1X,A14) GOTO 1010 END * No.17 SUBROUTINE TH IMPLICIT REAL*8 (Z) CHARACTER*14 CP,CT,CE,CS,CV,CC,CVI,CST,CL,CSV,CIP,CX, + CJT,CBP,CBS,CBV COMMON/UNITC/CP(9),CT(4),CE(4),CS(4),CV(3),CC(4),CVI(5),CST(3), + CL(4),CSV(4),CIP,CX,CJT(3),CBP(4),CBS(9),CBV(4) COMMON/UNITZ/ZP(9),ZT(4),ZE(4),ZS(4),ZV(3),ZC(4),ZVI(5),ZST(3), + ZL(4),ZSV(4),ZK(4),ZJT(3) COMMON/UNITJ/JP,JT,JE,JS,JV,JC,JVI,JST,JL,JSV,JJT PRINT *,'==================' PRINT *,'Calculation of XTH' PRINT *,'==================' LT=INDEX(CT(JT),' ') LE=INDEX(CE(JE),' ') 1010 PRINT '(5A)',' Input T',CT(JT)(1:LT),'and H',CE(JE)(1:LE), + ' ( T<-1000.0 : Quit) : ' READ(5,*) T,H IF (T.LT.-1000.0) RETURN TC=(T+ZK(JT))/ZT(JT) HC=H/ZE(JE) X =XTH(TC,HC) WRITE(6,600) 'T=',T,CT(JT),'H=',H,CE(JE) WRITE(6,600) 'XTH=',X,CX WRITE(6,*) 600 FORMAT(A10,1PE14.6,1X,A14,A10,1PE14.6,1X,A14) GOTO 1010 END * No.18 SUBROUTINE TS IMPLICIT REAL*8 (Z) CHARACTER*14 CP,CT,CE,CS,CV,CC,CVI,CST,CL,CSV,CIP,CX, + CJT,CBP,CBS,CBV COMMON/UNITC/CP(9),CT(4),CE(4),CS(4),CV(3),CC(4),CVI(5),CST(3), + CL(4),CSV(4),CIP,CX,CJT(3),CBP(4),CBS(9),CBV(4) COMMON/UNITZ/ZP(9),ZT(4),ZE(4),ZS(4),ZV(3),ZC(4),ZVI(5),ZST(3), + ZL(4),ZSV(4),ZK(4),ZJT(3) COMMON/UNITJ/JP,JT,JE,JS,JV,JC,JVI,JST,JL,JSV,JJT PRINT *,'==================' PRINT *,'Calculation of XTS' PRINT *,'==================' LT=INDEX(CT(JT),' ') LS=INDEX(CS(JS),' ') 1010 PRINT '(5A)',' Input T',CT(JT)(1:LT),'and S',CS(JS)(1:LS), + '( T<-1000.0 : Quit) : ' READ(5,*) T,S IF (T.LT.-1000.0) RETURN TC=(T+ZK(JT))/ZT(JT) SC=S/ZS(JS) X =XTS(TC,SC) WRITE(6,600) 'T=',T,CT(JT),'S=',S,CS(JS) WRITE(6,600) 'XTS=',X,CX WRITE(6,*) 600 FORMAT(A10,1PE14.6,1X,A14,A10,1PE14.6,1X,A14) GOTO 1010 END * No.19 SUBROUTINE TU IMPLICIT REAL*8 (Z) CHARACTER*14 CP,CT,CE,CS,CV,CC,CVI,CST,CL,CSV,CIP,CX, + CJT,CBP,CBS,CBV COMMON/UNITC/CP(9),CT(4),CE(4),CS(4),CV(3),CC(4),CVI(5),CST(3), + CL(4),CSV(4),CIP,CX,CJT(3),CBP(4),CBS(9),CBV(4) COMMON/UNITZ/ZP(9),ZT(4),ZE(4),ZS(4),ZV(3),ZC(4),ZVI(5),ZST(3), + ZL(4),ZSV(4),ZK(4),ZJT(3) COMMON/UNITJ/JP,JT,JE,JS,JV,JC,JVI,JST,JL,JSV,JJT PRINT *,'==================' PRINT *,'Calculation of XTU' PRINT *,'==================' LT=INDEX(CT(JT),' ') LE=INDEX(CE(JE),' ') 1010 PRINT '(5A)',' Input T',CT(JT)(1:LT),'and U',CE(JE)(1:LE), + '( T<-1000.0 : Quit) : ' READ(5,*) T,U IF (T.LT.-1000.0) RETURN TC=(T+ZK(JT))/ZT(JT) UC=U/ZE(JE) X =XTU(TC,UC) WRITE(6,600) 'T=',T,CT(JT),'U=',U,CE(JE) WRITE(6,600) 'XTU=',X,CX WRITE(6,*) 600 FORMAT(A10,1PE14.6,1X,A14,A10,1PE14.6,1X,A14) GOTO 1010 END * No.20 SUBROUTINE TV IMPLICIT REAL*8 (Z) CHARACTER*14 CP,CT,CE,CS,CV,CC,CVI,CST,CL,CSV,CIP,CX, + CJT,CBP,CBS,CBV COMMON/UNITC/CP(9),CT(4),CE(4),CS(4),CV(3),CC(4),CVI(5),CST(3), + CL(4),CSV(4),CIP,CX,CJT(3),CBP(4),CBS(9),CBV(4) COMMON/UNITZ/ZP(9),ZT(4),ZE(4),ZS(4),ZV(3),ZC(4),ZVI(5),ZST(3), + ZL(4),ZSV(4),ZK(4),ZJT(3) COMMON/UNITJ/JP,JT,JE,JS,JV,JC,JVI,JST,JL,JSV,JJT PRINT *,'==================' PRINT *,'Calculation of XTV' PRINT *,'==================' LT=INDEX(CT(JT),' ') LV=INDEX(CV(JV),' ') 1010 PRINT '(5A)',' Input T',CT(JT)(1:LT),'and V',CV(JV)(1:LV), + '( T<-1000.0 : Quit) : ' READ(5,*) T,V IF (T.LT.-1000.0) RETURN TC=(T+ZK(JT))/ZT(JT) VC=V/ZV(JV) X =XTV(TC,VC) WRITE(6,600) 'T=',T,CT(JT),'V=',V,CV(JV) WRITE(6,600) 'XTV=',X,CX WRITE(6,*) 600 FORMAT(A10,1PE14.6,1X,A14,A10,1PE14.6,1X,A14) GOTO 1010 END * No.21 SUBROUTINE TX IMPLICIT REAL*8 (Z) CHARACTER*14 CP,CT,CE,CS,CV,CC,CVI,CST,CL,CSV,CIP,CX, + CJT,CBP,CBS,CBV COMMON/UNITC/CP(9),CT(4),CE(4),CS(4),CV(3),CC(4),CVI(5),CST(3), + CL(4),CSV(4),CIP,CX,CJT(3),CBP(4),CBS(9),CBV(4) COMMON/UNITZ/ZP(9),ZT(4),ZE(4),ZS(4),ZV(3),ZC(4),ZVI(5),ZST(3), + ZL(4),ZSV(4),ZK(4),ZJT(3) COMMON/UNITJ/JP,JT,JE,JS,JV,JC,JVI,JST,JL,JSV,JJT PRINT *,'=================================' PRINT *,'Calculation of HTX, STX, UTX, VTX' PRINT *,'=================================' LT=INDEX(CT(JT),' ') 1010 PRINT '(3A)',' Input T',CT(JT)(1:LT), + 'and X[-] ( T<-1000.0 : Quit) : ' READ(5,*) T,X IF (T.LT.-1000.0) RETURN TC=(T+ZK(JT))/ZT(JT) V =VTX(TC,X)*ZV(JV) H =HTX(TC,X)*ZE(JE) S =STX(TC,X)*ZS(JS) U =UTX(TC,X)*ZE(JE) WRITE(6,600) 'T=',T,CT(JT),'X=',X,CX WRITE(6,600) 'HTX=',H,CE(JE),'STX=',S,CS(JS) WRITE(6,600) 'UTX=',U,CE(JE),'VTX=',V,CV(JV) WRITE(6,*) 600 FORMAT(A10,1PE14.6,1X,A14,A10,1PE14.6,1X,A14) GOTO 1010 END * No.22 SUBROUTINE A IMPLICIT REAL*8 (Z) CHARACTER*14 CP,CT,CE,CS,CV,CC,CVI,CST,CL,CSV,CIP,CX, + CJT,CBP,CBS,CBV COMMON/UNITC/CP(9),CT(4),CE(4),CS(4),CV(3),CC(4),CVI(5),CST(3), + CL(4),CSV(4),CIP,CX,CJT(3),CBP(4),CBS(9),CBV(4) COMMON/UNITZ/ZP(9),ZT(4),ZE(4),ZS(4),ZV(3),ZC(4),ZVI(5),ZST(3), + ZL(4),ZSV(4),ZK(4),ZJT(3) COMMON/UNITJ/JP,JT,JE,JS,JV,JC,JVI,JST,JL,JSV,JJT PRINT *,'============================' PRINT *,'Calculation of CRP, FC, TRPL' PRINT *,'============================' * Critical Constants CRPH=CRP('H')*ZE(JE) CRPP=CRP('P')*ZP(JP) CRPS=CRP('S')*ZS(JS) CRPT=CRP('T')*ZT(JT)-ZK(JT) CRPV=CRP('V')*ZV(JV) * Fundamental Constants FCR=FC('R')*ZS(JS) FCM=FC('M') * Triple Point TRPLP=TRPL('P')*ZP(JP) TRPLT=TRPL('T')*ZT(JT)-ZK(JT) WRITE(6,*) 'Critical Constants' WRITE(6,600) 'H=',CRPH,CE(JE),'P=',CRPP,CP(JP) WRITE(6,600) 'S=',CRPS,CS(JS),'T=',CRPT,CT(JT) WRITE(6,600) 'V=',CRPV,CV(JV) WRITE(6,*) 'Fundamental Constants' WRITE(6,600) 'M=',FCM,CX,'R=',FCR,CS(JS) WRITE(6,*) 'Triple Point' WRITE(6,600) 'P=',TRPLP,CP(JP),'T=',TRPLT,CT(JT) PRINT '(A)','--- Hit RETURN Key to Function Menu---' READ(5,'(A1)') RTN 600 FORMAT(A10,1PE14.6,1X,A14,A10,1PE14.6,1X,A14) RETURN END * No.23 SUBROUTINE T9068 IMPLICIT REAL*8 (Z) CHARACTER*14 CP,CT,CE,CS,CV,CC,CVI,CST,CL,CSV,CIP,CX, + CJT,CBP,CBS,CBV COMMON/UNITC/CP(9),CT(4),CE(4),CS(4),CV(3),CC(4),CVI(5),CST(3), + CL(4),CSV(4),CIP,CX,CJT(3),CBP(4),CBS(9),CBV(4) COMMON/UNITZ/ZP(9),ZT(4),ZE(4),ZS(4),ZV(3),ZC(4),ZVI(5),ZST(3), + ZL(4),ZSV(4),ZK(4),ZJT(3) COMMON/UNITJ/JP,JT,JE,JS,JV,JC,JVI,JST,JL,JSV,JJT PRINT *,'=======================================' PRINT *,'Conversion of Temperature Scale ' PRINT *,' T90(T68): from IPTS-1968 to ITS-1990' PRINT *,' T68(T90): from ITS-1990 to IPTS-1968' PRINT *,'=======================================' LT=INDEX(CT(JT),' ') 1010 PRINT '(3A)',' Input T68 or T90 ',CT(JT)(1:LT), + '( T<-1000.0 : Quit) : ' READ(5,*) T IF (T.LT.-1000.0) RETURN TC=(T+ZK(JT))/ZT(JT) T1990=T90(TC)*ZT(JT)-ZK(JT) T1968=T68(TC)*ZT(JT)-ZK(JT) WRITE(6,600) 'T90(T68)=',T1990,CT(JT),'T68(T90)=',T1968,CT(JT) WRITE(6,*) 600 FORMAT(A10,1PE14.6,1X,A14,A10,1PE14.6,1X,A14) GOTO 1010 END *SUB_3 SUBROUTINE UNITS CHARACTER*14 CP,CT,CE,CS,CV,CC,CVI,CST,CL,CSV,CIP,CX, + CJT,CBP,CBS,CBV COMMON/UNITC/CP(9),CT(4),CE(4),CS(4),CV(3),CC(4),CVI(5),CST(3), + CL(4),CSV(4),CIP,CX,CJT(3),CBP(4),CBS(9),CBV(4) COMMON/UNITJ/JP,JT,JE,JS,JV,JC,JVI,JST,JL,JSV,JJT 100 PRINT *,'=========================================' PRINT *,'No. Unit (Current)' PRINT *,'=========================================' PRINT *,' 1 ---> Pressure ',CP(JP) PRINT *,' 2 ---> Temperature ',CT(JT) PRINT *,' 3 ---> Energy ',CE(JE) PRINT *,' Entropy and Sp. Heat ',CS(JE) PRINT *,' 4 ---> Specific Volume ',CV(JV) PRINT *,' 5 ---> Thermal Conductivity ',CC(JC) PRINT *,' 6 ---> Viscosity ',CVI(JVI) PRINT *,' 7 ---> Surface Tension ',CST(JST) PRINT *,' 8 ---> Laplace Coefficient ',CL(JL) PRINT *,' 9 ---> Sonic Velocity ',CSV(JSV) PRINT *,'10 ---> Joul-Thomson Coef. ',CJT(JJT) PRINT *,' 0 ---> Return to the Function Menu ' PRINT *,'=========================================' 1000 PRINT '(A)',' Input No. : ' READ(5,*) ID IF (ID.EQ.0) THEN RETURN * ELSE IF (ID.EQ.1) THEN PRINT *,'==================' PRINT *,'Unit for Pressure' PRINT *,'==================' PRINT *,' 1 ---> ',CP(1) PRINT *,' 2 ---> ',CP(2) PRINT *,' 3 ---> ',CP(3) PRINT *,' 4 ---> ',CP(4) PRINT *,' 5 ---> ',CP(5) PRINT *,' 6 ---> ',CP(6) PRINT *,' 7 ---> ',CP(7) PRINT *,' 8 ---> ',CP(8) PRINT *,' 9 ---> ',CP(9) PRINT *,'==================' 1010 PRINT '(A)',' Input No. : ' READ(5,*) JP IF((JP.LT.1).OR.(JP.GT.9)) GOTO 1010 * ELSE IF (ID.EQ.2) THEN PRINT *,'====================' PRINT *,'Unit for Temperature' PRINT *,'====================' PRINT *,' 1 ---> ',CT(1) PRINT *,' 2 ---> ',CT(2) PRINT *,' 3 ---> ',CT(3) PRINT *,' 4 ---> ',CT(4) PRINT *,'====================' 1020 PRINT '(A)',' Input No. : ' READ(5,*) JT IF((JT.LT.1).OR.(JT.GT.4)) GOTO 1020 * ELSE IF (ID.EQ.3) THEN PRINT *,'=====================================' PRINT *,'Unit for Energy, Entropy and Sp. Heat' PRINT *,'=====================================' PRINT *,' 1 ---> ',CE(1),CS(1) PRINT *,' 2 ---> ',CE(2),CS(2) PRINT *,' 3 ---> ',CE(3),CS(3) PRINT *,' 4 ---> ',CE(4),CS(4) PRINT *,'=====================================' 1030 PRINT '(A)',' Input No. : ' READ(5,*) JE IF((JE.LT.1).OR.(JE.GT.4)) GOTO 1030 JS=JE * ELSE IF (ID.EQ.4) THEN PRINT *,'========================' PRINT *,'Unit for Specific Volume' PRINT *,'========================' PRINT *,' 1 ---> ',CV(1) PRINT *,' 2 ---> ',CV(2) PRINT *,' 3 ---> ',CV(3) PRINT *,'========================' 1040 PRINT '(A)',' Input No. : ' READ(5,*) JV IF((JV.LT.1).OR.(JV.GT.3)) GOTO 1040 * ELSE IF (ID.EQ.5) THEN PRINT *,'=============================' PRINT *,'Unit for Thermal Conductivity' PRINT *,'=============================' PRINT *,' 1 ---> ',CC(1) PRINT *,' 2 ---> ',CC(2) PRINT *,' 3 ---> ',CC(3) PRINT *,' 4 ---> ',CC(4) PRINT *,'=============================' 1050 PRINT '(A)',' Input No. : ' READ(5,*) JC IF((JC.LT.1).OR.(JC.GT.4)) GOTO 1050 * ELSE IF (ID.EQ.6) THEN PRINT *,'=====================' PRINT *,'Unit for Viscosity' PRINT *,'=====================' PRINT *,' 1 ---> ',CVI(1) PRINT *,' 2 ---> ',CVI(2) PRINT *,' 3 ---> ',CVI(3) PRINT *,' 4 ---> ',CVI(4) PRINT *,' 5 ---> ',CVI(5) PRINT *,'=====================' 1060 PRINT '(A)',' Input No. : ' READ(5,*) JVI IF((JVI.LT.1).OR.(JVI.GT.5)) GOTO 1060 * ELSE IF (ID.EQ.7) THEN PRINT *,'========================' PRINT *,'Unit for Surface Tension' PRINT *,'========================' PRINT *,' 1 ---> ',CST(1) PRINT *,' 2 ---> ',CST(2) PRINT *,' 3 ---> ',CST(3) PRINT *,'========================' 1070 PRINT '(A)',' Input No. : ' READ(5,*) JST IF((JST.LT.1).OR.(JST.GT.3)) GOTO 1070 * ELSE IF (ID.EQ.8) THEN PRINT *,'============================' PRINT *,'Unit for Laplace Coefficient' PRINT *,'============================' PRINT *,' 1 ---> ',CL(1) PRINT *,' 2 ---> ',CL(2) PRINT *,' 3 ---> ',CL(3) PRINT *,' 4 ---> ',CL(4) PRINT *,'============================' 1080 PRINT '(A)',' Input No. : ' READ(5,*) JL IF((JL.LT.1).OR.(JL.GT.4)) GOTO 1080 * ELSE IF (ID.EQ.9) THEN PRINT *,'=======================' PRINT *,'Unit for Sonic Velocity' PRINT *,'=======================' PRINT *,' 1 ---> ',CSV(1) PRINT *,' 2 ---> ',CSV(2) PRINT *,' 3 ---> ',CSV(3) PRINT *,' 4 ---> ',CSV(4) PRINT *,'=======================' 1090 PRINT '(A)',' Input No. : ' READ(5,*) JSV IF((JSV.LT.1).OR.(JSV.GT.4)) GOTO 1090 * ELSE IF (ID.EQ.10) THEN PRINT *,'=================================' PRINT *,'Unit for Joul-Thomson Coefficient' PRINT *,'=================================' PRINT *,' 1 ---> ',CJT(1) PRINT *,' 2 ---> ',CJT(2) PRINT *,' 3 ---> ',CJT(3) PRINT *,'=================================' 1100 PRINT '(A)',' Input No. : ' READ(5,*) JJT IF((JJT.LT.1).OR.(JJT.GT.3)) GOTO 1100 * ELSE GOTO 1000 ENDIF GOTO 100 END *SUB_2 ***** Main Menu ***** SUBROUTINE MENU(ID) CHARACTER CHA*1,IDENTF*20,FNAME*65,FSUB1*20,FSUB2*20,FVER*10 CHA='S' FSUB1=IDENTF(CHA) CHA='C' FSUB2=IDENTF(CHA) CHA='V' FVER=IDENTF(CHA) LSUB1=INDEX(FSUB1,' ') IF (LSUB1.EQ.0) LSUB1=19 LSUB2=INDEX(FSUB2,' ')-1 FNAME='Thermophysical Properties of '//FSUB1(1:LSUB1)// + '('//FSUB2(1:LSUB2)//')'//' VER.'//FVER PRINT *,'======================================' + ,'======================================' PRINT *,'| SS: An Application Program f' + ,'or PROPATH Providing |' PRINT *,'| '//FNAME//'|' PRINT *,'======================================' + ,'======================================' PRINT *,'| No. PROPATH Functions ' + ,' | No. PROPATH Functions |' PRINT *,'======================================' + ,'======================================' PRINT *,'| 1: TSP, AKPD, AKPDD, VPD, VPDD, HPD,', + ' HPDD, | 12: TPH, TPH2, XPH |' PRINT *,'| SPD, SPDD, UPD, UPDD, ALHP ', + ' | 13: HPS, TPS, TPS2, UPS, |' PRINT *,'| 2: TSP, ALAPP, ALMPD, ALMPDD, AMUPD, ', + ' AMUPDD | VPS, XPS |' PRINT *,'| 3: CPPD, CPPDD, CVPD, CVPDD, EPSPD, ', + ' EPSPDD, | 14: XPU |' PRINT *,'| GAMPD, GAMPDD, PRPD, PRPDD, SIGP, ', + 'WPD, | 15: TPV, XPV |' PRINT *,'| WPDD ', + ' | 16: HPX, SPX, UPX, VPX |' PRINT *,'| 4: TSP, TSPD, TSPDD, TLDP,TMLP, TPSEUP,', + ' TSBP | 17: XTH |' PRINT *,'| 5: PST, AKTD, AKTDD, VTD, VTDD, HTD,', + ' HTDD, | 18: XTS |' PRINT *,'| STD, STDD, UTD, UTDD, ALHT ', + ' | 19: XTU |' PRINT *,'| 6: PST, ALAPT, ALMTD, ALMTDD, AMUTD,', + ' AMUTDD | 20: XTV |' PRINT *,'| 7: CPTD, CPTDD, CVTD, CVTDD, EPSTD, EPSTDD,', + ' | 21: HTX, STX, UTX, VTX |' PRINT *,'| GAMTD, GAMTDD, PRTD, PRTDD, SIGT, WTD,', + ' | 22: CRP, FC, TRPL |' PRINT *,'| WTDD ', + ' | 23: T90, T68 |' PRINT *,'| 8: PST, PSTD, PSTDD, PLDT, PMLT, PSBT', + ' | |' PRINT *,'| 9: VPT, HPT, SPT, UPT ', + ' | |' PRINT *,'|10: ALMPT, AMUPT, CPPT, CVPT, GAMPT, PRPT', + ' | |' PRINT *,'|11: AKPT, AJTPT, AIPPT, BPPT, BSPT, BTPT', + ' | 99: Change System of Unit |' PRINT *,'| BVPT, EPSPT, WPT ', + ' | 0: Quit |' PRINT *,'======================================' + ,'======================================' PRINT '(A)',' Input No. : ' READ(5,*) ID RETURN END