********************************************************************** * PROPATH --- MOIST AIR V10.1 (P10MAIG.LIB) by T.FUJITA (AUG.1996) * ********************************************************************** C mofified by R. Akasaka for ver.12.1 C - return value of IDENTF: 11.1 -> 12.1 C C--DPA FUNCTION DPA(P,T,WB) CHARACTER*6 FUN CHARACTER*2 N2,N3 COMMON/UNIT/KPA,MESS DATA FUN/'DPA'/,N2/'T'/,N3/'WB'/ U1=G98L02(KPA,P) U2=G99L02(KPA,T) U3=G99L02(KPA,WB) FF=F1L02(U1,U2,U3) IF(MESS.NE.0) CALL S99L02(FF,U1,U2,U3,FUN,N2,N3) T0=G99L02(KPA,0.) IF(FF.LE.-1.E10) T0=0. DPA=FF-T0 RETURN END C--DPC FUNCTION DPC(P,T,RH) CHARACTER*6 FUN CHARACTER*2 N2,N3 COMMON/UNIT/KPA,MESS DATA FUN/'DPC'/,N2/'T'/,N3/'RH'/ U1=G98L02(KPA,P) U2=G99L02(KPA,T) U3=RH FF=F2L02(U1,U2,U3) IF(MESS.NE.0) CALL S99L02(FF,U1,U2,U3,FUN,N2,N3) T0=G99L02(KPA,0.) IF(FF.LE.-1.E10) T0=0. DPC=FF-T0 RETURN END C--DPD FUNCTION DPD(P,T,X) CHARACTER*6 FUN CHARACTER*2 N2,N3 COMMON/UNIT/KPA,MESS DATA FUN/'DPD'/,N2/'T'/,N3/'X'/ U1=G98L02(KPA,P) U2=G99L02(KPA,T) U3=X FF=F3L02(U1,U2,U3) IF(MESS.NE.0) CALL S99L02(FF,U1,U2,U3,FUN,N2,N3) T0=G99L02(KPA,0.) IF(FF.LE.-1.E10) T0=0. DPD=FF-T0 RETURN END C--DPE FUNCTION DPE(P,T,H) CHARACTER*6 FUN CHARACTER*2 N2,N3 COMMON/UNIT/KPA,MESS DATA FUN/'DPE'/,N2/'T'/,N3/'H'/ U1=G98L02(KPA,P) U2=G99L02(KPA,T) U3=H FF=F4L02(U1,U2,U3) IF(MESS.NE.0) CALL S99L02(FF,U1,U2,U3,FUN,N2,N3) T0=G99L02(KPA,0.) IF(FF.LE.-1.E10) T0=0. DPE=FF-T0 RETURN END C--DPF FUNCTION DPF(P,X,H) CHARACTER*6 FUN CHARACTER*2 N2,N3 COMMON/UNIT/KPA,MESS DATA FUN/'DPF'/,N2/'X'/,N3/'H'/ U1=G98L02(KPA,P) U2=X U3=H FF=F5L02(U1,U2,U3) IF(MESS.NE.0) CALL S99L02(FF,U1,U2,U3,FUN,N2,N3) T0=G99L02(KPA,0.) IF(FF.LE.-1.E10) T0=0. DPF=FF-T0 RETURN END C--DSA FUNCTION DSA(P,T,WB) CHARACTER*6 FUN CHARACTER*2 N2,N3 COMMON/UNIT/KPA,MESS DATA FUN/'DSA'/,N2/'T'/,N3/'WB'/ U1=G98L02(KPA,P) U2=G99L02(KPA,T) U3=G99L02(KPA,WB) FF=F6L02(U1,U2,U3) IF(MESS.NE.0) CALL S99L02(FF,U1,U2,U3,FUN,N2,N3) DSA=FF RETURN END C--DSB FUNCTION DSB(P,T,DP) CHARACTER*6 FUN CHARACTER*2 N2,N3 COMMON/UNIT/KPA,MESS DATA FUN/'DSB'/,N2/'T'/,N3/'DP'/ U1=G98L02(KPA,P) U2=G99L02(KPA,T) U3=G99L02(KPA,DP) FF=F7L02(U1,U2,U3) IF(MESS.NE.0) CALL S99L02(FF,U1,U2,U3,FUN,N2,N3) DSB=FF RETURN END C--DSC FUNCTION DSC(P,T,RH) CHARACTER*6 FUN CHARACTER*2 N2,N3 COMMON/UNIT/KPA,MESS DATA FUN/'DSC'/,N2/'T'/,N3/'RH'/ U1=G98L02(KPA,P) U2=G99L02(KPA,T) U3=RH FF=F8L02(U1,U2,U3) IF(MESS.NE.0) CALL S99L02(FF,U1,U2,U3,FUN,N2,N3) DSC=FF RETURN END C--DSD FUNCTION DSD(P,T,X) CHARACTER*6 FUN CHARACTER*2 N2,N3 COMMON/UNIT/KPA,MESS DATA FUN/'DSD'/,N2/'T'/,N3/'X'/ U1=G98L02(KPA,P) U2=G99L02(KPA,T) U3=X FF=F9L02(U1,U2,U3) IF(MESS.NE.0) CALL S99L02(FF,U1,U2,U3,FUN,N2,N3) DSD=FF RETURN END C--DSE FUNCTION DSE(P,T,H) CHARACTER*6 FUN CHARACTER*2 N2,N3 COMMON/UNIT/KPA,MESS DATA FUN/'DSE'/,N2/'T'/,N3/'H'/ U1=G98L02(KPA,P) U2=G99L02(KPA,T) U3=H FF=F10L02(U1,U2,U3) IF(MESS.NE.0) CALL S99L02(FF,U1,U2,U3,FUN,N2,N3) DSE=FF RETURN END C--DSF FUNCTION DSF(P,X,H) CHARACTER*6 FUN CHARACTER*2 N2,N3 COMMON/UNIT/KPA,MESS DATA FUN/'DSF'/,N2/'X'/,N3/'H'/ U1=G98L02(KPA,P) U2=X U3=H FF=F11L02(U1,U2,U3) IF(MESS.NE.0) CALL S99L02(FF,U1,U2,U3,FUN,N2,N3) DSF=FF RETURN END C--HA FUNCTION HA(P,T,WB) CHARACTER*6 FUN CHARACTER*2 N2,N3 COMMON/UNIT/KPA,MESS DATA FUN/'HA'/,N2/'T'/,N3/'WB'/ U1=G98L02(KPA,P) U2=G99L02(KPA,T) U3=G99L02(KPA,WB) FF=F12L02(U1,U2,U3) IF(MESS.NE.0) CALL S99L02(FF,U1,U2,U3,FUN,N2,N3) HA=FF RETURN END C--HB FUNCTION HB(P,T,DP) CHARACTER*6 FUN CHARACTER*2 N2,N3 COMMON/UNIT/KPA,MESS DATA FUN/'HB'/,N2/'T'/,N3/'DP'/ U1=G98L02(KPA,P) U2=G99L02(KPA,T) U3=G99L02(KPA,DP) FF=F13L02(U1,U2,U3) IF(MESS.NE.0) CALL S99L02(FF,U1,U2,U3,FUN,N2,N3) HB=FF RETURN END C--HC FUNCTION HC(P,T,RH) CHARACTER*6 FUN CHARACTER*2 N2,N3 COMMON/UNIT/KPA,MESS DATA FUN/'HC'/,N2/'T'/,N3/'RH'/ U1=G98L02(KPA,P) U2=G99L02(KPA,T) U3=RH FF=F14L02(U1,U2,U3) IF(MESS.NE.0) CALL S99L02(FF,U1,U2,U3,FUN,N2,N3) HC=FF RETURN END C--HD FUNCTION HD(P,T,X) CHARACTER*6 FUN CHARACTER*2 N2,N3 COMMON/UNIT/KPA,MESS DATA FUN/'HD'/,N2/'T'/,N3/'X'/ U1=G98L02(KPA,P) U2=G99L02(KPA,T) U3=X FF=F15L02(U1,U2,U3) IF(MESS.NE.0) CALL S99L02(FF,U1,U2,U3,FUN,N2,N3) HD=FF RETURN END C--RWA FUNCTION RWA(P,T,WB) CHARACTER*6 FUN CHARACTER*2 N2,N3 COMMON/UNIT/KPA,MESS DATA FUN/'RWA'/,N2/'T'/,N3/'WB'/ U1=G98L02(KPA,P) U2=G99L02(KPA,T) U3=G99L02(KPA,WB) FF=F16L02(U1,U2,U3) IF(MESS.NE.0) CALL S99L02(FF,U1,U2,U3,FUN,N2,N3) RWA=FF RETURN END C--RWB FUNCTION RWB(P,T,DP) CHARACTER*6 FUN CHARACTER*2 N2,N3 COMMON/UNIT/KPA,MESS DATA FUN/'RWB'/,N2/'T'/,N3/'DP'/ U1=G98L02(KPA,P) U2=G99L02(KPA,T) U3=G99L02(KPA,DP) FF=F17L02(U1,U2,U3) IF(MESS.NE.0) CALL S99L02(FF,U1,U2,U3,FUN,N2,N3) RWB=FF RETURN END C--RWC FUNCTION RWC(P,T,RH) CHARACTER*6 FUN CHARACTER*2 N2,N3 COMMON/UNIT/KPA,MESS DATA FUN/'RWC'/,N2/'T'/,N3/'RH'/ U1=G98L02(KPA,P) U2=G99L02(KPA,T) U3=RH FF=F18L02(U1,U2,U3) IF(MESS.NE.0) CALL S99L02(FF,U1,U2,U3,FUN,N2,N3) RWC=FF RETURN END C--RWD FUNCTION RWD(P,T,X) CHARACTER*6 FUN CHARACTER*2 N2,N3 COMMON/UNIT/KPA,MESS DATA FUN/'RWD'/,N2/'T'/,N3/'X'/ U1=G98L02(KPA,P) U2=G99L02(KPA,T) U3=X FF=F19L02(U1,U2,U3) IF(MESS.NE.0) CALL S99L02(FF,U1,U2,U3,FUN,N2,N3) RWD=FF RETURN END C--RWE FUNCTION RWE(P,T,H) CHARACTER*6 FUN CHARACTER*2 N2,N3 COMMON/UNIT/KPA,MESS DATA FUN/'RWE'/,N2/'T'/,N3/'H'/ U1=G98L02(KPA,P) U2=G99L02(KPA,T) U3=H FF=F20L02(U1,U2,U3) IF(MESS.NE.0) CALL S99L02(FF,U1,U2,U3,FUN,N2,N3) RWE=FF RETURN END C--RWF FUNCTION RWF(P,X,H) CHARACTER*6 FUN CHARACTER*2 N2,N3 COMMON/UNIT/KPA,MESS DATA FUN/'RWF'/,N2/'X'/,N3/'H'/ U1=G98L02(KPA,P) U2=X U3=H FF=F21L02(U1,U2,U3) IF(MESS.NE.0) CALL S99L02(FF,U1,U2,U3,FUN,N2,N3) RWF=FF RETURN END C--RHA FUNCTION RHA(P,T,WB) CHARACTER*6 FUN CHARACTER*2 N2,N3 COMMON/UNIT/KPA,MESS DATA FUN/'RHA'/,N2/'T'/,N3/'WB'/ U1=G98L02(KPA,P) U2=G99L02(KPA,T) U3=G99L02(KPA,WB) FF=F22L02(U1,U2,U3) IF(MESS.NE.0) CALL S99L02(FF,U1,U2,U3,FUN,N2,N3) RHA=FF RETURN END C--RHB FUNCTION RHB(P,T,DP) CHARACTER*6 FUN CHARACTER*2 N2,N3 COMMON/UNIT/KPA,MESS DATA FUN/'RHB'/,N2/'T'/,N3/'DP'/ U1=G98L02(KPA,P) U2=G99L02(KPA,T) U3=G99L02(KPA,DP) FF=F23L02(U1,U2,U3) IF(MESS.NE.0) CALL S99L02(FF,U1,U2,U3,FUN,N2,N3) RHB=FF RETURN END C--RHD FUNCTION RHD(P,T,X) CHARACTER*6 FUN CHARACTER*2 N2,N3 COMMON/UNIT/KPA,MESS DATA FUN/'RHD'/,N2/'T'/,N3/'X'/ U1=G98L02(KPA,P) U2=G99L02(KPA,T) U3=X FF=F24L02(U1,U2,U3) IF(MESS.NE.0) CALL S99L02(FF,U1,U2,U3,FUN,N2,N3) RHD=FF RETURN END C--RHE FUNCTION RHE(P,T,H) CHARACTER*6 FUN CHARACTER*2 N2,N3 COMMON/UNIT/KPA,MESS DATA FUN/'RHE'/,N2/'T'/,N3/'H'/ U1=G98L02(KPA,P) U2=G99L02(KPA,T) U3=H FF=F25L02(U1,U2,U3) IF(MESS.NE.0) CALL S99L02(FF,U1,U2,U3,FUN,N2,N3) RHE=FF RETURN END C--RHF FUNCTION RHF(P,X,H) CHARACTER*6 FUN CHARACTER*2 N2,N3 COMMON/UNIT/KPA,MESS DATA FUN/'RHF'/,N2/'X'/,N3/'H'/ U1=G98L02(KPA,P) U2=X U3=H FF=F26L02(U1,U2,U3) IF(MESS.NE.0) CALL S99L02(FF,U1,U2,U3,FUN,N2,N3) RHF=FF RETURN END C--SA FUNCTION SA(P,T,WB) CHARACTER*6 FUN CHARACTER*2 N2,N3 COMMON/UNIT/KPA,MESS DATA FUN/'SA'/,N2/'T'/,N3/'WB'/ U1=G98L02(KPA,P) U2=G99L02(KPA,T) U3=G99L02(KPA,WB) FF=F27L02(U1,U2,U3) IF(MESS.NE.0) CALL S99L02(FF,U1,U2,U3,FUN,N2,N3) SA=FF RETURN END C--SB FUNCTION SB(P,T,DP) CHARACTER*6 FUN CHARACTER*2 N2,N3 COMMON/UNIT/KPA,MESS DATA FUN/'SB'/,N2/'T'/,N3/'DP'/ U1=G98L02(KPA,P) U2=G99L02(KPA,T) U3=G99L02(KPA,DP) FF=F28L02(U1,U2,U3) IF(MESS.NE.0) CALL S99L02(FF,U1,U2,U3,FUN,N2,N3) SB=FF RETURN END C--SC FUNCTION SC(P,T,RH) CHARACTER*6 FUN CHARACTER*2 N2,N3 COMMON/UNIT/KPA,MESS DATA FUN/'SC'/,N2/'T'/,N3/'RH'/ U1=G98L02(KPA,P) U2=G99L02(KPA,T) U3=RH FF=F29L02(U1,U2,U3) IF(MESS.NE.0) CALL S99L02(FF,U1,U2,U3,FUN,N2,N3) SC=FF RETURN END C--SD FUNCTION SD(P,T,X) CHARACTER*6 FUN CHARACTER*2 N2,N3 COMMON/UNIT/KPA,MESS DATA FUN/'SD'/,N2/'T'/,N3/'X'/ U1=G98L02(KPA,P) U2=G99L02(KPA,T) U3=X FF=F30L02(U1,U2,U3) IF(MESS.NE.0) CALL S99L02(FF,U1,U2,U3,FUN,N2,N3) SD=FF RETURN END C--SE FUNCTION SE(P,T,H) CHARACTER*6 FUN CHARACTER*2 N2,N3 COMMON/UNIT/KPA,MESS DATA FUN/'SE'/,N2/'T'/,N3/'H'/ U1=G98L02(KPA,P) U2=G99L02(KPA,T) U3=H FF=F31L02(U1,U2,U3) IF(MESS.NE.0) CALL S99L02(FF,U1,U2,U3,FUN,N2,N3) SE=FF RETURN END C--SF FUNCTION SF(P,X,H) CHARACTER*6 FUN CHARACTER*2 N2,N3 COMMON/UNIT/KPA,MESS DATA FUN/'SF'/,N2/'X'/,N3/'H'/ U1=G98L02(KPA,P) U2=X U3=H FF=F32L02(U1,U2,U3) IF(MESS.NE.0) CALL S99L02(FF,U1,U2,U3,FUN,N2,N3) SF=FF RETURN END C--TF FUNCTION TF(P,X,H) CHARACTER*6 FUN CHARACTER*2 N2,N3 COMMON/UNIT/KPA,MESS DATA FUN/'TF'/,N2/'X'/,N3/'H'/ U1=G98L02(KPA,P) U2=X U3=H FF=F33L02(U1,U2,U3) IF(MESS.NE.0) CALL S99L02(FF,U1,U2,U3,FUN,N2,N3) T0=G99L02(KPA,0.) IF(FF.LE.-1.E10) T0=0. TF=FF-T0 RETURN END C--VA FUNCTION VA(P,T,WB) CHARACTER*6 FUN CHARACTER*2 N2,N3 COMMON/UNIT/KPA,MESS DATA FUN/'VA'/,N2/'T'/,N3/'WB'/ U1=G98L02(KPA,P) U2=G99L02(KPA,T) U3=G99L02(KPA,WB) FF=F34L02(U1,U2,U3) IF(MESS.NE.0) CALL S99L02(FF,U1,U2,U3,FUN,N2,N3) VA=FF RETURN END C--VB FUNCTION VB(P,T,DP) CHARACTER*6 FUN CHARACTER*2 N2,N3 COMMON/UNIT/KPA,MESS DATA FUN/'VB'/,N2/'T'/,N3/'DP'/ U1=G98L02(KPA,P) U2=G99L02(KPA,T) U3=G99L02(KPA,DP) FF=F35L02(U1,U2,U3) IF(MESS.NE.0) CALL S99L02(FF,U1,U2,U3,FUN,N2,N3) VB=FF RETURN END C--VC FUNCTION VC(P,T,RH) CHARACTER*6 FUN CHARACTER*2 N2,N3 COMMON/UNIT/KPA,MESS DATA FUN/'VC'/,N2/'T'/,N3/'RH'/ U1=G98L02(KPA,P) U2=G99L02(KPA,T) U3=RH FF=F36L02(U1,U2,U3) IF(MESS.NE.0) CALL S99L02(FF,U1,U2,U3,FUN,N2,N3) VC=FF RETURN END C--VD FUNCTION VD(P,T,X) CHARACTER*6 FUN CHARACTER*2 N2,N3 COMMON/UNIT/KPA,MESS DATA FUN/'VD'/,N2/'T'/,N3/'X'/ U1=G98L02(KPA,P) U2=G99L02(KPA,T) U3=X FF=F37L02(U1,U2,U3) IF(MESS.NE.0) CALL S99L02(FF,U1,U2,U3,FUN,N2,N3) VD=FF RETURN END C--VE FUNCTION VE(P,T,H) CHARACTER*6 FUN CHARACTER*2 N2,N3 COMMON/UNIT/KPA,MESS DATA FUN/'VE'/,N2/'T'/,N3/'H'/ U1=G98L02(KPA,P) U2=G99L02(KPA,T) U3=H FF=F38L02(U1,U2,U3) IF(MESS.NE.0) CALL S99L02(FF,U1,U2,U3,FUN,N2,N3) VE=FF RETURN END C--VF FUNCTION VF(P,X,H) CHARACTER*6 FUN CHARACTER*2 N2,N3 COMMON/UNIT/KPA,MESS DATA FUN/'VF'/,N2/'X'/,N3/'H'/ U1=G98L02(KPA,P) U2=X U3=H FF=F39L02(U1,U2,U3) IF(MESS.NE.0) CALL S99L02(FF,U1,U2,U3,FUN,N2,N3) VF=FF RETURN END C--WBB FUNCTION WBB(P,T,DP) CHARACTER*6 FUN CHARACTER*2 N2,N3 COMMON/UNIT/KPA,MESS DATA FUN/'WBB'/,N2/'T'/,N3/'DP'/ U1=G98L02(KPA,P) U2=G99L02(KPA,T) U3=G99L02(KPA,DP) FF=F40L02(U1,U2,U3) IF(MESS.NE.0) CALL S99L02(FF,U1,U2,U3,FUN,N2,N3) T0=G99L02(KPA,0.) IF(FF.LE.-1.E10) T0=0. WBB=FF-T0 RETURN END C--WBC FUNCTION WBC(P,T,RH) CHARACTER*6 FUN CHARACTER*2 N2,N3 COMMON/UNIT/KPA,MESS DATA FUN/'WBC'/,N2/'T'/,N3/'RH'/ U1=G98L02(KPA,P) U2=G99L02(KPA,T) U3=RH FF=F41L02(U1,U2,U3) IF(MESS.NE.0) CALL S99L02(FF,U1,U2,U3,FUN,N2,N3) T0=G99L02(KPA,0.) IF(FF.LE.-1.E10) T0=0. WBC=FF-T0 RETURN END C--WBD FUNCTION WBD(P,T,X) CHARACTER*6 FUN CHARACTER*2 N2,N3 COMMON/UNIT/KPA,MESS DATA FUN/'WBD'/,N2/'T'/,N3/'X'/ U1=G98L02(KPA,P) U2=G99L02(KPA,T) U3=X FF=F42L02(U1,U2,U3) IF(MESS.NE.0) CALL S99L02(FF,U1,U2,U3,FUN,N2,N3) T0=G99L02(KPA,0.) IF(FF.LE.-1.E10) T0=0. WBD=FF-T0 RETURN END C--WBE FUNCTION WBE(P,T,H) CHARACTER*6 FUN CHARACTER*2 N2,N3 COMMON/UNIT/KPA,MESS DATA FUN/'WBE'/,N2/'T'/,N3/'H'/ U1=G98L02(KPA,P) U2=G99L02(KPA,T) U3=H FF=F43L02(U1,U2,U3) IF(MESS.NE.0) CALL S99L02(FF,U1,U2,U3,FUN,N2,N3) T0=G99L02(KPA,0.) IF(FF.LE.-1.E10) T0=0. WBE=FF-T0 RETURN END C--WBF FUNCTION WBF(P,X,H) CHARACTER*6 FUN CHARACTER*2 N2,N3 COMMON/UNIT/KPA,MESS DATA FUN/'WBF'/,N2/'X'/,N3/'H'/ U1=G98L02(KPA,P) U2=X U3=H FF=F44L02(U1,U2,U3) IF(MESS.NE.0) CALL S99L02(FF,U1,U2,U3,FUN,N2,N3) T0=G99L02(KPA,0.) IF(FF.LE.-1.E10) T0=0. WBF=FF-T0 RETURN END C--XA FUNCTION XA(P,T,WB) CHARACTER*6 FUN CHARACTER*2 N2,N3 COMMON/UNIT/KPA,MESS DATA FUN/'XA'/,N2/'T'/,N3/'WB'/ U1=G98L02(KPA,P) U2=G99L02(KPA,T) U3=G99L02(KPA,WB) FF=F45L02(U1,U2,U3) IF(MESS.NE.0) CALL S99L02(FF,U1,U2,U3,FUN,N2,N3) XA=FF RETURN END C--XB FUNCTION XB(P,T,DP) CHARACTER*6 FUN CHARACTER*2 N2,N3 COMMON/UNIT/KPA,MESS DATA FUN/'XB'/,N2/'T'/,N3/'DP'/ U1=G98L02(KPA,P) U2=G99L02(KPA,T) U3=G99L02(KPA,DP) FF=F46L02(U1,U2,U3) IF(MESS.NE.0) CALL S99L02(FF,U1,U2,U3,FUN,N2,N3) XB=FF RETURN END C--XC FUNCTION XC(P,T,RH) CHARACTER*6 FUN CHARACTER*2 N2,N3 COMMON/UNIT/KPA,MESS DATA FUN/'XC'/,N2/'T'/,N3/'RH'/ U1=G98L02(KPA,P) U2=G99L02(KPA,T) U3=RH FF=F47L02(U1,U2,U3) IF(MESS.NE.0) CALL S99L02(FF,U1,U2,U3,FUN,N2,N3) XC=FF RETURN END C--XE FUNCTION XE(P,T,H) CHARACTER*6 FUN CHARACTER*2 N2,N3 COMMON/UNIT/KPA,MESS DATA FUN/'XE'/,N2/'T'/,N3/'H'/ U1=G98L02(KPA,P) U2=G99L02(KPA,T) U3=H FF=F48L02(U1,U2,U3) IF(MESS.NE.0) CALL S99L02(FF,U1,U2,U3,FUN,N2,N3) XE=FF RETURN END C--PST FUNCTION PST(T) COMMON/UNIT/KPA,MESS U2=G99L02(KPA,T) FF=F49L02(U2) IF((FF.LE.-1.E20).AND.(MESS.NE.0)) WRITE(6,200) U2 200 FORMAT(1H ,5X,'**** OUT OF RANGE AT PST FOR PURE WATER', &' WHEN T =',1PE13.6,' ****') P0=G98L02(KPA,1.) IF(FF.LE.-1.E10) P0=1. PST=FF/P0 RETURN END C--ENHFAC FUNCTION ENHFAC(P,T) COMMON/UNIT/KPA,MESS U1=G98L02(KPA,P) U2=G99L02(KPA,T) FF=F50L02(U1,U2) IF((FF.LE.-1.E10).AND.(MESS.NE.0)) WRITE(6,200) U1,U2 200 FORMAT(1H ,5X,'**** OUT OF RANGE AT ENHFAC FOR MOIST AIR', &' WHEN P =',1PE13.6,' AND T =',E13.6,' ****') ENHFAC=FF RETURN END C--IDENTF CHARACTER*60 FUNCTION IDENTF(A) CHARACTER A*1,MSG*120 COMMON/UNIT/KPA,MESS IF(A.EQ.'S') THEN IDENTF='MOIST AIR AS MIXTURE OF IDEAL GASES' ELSE IF(A.EQ.'C') THEN IDENTF='TWO-COMPONENT MIXTURE OF DRY AIR AND WATER VAPOR' ELSE IF(A.EQ.'V') THEN IDENTF='12.1' ELSE IDENTF='????????????????????' IF(MESS.NE.0) THEN MSG='**** OUT OF RANGE AT IDENTF FOR MOIST AIR WHEN A=''' & //A//''' ****' WRITE(6,'(1H ,A)') MSG ENDIF ENDIF RETURN END C--FC FUNCTION FC(A) CHARACTER A*2,MSG*120 COMMON/UNIT/KPA,MESS IF(A.EQ.'MA') THEN FC=18.01528 ELSE IF(A.EQ.'MW') THEN FC=28.9645 ELSE IF(A.EQ.'RA') THEN FC=461.520 ELSE IF(A.EQ.'RW') THEN FC=287.055 ELSE FC=-1.E+20 IF (MESS.NE.0) THEN MSG='**** OUT OF RANGE AT FC FOR MOIST AIR WHEN A=''' & //A//''' ****' WRITE(6,'(1H ,A)') MSG ENDIF ENDIF RETURN END C*******************************************************FUNCTION-F*** C--F1 -------------> DPA [C] FUNCTION F1L02(ZP,ZT,ZWB) IF((ZP.LE.0.).OR.(ZP.GT.50.)) GOTO 99 P=ZP*1.E5 T=G1L02(ZT) IF(T.EQ.-1.E20) GOTO 99 WB=G1L02(ZWB) IF(WB.EQ.-1.E20) GOTO 99 RW=G7L02(P,T,WB) DP=G4L02(P,T,RW) F1L02=G2L02(DP) RETURN 99 F1L02=-1.E20 RETURN END C--F2 -------------> DPC [C] FUNCTION F2L02(ZP,ZT,RH) IF((ZP.LE.0.).OR.(ZP.GT.50.)) GOTO 99 P=ZP*1.E5 T=G1L02(ZT) IF(T.EQ.-1.E20) GOTO 99 IF(RH*(RH-1.).GT.0.) GOTO 99 RW=G6L02(P,T,RH) DP=G4L02(P,T,RW) F2L02=G2L02(DP) RETURN 99 F2L02=-1.E20 RETURN END C--F3 -------------> DPD [C] FUNCTION F3L02(ZP,ZT,X) DATA EM/0.62198/ IF((ZP.LE.0.).OR.(ZP.GT.50.)) GOTO 99 P=ZP*1.E5 T=G1L02(ZT) IF(T.EQ.-1.E20) GOTO 99 IF(X.LT.0.) GOTO 99 RW=X/(X+EM) DP=G4L02(P,T,RW) F3L02=G2L02(DP) RETURN 99 F3L02=-1.E20 RETURN END C--F4 -------------> DPE [C] FUNCTION F4L02(ZP,ZT,ZH) IF((ZP.LE.0.).OR.(ZP.GT.50.)) GOTO 99 P=ZP*1.E5 H=ZH*1.E-3 T=G1L02(ZT) IF(T.EQ.-1.E20) GOTO 99 RW=G9L02(T,H) DP=G4L02(P,T,RW) F4L02=G2L02(DP) RETURN 99 F4L02=-1.E20 RETURN END C--F5 -------------> DPF [C] FUNCTION F5L02(ZP,X,ZH) DATA EM/0.62198/ IF((ZP.LE.0.).OR.(ZP.GT.50.)) GOTO 99 IF(X.LT.0.) GOTO 99 P=ZP*1.E5 H=ZH*1.E-3 T=G10L02(X,H) IF(G2L02(T).EQ.-1.E20) GOTO 99 RW=X/(X+EM) DP=G4L02(P,T,RW) F5L02=G2L02(DP) RETURN 99 F5L02=-1.E20 RETURN END C--F6 -------------> DSA [-] FUNCTION F6L02(ZP,ZT,ZWB) IF((ZP.LE.0.).OR.(ZP.GT.50.)) GOTO 99 P=ZP*1.E5 T=G1L02(ZT) IF(T.EQ.-1.E20) GOTO 99 WB=G1L02(ZWB) IF(WB.EQ.-1.E20) GOTO 99 RW=G7L02(P,T,WB) CALL S1L02(3,P,T,E1,XS,RW,X,E5,E6,E7) IF((X.LT.0.).OR.(XS.LE.0.)) GOTO 99 F6L02=X/XS RETURN 99 F6L02=-1.E20 RETURN END C--F7 -------------> DSB [-] FUNCTION F7L02(ZP,ZT,ZDP) IF((ZP.LE.0.).OR.(ZP.GT.50.)) GOTO 99 P=ZP*1.E5 T=G1L02(ZT) IF(T.EQ.-1.E20) GOTO 99 DP=G1L02(ZDP) IF(DP.EQ.-1.E20) GOTO 99 RW=G5L02(P,T,DP) CALL S1L02(3,P,T,E1,XS,RW,X,E5,E6,E7) IF((X.LT.0.).OR.(XS.LE.0.)) GOTO 99 F7L02=X/XS RETURN 99 F7L02=-1.E20 RETURN END C--F8 -------------> DSC [-] FUNCTION F8L02(ZP,ZT,RH) IF((ZP.LE.0.).OR.(ZP.GT.50.)) GOTO 99 P=ZP*1.E5 T=G1L02(ZT) IF(T.EQ.-1.E20) GOTO 99 IF(RH*(RH-1.).GT.0.) GOTO 99 RW=G6L02(P,T,RH) CALL S1L02(3,P,T,E1,XS,RW,X,E5,E6,E7) IF((X.LT.0.).OR.(XS.LE.0.)) GOTO 99 F8L02=X/XS RETURN 99 F8L02=-1.E20 RETURN END C--F9 -------------> DSD [-] FUNCTION F9L02(ZP,ZT,X) DATA EM/0.62198/ IF((ZP.LE.0.).OR.(ZP.GT.50.)) GOTO 99 P=ZP*1.E5 T=G1L02(ZT) IF(T.EQ.-1.E20) GOTO 99 IF(X.LT.0.) GOTO 99 RW=X/(X+EM) CALL S1L02(3,P,T,E1,XS,RW,XE4,E5,E6,E7) IF((XE4.LT.0.).OR.(XS.LE.0.)) GOTO 99 F9L02=X/XS RETURN 99 F9L02=-1.E20 RETURN END C--F10 -------------> DSE [-] FUNCTION F10L02(ZP,ZT,ZH) IF((ZP.LE.0.).OR.(ZP.GT.50.)) GOTO 99 P=ZP*1.E5 H=ZH*1.E-3 T=G1L02(ZT) IF(T.EQ.-1.E20) GOTO 99 RW=G9L02(T,H) CALL S1L02(3,P,T,E1,XS,RW,X,E5,E6,E7) IF((X.LT.0.).OR.(XS.LE.0.)) GOTO 99 F10L02=X/XS RETURN 99 F10L02=-1.E20 RETURN END C--F11 -------------> DSF [-] FUNCTION F11L02(ZP,X,ZH) DATA EM/0.62198/ IF((ZP.LE.0.).OR.(ZP.GT.50.)) GOTO 99 IF(X.LT.0.) GOTO 99 P=ZP*1.E5 H=ZH*1.E-3 T=G10L02(X,H) IF(G2L02(T).EQ.-1.E20) GOTO 99 RW=X/(X+EM) CALL S1L02(3,P,T,E1,XS,RW,XE4,E5,E6,E7) IF((XE4.LT.0.).OR.(XS.LE.0.)) GOTO 99 F11L02=X/XS RETURN 99 F11L02=-1.E20 RETURN END C--F12 -------------> HA [J/kgDA] FUNCTION F12L02(ZP,ZT,ZWB) IF((ZP.LE.0.).OR.(ZP.GT.50.)) GOTO 99 P=ZP*1.E5 T=G1L02(ZT) IF(T.EQ.-1.E20) GOTO 99 WB=G1L02(ZWB) IF(WB.EQ.-1.E20) GOTO 99 RW=G7L02(P,T,WB) CALL S1L02(5,P,T,E1,XS,RW,X,E5,F12L02,E7) IF(F12L02.GT.-1.E10) F12L02=F12L02*1.E3 RETURN 99 F12L02=-1.E20 RETURN END C--F13 -------------> HB [J/kgDA] FUNCTION F13L02(ZP,ZT,ZDP) IF((ZP.LE.0.).OR.(ZP.GT.50.)) GOTO 99 P=ZP*1.E5 T=G1L02(ZT) IF(T.EQ.-1.E20) GOTO 99 DP=G1L02(ZDP) IF(DP.EQ.-1.E20) GOTO 99 RW=G5L02(P,T,DP) CALL S1L02(5,P,T,E1,E2,RW,E4,E5,F13L02,E7) IF(F13L02.GT.-1.E10) F13L02=F13L02*1.E3 RETURN 99 F13L02=-1.E20 RETURN END C--F14 -------------> HC [J/kgDA] FUNCTION F14L02(ZP,ZT,RH) IF((ZP.LE.0.).OR.(ZP.GT.50.)) GOTO 99 P=ZP*1.E5 T=G1L02(ZT) IF(T.EQ.-1.E20) GOTO 99 IF(RH*(RH-1.).GT.0.) GOTO 99 RW=G6L02(P,T,RH) CALL S1L02(5,P,T,E1,E2,RW,E4,E5,F14L02,E7) IF(F14L02.GT.-1.E10) F14L02=F14L02*1.E3 RETURN 99 F14L02=-1.E20 RETURN END C--F15 -------------> HD [J/kgDA] FUNCTION F15L02(ZP,ZT,X) DATA EM/0.62198/ IF((ZP.LE.0.).OR.(ZP.GT.50.)) GOTO 99 P=ZP*1.E5 T=G1L02(ZT) IF(T.EQ.-1.E20) GOTO 99 IF(X.LT.0.) GOTO 99 RW=X/(X+EM) CALL S1L02(5,P,T,E1,E2,RW,E4,E5,F15L02,E7) IF(F15L02.GT.-1.E10) F15L02=F15L02*1.E3 RETURN 99 F15L02=-1.E20 RETURN END C--F16 -------------> RWA [-] FUNCTION F16L02(ZP,ZT,ZWB) IF((ZP.LE.0.).OR.(ZP.GT.50.)) GOTO 99 P=ZP*1.E5 T=G1L02(ZT) IF(T.EQ.-1.E20) GOTO 99 WB=G1L02(ZWB) IF(WB.EQ.-1.E20) GOTO 99 F16L02=G7L02(P,T,WB) RETURN 99 F16L02=-1.E20 RETURN END C--F17 -------------> RWB [-] FUNCTION F17L02(ZP,ZT,ZDP) IF((ZP.LE.0.).OR.(ZP.GT.50.)) GOTO 99 P=ZP*1.E5 T=G1L02(ZT) IF(T.EQ.-1.E20) GOTO 99 DP=G1L02(ZDP) IF(DP.EQ.-1.E20) GOTO 99 F17L02=G5L02(P,T,DP) RETURN 99 F17L02=-1.E20 RETURN END C--F18 -------------> RWC [-] FUNCTION F18L02(ZP,ZT,RH) IF((ZP.LE.0.).OR.(ZP.GT.50.)) GOTO 99 P=ZP*1.E5 T=G1L02(ZT) IF(T.EQ.-1.E20) GOTO 99 IF(RH*(RH-1.).GT.0.) GOTO 99 F18L02=G6L02(P,T,RH) RETURN 99 F18L02=-1.E20 RETURN END C--F19 -------------> RWD [-] FUNCTION F19L02(ZP,ZT,X) DATA EM/0.62198/ IF((ZP.LE.0.).OR.(ZP.GT.50.)) GOTO 99 P=ZP*1.E5 T=G1L02(ZT) IF(T.EQ.-1.E20) GOTO 99 IF(X.LT.0.) GOTO 99 RW=X/(X+EM) F19L02=RW CALL S1L02(3,P,T,E1,E2,RW,XE4,E5,E6,E7) IF(XE4.LT.0.) GOTO 99 RETURN 99 F19L02=-1.E20 RETURN END C--F20 -------------> RWE [-] FUNCTION F20L02(ZP,ZT,ZH) IF((ZP.LE.0.).OR.(ZP.GT.50.)) GOTO 99 P=ZP*1.E5 H=ZH*1.E-3 T=G1L02(ZT) IF(T.EQ.-1.E20) GOTO 99 F20L02=G9L02(T,H) RETURN 99 F20L02=-1.E20 RETURN END C--F21 -------------> RWF [-] FUNCTION F21L02(ZP,X,ZH) DATA EM/0.62198/ IF((ZP.LE.0.).OR.(ZP.GT.50.)) GOTO 99 IF(X.LT.0.) GOTO 99 P=ZP*1.E5 H=ZH*1.E-3 RW=X/(X+EM) F21L02=RW T=G10L02(X,H) IF(G2L02(T).EQ.-1.E20) GOTO 99 CALL S1L02(3,P,T,E1,E2,RW,XE4,E5,E6,E7) IF(XE4.LT.0.) GOTO 99 RETURN 99 F21L02=-1.E20 RETURN END C--F22 -------------> RHA [-] FUNCTION F22L02(ZP,ZT,ZWB) IF((ZP.LE.0.).OR.(ZP.GT.50.)) GOTO 99 P=ZP*1.E5 T=G1L02(ZT) IF(T.EQ.-1.E20) GOTO 99 WB=G1L02(ZWB) IF(WB.EQ.-1.E20) GOTO 99 RW=G7L02(P,T,WB) CALL S1L02(3,P,T,RWS,E2,RW,XE4,E5,E6,E7) IF((XE4.LT.0.).OR.(RWS.LE.0.)) GOTO 99 F22L02=RW/RWS RETURN 99 F22L02=-1.E20 RETURN END C--F23 -------------> RHB [-] FUNCTION F23L02(ZP,ZT,ZDP) IF((ZP.LE.0.).OR.(ZP.GT.50.)) GOTO 99 P=ZP*1.E5 T=G1L02(ZT) IF(T.EQ.-1.E20) GOTO 99 DP=G1L02(ZDP) IF(DP.EQ.-1.E20) GOTO 99 RW=G5L02(P,T,DP) CALL S1L02(3,P,T,RWS,E2,RW,XE4,E5,E6,E7) IF((XE4.LT.0.).OR.(RWS.LE.0.)) GOTO 99 F23L02=RW/RWS RETURN 99 F23L02=-1.E20 RETURN END C--F24 -------------> RHD [-] FUNCTION F24L02(ZP,ZT,X) DATA EM/0.62198/ IF((ZP.LE.0.).OR.(ZP.GT.50.)) GOTO 99 P=ZP*1.E5 T=G1L02(ZT) IF(T.EQ.-1.E20) GOTO 99 IF(X.LT.0.) GOTO 99 RW=X/(X+EM) CALL S1L02(3,P,T,RWS,E2,RW,XE4,E5,E6,E7) IF((XE4.LT.0.).OR.(RWS.LE.0.)) GOTO 99 F24L02=RW/RWS RETURN 99 F24L02=-1.E20 RETURN END C--F25 -------------> RHE [-] FUNCTION F25L02(ZP,ZT,ZH) IF((ZP.LE.0.).OR.(ZP.GT.50.)) GOTO 99 P=ZP*1.E5 H=ZH*1.E-3 T=G1L02(ZT) IF(T.EQ.-1.E20) GOTO 99 RW=G9L02(T,H) CALL S1L02(3,P,T,RWS,E2,RW,XE4,E5,E6,E7) IF((XE4.LT.0.).OR.(RWS.LE.0.)) GOTO 99 F25L02=RW/RWS RETURN 99 F25L02=-1.E20 RETURN END C--F26 -------------> RHF [-] FUNCTION F26L02(ZP,X,ZH) DATA EM/0.62198/ IF((ZP.LE.0.).OR.(ZP.GT.50.)) GOTO 99 IF(X.LT.0.) GOTO 99 P=ZP*1.E5 H=ZH*1.E-3 T=G10L02(X,H) IF(G2L02(T).EQ.-1.E20) GOTO 99 RW=X/(X+EM) CALL S1L02(3,P,T,RWS,E2,RW,XE4,E5,E6,E7) IF((XE4.LT.0.).OR.(RWS.LE.0.)) GOTO 99 F26L02=RW/RWS RETURN 99 F26L02=-1.E20 RETURN END C--F27 -------------> SA [J/(kgDA K)] FUNCTION F27L02(ZP,ZT,ZWB) IF((ZP.LE.0.).OR.(ZP.GT.50.)) GOTO 99 P=ZP*1.E5 T=G1L02(ZT) IF(T.EQ.-1.E20) GOTO 99 WB=G1L02(ZWB) IF(WB.EQ.-1.E20) GOTO 99 RW=G7L02(P,T,WB) CALL S1L02(6,P,T,E1,E2,RW,XE4,E5,E6,F27L02) IF(F27L02.GT.-1.E10) F27L02=F27L02*1.E3 RETURN 99 F27L02=-1.E20 RETURN END C--F28 -------------> SB [J/(kgDA K)] FUNCTION F28L02(ZP,ZT,ZDP) IF((ZP.LE.0.).OR.(ZP.GT.50.)) GOTO 99 P=ZP*1.E5 T=G1L02(ZT) IF(T.EQ.-1.E20) GOTO 99 DP=G1L02(ZDP) IF(DP.EQ.-1.E20) GOTO 99 RW=G5L02(P,T,DP) CALL S1L02(6,P,T,E1,E2,RW,E4,E5,E6,F28L02) IF(F28L02.GT.-1.E10) F28L02=F28L02*1.E3 RETURN 99 F28L02=-1.E20 RETURN END C--F29 -------------> SC [J/(kgDA K)] FUNCTION F29L02(ZP,ZT,RH) IF((ZP.LE.0.).OR.(ZP.GT.50.)) GOTO 99 P=ZP*1.E5 T=G1L02(ZT) IF(T.EQ.-1.E20) GOTO 99 IF(RH*(RH-1.).GT.0.) GOTO 99 RW=G6L02(P,T,RH) CALL S1L02(6,P,T,E1,E2,RW,E4,E5,E6,F29L02) IF(F29L02.GT.-1.E10) F29L02=F29L02*1.E3 RETURN 99 F29L02=-1.E20 RETURN END C--F30 -------------> SD [J/(kgDA K)] FUNCTION F30L02(ZP,ZT,X) DATA EM/0.62198/ IF((ZP.LE.0.).OR.(ZP.GT.50.)) GOTO 99 P=ZP*1.E5 T=G1L02(ZT) IF(T.EQ.-1.E20) GOTO 99 IF(X.LT.0.) GOTO 99 RW=X/(X+EM) CALL S1L02(6,P,T,E1,E2,RW,E4,E5,E6,F30L02) IF(F30L02.GT.-1.E10) F30L02=F30L02*1.E3 RETURN 99 F30L02=-1.E20 RETURN END C--F31 -------------> SE [J/(kgDA K)] FUNCTION F31L02(ZP,ZT,ZH) IF((ZP.LE.0.).OR.(ZP.GT.50.)) GOTO 99 P=ZP*1.E5 H=ZH*1.E-3 T=G1L02(ZT) IF(T.EQ.-1.E20) GOTO 99 RW=G9L02(T,H) CALL S1L02(6,P,T,E1,E2,RW,E4,E5,E6,F31L02) IF(F31L02.GT.-1.E10) F31L02=F31L02*1.E3 RETURN 99 F31L02=-1.E20 RETURN END C--F32 -------------> SF [J/(kgDA K)] FUNCTION F32L02(ZP,X,ZH) DATA EM/0.62198/ IF((ZP.LE.0.).OR.(ZP.GT.50.)) GOTO 99 IF(X.LT.0.) GOTO 99 P=ZP*1.E5 H=ZH*1.E-3 T=G10L02(X,H) IF(G2L02(T).EQ.-1.E20) GOTO 99 RW=X/(X+EM) CALL S1L02(6,P,T,E1,E2,RW,E4,E5,E6,F32L02) IF(F32L02.GT.-1.E10) F32L02=F32L02*1.E3 RETURN 99 F32L02=-1.E20 RETURN END C--F33 -------------> TF [C] FUNCTION F33L02(ZP,X,ZH) IF((ZP.LE.0.).OR.(ZP.GT.50.)) GOTO 99 IF(X.LT.0.) GOTO 99 P=ZP*1.E5 H=ZH*1.E-3 T=G10L02(X,H) F33L02=G2L02(T) RETURN 99 F33L02=-1.E20 RETURN END C--F34 -------------> VA [m3/kgDA] FUNCTION F34L02(ZP,ZT,ZWB) IF((ZP.LE.0.).OR.(ZP.GT.50.)) GOTO 99 P=ZP*1.E5 T=G1L02(ZT) IF(T.EQ.-1.E20) GOTO 99 WB=G1L02(ZWB) IF(WB.EQ.-1.E20) GOTO 99 RW=G7L02(P,T,WB) CALL S1L02(4,P,T,E1,E2,RW,E4,F34L02,E6,E7) RETURN 99 F34L02=-1.E20 RETURN END C--F35 -------------> VB [m3/kgDA] FUNCTION F35L02(ZP,ZT,ZDP) IF((ZP.LE.0.).OR.(ZP.GT.50.)) GOTO 99 P=ZP*1.E5 T=G1L02(ZT) IF(T.EQ.-1.E20) GOTO 99 DP=G1L02(ZDP) IF(DP.EQ.-1.E20) GOTO 99 RW=G5L02(P,T,DP) CALL S1L02(4,P,T,E1,E2,RW,E4,F35L02,E6,E7) RETURN 99 F35L02=-1.E20 RETURN END C--F36 -------------> VC [m3/kgDA] FUNCTION F36L02(ZP,ZT,RH) IF((ZP.LE.0.).OR.(ZP.GT.50.)) GOTO 99 P=ZP*1.E5 T=G1L02(ZT) IF(T.EQ.-1.E20) GOTO 99 IF(RH*(RH-1.).GT.0.) GOTO 99 RW=G6L02(P,T,RH) CALL S1L02(4,P,T,E1,E2,RW,E4,F36L02,E6,E7) RETURN 99 F36L02=-1.E20 RETURN END C--F37 -------------> VD [m3/kgDA] FUNCTION F37L02(ZP,ZT,X) DATA EM/0.62198/ IF((ZP.LE.0.).OR.(ZP.GT.50.)) GOTO 99 P=ZP*1.E5 T=G1L02(ZT) IF(T.EQ.-1.E20) GOTO 99 IF(X.LT.0.) GOTO 99 RW=X/(X+EM) CALL S1L02(4,P,T,E1,E2,RW,E4,F37L02,E6,E7) RETURN 99 F37L02=-1.E20 RETURN END C--F38 -------------> VE [m3/kgDA] FUNCTION F38L02(ZP,ZT,ZH) IF((ZP.LE.0.).OR.(ZP.GT.50.)) GOTO 99 P=ZP*1.E5 H=ZH*1.E-3 T=G1L02(ZT) IF(T.EQ.-1.E20) GOTO 99 RW=G9L02(T,H) CALL S1L02(4,P,T,E1,E2,RW,E4,F38L02,E6,E7) RETURN 99 F38L02=-1.E20 RETURN END C--F39 -------------> VF [m3/kgDA] FUNCTION F39L02(ZP,X,ZH) DATA EM/0.62198/ IF((ZP.LE.0.).OR.(ZP.GT.50.)) GOTO 99 IF(X.LT.0.) GOTO 99 P=ZP*1.E5 H=ZH*1.E-3 T=G10L02(X,H) IF(G2L02(T).EQ.-1.E20) GOTO 99 RW=X/(X+EM) CALL S1L02(4,P,T,E1,E2,RW,E4,F39L02,E6,E7) RETURN 99 F39L02=-1.E20 RETURN END C--F40 -------------> WBB [C] FUNCTION F40L02(ZP,ZT,ZDP) IF((ZP.LE.0.).OR.(ZP.GT.50.)) GOTO 99 P=ZP*1.E5 T=G1L02(ZT) IF(T.EQ.-1.E20) GOTO 99 DP=G1L02(ZDP) IF(DP.EQ.-1.E20) GOTO 99 RW=G5L02(P,T,DP) WB=G8L02(P,T,RW) F40L02=G2L02(WB) RETURN 99 F40L02=-1.E20 RETURN END C--F41 -------------> WBC [C] FUNCTION F41L02(ZP,ZT,RH) IF((ZP.LE.0.).OR.(ZP.GT.50.)) GOTO 99 P=ZP*1.E5 T=G1L02(ZT) IF(T.EQ.-1.E20) GOTO 99 IF(RH*(RH-1.).GT.0.) GOTO 99 RW=G6L02(P,T,RH) WB=G8L02(P,T,RW) F41L02=G2L02(WB) RETURN 99 F41L02=-1.E20 RETURN END C--F42 -------------> WBD [C] FUNCTION F42L02(ZP,ZT,X) DATA EM/0.62198/ IF((ZP.LE.0.).OR.(ZP.GT.50.)) GOTO 99 P=ZP*1.E5 T=G1L02(ZT) IF(T.EQ.-1.E20) GOTO 99 IF(X.LT.0.) GOTO 99 RW=X/(X+EM) WB=G8L02(P,T,RW) F42L02=G2L02(WB) RETURN 99 F42L02=-1.E20 RETURN END C--F43 -------------> WBE [C] FUNCTION F43L02(ZP,ZT,ZH) IF((ZP.LE.0.).OR.(ZP.GT.50.)) GOTO 99 P=ZP*1.E5 H=ZH*1.E-3 T=G1L02(ZT) IF(T.EQ.-1.E20) GOTO 99 RW=G9L02(T,H) WB=G8L02(P,T,RW) F43L02=G2L02(WB) RETURN 99 F43L02=-1.E20 RETURN END C--F44 -------------> WBF [C] FUNCTION F44L02(ZP,X,ZH) DATA EM/0.62198/ IF((ZP.LE.0.).OR.(ZP.GT.50.)) GOTO 99 IF(X.LT.0.) GOTO 99 P=ZP*1.E5 H=ZH*1.E-3 T=G10L02(X,H) IF(G2L02(T).EQ.-1.E20) GOTO 99 RW=X/(X+EM) WB=G8L02(P,T,RW) F44L02=G2L02(WB) RETURN 99 F44L02=-1.E20 RETURN END C--F45 -------------> XA [kg/kgDA] FUNCTION F45L02(ZP,ZT,ZWB) IF((ZP.LE.0.).OR.(ZP.GT.50.)) GOTO 99 P=ZP*1.E5 T=G1L02(ZT) IF(T.EQ.-1.E20) GOTO 99 WB=G1L02(ZWB) IF(WB.EQ.-1.E20) GOTO 99 RW=G7L02(P,T,WB) CALL S1L02(3,P,T,E1,E2,RW,F45L02,E5,E6,E7) RETURN 99 F45L02=-1.E20 RETURN END C--F46 -------------> XB [kg/kgDA] FUNCTION F46L02(ZP,ZT,ZDP) IF((ZP.LE.0.).OR.(ZP.GT.50.)) GOTO 99 P=ZP*1.E5 T=G1L02(ZT) IF(T.EQ.-1.E20) GOTO 99 DP=G1L02(ZDP) IF(DP.EQ.-1.E20) GOTO 99 RW=G5L02(P,T,DP) CALL S1L02(3,P,T,E1,E2,RW,F46L02,E5,E6,E7) RETURN 99 F46L02=-1.E20 RETURN END C--F47 -------------> XC [kg/kgDA] FUNCTION F47L02(ZP,ZT,RH) IF((ZP.LE.0.).OR.(ZP.GT.50.)) GOTO 99 P=ZP*1.E5 T=G1L02(ZT) IF(T.EQ.-1.E20) GOTO 99 IF(RH*(RH-1.).GT.0.) GOTO 99 RW=G6L02(P,T,RH) CALL S1L02(3,P,T,E1,E2,RW,F47L02,E5,E6,E7) RETURN 99 F47L02=-1.E20 RETURN END C--F48 -------------> XE [kg/kgDA] FUNCTION F48L02(ZP,ZT,ZH) IF((ZP.LE.0.).OR.(ZP.GT.50.)) GOTO 99 P=ZP*1.E5 H=ZH*1.E-3 T=G1L02(ZT) IF(T.EQ.-1.E20) GOTO 99 RW=G9L02(T,H) CALL S1L02(3,P,T,E1,E2,RW,F48L02,E5,E6,E7) RETURN 99 F48L02=-1.E20 RETURN END C--F49 -------------> PST [bar] FUNCTION F49L02(ZT) T=G1L02(ZT) IF(T.EQ.-1.E20) GOTO 99 F49L02=G3L02(T)*1.D-5 RETURN 99 F49L02=-1.E20 RETURN END C--F50 -------------> ENHFAC [-] FUNCTION F50L02(ZP,ZT) IF((ZP.LE.0.).OR.(ZP.GT.50.)) GOTO 99 P=ZP*1.D5 T=G1L02(ZT) IF(T.EQ.-1.E20) GOTO 99 F50L02=G11L02(P,T) RETURN 99 F50L02=-1.E20 RETURN END C*******************************************************FUNCTION-G*** C--G1 FUNCTION G1L02(TC) C Temperature, from [C] to [K] IF((TC+100.)*(TC-200.).GT.0.) GOTO 99 G1L02=TC+273.15 RETURN 99 G1L02=-1.E20 RETURN END C--G2 FUNCTION G2L02(T) C Temperature, from [K] to [C] IF(T.EQ.-1.E20) GOTO 99 G2L02=T-273.15 IF((G2L02+100.)*(G2L02-200.).LE.0.) RETURN 99 G2L02=-1.E20 RETURN END C--G3 FUNCTION G3L02(TK68) C Saturation vapor pressure of pure liquid water and ice [Pa] C Temperature(TTS) T=173.15 to 473.15[K] DIMENSION CG(6),CM(7) DATA CG/-0.58002206E4, 0.13914993E1, -0.48640239E-1, & 0.41764768E-4, -0.14452093E-7, 0.65459673E1/ DATA CM/-0.56745359E4, 0.63925247E1, -0.96778430E-2, & 0.62215701E-6, 0.20747825E-8, -0.94840240E-12, & 0.41635019E1/ T=TK68 IF(T.GT.273.16D0) THEN DO 1 J=1,5 1 T=TK68-0.4931358+0.46094296E-2*T-0.13746454E-4*T**2 & +0.12743214E-7*T**3 GG3=CG(6)*ALOG(T) DO 10 I=1,5 10 GG3=GG3+CG(I)*T**(I-2) ELSE GG3=CM(7)*ALOG(T) DO 20 I=1,6 20 GG3=GG3+CM(I)*T**(I-2) ENDIF G3L02=EXP(GG3) RETURN END C--G4 FUNCTION G4L02(P,T,RW) C Dew point temperature DP[K] DP=T CALL S1L02(3,P,DP,RWS,E2,RW,X,E5,E6,E7) IF(X.LE.0.) GOTO 99 IF((RWS.GT.0.).AND.(ABS(1.-RW/RWS).LT.1.E-6)) GOTO 50 DP2=DP DP=173.15 CALL S1L02(1,P,DP,RWS,E2,E3,E4,E5,E6,E7) IF(RW*(RWS-RW).GT.0.) GOTO 99 DP1=DP 10 DP=(DP1+DP2)/2. IF(DP2-DP1.LT.1.E-4) GOTO 50 RWC=G5L02(P,T,DP) IF(RWC.LT.0.) RWC=1. ERW=RW-RWC IF(ABS(ERW/RW).LT.1.E-6) GOTO 50 IF(RWC.GT.RW) THEN DP2=DP ELSE DP1=DP ENDIF GOTO 10 50 G4L02=DP RETURN 99 G4L02=-1.E20 RETURN END C--G5 FUNCTION G5L02(P,T,DP) C Mole fraction of water vapor RW[-] IF(T.LT.DP) GOTO 99 CALL S1L02(1,P,DP,G5L02,E2,E3,E4,E5,E6,E7) RETURN 99 G5L02=-1.E20 RETURN END C--G6 FUNCTION G6L02(P,T,RH) C Mole fraction of water vapor RW[-] IF(RH*(RH-1.).GT.0.) GOTO 99 CALL S1L02(1,P,T,RWS,E2,E3,E4,E5,E6,E7) IF(RWS.EQ.-1.E20) GOTO 99 G6L02=RWS*RH RETURN 99 G6L02=-1.E20 RETURN END C--G7 FUNCTION G7L02(P,T,WB) C Mole fraction of water vapor RW[-] DATA EM/0.62198/ TC=G2L02(T) WBC=G2L02(WB) IF(WBC.GT.TC) GOTO 99 CALL S1L02(2,P,WB,RWS,XS,E3,E4,E5,HS,E7) IF(RWS.LE.0.) GOTO 99 IF(TC.EQ.WBC) THEN G7L02=RWS RETURN ENDIF CALL S1L02(5,P,T,E1,E2,0.,X,E5,H,E7) IF(WBC.GT.0.) THEN HC=4.186*WBC ELSE HC=-334.+2.1*WBC ENDIF HDEF=HS+(X-XS)*HC IF((X.LT.0.).OR.(HDEF.LT.H)) GOTO 99 HA=(1.006+1.805*XS)*(TC-WBC) HB=2501.+1.805*TC-HC X=XS-HA/HB G7L02=X/(EM+X) RETURN 99 G7L02=-1.E20 RETURN END C--G8 FUNCTION G8L02(P,T,RW) C Wet-bulb temperature WB[K] WB=T CALL S1L02(3,P,WB,RWS,E2,RW,X,E5,E6,E7) IF(X.LT.0.) GOTO 99 IF((RWS.GT.0.).AND.(ABS(1.-RW/RWS).LT.1.E-6)) GOTO 50 WB2=WB WB=173.15 RWC=G7L02(P,T,WB) IF(RWC.GT.RW) GOTO 99 WB1=WB 10 WB=(WB1+WB2)/2. IF(WB2-WB1.LT.1.E-4) GOTO 50 CALL S1L02(1,P,WB,RWS,E2,E3,E4,E5,E6,E7) IF(RWS.LT.0.) THEN WB2=WB GOTO 10 ENDIF RWC=G7L02(P,T,WB) IF(ABS(RWC-RW).LT.RW*1.E-6) GOTO 50 IF(RWC.GT.RW) THEN WB2=WB ELSE WB1=WB ENDIF GOTO 10 50 G8L02=WB RETURN 99 G8L02=-1.E20 RETURN END C--G9 FUNCTION G9L02(T,H) C Mole fraction of water vapor RW[-] DATA EM/0.62198/ TC=T-273.15 X=(H-1.006*TC)/(2501.+1.805*TC) IF(X.LT.0.) GOTO 99 G9L02=X/(EM+X) RETURN 99 G9L02=-1.E20 RETURN END C--G10 FUNCTION G10L02(X,H) C Dry-bulb temperature of moist air T[K] IF(X.LT.0.) GOTO 99 TC=(H-2501.*X)/(1.006+1.805*X) G10L02=G1L02(TC) RETURN 99 G10L02=-1.E20 RETURN END C--G11 FUNCTION G11L02(P,TK68) C Enhancement factor FS[-] DIMENSION CF(8),CJ(7),CI(7),CG(6),CM(7) DATA R/8.31441/,WM/18.01528/ DATA CF/-0.2403360201E4, -0.140758895E1, 0.1068287657, & -0.2914492351E-3, 0.373497936E-6, -0.21203787E-9, & -0.3424442728E1, 0.1619785E-1/ DATA CJ/ 0.5088496E2, 0.6163813, 0.1459187E-2, & 0.2008438E-4, -0.5847727E-7, 0.4104110E-9, & 0.1967348E-1/ DATA CI/ 0.50884917E2, 0.62590623, 0.13848668E-2, & 0.21603427E-4, -0.72087667E-7, 0.46545054E-9, & 0.19859983E-1/ DATA CG/-0.58002206E4, 0.13914993E1, -0.48640239E-1, & 0.41764768E-4, -0.14452093E-7, 0.65459673E1/ DATA CM/-0.56745359E4, 0.63925247E1, -0.96778430E-2, & 0.62215701E-6, 0.20747825E-8, -0.94840240E-12, & 0.41635019E1/ T=TK68 IF(TK68.GT.273.16D0) THEN DO 1 J=1,5 1 T=TK68-0.4931358+0.46094296E-2*T-0.13746454E-4*T**2 & +0.12743214E-7*T**3 ENDIF C Volume-series virial and cross-virial coefficients C WV[m3/mol]: Molar volume of saturated liquid water C WK[1/Pa]: Isothermal compressibility of liquid water IF(T.GE.273.16D0) THEN ROU=CF(1) DO 10 K=2,6 10 ROU=ROU+CF(K)*T**(K-1) ROU=ROU/(CF(7)+CF(8)*T) WV=1.E-3*WM/ROU TC=T-273.15 WK=CJ(1) IF(T.LE.373.15) THEN DO 20 K=2,6 20 WK=WK+CJ(K)*TC**(K-1) WK=WK/(1.+CJ(7)*TC)*1.E-11 ELSE DO 30 K=2,6 30 WK=WK+CI(K)*TC**(K-1) WK=WK/(1.+CI(7)*TC)*1.E-11 ENDIF C WE[1/Pa]: Henry's law constant for air dissolved in liquid water TAU=1.E3/T TAU2=TAU**2 BO=-(0.0512*TAU+0.1076)/2./0.0005943 CO=(-0.147*TAU2+0.8447*TAU-1.)/0.0005943 EO=10.**(BO+SQRT(BO*BO+CO)) BN=-(0.019*TAU+0.03741)/2./0.1021 CN=(-0.1482*TAU2+0.851*TAU-1.)/0.1021 EN=10.**(BN+SQRT(BN*BN+CN)) WE=(0.22/EO+0.78/EN)*1.E-4/101325. ELSE C WV, WK and WE for ice WV=WM*(0.1070003E-5-0.249936E-10*T+0.371611E-12*T**2) WK=(8.875+0.0165*T)*1.E-11 WE=0. ENDIF C Virial and cross-virial coefficients RT=R*T*1.E6 T2=T**2 T3=T2*T T4=T3*T BAA=0.349568E2-0.668772E4/T-0.210141E7/T2+0.924746E8/T3 CAAA=0.125975E4-0.190905E6/T+0.632467E8/T2 BWW1=0.70E-8-0.147184E-8*EXP(1734.29/T) BWW=RT*BWW1 CWWW1=0.104E-14-0.335297E-17*EXP(3645.09/T) CWWW=RT**2*(CWWW1+BWW1**2) BAW=0.32366097E2-0.141138E5/T-0.1244535E7/T2-0.2348789E10/T4 CAAW=0.482737E3+0.105678E6/T-0.656394E8/T2+0.294442E11/T3 &-0.319317E13/T4 CAWW=-0.10728876E2+0.347802E4/T-0.383383E6/T2+0.33406E8/T3 CAWW=-1.E6*EXP(CAWW) C Enhancement factor FS[-] IF(T.GE.273.16) THEN PS=CG(6)*ALOG(T) DO 40 I=1,5 40 PS=PS+CG(I)*T**(I-2) ELSE PS=CM(7)*ALOG(T) DO 50 I=1,6 50 PS=PS+CM(I)*T**(I-2) ENDIF PS=EXP(PS) IF(PS.GE.P) GOTO 999 PRT=P/RT PRT2=PRT**2 PSRT=PS/RT PSRT2=PSRT**2 FS=1. DO 100 K=1,2 RWS=FS*PS/P RAS=1.-RWS RAS2=RAS**2 RAS3=RAS2*RAS RAS4=RAS3*RAS RWS2=RWS**2 RWS3=RWS2*RWS FS=((1.+WK*PS)*(PRT-PSRT)-WK*(P*PRT-PS*PSRT)/2.)*WV*1.0E6 FS=FS+ALOG(1.-WE*RAS*P)+RAS2*PRT*BAA-2.*RAS2*PRT*BAW FS=FS-((1.-RAS2)*PRT-PSRT)*BWW+RAS3*PRT2*CAAA FS=FS+3.*RAS2*(RWS-RAS)*PRT2/2.*CAAW-3.*RAS2*RWS*PRT2*CAWW FS=FS-((1.+2.*RAS)*RWS2*PRT2-PSRT2)/2.*CWWW FS=FS-RAS2*(1.-3.*RAS)*RWS*PRT2*BAA*BWW FS=FS-2.*RAS3*(2.-3.*RAS)*PRT2*BAA*BAW FS=FS+6.*RAS2*RWS2*PRT2*BWW*BAW-3.*RAS4*PRT2/2.*BAA*BAA FS=FS-2.*RAS2*RWS*(1.-3.*RAS)*PRT2*BAW*BAW FS=FS-(PSRT2-(1.+3.*RAS)*RWS3*PRT2)/2.*BWW*BWW 100 FS=EXP(FS) IF((FS.LT.1.).OR.(FS*PS.GE.P)) GOTO 999 IF(RWS.GT.0.99) GOTO 999 G11L02=FS RETURN 999 G11L02=-1.E20 RETURN END C--G98 FUNCTION G98L02(KPA,P) IF(KPA.EQ.1) THEN PBAR=1.0 ELSE IF(KPA.EQ.2) THEN PBAR=1.0 ELSE IF(KPA.EQ.3) THEN PBAR=1.0E-05 ELSE PBAR=1.0E-05 ENDIF G98L02=P*PBAR RETURN END C--G99 FUNCTION G99L02(KPA,T) IF(KPA.EQ.1) THEN T0K=0.0 ELSE IF(KPA.EQ.2) THEN T0K=273.15 ELSE IF(KPA.EQ.3) THEN T0K=0.0 ELSE T0K=273.15 ENDIF G99L02=T-T0K RETURN END C********************************************************SUBROUTINE*** C--S1 SUBROUTINE S1L02(N,P,T,RWS,XS,RW,X,V,H,S) C Input: N,P,T Input: RW if N=3-7 C Output: N=1/RWS,XS; 2/HS; 3/X; 4/V; 5/H; 6/S; 7/all DATA R/8.31441/,AM/28.9645/,EM/0.62198/ IF(N.GE.3) THEN IF(RW.LT.0.) GOTO 999 RW0=RW ENDIF C Mole fraction RWS[-] and Humidity ratio XS[kg/kgDA] at saturation PS=G3L02(T) IF(PS.LE.0.99*P) THEN RWS=PS/P RAS=1.-RWS XS=EM*RWS/RAS IF(N.EQ.1) RETURN ELSE RWS=-1.E20 XS=-1.E20 IF(N.LE.2) GOTO 999 ENDIF URWS=ABS(RWS) IF(RW.GT.AMIN1(URWS,0.99)) GOTO 999 RA=1.-RW C Humidity ratio X[kg/kgDA] IF(N.GE.3) THEN URWS=ABS(RWS) IF(RW.GT.AMIN1(URWS,0.99)) GOTO 999 RA=1.-RW X=EM*RW/RA IF(N.EQ.3) RETURN ENDIF C Specific volume V[m3/kgDA] (Molar volume VM[cm3/mol]) IF((N-4)*(N-7).EQ.0) THEN VM=R*T*1.E6/P V=VM/(RA*AM)*1.E-3 IF(N.EQ.4) RETURN ENDIF C Specific enthalpy H[kJ/kgDA] IF((N-2)*(N-5)*(N-7).EQ.0) THEN IF(N.EQ.2) X=XS TC=T-273.15 H=1.006*TC+X*(1.805*TC+2501.) IF(N.NE.7) RETURN ENDIF C Specific entropy of moist air S[kJ/(kgDA K)] T0=273.15 P0=101325. PW=P*RW PW0=G3L02(T0) S=1.006*ALOG(T/T0)-R/AM*ALOG((P-PW)/P0) IF(RW.LE.0.) RETURN S=S+X*(1.805*ALOG(T/T0)+2501./T0-R/AM*ALOG(PW/PW0)) RETURN 999 RWS=-1.E20 XS=-1.E20 IF(N.GE.3) RW=RW0 X=-1.E20 V=-1.E20 H=-1.E20 S=-1.E20 RETURN END C--S99 SUBROUTINE S99L02(FF,U1,U2,U3,FUN,N2,N3) C Error check and message CHARACTER FUN*6,N2*2,N3*2 * Level 1 IF(FF.EQ.-1.0E+10) THEN WRITE(6,100) FUN 100 FORMAT(1H ,5X,'**** NO CONVERGENCE AT ',A6, & ' FOR MOIST AIR ****') * Level 2 ELSE IF(FF.EQ.-1.0E+20) THEN WRITE(6,200) FUN,U1,N2,U2,N3,U3 200 FORMAT(1H ,5X,'**** OUT OF RANGE AT ',A6, & ' FOR MOIST AIR WHEN P =',1PE13.6,3X,A2,' =',E13.6, & ' AND ',A2,' =',E13.6,' ****') ENDIF RETURN END REAL FUNCTION T90(T) * Conversion of temperature scal from IPTS-68 to ITS-90 * Range -200C<=T68<=630C anf T68>=1064 REAL T68,T0K REAL*8 CA(8) INTEGER KPA,MESS COMMON/UNIT/KPA,MESS DATA CA/-0.14542, -0.26722, 1.06471, 1.131286, -4.25835, + -1.59924, 7.29176, -3.52573/ IF((KPA.EQ.1).OR.(KPA.EQ.3)) THEN T0K=0.0 ELSE T0K=273.15 END IF T68=T-T0K * Check of argument range IF((-200.0.LE.T68).AND.(T68.LE.630.0)) THEN RT68=T68/630.0 TEMP=T68+RT68*(CA(1)+RT68*(CA(2)+RT68*(CA(3)+RT68*(CA(4) + +RT68*(CA(5)+RT68*(CA(6)+RT68*(CA(7)+RT68*CA(8)))))))) ELSE IF((1064.0.LE.T68).AND.(T68.LE.3000.0)) THEN TEMP=T68-0.25*(T68+273.15)*(T68+273.15)/1337.33/1337.33 ELSE IF(MESS.NE.0) WRITE(6,6020) T 6020 FORMAT(1H ,5X,'**** OUT OF RANGE AT T90', & ' WHEN T68 =',1PE14.7,' ****') T90=-1.0E+20 RETURN END IF T90=TEMP+T0K RETURN END REAL FUNCTION T68(T) * Conversion of temperature scal from ITS-90 to IPTS-68 * Range -200C<=T68<=630C anf T68>=1064 T1=T90(T) T2=T ITER=0 DT=T-T1 1000 CONTINUE ITER=ITER+1 IF(ITER.GE.10000) THEN WRITE(6,*) ' ITERATION EXCEEDED MAXIMUM ' T68=-1.0E+10 RETURN END IF T2=T2+DT T1=T90(T2) DT=T-T1 IF(ABS(DT).GE.1.0E-4) GOTO 1000 T68=T2 RETURN END * Subroutine Program Specifying KPA and MESS * MS-FORTRAN and MS-C Mixed Langage Programing * SUBROUTINE KPAMES(KPAC,MESSC) COMMON/UNIT/KPA,MESS INTEGER KPAC INTEGER MESSC KPA=KPAC MESS=MESSC RETURN END