C********************************************************************* C PROPATH --- MOIST AIR V10.1 (MAIG-SS.EXE) by T.FUJITA (AUG.1996) * C********************************************************************* CHARACTER LSS(7)*78, LME(15)*63, LUP(7)*6, LUT(2)*3, LUR(2)*3, & LUX(2)*9, LUV*11, LUH(3)*12, LUS(3)*14, LL, L(10) DIMENSION UP(7),UT(2),UR(2),UX(2),UHS(3) DATA LSS(1)/'+--------------------------------------------------- &------------------------+'/, & LSS(2)/'| PROPATH Version 12.1 & |'/, & LSS(3)/'| A Program Package for Thermophysical Properties o &f Fluids |'/, & LSS(4)/'| & |'/, & LSS(5)/'| Application Program: |'/, & LSS(6)/'| Copyright PROPATH Group, May. 7, 2001 & |'/, & LSS(7)/'+--------------------------------------------------- &------------------------+'/ DATA LME/'======================================================== &=======', &'| SS: An Application Program for PROPATH Providing |', &'| Thermophysical Properties of MOIST AIR as Mixture of |', &'| Ideal Gases Ver.12.1 |', &'| No. PROPATH Functions |', &'| 1 --(P,T,WB)--> DPA RHA DSA RWA XA VA HA SA |', &'| 2 --(P,T,DP)--> WBB RHB DSB RWB XB VB HB SB |', &'| 3 --(P,T,RH)--> WBC DPC DSC RWC XC VC HC SC |', &'| 4 --(P,T,X) --> WBD DPD RHD DSD RWD VD HD SD |', &'| 5 --(P,T,H) --> WBE DPE RHE DSE RWE XE VE SE |', &'| 6 --(P,X,H) --> TF WBF DPF RHF DSF RWF VF SF |', &'| 7 ------------> PST(T) ENHFAC(P,T) |', &'| 8 ------------> FC |', &'| 9 ------------> Change System of Unit |', &'| 0 ------------> Quit |'/ DATA LUP/'[Pa] ','[kPa] ','[MPa] ','[bar] ','[ata] ','[atm] ', & '[mmHg]'/, LUT/'[K]','[C]'/, LUR/'[-]','[%]'/, & LUX/'[kg/kgDA] ','[g/kgDA] '/, LUV/'[m**3/kgDA] '/, & LUH/'[J/kgDA] ','[kJ/kgDA] ','[kcal/kgfDA]'/, & LUS/'[J/(kgDA*K)] ','[kJ/(kgDA*K)] ','[kcal/kgfDA*K]'/ DATA UP(1)/101325./,UP(2)/101.325/,UP(3)/0.101325/, & UP(4)/1.01325/,UP(5)/1.03323/,UP(6)/1./,UP(7)/760./, & UT(1)/273.15/,UT(2)/0./, UR(1)/1./,UR(2)/100./, & UX(1)/1./,UX(2)/1000./, UHS(1)/4186.8/,UHS(2)/4.1868/,UHS(3)/1./ DATA JP/1/,JT/1/,JR/1/,JX/1/,JHS/1/ WRITE(*,30) (LSS(J),J=1,7) 30 FORMAT(1H ,A78) WRITE(*,'(A)')' --- Hit RETURN Key ---' READ(*,'(A)') LL 1000 WRITE(*,31) (LME(J),J=1,4),LME(1),LME(5) 1,LME(1),(LME(J),J=6,15),LME(1) 31 FORMAT(1H ,A63) WRITE(*,'(A)')' Input No. ====> ' DO 1001 JK=1,10 1001 L(JK)=' ' READ(*,*) QNM NM=IFIX(QNM) IF(NM*(NM-9).LT.0) GOTO(100,200,300,400,500,600,700,800),NM IF(NM.EQ.0) THEN WRITE(*,'(A)')' ***** See You Again ! *****' GOTO 999 ENDIF IF(NM.NE.9) THEN WRITE(*,'(A)')' ***** Invalid No. *****' GOTO 1000 ENDIF 900 CALL SUNIT(JP,JT,JR,JX,JHS) 901 WRITE(*,'(A)')' Input No. ====> ' READ(*,*) QNU NU=IFIX(QNU) IF(NU.EQ.0) GOTO 1000 IF(NU*(NU-6).GT.0) GOTO 901 GOTO(910,920,930,940,950,960),NU 910 WRITE(*,'(A)')' ===================' WRITE(*,'(A)')' Unit for Pressure' WRITE(*,'(A)')' ===================' WRITE(*,'(A)')' 1 ---> [Pa]' WRITE(*,'(A)')' 2 ---> [kPa]' WRITE(*,'(A)')' 3 ---> [MPa]' WRITE(*,'(A)')' 4 ---> [bar]' WRITE(*,'(A)')' 5 ---> [ata]' WRITE(*,'(A)')' 6 ---> [atm]' WRITE(*,'(A)')' 7 ---> [mmHg]' WRITE(*,'(A)')' ===================' 911 WRITE(*,'(A)')' Input No. ====> ' READ(*,*) QJP JP=IFIX(QJP) IF(JP*(JP-8).GE.0) GOTO 911 GOTO 900 920 WRITE(*,'(A)')' ==============================' WRITE(*,'(A)')' Unit for Temperature' WRITE(*,'(A)')' ==============================' WRITE(*,'(A)')' 1 ---> [K]' WRITE(*,'(A)')' 2 ---> [C]' WRITE(*,'(A)')' ==============================' 921 WRITE(*,'(A)')' Input No. ====> ' READ(*,*) QJT JT=IFIX(QJT) IF(JT*(JT-3).GE.0) GOTO 921 GOTO 900 930 WRITE(*,'(A)')' ============================' WRITE(*,'(A)')' Unit for Relative Humidity' WRITE(*,'(A)')' and Degree of Saturation' WRITE(*,'(A)')' ============================' WRITE(*,'(A)')' 1 ---> [-]' WRITE(*,'(A)')' 2 ---> [%]' WRITE(*,'(A)')' ============================' 931 WRITE(*,'(A)')' Input No. ====> ' READ(*,*) QJR JR=IFIX(QJR) IF(JR*(JR-3).GE.0) GOTO 931 GOTO 900 940 WRITE(*,'(A)')' =========================' WRITE(*,'(A)')' Unit for Humidity Ratio' WRITE(*,'(A)')' =========================' WRITE(*,'(A)')' 1 ---> [kg/kgDA]' WRITE(*,'(A)')' 2 ---> [g/kgDA]' WRITE(*,'(A)')' =========================' 941 WRITE(*,'(A)')' Input No. ====> ' READ(*,*) QJX JX=IFIX(QJX) IF(JX*(JX-3).GE.0) GOTO 941 GOTO 900 950 WRITE(*,'(A)')' ==========================' WRITE(*,'(A)')' Unit for Specific Volume' WRITE(*,'(A)')' ==========================' WRITE(*,'(A)')' [m**3/kgDA]' WRITE(*,'(A)')' ==========================' WRITE(*,'(A)')' --- Hit RETURN Key ---' READ(*,'(A)') LL GOTO 900 960 WRITE(*,'(A)')' ========================================' WRITE(*,'(A)')' Unit for Specific Enthalpy and Entropy' WRITE(*,'(A)')' ========================================' WRITE(*,'(A)')' 1 ---> [J/kgDA] [J/(kgDA*K)]' WRITE(*,'(A)')' 2 ---> [kJ/kgDA] [kJ/(kgDA*K)]' WRITE(*,'(A)')' 3 ---> [kcal/kgfDA] [kcal/kgfDA*K]' WRITE(*,'(A)')' ========================================' 961 WRITE(*,'(A)')' Input No. ====> ' READ(*,*) QJHS JHS=IFIX(QJHS) IF(JHS*(JHS-4).GE.0) GOTO 961 GOTO 900 100 DO 101 J=1,2 101 L(J)=' ' DO 102 J=3,10 102 L(J)='A' WRITE(*,'(A)')' =======================================' WRITE(*,'(A)')' Calculation of DPA, RHA, DSA' WRITE(*,'(A)')' RWA, XA, VA, HA, SA' WRITE(*,'(A)')' =======================================' 110 WRITE(*,32) 'Input P',LUP(JP),' (P=0 : Quit) ====> ' 32 FORMAT(1H ,A,A,A) READ(*,*) XP IF(XP.LE.0.) GOTO 1000 WRITE(*,32) 'Input T',LUT(JT),' ====> ' READ(*,*) XT WRITE(*,32) 'Input WB',LUT(JT),' ====> ' READ(*,*) XWB YT=XT+UT(2)-UT(JT) YWB=XWB+UT(2)-UT(JT) GOTO 666 200 L(1)=' ' DO 201 J=2,10 201 L(J)='B' L(3)=' ' WRITE(*,'(A)')' =======================================' WRITE(*,'(A)')' Calculation of WBB, RHB, DSB' WRITE(*,'(A)')' RWB, XB, VB, HB, SB' WRITE(*,'(A)')' =======================================' 210 WRITE(*,32) 'Input P',LUP(JP),' (P=0 : Quit) ====> ' READ(*,*) XP IF(XP.LE.0.) GOTO 1000 WRITE(*,32) 'Input T',LUT(JT),' ====> ' READ(*,*) XT WRITE(*,32) 'Input DP',LUT(JT),' ====> ' READ(*,*) XDP YT=XT+UT(2)-UT(JT) YDP=XDP+UT(2)-UT(JT) GOTO 666 300 L(1)=' ' DO 301 J=2,10 301 L(J)='C' L(4)=' ' WRITE(*,'(A)')' =======================================' WRITE(*,'(A)')' Calculation of WBC, DPC, DSC' WRITE(*,'(A)')' RWC, XC, VC, HC, SC' WRITE(*,'(A)')' =======================================' 310 WRITE(*,32) 'Input P',LUP(JP),' (P=0 : Quit) ====> ' READ(*,*) XP IF(XP.LE.0.) GOTO 1000 WRITE(*,32) 'Input T',LUT(JT),' ====> ' READ(*,*) XT WRITE(*,32) 'Input RH',LUR(JR),' ====> ' READ(*,*) XRH YT=XT+UT(2)-UT(JT) YRH=XRH*UR(1)/UR(JR) GOTO 666 400 L(1)=' ' DO 401 J=2,10 401 L(J)='D' L(7)=' ' WRITE(*,'(A)')' ===================================' WRITE(*,'(A)')' Calculation of WBD, DPD, RHD, DSD' WRITE(*,'(A)')' RWD, VD, HD, SD' WRITE(*,'(A)')' ===================================' 410 WRITE(*,32) 'Input P',LUP(JP),' (P=0 : Quit) ====> ' READ(*,*) XP IF(XP.LE.0.) GOTO 1000 WRITE(*,32) 'Input T',LUT(JT),' ====> ' READ(*,*) XT WRITE(*,32) 'Input X',LUX(JX),' ====> ' READ(*,*) XX YT=XT+UT(2)-UT(JT) YX=XX*UX(1)/UX(JX) GOTO 666 500 L(1)=' ' DO 501 J=2,10 501 L(J)='E' L(9)=' ' WRITE(*,'(A)')' ===================================' WRITE(*,'(A)')' Calculation of WBE, DPE, RHE, DSE' WRITE(*,'(A)')' RWE, XE, VE, SE' WRITE(*,'(A)')' ===================================' 510 WRITE(*,32) 'Input P',LUP(JP),' (P=0 : Quit) ====> ' READ(*,*) XP IF(XP.LE.0.) GOTO 1000 WRITE(*,32) 'Input T',LUT(JT),' ====> ' READ(*,*) XT WRITE(*,32) 'Input H',LUH(JHS),' ====> ' READ(*,*) XH YT=XT+UT(2)-UT(JT) YH=XH*UHS(1)/UHS(JHS) GOTO 666 600 DO 601 J=1,10 601 L(J)='F' L(7)=' ' L(9)=' ' WRITE(*,'(A)')' ========================================' WRITE(*,'(A)')' Calculation of TF, WBF, DPF, RHF, DSF' WRITE(*,'(A)')' RWF, VF, SF' WRITE(*,'(A)')' ========================================' 610 WRITE(*,32) 'Input P',LUP(JP),'(P=0 : Quit) ====> ' READ(*,*) XP IF(XP.LE.0.) GOTO 1000 WRITE(*,32) 'Input X',LUX(JX),' ====> ' READ(*,*) XX WRITE(*,32) 'Input H',LUH(JHS),' ====> ' READ(*,*) XH YX=XX*UX(1)/UX(JX) YH=XH*UHS(1)/UHS(JHS) 666 YP=XP*UP(4)/UP(JP) CALL SCAL(NM,YP,YT,YWB,YDP,YRH,YDS,YRW,YX,YV,YH,YS) YP=XP IF(YT.NE.-1.E20) YT=YT-UT(2)+UT(JT) IF(YWB.NE.-1.E20) YWB=YWB-UT(2)+UT(JT) IF(YDP.NE.-1.E20) YDP=YDP-UT(2)+UT(JT) IF(YRH.NE.-1.E20) YRH=YRH*UR(JR)/UR(1) IF(YDS.NE.-1.E20) YDS=YDS*UR(JR)/UR(1) IF(YX.NE.-1.E20) YX=YX*UX(JX)/UX(1) IF(YH.NE.-1.E20) YH=YH*UHS(JHS)/UHS(1) IF(YS.NE.-1.E20) YS=YS*UHS(JHS)/UHS(1) WRITE(*,33) YP, LUP(JP) WRITE(*,34) L(1),YT, LUT(JT), L(6),YRW,LUR(1) WRITE(*,35) L(2),YWB,LUT(JT), L(7), YX,LUX(JX) WRITE(*,36) L(3),YDP,LUT(JT), L(8), YV,LUV WRITE(*,37) L(4),YRH,LUR(JR), L(9), YH,LUH(JHS) WRITE(*,38) L(5),YDS,LUR(JR), L(10),YS,LUS(JHS) WRITE(*,'(A)')' ' 33 FORMAT(' P =',1PE13.5,1H ,A) 34 FORMAT(' T',A1,'=',1PE13.5,1H ,A,' RW',A1,'=',E13.5,1H ,A) 35 FORMAT(' WB',A1,'=',1PE13.5,1H ,A,' X',A1,'=',E13.5,1H ,A) 36 FORMAT(' DP',A1,'=',1PE13.5,1H ,A,' V',A1,'=',E13.5,1H ,A) 37 FORMAT(' RH',A1,'=',1PE13.5,1H ,A,' H',A1,'=',E13.5,1H ,A) 38 FORMAT(' DS',A1,'=',1PE13.5,1H ,A,' S',A1,'=',E13.5,1H ,A) GOTO(110,210,310,410,510,610),NM 700 WRITE(*,'(A)')' ====================================' WRITE(*,'(A)')' Calculation of PST(T), ENHFAC(P,T)' WRITE(*,'(A)')' ====================================' 710 WRITE(*,32) 'Input P',LUP(JP),' (P=0 : Quit) ====> ' READ(*,*) XP IF(XP.EQ.0.) GOTO 1000 WRITE(*,32) 'Input T',LUT(JT),' ====> ' READ(*,*) XT YP=XP*UP(4)/UP(JP) YT=XT+UT(2)-UT(JT) YFS=F50L02(YP,YT) YTK68=G1L02(YT) YPS=-1.E20 IF(YTK68.NE.-1.E20) YPS=G3L02(YTK68)*1.E-5*UP(JP)/UP(4) YP=XP YT=XT WRITE(*,41) YP,LUP(JP),YT,LUT(JT) WRITE(*,42) YPS,LUP(JP),YFS,LUR(1) WRITE(*,'(A)')' ' 41 FORMAT(' P=',1PE13.5,1H ,A,' T=',1PE13.5,1H ,A) 42 FORMAT(' PST=',1PE13.5,1H ,A,' ENHFAC=',1PE13.5,1H ,A) GOTO 710 800 CALL SFC(JHS) WRITE(*,'(A)')' --- Hit RETURN Key ---' READ(*,'(A)') LL GOTO 1000 999 STOP END C--SUNIT SUBROUTINE SUNIT(JP,JT,JR,JX,JHS) CHARACTER*6 LUP(7) CHARACTER*3 LUT(2),LUR(2) CHARACTER*9 LUX(2) CHARACTER*11 LUV CHARACTER*12 LUH(3) CHARACTER*14 LUS(3) DATA LUP/'[Pa] ','[kPa] ','[MPa] ','[bar] ','[ata] ','[atm] ', & '[mmHg]'/, LUT/'[K]','[C]'/, LUR/'[-]','[%]'/, & LUX/'[kg/kgDA] ','[g/kgDA] '/, LUV/'[m**3/kgDA] '/, & LUH/'[J/kgDA] ','[kJ/kgDA] ','[kcal/kgfDA]'/, & LUS/'[J/(kgDA*K)] ','[kJ/(kgDA*K)] ','[kcal/kgfDA*K]'/ WRITE(*,30) WRITE(*,31) WRITE(*,30) WRITE(*,32) LUP(JP) WRITE(*,33) LUT(JT) WRITE(*,34) LUR(JR) WRITE(*,35) LUX(JX) WRITE(*,36) LUV WRITE(*,37) LUH(JHS),LUS(JHS) WRITE(*,38) WRITE(*,30) WRITE(*,39) 30 FORMAT(' ============================================') 31 FORMAT(' No. Unit (Current) ') 32 FORMAT(' 1 ---> Pressure ',A) 33 FORMAT(' 2 ---> Temperature ',A) 34 FORMAT(' 3 ---> Relative Humidity ',A,/ & ' Degree of Saturation ') 35 FORMAT(' 4 ---> Humidity Ratio ',A) 36 FORMAT(' 5 ---> Specific Volume ',A) 37 FORMAT(' 6 ---> Enthalpy ',A,/ & ' Entropy ',A) 38 FORMAT(' 0 ---> Return to the Function Menu') 39 FORMAT(' (DA : of Dry Air)') RETURN END C--SFC SUBROUTINE SFC(JE) CHARACTER LUE(3)*13 DIMENSION UE(3) DATA R/8.31441/,AM/28.9645/,WM/18.01528/ DATA LUE/' [J/(kg*K)] ',' [kJ/(kg*K)] ',' [kcal/kgf*K]'/ DATA UE(1)/4186.8/,UE(2)/4.1868/,UE(3)/1./ RA=R/AM*UE(JE)/UE(2) RW=R/WM*UE(JE)/UE(2) WRITE(*,'(A)')' ================================================== &===============' WRITE(*,'(A)')' Thermodynamic Properties of MOIST AIR as Mixture &of Ideal Gases' WRITE(*,'(A)')' PROPATH VER.12.1, May 78, 2001 ' WRITE(*,'(A)')' ================================================== &===============' WRITE(*,'(A)')' Fundamental Constants' WRITE(*,30) AM,RA,LUE(JE) WRITE(*,31) WM,RW,LUE(JE) 30 FORMAT(' Dry Air : M=',1PE13.5,' [-]',6X,'R=',E13.5,A) 31 FORMAT(' Water Vapor : M=',1PE13.5,' [-]',6X,'R=',E13.5,A) WRITE(*,'(A)')' Temperature Scale' WRITE(*,'(A)')' based on the International Practical Temperat &ure Scale of 1968' WRITE(*,'(A)')' References' WRITE(*,'(A)')' [1] ASHRAE HANDBOOK FUNDAMENTALS, 1993, Chapter 6 &, pp.6.1-6.10.' RETURN END C--SCAL SUBROUTINE SCAL(M,P,T,WB,DP,RH,DS,RW,X,V,H,S) C M=1(T,WB), 2(T,DP), 3(T,RH), 4(T,X), 5(T,H), 6(X,H) C 1: F1 =DPA F22=RHA F6 =DSA F16=RWA F45=XA F34=VA F12=HA F27=SA C 2: F40=WBB F23=RHB F7 =DSB F17=RWB F46=XB F35=VB F13=HB F28=SB C 3: F41=WBC F2 =DPC F8 =DSC F18=RWC F47=XC F36=VC F14=HC F29=SC C 4: F42=WBD F3 =DPD F24=RHD F9 =DSD F19=RWD F37=VD F15=HD F30=SD C 5: F43=WBE F4 =DPE F25=RHE F10=DSE F20=RWE F48=XE F38=VE F31=SE C 6: F33=TF F44=WBF F5 =DPF F26=RHF F11=DSF F21=RWF F39=VF F32=SF DATA EM/0.62198/ IF((P.LE.0.).OR.(P.GT.50.)) GOTO 99 PK=P*1.E5 IF(M.NE.6) THEN IF((T+100.)*(T-200.).GT.0.) GOTO 99 TK=G1L02(T) ENDIF IF(M.GE.5) HK=H*1.E-3 GOTO(1,2,3,4,5,6),M 1 IF((WB+100.)*(WB-200.).GT.0.) GOTO 99 WBK=G1L02(WB) RW=G7L02(PK,TK,WBK) GOTO 9 2 IF((DP+100.)*(DP-200.).GT.0.) GOTO 99 DPK=G1L02(DP) RW=G5L02(PK,TK,DPK) GOTO 9 3 RW=G6L02(PK,TK,RH) GOTO 9 4 IF(X.LT.0.) GOTO 99 RW=X/(X+EM) CALL S1L02(3,PK,TK,E1,E2,RW,EX,E5,E6,E7) IF(EX.EQ.-1.E20) RW=-1.E20 GOTO 9 5 RW=G9L02(TK,HK) GOTO 9 6 IF(X.LT.0.) GOTO 99 TK=G10L02(X,HK) T=G2L02(TK) IF(T.EQ.-1.E20) GOTO 99 GOTO 4 9 IF(RW.LT.0) GOTO 99 GOTO(10,10,10,40,50,60),M 10 CALL S1L02(7,PK,TK,RWS,XS,RW,X,V,HK,SK) GOTO 70 40 CALL S1L02(7,PK,TK,RWS,XS,RW,EX,V,HK,SK) GOTO 70 50 CALL S1L02(7,PK,TK,RWS,XS,RW,X,V,EH,SK) GOTO 80 60 CALL S1L02(7,PK,TK,RWS,XS,RW,EX,V,EH,SK) GOTO 80 70 H=HK IF(HK.NE.-1.E20) H=HK*1.E3 80 S=SK IF(SK.NE.-1.E20) S=SK*1.E3 IF(M.NE.1) THEN WBK=G8L02(PK,TK,RW) WB=G2L02(WBK) ENDIF IF(M.NE.2) THEN DPK=G4L02(PK,TK,RW) DP=G2L02(DPK) ENDIF IF(M.NE.3) THEN RH=-1.E20 IF(RWS.GT.0.) RH=RW/RWS ENDIF DS=-1.E20 IF(XS.GT.0.) DS=X/XS RETURN 99 IF(M.NE.1) WB=-1.E20 IF(M.NE.2) DP=-1.E20 IF(M.NE.3) RH=-1.E20 IF((M-4)*(M-6).NE.0) X=-1.E20 IF(M.LE.4) H=-1.E20 RW=-1.E20 DS=-1.E20 V=-1.E20 S=-1.E20 RETURN END