SUBROUTINE TYPE73 (TIME,XIN,OUT,T,DTDT,PAR,INFO,ICNTRL,*) C*********************************************************************** C* Copyright ASHRAE. Toolkit for HVAC System Energy Calculations C************************************************************************ C* SUBROUTINE: CCDET C* C* LANGUAGE: FORTRAN 77 C* C* PURPOSE: Model the performance of a finned tube C* multi-row heat exchanger with a counterflow C* crossflow configuration. The model accounts C* for condensation on the outside surface. C* Three conditions are possible: all wet, C* partially wet or all dry. Output includes C* outlet air temperature and humidity, outlet C* water temperature, sensible and total C* cooling capacities and the wet fraction of C* air-side surface area. C*********************************************************************** C* INPUT VARIABLES DESCRIPTION(UNITS) SAMPLE VALUES C* XIN(1) MLiq Liquid mass flow rate(kg/s) 1.60 C* XIN(2) TLiqEnt Entering water temperature(C) 6.50 C* XIN(3) MAir Dry air mass flow rate(kg/s) 2.887 C* XIN(4) TAirEnt Entering air dry bulb temperature(C) 25.60 C* XIN(5) WAirEnt Entering air humidity ratio(-) .008 C* C* OUTPUT VARIABLES C* OUT(1) TLiqLvg Leaving water temperature(C) 13.7463 C* OUT(2) TAirLvg Leaving air dry bulb temperature(C) 10.7458 C* OUT(3) WAirLvg Leaving air humidity ratio(-) .00734412 C* OUT(4) QTot Total heat transfer rate(W) 48533.0 C* OUT(5) QSen Sensible heat transfer rate(W) 43760.6 C* OUT(6) FWet Fraction of surface area wet(-) .457194 C* OUT(7) ErrStat Error status indicator,0=ok,1=error(-) 0.0 C* C* PARAMETERS C* PAR(1) CoilType Coil type(-) 1.0 C* 0 = Flat continuous fins C* 1 = Circular fins C* PAR(2) AFace Coil face area(m2) 2.235 C* PAR(3) ARatPri Primary surface area/face area(-) 5.218 C* PAR(4) ARatSec Secondary surface area/face area(-) 74.66 C* PAR(5) ARatInt Internal surface area/face area(-) 5.06 C* PAR(6) ARatFlow Minimum air flow area/face area(-) .53 C* PAR(7) FinPerM Number of fins per meter(1/m) 288.714 C* PAR(8) TubePerRow Number of tubes per row(-) 22.00 C* PAR(9) NumRow Number of rows(-) 4.0 C* PAR(10) NumCircuit Number of circuits(-) 11.0 C* PAR(11) OdTube Outside diameter of tube(m) .016357 C* PAR(12) IdTube Inside diameter of tube(m) .015341 C* PAR(13) FinThick Fin thickness(m) .0001905 C* PAR(14) RowSpace Row spacing(m) .0254 C* PAR(15) FinDia Fin diameter (coil type = 1) or(m) .0381 C* distance between face tubes (coil type = 0) C* PAR(16) KFin Fin thermal conductivity(W/m C) 228.30 C* PAR(17) KTube Tube thermal conductivity(W/m C) 385.70 C* PAR(18) FoulFactor Fouling factor for tubes(C m2/W) .00003 C* C* PROPERTIES C* CpAir Dry air specific heat (J/kg C) C* KAir Air thermal conductivity (W/m C) C* DViscAir Air dynamic viscosity (kg/m s) C* CpLiq Liquid specific heat (J/kg C) C* KLiq Liquid thermal conductivity (W/m C) C* DViscLiq Liquid dynamic viscosity (kg/m s) C*********************************************************************** C MAJOR RESTRICTIONS: General application is for heat exchanger C with four or more rows in a counterflow C configuration. C C DEVELOPER: Shauna Gabel C Michael J. Brandemuehl, PhD, PE C University of Colorado at Boulder C C DATE: January 1, 1992 C C INCLUDE FILES: coildet.inc C prop.inc C SUBROUTINES CALLED: DRYCOIL C WETCOIL C DRYWETCOIL C FUNCTIONS CALLED: DEWPOINT C UTUBCONV C UFINCONV C UFINWET C FINEFF C C REVISION HISTORY: None C C REFERENCE: Elmahdy, A.H. and Mitalas, G.P. 1977. C Fortran IV program to simulate cooling and C dehumidifying finned-tube multi-row heat C exchangers, Computer Program No. 43. C Division of Building Research, National C Research Council of Canada, Ottawa. C C Elmahdy, A.H. and Mitalas, G.P. 1977. C "A Simple Model for Cooling and C Dehumidifying Coils for Use In Calculating C Energy Requirements for Buildings," C ASHRAE Transactions,Vol.83 Part 2, C pp. 103-117. C C TRNSYS. 1990. A Transient System C Simulation Program: Reference Manual. C Solar Energy Laboratory, Univ. Wisconsin- C Madison, pp. 4.6.8-1 - 4.6.8-12. C C Threlkeld, J.L. 1970. Thermal C Environmental Engineering, 2nd Edition, C Englewood Cliffs: Prentice-Hall,Inc. C pp. 254-270. C*********************************************************************** C INTERNAL VARIABLES: C configHX Heat exchanger configuration (-) C P(TubeLength) Tube length (m) C P(DiamFin) Fin diameter (m) C P(DHydCoil) Hydraulic diameter of coil for air-side flow (m) C P(FinHt) Fin height (m) C P(ARatTot) Total surface area/face area (-) C P(ASecTot) Secondary/total surface area (-) C P(AIntTot) Internal/total surface area (-) C P(ATot) Total air-side (external) heat transfer area (m2) C P(CondResist) Tube conductive resistance (m2 C/W) C tDewPt Dewpoint of air (C) C gLiq Liquid mass flow rate/flow area (kg/m2 s) C liqFilmCoeff Water film coefficient (W/m2 C) C uIntTot Overall internal UA/total external area (W/m2 C) C gAir Moist air mass flow rate/flow area (kg/m2 s) C drySurfCoeff Dry air-side film coefficient (W/m2 C) C dryFinEff Dry fin efficiency (-) C dryEffSurf Dry surface effectiveness (-) C dryUExtTot Overall external dry UA/total external area (W/m2 C) C dryUA Dry overall heat transfer coefficient (W/m2 C) C wetSurfCoeff Wet air-side film coefficient (W/m2 C) C wetFinEff Wet fin efficiency (-) C wetEffSurf Wet surface effectiveness (-) C wetUExtTot Overall external wet UA/total external area (W/m2 C) C tSurfEnt Coil surface temperature at air entrance (C) C small Small number in place of zero C pi Pi (-) C*********************************************************************** DOUBLE PRECISION XIN,OUT REAL liqFilmCoeff,AFACE,ARATPRI,COILTYPE,ARATSEC, &ARATINT,ARATFLOW,FINSPERM,TUBEPERROW,NUMROW,NUMCIRCUIT,ODTUBE, &IDTUBE,FINTHICK,ROWSPACE,FINDIA,KFIN,KTUBE,FOULFACTOR, &PROP(16),GAIR INTEGER Patm,CpAir,CpWat,CpLiq,CpVap,DViscAir, & DViscLiq,KAir,KLiq,RhoLiq,Hfg,RAir, & TKelMult,TAbsAdd,PaMult,PAbsAdd,ERRSTAT,INFO,NI, & NP,ND DIMENSION XIN(5),OUT(7),PAR(18),INFO(15) CHARACTER*3 YCHECK(5),OCHECK(7) COMMON /LUNITS/LUR,LUW,IFORM,LUK DATA pi /3.141592654/, small /1.E-9/, configHX/1./ DATA YCHECK/'MF2','TE1','MF2','TE1','DM1'/ DATA OCHECK/'TE1','TE1','DM1','PW2','PW2','DM1','DM1'/ PARAMETER (Patm = 1) PARAMETER (CpAir = 2) PARAMETER (CpWat = 3) PARAMETER (CpVap = 4) PARAMETER (CpLiq = 5) PARAMETER (DViscAir = 6) PARAMETER (DViscLiq = 7) PARAMETER (KAir = 8) PARAMETER (KLiq = 9) PARAMETER (RhoLiq = 10) PARAMETER (Hfg = 11) PARAMETER (RAir = 12) PARAMETER (TKelMult = 13) PARAMETER (TAbsAdd = 14) PARAMETER (PaMult = 15) PARAMETER (PAbsAdd = 16) PROP(PATM) = 101325.0 PROP(CPAIR) = 1006.0 PROP(CPWAT) = 4186.0 PROP(CPVAP) = 1805.0 PROP(CPLIQ) = 4186.0 PROP(DVISCAIR) = .0000182 PROP(DVISCLIQ) = .00144 PROP(KAIR) = .026 PROP(KLIQ) = .604 PROP(RHOLIQ) = 998.0 PROP(HFG) = 2501000.0 PROP(RAIR) = 287.055 PROP(TKELMULT) = 1.0 PROP(TABSADD) = 273.15 PROP(PAMULT) = 1.0 PROP(PABSADD) = 0.0 IOPT = -1 NI = 5 !CORRECT NUMBER OF INPUTS NP = 18 !CORRECT NUMBER OF PARAMETERS ND = 0 !CORRECT NUMBER OF DERIVATIVES MLIQ = XIN(1) TLIQENT = XIN(2) MAIR = XIN(3) TAIRENT = XIN(4) WAIRENT = XIN(5) COILTYPE = PAR(1) AFACE = PAR(2) ARATPRI = PAR(3) ARATSEC = PAR(4) ARATINT = PAR(5) ARATFLOW = PAR(6) FINSPERM = PAR(7) TUBEPERROW = PAR(8) NUMROW = PAR(9) NUMCIRCUIT = PAR(10) ODTUBE = PAR(11) IDTUBE = PAR(12) FINTHICK = PAR(13) ROWSPACE = PAR(14) FINDIA = PAR(15) KFIN = PAR(16) KTUBE = PAR(17) FOULFACTOR = PAR(18) IF (INFO(7).EQ.-1) THEN CALL TYPECK(IOPT,INFO,NI,NP,ND) C CHECKS TO SEE IF USER'S INFO MATCHES CORRECT NUMBERS CALL RCHECK(INFO,YCHECK,OCHECK) C CHECKS TO SEE IF INPUT AND OUTPUT UNITS MATCH ENDIF C2********************************************************************** C2 The code between these bars of asterisks is used to set internal C2 parameters and is independent of component input values. In an C2 hourly simulation, this block of code may be skipped after the C2 first call. C1*** Calculate basic coil parameters common to program C2*** If coils are flat continuous fins, annular fin conversion C2*** calculated IF (CoilType .EQ. 0.0) THEN DiamFin = SQRT(4*FinDia*RowSpace/pi) ELSE DiamFin = FinDia ENDIF C2*** Physical measurements FinHt = 0.5*(DiamFin-OdTube) TubeLength = AFace/FinDia/TubePerRow ARatTot = ARatPri+ARatSec ASecTot = ARatSec/ARatTot AIntTot = ARatInt/ARatTot ATot = ARatTot*AFace DHydCoil = 4.*ARatFlow*NumRow*RowSpace/ARatTot C1*** Calculate the tube conduction heat transfer resistance CondResist = (0.5*(OdTube-IdTube)/KTube & + FoulFactor) C2********************************************************************** C1*** If both flows are zero, set outputs to inputs and return IF (ABS(MAir) .LT. small .AND. ABS(MLiq) .LT. small) THEN TLiqLvg = TLiqEnt TAirLvg = TAirEnt WAirLvg = WAirEnt GO TO 999 ENDIF C1*** Calculate water-side (internal) heat transfer coefficient C2*** Assume dynamic viscosity of liquid at wall is 93% of the C2*** value at the bulk fluid temperature, corresponding to C2*** approximately 2 C temperature difference for 10 C water gLiq = MLiq/NumCircuit/(pi*(0.5*IdTube)**2) dViscWall = 0.93*Prop(DViscLiq) liqFilmCoeff = UTUBCONV(gLiq,IdTube,TubeLength, & Prop(CpLiq),Prop(KLiq),Prop(DViscLiq), & dViscWall) liqFilmCoeff = MAX(liqFilmCoeff,small) uIntTot = AIntTot/(1./liqFilmCoeff+CondResist) C1*** Calculate air-side (external) convection coefficient gAir = MAir*(1.+WAirEnt)/(ARatFlow*AFace) drySurfCoeff = UFINCONV (gAir,DHydCoil,FinHt,FinThick, & FinsPerM,Prop(CpAir),Prop(KAir), & Prop(DViscAir)) drySurfCoeff = MAX(drySurfCoeff,small) C1*** Calculate the external heat traansfer coefficient for dry surface dryFinEff = FINEFF (drySurfCoeff,DiamFin,FinThick, & KFiN,OdTube) dryEffSurf = ASecTot*dryFinEff+(1-ASecTot) dryUExtTot = dryEffSurf*drySurfCoeff C1*** IF coil is completely dry THEN tDewPt = DEWPOINT (Prop,WAirEnt) IF (tDewPt .LE. TLiqEnt) THEN C1*** Calculate overall heat transfer coefficient for dry coil dryUA = ATot/(1./dryUExtTot+1./uIntTot) C1*** Calculate the leaving conditions and performance of dry coil CALL DRYCOIL (Prop,MLiq,TLiqEnt,MAir,TAirEnt,WAirEnt, & dryUA,configHX, & TLiqLvg,TAirLvg,WAirLvg,QTot,ErrStat) QSen = QTot FWet = 0. ELSE C1*** ELSE Assume external surface of coil is completely wet C1*** Calculate wet surface coefficient and overall heat transfer C1*** coefficient wetSurfCoeff = UFINWET (drySurfCoeff,gAir) wetSurfCoeff = MAX(wetSurfCoeff,small) wetFinEff = FINEFF (wetSurfCoeff,DiamFin,FinThick, & KFin,OdTube) wetEffSurf = ASecTot*wetFinEff+(1-ASecTot) wetUExtTot = wetEffSurf*wetSurfCoeff wetUAExt = WetUExtTot*ATot wetUAInt = UIntTot*ATot C1*** Calculate the leaving conditions and performance of wet coil CALL WETCOIL (Prop,MLiq,TLiqEnt,MAir,TAirEnt,WAirEnt, & wetUAInt,wetUAExt,configHX, & TLiqLvg,TAirLvg,WAirLvg,QTot,QSen,FWet, & tSurfEnt,ErrStat) C1*** IF coil is only partially wet THEN IF (tDewPt .LT. tSurfEnt) THEN C1*** Calculate the leaving conditions and performance of part-wet coil CALL DRYWETCOIL (Prop,MLiq,TLiqEnt,MAir,TAirEnt,WAirEnt, & tDewPt,ATot,uIntTot,dryUExtTot,wetUExtTot, & TLiqLvg,TAirLvg,WAirLvg,QTot,QSen,FWet, & ErrStat) ENDIF ENDIF 999 CONTINUE OUT(1) = TLiqLvg OUT(2) = TAirLvg OUT(3) = WAirLvg OUT(4) = QTot OUT(5) = QSen OUT(6) = FWet OUT(7) = ErrStat RETURN 1 END C*********************************************************************** C* FILE: PROP.INC C* C* This file assigns a numbers to air and water property names to be C* used in the "Prop" array. C*********************************************************************** C DEVELOPER: Inger Andresen C Michael J. Brandemuehl, PhD, PE C C DATE: July 1, 1991 C C FILES REQUIRED: None C*********************************************************************** C INTERNAL VARIABLES: C Patm Atmospheric pressure (Pa) C CpAir Specific heat of dry air (J/kg C) C CpLiq Specific heat of liquid water (J/kg C) C CpVap Specific heat of saturated water vapor (J/kg C) C DViscAir Air dynamic viscosity (kg/m s) C DViscLiq Liquid dynamic viscosity (kg/m s) C KAir Air thermal conductivity (W/m C) C KLiq Liquid thermal conductivity (W/m C) C RhoLiq Liquid density (kg/m3) C Hfg Latent heat of vaporization of water (J/kg) C RAir Gas constant for air (J/kg C) C TKelMult Multiplying factor to convert user T to Kelvin C TAbsAdd Additive factor to convert user P to Kelvin C tKel = Prop(TKelMult)*T + Prop(TKelAdd) C PaMult Multiplying factor to convert user P to Pascals C PAbsAdd Additive factor to convert user P to Pascals C Pa = Prop(PaMult)*P + Prop(PaAdd) C*********************************************************************** C INTEGER Patm,CpAir,CpWat,CpLiq,CpVap,DViscAir, C & DViscLiq,KAir,KLiq,RhoLiq,Hfg,RAir, C & TKelMult,TAbsAdd,PaMult,PAbsAdd C REAL Prop(16) C PARAMETER (Patm = 1) C PARAMETER (CpAir = 2) C PARAMETER (CpWat = 3) C PARAMETER (CpVap = 4) C PARAMETER (CpLiq = 5) C PARAMETER (DViscAir = 6) C PARAMETER (DViscLiq = 7) C PARAMETER (KAir = 8) C PARAMETER (KLiq = 9) C PARAMETER (RhoLiq = 10) C PARAMETER (Hfg = 11) C PARAMETER (RAir = 12) C PARAMETER (TKelMult = 13) C PARAMETER (TAbsAdd = 14) C PARAMETER (PaMult = 15) C PARAMETER (PAbsAdd = 16) SUBROUTINE DRYCOIL (Prop,MLiq,TLiqEnt,MAir,TAirEnt,WAirEnt, & UA,ConfigHX, & TLiqLvg,TAirLvg,WAirLvg,Q, & ErrStat) C*********************************************************************** C* Copyright ASHRAE. Toolkit for HVAC System Energy Calculations C*********************************************************************** C* SUBROUTINE: DRYCOIL C* C* LANGUAGE: FORTRAN 77 C* C* PURPOSE: Calculate the performance of a sensible C* air-liquid heat exchanger. Calculated C* results include outlet air temperature C* and humidity, outlet water temperature, C* and heat transfer rate. C*********************************************************************** C* INPUT VARIABLES C* MLiq Liquid mass flow rate (kg/s) C* TLiqEnt Entering water temperature (C) C* MAir Dry air mass flow rate (kg/s) C* TAirEnt Entering air dry bulb temperature (C) C* WAirEnt Entering air humidity ratio (-) C* C* UA Overall heat transfer coefficient (W/C) C* ConfigHX Heat exchanger configuration (-) C* 1 - Counterflow C* 2 - Parallel flow C* 3 - Cross flow, both streams unmixed C* 4 - Cross flow, both streams mixed C* 5 - Cross flow, stream 1 unmixed C* 6 - Cross flow, stream 2 unmixed C* C* OUTPUT VARIABLES C* TLiqLvg Leaving water temperature (C) C* TAirLvg Leaving air dry bulb temperature (C) C* WAirLvg Leaving air humidity ratio (-) C* Q Heat transfer rate (W) C* ErrStat Error status indicator, 0 = ok, 1 = error (-) C* C* PROPERTIES C* CpAir Specific heat of air (J/kg C) C* CpVap Specific heat of water vapor (J/kg C) C* CpLiq Specific heat of liquid (J/kg C) C*********************************************************************** C MAJOR RESTRICTIONS: Models coil using effectiveness-Ntu model. C C DEVELOPER: Shauna Gabel C Michael J. Brandemuehl, PhD, PE C University of Colorado at Boulder C C DATE: January 1, 1992 C C INCLUDE FILES: prop.inc C SUBROUTINES CALLED: HEATEX C FUNCTIONS CALLED: None C C REVISION HISTORY: None C C REFERENCE: Kays, W.M. and A.L. London. 1964. C Compact Heat Exchangers, 2nd Edition, C New York: McGraw-Hill. C C Threlkeld, J.L. 1970. Thermal C Environmental Engineering, 2nd Edition, C Englewood Cliffs: Prentice-Hall, Inc. C pp. 254-270. C*********************************************************************** C INTERNAL VARIABLES: C capAir Air-side capacity rate (W/C) C capLiq Water-side capacity rate (W/C) C*********************************************************************** INTEGER Patm,CpAir,CpWat,CpLiq,CpVap,DViscAir, & DViscLiq,KAir,KLiq,RhoLiq,Hfg,RAir, & TKelMult,TAbsAdd,PaMult,PAbsAdd REAL Prop(16) PARAMETER (Patm = 1) PARAMETER (CpAir = 2) PARAMETER (CpWat = 3) PARAMETER (CpVap = 4) PARAMETER (CpLiq = 5) PARAMETER (DViscAir = 6) PARAMETER (DViscLiq = 7) PARAMETER (KAir = 8) PARAMETER (KLiq = 9) PARAMETER (RhoLiq = 10) PARAMETER (Hfg = 11) PARAMETER (RAir = 12) PARAMETER (TKelMult = 13) PARAMETER (TAbsAdd = 14) PARAMETER (PaMult = 15) PARAMETER (PAbsAdd = 16) REAL MAir,MLiq INTEGER Errstat Errstat = 0 C2*** Calculate air and water capacity rates capAir = MAir*(Prop(CpAir)+WAirEnt*Prop(CpVap)) capLiq = MLiq*Prop(CpLiq) C1*** Determine the air and water outlet conditions CALL HEATEX (capLiq,TLiqEnt,capAir,TAirEnt,UA,ConfigHX, & TLiqLvg,TAirLvg) C1*** Calculate the total and sensible heat transfer rate Q = capAir*(TAirEnt-TAirLvg) WAirLvg = WAirEnt RETURN END SUBROUTINE WETCOIL (Prop,MLiq,TLiqEnt,MAir,TAirEnt,WAirEnt, & UAIntTot,UAExtTot,ConfigHX, & TLiqLvg,TAirLvg,WAirLvg,QTot,QSen,FWet, & TSurfEnt,ErrStat) C*********************************************************************** C* Copyright ASHRAE. Toolkit for HVAC System Energy Calculations C*********************************************************************** C* SUBROUTINE: WETCOIL C* C* LANGUAGE: FORTRAN 77 C* C* PURPOSE: Calculate the performance of a cooling C* coil when the external fin surface is C* complete wet. Results include C* outlet air temperature and humidity, C* outlet water temperature, sensible and C* total cooling capacities, and the wet C* fraction of the air-side surface area. C*********************************************************************** C* INPUT VARIABLES C* MLiq Liquid mass flow rate (kg/s) C* TLiqEnt Entering water temperature (C) C* MAir Dry air mass flow rate (kg/s) C* TAirEnt Entering air dry bulb temperature (C) C* WAirEnt Entering air humidity ratio (-) C* C* UAIntTot Internal overall heat transfer coefficient (W/m2 C) C* UAExtTot External overall heat transfer coefficient (W/m2 C) C* ConfigHX Heat exchanger configuration (-) C* 1 - Counterflow C* 2 - Parallel flow C* 3 - Cross flow, both streams unmixed C* 4 - Cross flow, both streams mixed C* 5 - Cross flow, stream 1 unmixed C* 6 - Cross flow, stream 2 unmixed C* C* OUTPUT VARIABLES C* TLiqLvg Leaving water temperature (C) C* TAirLvg Leaving air dry bulb temperature (C) C* WAirLvg Leaving air humidity ratio (-) C* QTot Total heat transfer rate (W) C* QSen Sensible heat transfer rate (W) C* FWet Fraction of surface area wet (-) C* TSurfEnt Surface temperature at air entrance (C) C* ErrStat Error status indicator, 0 = ok, 1 = error (-) C* C* PROPERTIES C* CpLiq Specific heat of liquid (J/kg C) C* CpAir Specific heat of dry air (J/kg C) C*********************************************************************** C MAJOR RESTRICTIONS: Models coil as counterflow heat exchanger C Approximates saturated air enthalpy as C a linear function of temperature C C DEVELOPER: Shauna Gabel C Michael J. Brandemuehl, PhD, PE C University of Colorado at Boulder C C DATE: January 1, 1992 C C INCLUDE FILES: prop.inc C SUBROUTINES CALLED: HEATEX C WCOILOUT C FUNCTIONS CALLED: ENTHALPY C ENTHSAT C TAIRSAT C C REVISION HISTORY: None C C REFERENCE: Elmahdy, A.H. and Mitalas, G.P. 1977. C "A Simple Model for Cooling and C Dehumidifying Coils for Use In Calculating C Energy Requirements for Buildings," C ASHRAE Transactions,Vol.83 Part 2, C pp. 103-117. C C TRNSYS. 1990. A Transient System C Simulation Program: Reference Manual. C Solar Energy Laboratory, Univ. Wisconsin- C Madison, pp. 4.6.8-1 - 4.6.8-12. C C Threlkeld, J.L. 1970. Thermal C Environmental Engineering, 2nd Edition, C Englewood Cliffs: Prentice-Hall,Inc. C pp. 254-270. C*********************************************************************** C INTERNAL VARIABLES: C extResist Air-side resistance to heat transfer (m2 C/W) C intResist Liquid-side resistance to heat transfer (m2 C/W) C tDewEnt Entering air dew point (C) C uaH Overall enthalpy heat transfer coefficient (kg/s) C capAirWet Air-side capacity rate (kg/s) C capLiqWet Liquid-side capacity rate (kg/s) C resistRatio Ratio of resistances (-) C hAirLvg Outlet air enthalpy C hLiqEntSat Saturated enthalpy of air at (J/kg) C entering water temperature C hLiqLvgSat Saturated enthalpy of air at exit (J/kg) C water temperature C hSurfEntSat Saturated enthalpy of air at (J/kg) C entering surface temperature C hSurfLvgSat Saturated enthalpy of air at exit (J/kg) C surface temperature C cpSat Coefficient for equation below (J/kg C) C EnthSat1-EnthSat2 = cpSat*(TSat1-TSat2) C (all water and surface temperatures are C related to saturated air enthalpies for C wet surface heat transfer calculations) C************************************************************************ INTEGER Patm,CpAir,CpWat,CpLiq,CpVap,DViscAir, & DViscLiq,KAir,KLiq,RhoLiq,Hfg,RAir, & TKelMult,TAbsAdd,PaMult,PAbsAdd REAL Prop(16) PARAMETER (Patm = 1) PARAMETER (CpAir = 2) PARAMETER (CpWat = 3) PARAMETER (CpVap = 4) PARAMETER (CpLiq = 5) PARAMETER (DViscAir = 6) PARAMETER (DViscLiq = 7) PARAMETER (KAir = 8) PARAMETER (KLiq = 9) PARAMETER (RhoLiq = 10) PARAMETER (Hfg = 11) PARAMETER (RAir = 12) PARAMETER (TKelMult = 13) PARAMETER (TAbsAdd = 14) PARAMETER (PaMult = 15) PARAMETER (PAbsAdd = 16) REAL MAir,MLiq,intResist INTEGER ErrStat DATA small/1.E-9/ FWet = 1. extResist = 1./UAExtTot intResist = 1./UAIntTot C1*** Calculate enthalpies of entering air and water hAirEnt = ENTHALPY(Prop,TAirEnt,WAirEnt) hLiqEntSat = ENTHSAT(Prop,TLiqEnt) C1*** Estimate cpSat using entering air dewpoint and water temperature tDewEnt = DEWPOINT(Prop,WAirEnt) cpSat = (ENTHSAT(Prop,tDewEnt)-hLiqEntSat) & /(tDewEnt-TLiqEnt) C1*** Enthalpy-based heat transfer calculations C2*** Heat transfer in a wet coil is calculated based on enthalpy C2*** rather than temperature to include latent effects. Air enthalpies C2*** are evaluated using conventional psychrometric equations. The C2*** corresponding enthalpies of the coil and water are related to C2*** that of the air through "fictitious enthalpies," defined as the C2*** enthalpy of saturated air at the temperature of the coil or water. C2 C2*** While heat transfer rates are commonly expressed as the product C2*** of an overall heat transfer coefficient, UA, and a temperature C2*** difference, the use of enthalpy-based heat transfer calculations C2*** requires an enthalpy-based heat transfer coefficient, UAH. C2 C2*** q = UAH * (H1-H2) C2 C2*** where UAH = UA / cp C2*** UA = conventional heat transfer coefficient C2*** cp = specific heat across enthalpy difference C2 C2*** When using fictitious enthalpies, a corresponding fictitious C2*** specific heat must be defined. C2 C2*** EnthSat1-EnthSat2 = cpSat * (Temp1-Temp2) C2 C2*** UAH can be calculated from a combination of series or parallel C2*** enthalpy resistances, similar to thermal resistances modified for C2*** enthalpy as above. Enthalpy capacity rates relate heat transfer C2*** to the enthalpy change of a fluid between inlet and outlet. C2 C2*** q = CapH * (HAirLvg - HAirEnt) C2 C2*** On the air side, enthalpy capacity rate is the air mass flow rate. C2*** On the water side, the enthalpy capacity rate is based on the C2*** enthalpy of saturated air at the water temperature. C1*** Determine air and water enthalpy outlet conditions by modeling C1*** coil as counterflow enthalpy heat exchanger uaH = 1./(cpSat*intResist+Prop(CpAir)*extResist) capAirWet = MAir capLiqWet = MLiq * (Prop(CpLiq)/cpSat) CALL HEATEX(capAirWet,hAirEnt,capLiqWet,hLiqEntSat,uaH, & ConfigHX,hAirLvg,hLiqLvgSat) C1*** Calculate entering and leaving external surface conditions from C1*** air and water conditions and the ratio of resistances resistRatio = (intResist)/(intResist + & Prop(CpAir)/cpSat*extResist) hSurfEntSat = hLiqLvgSat + resistRatio*(hAirEnt-hLiqLvgSat) hSurfLvgSat = hLiqEntSat + resistRatio*(hAirLvg-hLiqEntSat) TSurfEnt = TAIRSAT(Prop,hSurfEntSat) C1*** Calculate outlet air temperature and humidity from enthalpies and C1*** surface conditions. QTot = MAir*(hAirEnt-hAirLvg) TLiqLvg = TLiqEnt+QTot/MAX(MLiq,small)/Prop(CpLiq) CALL WCOILOUT (Prop,MAir,TAirEnt,WAirEnt,hAirEnt,hAirLvg, & UAExtTot,TAirLvg,WAirLvg,QSen,ErrStat) 999 RETURN END SUBROUTINE DRYWETCOIL (Prop,MLiq,TLiqEnt,MAir,TAirEnt,WAirEnt, & TDewPt,ATot,UIntTot,DryUExtTot,WetUExtTot, & TLiqLvg,TAirLvg,WAirLvg,QTot,QSen,FWet, & ErrStat) C*********************************************************************** C* Copyright ASHRAE. Toolkit for HVAC System Energy Calculations C*********************************************************************** C* SUBROUTINE: DRYWETCOIL C* C* LANGUAGE: FORTRAN 77 C* C* PURPOSE: Calculate the performance of a cooling C* coil when the external fin surface is C* part wet and part dry. Results include C* outlet air temperature and humidity, C* outlet liquid temperature, sensible and C* total cooling capacities, and the wet C* fraction of the air-side surface area. C*********************************************************************** C* INPUT VARIABLES C* MLiq Liquid mass flow rate (kg/s) C* TLiqEnt Entering liquid temperature (C) C* MAir Dry air mass flow rate (kg/s) C* TAirEnt Entering air dry bulb temperature (C) C* HAirEnt Entering air enthalpy (J/kg) C* WAirEnt Entering air humidity ratio (-) C* TDewPt Entering air dew point (C) C* ATot External (air-side) surface area (m2) C* UIntTot Internal overall heat transfer coefficient (W/m2 C) C* DryUExtTot External overall heat transfer coefficient (W/m2 C) C* WetUExtTot External overall heat transfer coefficient (W/m2 C) C* C* OUTPUT VARIABLES C* TLiqLvg Leaving liquid temperature (C) C* TAirLvg Leaving air dry bulb temperature (C) C* WAirLvg Leaving air humidity ratio (-) C* QTot Total heat transfer rate (W) C* QSen Sensible heat transfer rate (W) C* FWet Fraction of surface area wet (-) C* ErrStat Error status indicator, 0 = ok, 1 = error (-) C*********************************************************************** C MAJOR RESTRICTIONS: None C C DEVELOPER: Shauna Gabel C Michael J. Brandemuehl, PhD, PE C University of Colorado at Boulder C C DATE: January 1, 1992 C C INCLUDE FILES: None C SUBROUTINES CALLED: DRYCOIL C WETCOIL C FUNCTIONS CALLED: XITERATE C C REVISION HISTORY: None C C REFERENCE: Elmahdy, A.H. and Mitalas, G.P. 1977. C "A Simple Model for Cooling and C Dehumidifying Coils for Use In Calculating C Energy Requirements for Buildings," C ASHRAE Transactions,Vol.83 Part 2, C pp. 103-117. C C TRNSYS. 1990. A Transient System C Simulation Program: Reference Manual. C Solar Energy Laboratory, Univ. Wisconsin- C Madison, pp. 4.6.8-1 - 4.6.8-12. C C Threlkeld, J.L. 1970. Thermal C Environmental Engineering, 2nd Edition, C Englewood Cliffs: Prentice-Hall,Inc. C pp. 254-270. C*********************************************************************** C INTERNAL VARIABLES C qDry Heat transfer rate for dry coil (W) C qTotWet Total heat transfer rate for wet coil (W) C qSenWet Sensible heat transfer rate for wet coil (W) C aWet Air-side area of wet coil (m2) C aDry Air-side area of dry coil (m2) C dryUA Overall heat transfer coefficient for dry coil (W/C) C wetUA Overall heat transfer coefficient for wet coil (W/C) C tLiqBnd Liquid temperature at wet/dry boundary (C) C tAirBnd Air temperature at wet/dry boundary (C) C tSurfBnd Surface temperature at wet/dry boundary (C) C tNewLiqBnd Estimated liquid temperature at wet/dry boundary (C) C error Deviation of dependent variable in iteration C iter Iteration counter C icvg Iteration convergence flag C F1,F2 Previous values of dependent variable in XITERATE C X1,X2 Previous values of independent variable in XITERATE C*********************************************************************** INTEGER ErrStat REAL MAir,MLiq DATA itmax/50/,configHX/1./ C1*** Iterate on FWet to converge on surface temperature equal to C1*** entering air dewpoint at wet/dry boundary. C1*** Preliminary estimates of coil performance to begin iteration TLiqLvg = TAirEnt qDry = 0. qTotWet = 0. qSenWet = 0. C2*** Estimate liquid temperature at boundary as entering air dew point tLiqBnd = TDewPt C2*** Estimate fraction wet surface area based on liquid temperatures FWet = (tLiqBnd-TLiqEnt)/(TLiqLvg-TLiqEnt) C1*** BEGIN LOOP to converge on FWet DO 100 iter = 1,itmax aWet = FWet*ATot aDry = ATot-aWet dryUA = aDry/(1./UIntTot+1./DryUExtTot) wetUAExt = WetUExtTot*aWet wetUAInt = UIntTot*aWet tLiqBnd = TLiqEnt+FWet*(TLiqLvg-TliqEnt) C1*** BEGIN LOOP to converge on liquid temperature at wet/dry boundary DO 50 itT = 1,itmax C1*** Calculate dry coil performance with estimated liquid temperature C1*** at the boundary. CALL DRYCOIL(Prop,MLiq,tLiqBnd,MAir,TAirEnt,WAirEnt, & dryUA,configHX, & TLiqLvg,tAirBnd,wAirBnd,qDry, & ErrStat) C1*** Calculate wet coil performance with calculated air temperature C1*** at the boundary. CALL WETCOIL (Prop,MLiq,TLiqEnt,MAir,tAirBnd,wAirBnd, & wetUAInt,wetUAExt,configHX, & tNewLiqBnd,TAirLvg,WAirLvg,qTotWet,qSenWet, & dumWet,tSurfBnd,ErrStat) errorT = tNewLiqBnd - tLiqBnd tLiqBnd = XITERATE(tLiqBnd,errorT,X1T,F1T,X2T,F2T,itT,icvgT) IF(icvgT .EQ. 1) GO TO 60 50 CONTINUE C2*** Boundary temperature not converged after maximum specified iterations. C2*** Print error message, set return error flag WRITE(LUW,1001) itmax 1001 FORMAT(/1X,'*** ERROR IN SUBROUTINE PARTWET ***'/ & 1X,' Liquid temperature not converged at boundary ' & 'after ',I2,' iterations'/) ErrStat = 1 C1*** Estimate new value for fraction wet surface area 60 CONTINUE C1*** If surface is dry, calculate dry coil performance and return IF(FWet .LE. 0.0 .AND. tSurfBnd .GE. TDewPt) THEN dryUA = aTot/(1./UIntTot+1./DryUExtTot) CALL DRYCOIL(Prop,MLiq,TLiqEnt,MAir,TAirEnt,WAirEnt, & dryUA,configHX, & TLiqLvg,TAirLvg,WAirLvg,QTot, & ErrStat) QSen = QTot FWet = 0. GO TO 999 ENDIF error = tSurfBnd - TDewPt FWet = XITERATE(FWet,error,X1,F1,X2,F2,iter,icvg) C1*** If converged, leave iteration loop IF (icvg .EQ. 1) GO TO 110 C2*** Surface temperature not converged. Repeat calculations with new C2*** estimate of fraction wet surface area. IF(FWet .GT. 1) FWet = 1. IF(FWet .LT. 0) FWet = 0. 100 CONTINUE C2*** Surface temperature not converged after maximum specified iterations. C2*** Print error message, set return error flag WRITE(LUW,1002) itmax 1002 FORMAT(/1X,'*** ERROR IN SUBROUTINE PARTWET ***'/ & 1X,' Wet/Dry boundary surface temperature not ' & 'converged after ',I2,' iterations'/) ErrStat = 1 110 CONTINUE C1*** Calculate outlet air temperature and humidity from enthalpies and C1*** surface conditions. QTot = qDry+qTotWet QSen = qDry+qSenWet 999 RETURN END REAL FUNCTION UTUBCONV (MassFlux,Diam,Length,Cp,K, & DViscBulk,DViscWall) C*********************************************************************** C* Copyright ASHRAE. Toolkit for HVAC System Energy Calculations C*********************************************************************** C* FUNCTION: UTUBCONV C* C* LANGUAGE: FORTRAN 77 C* C* PURPOSE: Calculate the heat transfer coefficient C* for fully developed laminar or turbulent C* flow in a tube. C*********************************************************************** C* INPUT VARIABLES C* MassFlux Mass flow rate per unit flow area (kg/m2 s) C* Diam Inside diameter of tube (m) C* Length Length of tube (m) C* Cp Specific heat of fluid (-) C* K Thermal conductivity of fluid (W/m C) C* DViscBulk Dynamic viscosity at bulk fluid temperature (kg/m s) C* DViscWall Dynamic viscosity at wall temperature (kg/m s) C* C* OUTPUT VARIABLES C* UTubConv Heat transfer coefficient (W/m2 C) C*********************************************************************** C MAJOR RESTRICTIONS: Fully developed flow in smooth tube C Prandtl number range from 0.6 to 100 C Properties evaluated at bulk temperature C except DViscWall C C DEVELOPER: Shauna Gabel C Michael J. Brandemuehl, PhD, PE C University of Colorado at Boulder C C DATE: January 1, 1992 C C INCLUDE FILES: None C SUBROUTINES CALLED: None C FUNCTIONS CALLED: None C C REVISION HISTORY: None C C REFERENCE: Sieder, E.N. and C.E. Tate. 1936. C Heat transfer and pressure drop of liquids C in tubes, Ind. Eng. Chem., Vol. 28. C*********************************************************************** C INTERNAL VARIABLES: C reynolds Reynold number (-) C nusselt Nusselt number (-) C prandtl Prandtl number (-) C reLamLim Reynolds number at upper limit for laminar flow (-) C reTurLim Reynolds number at lower limit for turbulent flow (-) C nuLamLim Nusselt number at upper limit for laminar flow (-) C nuTurLim Nusselt number at lower limit for turbulent flow (-) C*********************************************************************** REAL MassFlux,K,Length,nusselt,nuLamLim,nuTurLim DATA reLamLim/2000./, reTurLim/4000./ C1*** Calculate Reynold's number reynolds = MassFlux*Diam/DViscBulk prandtl = DViscBulk*Cp/K C1*** Calculate Nusselt number for laminar or turbulent flow IF (reynolds .LT. reLamLim) THEN C1*** Laminar flow. Use Sieder and Tate correlation for laminar flow param = reynolds*prandtl*Diam/Length IF(param.GT.10.) param=10. nusselt = 1.86*param**0.333333*(DViscBulk/DViscWall)**0.14 ELSE IF (reynolds .GT. reTurLim) THEN C1*** Flow is turbulent. Calculate Nusselt number using Sieder and Tate C1*** correlation for turbulent flow nusselt = 0.027*reynolds**0.8*Prandtl**0.333333 & *(DViscBulk/DViscWall)**0.14 ELSE C1*** Flow is transitional. Use a linear relationship C1*** between the convection coefficient for the turbulent and C1*** laminar cases param = reLamLim*prandtl*Diam/Length IF(param.GT.10.) param=10. nuLamLim = 1.86*param**0.333333*(DViscBulk/DViscWall)**0.14 nuTurLim = 0.027*reTurLim**0.8*prandtl**0.333333 & *(DViscBulk/DViscWall)**0.14 nusselt = nuLamLim + (reynolds-reLamLim)/(reTurLim-reLamLim) & *(nuTurLim-nuLamLim) ENDIF C1*** Calculate heat transfer coefficient from Nusselt number UTubConv = nusselt*K/Diam RETURN END REAL FUNCTION UFINCONV (MassFlux,Diam,FinHt,FinThick, & FinsPerM,Cp,K,DVisc) C*********************************************************************** C* Copyright ASHRAE. Toolkit for HVAC System Energy Calculations C*********************************************************************** C* FUNCTION: UFINCONV C* C* LANGUAGE: FORTRAN 77 C* C* PURPOSE: Calculate the convection heat transfer C* coefficient for a dry fin-tube surface. C*********************************************************************** C* INPUT VARIABLES C* MassFlux Mass flow per unit area (kg/s/m2) C* Diam Coil hydraulic diameter (m) C* FinHt Fin height (m) C* FinThick Fin thickness (m) C* FinPerM Fins per meter (1/m) C* Cp Specific heat of fluid (J/kg C) C* K Thermal conductivity of fluid (W/m C) C* DVisc Dynamic viscosity of fluid (kg/m s) C* C* OUTPUT VARIABLES C* UFinConv Dry fin surface convective coefficient (W/m2 C) C*********************************************************************** C MAJOR RESTRICTIONS: None C C DEVELOPER: Shauna Gabel C Michael J. Brandemuehl, PhD, PE C University of Colorado at Boulder C C DATE: January 1, 1992 C C INCLUDE FILES: None C SUBROUTINES CALLED: None C FUNCTIONS CALLED: None C C REVISION HISTORY: None C C REFERENCE: Elmahdy, A.H. and R.C. Biggs. 1979. C Finned tube heat exchanger: correlation C of dry surface heat transfer, ASHRAE C Transactions, Vol. 85, Part 2, 1979. C*********************************************************************** C INTERNAL VARIABLES: C c1,c2 Coefficients (-) C reynolds Reynolds number (-) C prandtl Prandtl number (-) C j Colburn heat transfer J-factor (-) C*********************************************************************** REAL MassFlux,K,j,FINHT,FINTHICK,FINSPERM,CP,DVISC,DIAM &PRANDTL DATA small/1.E-9/ C1*** Calculate dimensionless heat transfer parameters reynolds = MassFlux*Diam/DVisc IF( reynolds .LT. small) reynolds = small prandtl = DVisc*Cp/K C1*** Calculate Colburn j-factor coefficient C1 and C2 from regression c1 = 0.159*(Finthick/FinHt)**(0.141)* & (Diam/FinThick)**0.065 c2 = -0.323*(FinThick/FinHt)**0.049* & (1.0/(FinsPerM*FinThick))**0.077* & (Diam/RowSpace)**0.549 j = c1*reynolds**c2 C1*** Calculate dry surface convection coefficient UFinConv = MassFlux*Cp*j/(.7042)**0.6667 RETURN END REAL FUNCTION UFINWET (UFinDry,MassFlux) C*********************************************************************** C* Copyright ASHRAE. Toolkit for HVAC System Energy Calculations C*********************************************************************** C* FUNCTION: UFINWET C* C* LANGUAGE: FORTRAN 77 C* C* PURPOSE: Calculate the convection heat transfer C* coefficient for a wet fin-tube surface. C*********************************************************************** C* MUST USE SI UNITS! C*********************************************************************** C* INPUT VARIABLES C* UFinDry Dry fin surface convection coefficient (W/m2 C) C* MassFlux Mass flow per unit area (kg/s/m2) C* C* OUTPUT VARIABLES C* UFinWet Wet fin surface convective coefficient (W/m2 C) C*********************************************************************** C MAJOR RESTRICTIONS: None C C DEVELOPER: Shauna Gabel C Michael J. Brandemuehl, PhD, PE C University of Colorado at Boulder C C DATE: January 1, 1992 C C INCLUDE FILES: None C SUBROUTINES CALLED: None C FUNCTIONS CALLED: None C C REVISION HISTORY: None C C REFERENCE: Threlkeld, J.L. 1970. C Thermal Environmental Engineering, C 2nd Edition, Prentice-Hall, Englewood C Cliffs, NJ, pg. 263. C C Myers, R.J. 1967. The effects of C dehumidification on the air side heat C transfer coefficient for a finned-tube C coil. Masters thesis, University of C Minnesota, Minneapolis, MN. C*********************************************************************** C INTERNAL VARIABLES: C faceVel Standard face area velocity (m/s) C ipFaceVel Standard face area velocity (IP units) (ft/min) C stdRhoAir Density of air at standard T and P (kg/m3) C*********************************************************************** REAL MassFlux,ipFaceVel DATA stdRhoAir/1.204/ C1*** Calculate the standard-air face velocity faceVel = MassFlux/stdRhoAir C2*** Convert from SI to IP units ipFaceVel = faceVel/0.3048*60. C1*** Calculate the wet surface coefficient UFinWet = UFinDry*0.626*(ipFaceVel)**0.101 RETURN END REAL FUNCTION FINEFF (SurfCoeff,DiamFin,FinThick,FinCond,OdTube) C*********************************************************************** C* Copyright ASHRAE. Toolkit for HVAC System Energy Calculations C*********************************************************************** C* SUBROUTINE: FINEFF C* C* LANGUAGE: FORTRAN 77 C* C* PURPOSE: Calculate fin efficiency. C*********************************************************************** C* INPUT VARIABLES C* SurfCoeff Surface convection coefficient (W/m2 C) C* DiamFin Fin diameter (m) C* FinThick Fin thickness (m) C* FinCond Fin conductivity (W/m C) C* OdTube Outside diameter of tube (m) C* C* OUTPUT VARIABLES C* FinEff Fin efficiency (-) C*********************************************************************** C MAJOR RESTRICTIONS: Circular fin of uniform thickness C C DEVELOPER: Shauna Gabel C Michael J. Brandemuehl, PhD, PE C University of Colorado at Boulder C C DATE: January 1, 1992 C C INCLUDE FILES: None C SUBROUTINES CALLED: BESSEL C FUNCTIONS CALLED: None C C REVISION HISTORY: None C C REFERENCE: Elmahdy,A.H. & Biggs,R.C., "Efficiency of C Extended Surfaces with Simultaneous Heat C and Mass Transfer," ASHRAE Transactions, C Vol.89, Part 1A, (1983). C*********************************************************************** C* INTERNAL VARIABLES: C* rRat Radius at fin base/radius at fin tip (-) C* f1 Fin efficiency parameter (-) C* f2 Product of rRat and F1 (-) C*********************************************************************** C1*** Calculate fin efficiency parameters rRat = OdTube/DiamFin f1 = 0.5*DiamFin*SQRT(2.*SurfCoeff/FinCond/FinThick) f2 = rRat*f1 C1*** Evaluate Bessel functions for fin efficiency calculations CALL BESSEL (f2,XI0,XI1,XK0,XK1) CALL BESSEL (f1,YI0,YI1,YK0,YK1) C1*** Calculate fin efficiency FinEff = 2.*rRat/f1/(1.-rRat**2)*(XK1*YI1-XI1*YK1)/ & (XK0*YI1+XI0*YK1) RETURN END REAL FUNCTION DEWPOINT (Prop,W) C*********************************************************************** C* Copyright ASHRAE. Toolkit for HVAC System Energy Calculations C*********************************************************************** C* FUNCTION: DEWPOINT C* C* LANGUAGE: FORTRAN 77 C* C* PURPOSE: Calculate the dewpoint temperature given C* humidity ratio C*********************************************************************** C* INPUT VARIABLES C* W Humidity ratio (-) C* C* OUTPUT VARIABLES C* DewPoint Dew point temperature of air (C) C* C* PROPERTIES C* Patm Atmospheric pressure (Pa) C*********************************************************************** C MAJOR RESTRICTIONS: None C C DEVELOPER: Michael J. Brandemuehl, PhD, PE C University of Colorado at Boulder C C DATE: January 1, 1992 C C INCLUDE FILES: prop.inc C SUBROUTINES CALLED: None C FUNCTIONS CALLED: None C C REVISION HISTORY: None C C REFERENCE: 1989 ASHRAE Handbook - Fundamentals C*********************************************************************** C INTERNAL VARIABLES: C pw Partial water vapor pressure (Pa) C small Small number C*********************************************************************** INTEGER Patm,CpAir,CpWat,CpLiq,CpVap,DViscAir, & DViscLiq,KAir,KLiq,RhoLiq,Hfg,RAir, & TKelMult,TAbsAdd,PaMult,PAbsAdd REAL Prop(16) PARAMETER (Patm = 1) PARAMETER (CpAir = 2) PARAMETER (CpWat = 3) PARAMETER (CpVap = 4) PARAMETER (CpLiq = 5) PARAMETER (DViscAir = 6) PARAMETER (DViscLiq = 7) PARAMETER (KAir = 8) PARAMETER (KLiq = 9) PARAMETER (RhoLiq = 10) PARAMETER (Hfg = 11) PARAMETER (RAir = 12) PARAMETER (TKelMult = 13) PARAMETER (TAbsAdd = 14) PARAMETER (PaMult = 15) PARAMETER (PAbsAdd = 16) DATA small/1.E-9/ C1*** Test for "dry" air IF (W .LT. small) THEN DewPoint = -999 ELSE C1*** Calculate the partial water vapor pressure as a function of C1*** humidity ratio. pw= Prop(Patm)*W/(.62198+W) C1*** Calculate dewpoint as saturation temperature at water vapor C1*** partial pressure DewPoint = SATTEMP(Prop,pw) ENDIF 999 RETURN END REAL FUNCTION DRYBULB (Prop,H,W) C*********************************************************************** C* Copyright ASHRAE. Toolkit for HVAC System Energy Calculations C*********************************************************************** C* FUNCTION: DRYBULB C* C* LANGUAGE: FORTRAN 77 C* C* PURPOSE: Calculate the dry bulb temperature of C* moist air from enthalpy and humidity. C*********************************************************************** C* INPUT VARIABLES: C* H Enthalpy (J/kg) C* W Humidity ratio (-) C* C* OUTPUT VARIABLES: C* Drybulb Dry bulb temperature (C) C* C* PROPERTIES: C* CpAir Specific heat of air (J/kg C) C* CpVap Specific heat of water vapor (J/kg C) C* Hfg Reference heat of vaporization of water (J/kg) C*********************************************************************** C MAJOR RESTRICTIONS: Uses perfect gas relationships C Fit for enthalpy of saturated water vapor C C DEVELOPER: Shauna Gabel C Michael J. Brandemuehl, PhD, PE C University of Colorado at Boulder C C DATE: January 1, 1992 C C INCLUDE FILES: PROP.INC C SUBROUTINES CALLED: None C FUNCTIONS CALLED: None C C REVISION HISTORY: None C C REFERENCE: 1989 ASHRAE Handbook - Fundamentals C*********************************************************************** INTEGER Patm,CpAir,CpWat,CpLiq,CpVap,DViscAir, & DViscLiq,KAir,KLiq,RhoLiq,Hfg,RAir, & TKelMult,TAbsAdd,PaMult,PAbsAdd REAL Prop(16) PARAMETER (Patm = 1) PARAMETER (CpAir = 2) PARAMETER (CpWat = 3) PARAMETER (CpVap = 4) PARAMETER (CpLiq = 5) PARAMETER (DViscAir = 6) PARAMETER (DViscLiq = 7) PARAMETER (KAir = 8) PARAMETER (KLiq = 9) PARAMETER (RhoLiq = 10) PARAMETER (Hfg = 11) PARAMETER (RAir = 12) PARAMETER (TKelMult = 13) PARAMETER (TAbsAdd = 14) PARAMETER (PaMult = 15) PARAMETER (PAbsAdd = 16) C1*** Calculate the dry bulb temperature as a function of enthalpy and C1*** humidity ratio. C2*** hDryAir = Prop(CpAir)*TDB C2*** hSatVap = Prop(Hfg) + Prop(CpVap)*TDB C2*** Enthalpy = hDryAir + W*hSatVap Drybulb = (H-Prop(Hfg)*W)/(Prop(CpAir)+Prop(CpVap)*W) RETURN END REAL FUNCTION ENTHALPY (Prop,TDB,W) C*********************************************************************** C* Copyright ASHRAE. Toolkit for HVAC System Energy Calculations C*********************************************************************** C* FUNCTION: ENTHALPY C* C* LANGUAGE: FORTRAN 77 C* C* PURPOSE: Calculate the enthalpy of moist air. C*********************************************************************** C* INPUT VARIABLES: C* TDB Dry bulb temperature (C) C* W Humidity ratio (-) C* C* OUTPUT VARIABLES: C* Enthalpy Enthalpy of moist air (J/kg) C* C* PROPERTIES: C* CpAir Specific heat of air (J/kg C) C* CpVap Specific heat of water vapor (J/kg C) C* Hfg Reference heat of vaporization of water (J/kg) C*********************************************************************** C MAJOR RESTRICTIONS Uses perfect gas relationships C Fit for enthalpy of saturated water vapor C C DEVELOPER: Shauna Gabel C Michael J. Brandemuehl, PhD, PE C University of Colorado at Boulder C C DATE: January 1, 1992 C C INCLUDE FILES: PROP.INC C SUBROUTINES CALLED: None C FUNCTIONS CALLED: None C C REVISION HISTORY: None C C REFERENCE: 1989 ASHRAE Handbook - Fundamentals C*********************************************************************** INTEGER Patm,CpAir,CpWat,CpLiq,CpVap,DViscAir, & DViscLiq,KAir,KLiq,RhoLiq,Hfg,RAir, & TKelMult,TAbsAdd,PaMult,PAbsAdd REAL Prop(16) PARAMETER (Patm = 1) PARAMETER (CpAir = 2) PARAMETER (CpWat = 3) PARAMETER (CpVap = 4) PARAMETER (CpLiq = 5) PARAMETER (DViscAir = 6) PARAMETER (DViscLiq = 7) PARAMETER (KAir = 8) PARAMETER (KLiq = 9) PARAMETER (RhoLiq = 10) PARAMETER (Hfg = 11) PARAMETER (RAir = 12) PARAMETER (TKelMult = 13) PARAMETER (TAbsAdd = 14) PARAMETER (PaMult = 15) PARAMETER (PAbsAdd = 16) C1*** Calculate the enthalpy as a function of dry bulb temperature and C1*** humidity ratio. hDryAir = Prop(CpAir)*TDB hSatVap = Prop(Hfg) + Prop(CpVap)*TDB Enthalpy = hDryAir + W*hSatVap RETURN END REAL FUNCTION ENTHSAT (Prop,TDB) C*********************************************************************** C* Copyright ASHRAE. Toolkit for HVAC System Energy Calculations C*********************************************************************** C* FUNCTION: ENTHSAT C* C* LANGUAGE: FORTRAN 77 C* C* PURPOSE: Calculate the enthalpy at saturation C* for given dry bulb temperature C*********************************************************************** C* INPUT VARIABLES C* TDB Dry bulb temperature (C) C* C* OUTPUT VARIABLES C* EnthSat Enthalpy at saturation (J/kg) C* C* PROPERTIES C* Patm Atmospheric pressure (Pa) C*********************************************************************** C MAJOR RESTRICTIONS: None C C DEVELOPER: Shauna Gabel C Michael J. Brandemuehl, PhD, PE C University of Colorado at Boulder C C DATE: January 1, 1992 C C INCLUDE FILES: PROP.INC C SUBROUTINES CALLED: None C FUNCTIONS CALLED: SATPRESS C HUMRATIO C ENTHALPY C C REVISION HISTORY: None C C REFERENCE: 1989 ASHRAE Handbook - Fundamentals C*********************************************************************** C INTERNAL VARIABLES: C psat Saturated water vapor pressure (Pa) C w Humidity ratio (-) C*********************************************************************** INTEGER Patm,CpAir,CpWat,CpLiq,CpVap,DViscAir, & DViscLiq,KAir,KLiq,RhoLiq,Hfg,RAir, & TKelMult,TAbsAdd,PaMult,PAbsAdd REAL Prop(16) PARAMETER (Patm = 1) PARAMETER (CpAir = 2) PARAMETER (CpWat = 3) PARAMETER (CpVap = 4) PARAMETER (CpLiq = 5) PARAMETER (DViscAir = 6) PARAMETER (DViscLiq = 7) PARAMETER (KAir = 8) PARAMETER (KLiq = 9) PARAMETER (RhoLiq = 10) PARAMETER (Hfg = 11) PARAMETER (RAir = 12) PARAMETER (TKelMult = 13) PARAMETER (TAbsAdd = 14) PARAMETER (PaMult = 15) PARAMETER (PAbsAdd = 16) C1*** Calculate the saturation pressure at the given temperature. psat = SATPRESS (Prop,TDB) C1*** Calculate the humidity ratio from the saturation pressure w = HUMRATIO (Prop(Patm),psat) C1*** Calculate the enthalpy as a function of dry bulb temperature C1*** and humidity ratio. ENTHSAT = ENTHALPY (Prop,TDB,w) RETURN END REAL FUNCTION HUMRATIO (Patm,Pw) C*********************************************************************** C* Copyright ASHRAE. Toolkit for HVAC System Energy Calculations C*********************************************************************** C* FUNCTION: HUMRATIO C* C* LANGUAGE: FORTRAN 77 C* C* PURPOSE: Calculate the humidity ratio from water C* vapor pressure and atmospheric pressure C*********************************************************************** C* INPUT VARIABLES C* Patm Atmospheric pressure (Pa) C* Pw Partial water vapor pressure (Pa) C* C* OUTPUT VARIABLES C* HumRatio Humidity ratio (-) C*********************************************************************** C MAJOR RESRICTIONS: None C C DEVELOPER: Shauna Gabel C Michael J. Brandemuehl, PhD, PE C University of Colorado at Boulder C C DATE: January 1, 1992 C C INCLUDE FILES: None C SUBROUTINES CALLED: None C FUNCTIONS CALLED: None C C REVISION HISTORY: None C C REFERENCE: 1989 ASHRAE Handbook - Fundamentals C************************************************************************ C1*** Calculate the humidity ratio. HumRatio = 0.62198*Pw/(Patm-Pw) RETURN END REAL FUNCTION HUMTH (Prop,TDB,H) C*********************************************************************** C* Copyright ASHRAE. Toolkit for HVAC System Energy Calculations C*********************************************************************** C* FUNCTION: HUMTH C* C* LANGUAGE: FORTRAN 77 C* C* PURPOSE: Calculate the humidity ratio of moist air C* from dry bulb temperature and enthalpy. C*********************************************************************** C* INPUT VARIABLES: C* H Enthalpy (J/kg) C* TDB Dry bulb temperature (C) C* C* OUTPUT VARIABLES: C* HumTH Humidity ratio (-) C* C* PROPERTIES: C* CpAir Specific heat of air (J/kg C) C* CpVap Specific heat of water vapor (J/kg C) C* Hfg Reference heat of vaporization of water (J/kg) C*********************************************************************** C MAJOR RESTRICTIONS: Uses perfect gas relationships C Fit for enthalpy of saturated water vapor C C DEVELOPER: Shauna Gabel C Michael J. Brandemuehl, PhD, PE C University of Colorado at Boulder C C DATE: January 1, 1992 C C INCLUDE FILES: prop.inc C SUBROUTINES CALLED: None C FUNCTIONS CALLED: None C C REVISION HISTORY: None C C REFERENCE: 1989 ASHRAE Handbook - Fundamentals C*********************************************************************** INTEGER Patm,CpAir,CpWat,CpLiq,CpVap,DViscAir, & DViscLiq,KAir,KLiq,RhoLiq,Hfg,RAir, & TKelMult,TAbsAdd,PaMult,PAbsAdd REAL Prop(16) PARAMETER (Patm = 1) PARAMETER (CpAir = 2) PARAMETER (CpWat = 3) PARAMETER (CpVap = 4) PARAMETER (CpLiq = 5) PARAMETER (DViscAir = 6) PARAMETER (DViscLiq = 7) PARAMETER (KAir = 8) PARAMETER (KLiq = 9) PARAMETER (RhoLiq = 10) PARAMETER (Hfg = 11) PARAMETER (RAir = 12) PARAMETER (TKelMult = 13) PARAMETER (TAbsAdd = 14) PARAMETER (PaMult = 15) PARAMETER (PAbsAdd = 16) C1*** Calculate humidity ratio from dry bulb temperature and enthalpy C2*** hDryAir = Prop(CpAir)*TDB C2*** hSatVap = Prop(Hfg) + Prop(CpVap)*TDB C2*** Enthalpy = hDryAir + W*hSatVap HumTH = (H-Prop(CpAir)*TDB)/(Prop(Hfg)+Prop(CpVap)*TDB) RETURN END REAL FUNCTION RELHUM (Patm,Psat,HumRatio) C*********************************************************************** C* Copyright ASHRAE. Toolkit for HVAC System Energy Calculations C*********************************************************************** C* FUNCTION: RELHUM C* C* LANGUAGE: FORTRAN 77 C* C* PURPOSE: Calculate the relative humidity from C* saturation and atmospheric pressures C*********************************************************************** C* INPUT VARIABLES C* Patm Atmospheric pressure (Pa) C* Psat Saturation pressure (Pa) C* HumRatio Humidity ratio (-) C* C* OUTPUT VARIABLES C* RelHum Relative humidity (-) C****** ****************************************************************** C MAJOR RESTRICTIONS: None C C DEVELOPER: Shauna Gabel C Michael J. Brandemuehl, PhD, PE C University of Colorado at Boulder C C DATE: January 1, 1992 C C INCLUDE FILES: None C SUBROUTINES CALLED: None C FUNCTIONS CALLED: None C C REVISION HISTORY: None C C REFERENCE: 1989 ASHRAE Handbook - Fundamentals C*********************************************************************** C INTERNAL VARIABLES: C pw Partial water vapor pressure (Pa) C*********************************************************************** C1*** Calculate the partial water vapor pressure as a function of C1*** humidity ratio. pw = Patm*HumRatio/(.62198+HumRatio) C1*** Calculate the relative humidity as a function of partial water C1*** vapor pressure and water vapor pressure at saturation. RelHum = pw/Psat RETURN END REAL FUNCTION RHODRY (Prop,TDB,W) C*********************************************************************** C* Copyright ASHRAE. Toolkit for HVAC System Energy Calculations C*********************************************************************** C* FUNCTION: RHODRY C* C* LANGUAGE: FORTRAN 77 C* C* PURPOSE: Calculate dry air density. C*********************************************************************** C* INPUT VARIABLES C* TDB Dry bulb temperature (C) C* W Humidity ratio (-) C* C* OUTPUT VARIABLES C* RhoDry Density of dry air (kg/m3) C* C* PROPERTIES C* Patm Atmospheric pressure (Pa) C* RAir Gas constant for air (J/kg C) C* TAbsAdd Additive constant to convert user T to absolute T C*********************************************************************** C MAJOR RESTRICTIONS: Perfect gas relationships C C DEVELOPER: Shauna Gabel C Michael J. Brandemuehl, PhD, PE C University of Colorado at Boulder C C DATE: January 1, 1992 C C INCLUDE FILES: prop.inc C SUBROUTINES CALLED: None C FUNCTIONS CALLED: None C C REVISION HISTORY: None C C REFERENCE: 1989 ASHRAE Handbook - Fundamentals C*********************************************************************** C INTERNAL VARIABLES: C pAir Partial pressure of dry air (Pa) C*********************************************************************** INTEGER Patm,CpAir,CpWat,CpLiq,CpVap,DViscAir, & DViscLiq,KAir,KLiq,RhoLiq,Hfg,RAir, & TKelMult,TAbsAdd,PaMult,PAbsAdd REAL Prop(16) PARAMETER (Patm = 1) PARAMETER (CpAir = 2) PARAMETER (CpWat = 3) PARAMETER (CpVap = 4) PARAMETER (CpLiq = 5) PARAMETER (DViscAir = 6) PARAMETER (DViscLiq = 7) PARAMETER (KAir = 8) PARAMETER (KLiq = 9) PARAMETER (RhoLiq = 10) PARAMETER (Hfg = 11) PARAMETER (RAir = 12) PARAMETER (TKelMult = 13) PARAMETER (TAbsAdd = 14) PARAMETER (PaMult = 15) PARAMETER (PAbsAdd = 16) C1*** Calculate the dry air density from perfect gas laws. pAir = 0.62198*Prop(Patm)/(0.62198+W) RhoDry = pAir/Prop(RAir)/(TDB+Prop(TAbsAdd)) RETURN END REAL FUNCTION RHOMOIST (RhoDry,W) C*********************************************************************** C* Copyright ASHRAE. Toolkit for HVAC System Energy Calculations C*********************************************************************** C* FUNCTION: RHOMOIST C* C* LANGUAGE: FORTRAN 77 C* C* PURPOSE: Calculate moist air density from dry air C* density and humidity ratio C*********************************************************************** C* INPUT VARIABLES: C* RhoDry Dry air density (kg/m3) C* W Humidity ratio (-) C* C* OUTPUT VARIABLES: C* RhoMoist Density of dry air (kg/m3) C*********************************************************************** C MAJOR RESTRICTIONS: None C C DEVELOPER: Shauna Gabel C Michael J. Brandemuehl, PhD, PE C University of Colorado at Boulder C C DATE: January 1, 1992 C C INCLUDE FILES: None C SUBROUTINES CALLED: None C FUNCTIONS CALLED: None C C REVISION HISTORY: None C C REFERENCE: 1989 ASHRAE Handbook - Fundamentals C************************************************************************ C1*** Calculate the moist air density RhoMoist = RhoDry*(1.+W) RETURN END REAL FUNCTION SATPRESS (Prop,T) C*********************************************************************** C* Copyright ASHRAE. Toolkit for HVAC System Energy Calculations C*********************************************************************** C* SUBROUTINE: SATPRESS C* C* LANGUAGE: FORTRAN 77 C* C* PURPOSE: Calculate saturation pressure of water C* vapor as a function of temperature C*********************************************************************** C* INPUT VARIABLES C* T Temperature (C) C* C* OUTPUT VARIABLES C* SatPress Saturation pressure (Pa) C* C* PROPERTIES C* TKelMult Multiplying factor to convert user T to Kelvin C* TAbsAdd Additive factor to convert user T to absolute T C* tKel = Prop(TKelMult) * (T + Prop(TAbsAdd)) C* PaMult Multiplying factor to convert user P to Pascals C* PAbsAdd Additive factor to convert user P to absolute P C* Pa = Prop(PaMult) * (P + Prop(PAbsAdd)) C*********************************************************************** C MAJOR RESTRICTIONS: 173.16 K <= Temp <= 473.15 K C C DEVELOPER: Shauna Gabel C Michael J. Brandemuehl, PhD, PE C University of Colorado at Boulder C C DATE: January 1, 1992 C C INCLUDE FILES: prop.inc C SUBROUTINES CALLED: None C FUNCTIONS CALLED: None C C REVISION HISTORY: None C C REFERENCE: 1989 ASHRAE Handbook - Fundamentals C C Hyland, R.W., and A. Wexler. 1983. C Formulations for the thermodynamic C properties of the saturated phases of H2O C from 173.15 K to 473.15 K. ASHRAE C Transactions, Vol. 89, No. 2A, pp. 500-519 C*********************************************************************** C INTERNAL VARIABLES: C tKel Temperature in Kelvin (K) C pascals Saturation pressure (Pa) C*********************************************************************** INTEGER Patm,CpAir,CpWat,CpLiq,CpVap,DViscAir, & DViscLiq,KAir,KLiq,RhoLiq,Hfg,RAir, & TKelMult,TAbsAdd,PaMult,PAbsAdd REAL Prop(16) PARAMETER (Patm = 1) PARAMETER (CpAir = 2) PARAMETER (CpWat = 3) PARAMETER (CpVap = 4) PARAMETER (CpLiq = 5) PARAMETER (DViscAir = 6) PARAMETER (DViscLiq = 7) PARAMETER (KAir = 8) PARAMETER (KLiq = 9) PARAMETER (RhoLiq = 10) PARAMETER (Hfg = 11) PARAMETER (RAir = 12) PARAMETER (TKelMult = 13) PARAMETER (TAbsAdd = 14) PARAMETER (PaMult = 15) PARAMETER (PAbsAdd = 16) DATA C1/-5674.5359/,C2/6.3925247/,C3/-0.9677843E-2/ DATA C4/0.62215701E-6/,C5/0.20747825E-8/,C6/-0.9484024E-12/ DATA C7/4.1635019/,C8/-5800.2206/,C9/1.3914993/,C10/-0.048640239/ DATA C11/0.41764768E-4/,C12/-0.14452093E-7/,C13/6.5459673/ C1*** Convert temperature from user units to Kelvin. tKel = Prop(TKelMult)*(T+Prop(TAbsAdd)) C1*** If below freezing, calculate saturation pressure over ice. IF (tKel .LT. 273.15) THEN pascals = EXP(C1/tKel+C2+C3*tKel+C4*tKel**2+C5*tKel**3+C6* & tKel**4+C7*ALOG(tKel)) C1*** If above freezing, calculate saturation pressure over liquid water. ELSE IF (tKel .GE. 273.15) THEN pascals = EXP(C8/tKel+C9+C10*tKel+C11*tKel**2+C12*tKel**3+C13 & *ALOG(tKel)) ENDIF C1*** Convert pressure from Pascals to user units SatPress = pascals/Prop(PaMult) - Prop(PAbsAdd) RETURN END REAL FUNCTION SATTEMP (Prop,P) C*********************************************************************** C* Copyright ASHRAE. Toolkit for HVAC System Energy Calculations C*********************************************************************** C* FUNCTION: SATTEMP C* C* LANGUAGE: FORTRAN 77 C* C* PURPOSE: Calculate the saturation (boiling) C* temperature of water given pressure C*********************************************************************** C* INPUT VARIABLES C* P Pressure (Pa) C* C* OUTPUT VARIABLES C* SatTemp Saturation temperature of water vapor (C) C*********************************************************************** C MAJOR RESTRICTIONS: None C C DEVELOPER: Shauna Gabel C Michael J. Brandemuehl, PhD, PE C University of Colorado at Boulder C C DATE: January 1, 1992 C C INCLUDE FILES: prop.inc C SUBROUTINES CALLED: None C FUNCTIONS CALLED: SATPRESS C XITERATE C C REVISION HISTORY: None C C REFERENCE: 1989 ASHRAE Handbook - Fundamentals C*********************************************************************** C INTERNAL VARIABLES: C tSat Water temperature guess (C) C pSat Pressure corresponding to temp. guess (Pa) C error Deviation of dependent variable in iteration C iter Iteration counter C icvg Iteration convergence flag C F1,F2 Previous values of dependent variable in XITERATE C X1,X2 Previous values of independent variable in XITERATE C*********************************************************************** DATA itmax/50/ INTEGER Patm,CpAir,CpWat,CpLiq,CpVap,DViscAir, & DViscLiq,KAir,KLiq,RhoLiq,Hfg,RAir, & TKelMult,TAbsAdd,PaMult,PAbsAdd REAL Prop(16) PARAMETER (Patm = 1) PARAMETER (CpAir = 2) PARAMETER (CpWat = 3) PARAMETER (CpVap = 4) PARAMETER (CpLiq = 5) PARAMETER (DViscAir = 6) PARAMETER (DViscLiq = 7) PARAMETER (KAir = 8) PARAMETER (KLiq = 9) PARAMETER (RhoLiq = 10) PARAMETER (Hfg = 11) PARAMETER (RAir = 12) PARAMETER (TKelMult = 13) PARAMETER (TAbsAdd = 14) PARAMETER (PaMult = 15) PARAMETER (PAbsAdd = 16) C1*** Use an iterative process to determine the saturation temperature C1*** at a given pressure using a correlation of saturated water vapor C1*** pressure as a function of temperature C1*** Initial guess of boiling temperature tSat = 100. C1*** Iterate to find the saturation temperature C1*** of water given the total pressure C2*** Set iteration loop parameters DO 100 iter = 1,itmax C1*** Calculate saturation pressure for estimated boiling temperature pSat = SATPRESS(Prop,tSat) C1*** Compare with specified pressure and update estimate of temperature error = P - pSat tSat = XITERATE (tSat,error,X1,F1,X2,F2,iter,icvg) C2*** If converged leave loop iteration IF (icvg .EQ. 1) GO TO 110 C2*** Water temperature not converged, repeat calculations with new C2*** estimate of water temperature 100 CONTINUE C1*** Saturation temperature has not converged after maximum specified C1*** iterations. Print error message, set return error flag, and RETURN WRITE(LUW,1001) itmax 1001 FORMAT(/1X,'*** ERROR IN FUNCTION SatTemp ***'/ & 1X,' Saturation temperature has not ' & 'converged after ',I2,' iterations'/) 110 SatTemp = tSat RETURN END REAL FUNCTION TAIRSAT (Prop,HSat) C*********************************************************************** C* Copyright ASHRAE. Toolkit for HVAC System Energy Calculations C*********************************************************************** C* FUNCTION: ENTHSAT C* C* LANGUAGE: FORTRAN 77 C* C* PURPOSE: Calculate the dry bulb temperature given C* enthalpy at saturation. C*********************************************************************** C* INPUT VARIABLES: C* HSat Enthalpy at saturation (J/kg) C* C* OUTPUT VARIABLES: C* TAirSat Dry bulb temperature (C) C*********************************************************************** C MAJOR RESTRICTIONS: None C C DEVELOPER: Michael J. Brandemuehl, PhD, PE C University of Colorado at Boulder C C DATE: January 1, 1992 C C INCLUDE FILES: prop.inc C SUBROUTINES CALLED: None C FUNCTIONS CALLED: ENTHSAT C C REVISION HISTORY: None C C REFERENCE: 1989 ASHRAE Handbook - Fundamentals C*********************************************************************** C INTERNAL VARIABLES: C error Deviation of dependent variable in iteration C iter Iteration counter C icvg Iteration convergence flag C F1,F2 Previous values of dependent variable in XITERATE C X1,X2 Previous values of independent variable in XITERATE C*********************************************************************** INTEGER Patm,CpAir,CpWat,CpLiq,CpVap,DViscAir, & DViscLiq,KAir,KLiq,RhoLiq,Hfg,RAir, & TKelMult,TAbsAdd,PaMult,PAbsAdd REAL Prop(16) PARAMETER (Patm = 1) PARAMETER (CpAir = 2) PARAMETER (CpWat = 3) PARAMETER (CpVap = 4) PARAMETER (CpLiq = 5) PARAMETER (DViscAir = 6) PARAMETER (DViscLiq = 7) PARAMETER (KAir = 8) PARAMETER (KLiq = 9) PARAMETER (RhoLiq = 10) PARAMETER (Hfg = 11) PARAMETER (RAir = 12) PARAMETER (TKelMult = 13) PARAMETER (TAbsAdd = 14) PARAMETER (PaMult = 15) PARAMETER (PAbsAdd = 16) DATA itmax/20/,tSat/50./ C1*** Estimate saturation temperature if reasonable value not available IF(tSat .LT. -200. .OR. tSat .GT. 1000.) tSat = 50. C1*** Calculate saturation temperature by iteration using function to C1*** calculate saturation enthalpy from temperature DO 100 iter=1,itmax error = HSat - ENTHSAT(Prop,tSat) tSat = XITERATE(tSat,error,X1,F1,X2,F2,iter,icvg) C1*** If converged, leave iteration loop. IF (icvg .EQ. 1) GO TO 110 C1*** Temperature not converged, repeat calculation with new C1*** estimate of temperature. 100 CONTINUE C1*** Temperature has not converged after maximum specified C1*** iterations. Print error message and RETURN WRITE(LUW,1001) itmax 1001 FORMAT(/1X,'*** ERROR IN FUNCTION TAIRSAT ***'/ & 1X,' Temperature has not ' & 'converged after ',I2,' iterations'/) 110 CONTINUE TAirSat = tSat RETURN END REAL FUNCTION WETBULB (Prop,TDB,W) C*********************************************************************** C* Copyright ASHRAE. Toolkit for HVAC System Energy Calculations C*********************************************************************** C* FUNCTION: WETBULB C* C* LANGUAGE: FORTRAN 77 C* C* PURPOSE: Calculate wet bulb temperature from dry C* bulb temperature and humidity ratio C*********************************************************************** C* INPUT VARIABLES C* TDB Dry bulb temperature (C) C* W Humidity ratio of air (-) C* C* OUTPUT VARIABLES C* WetBulb Wet bulb temperature (C) C* C* PROPERTIES: C* Patm Atmospheric pressure (Pa) C* Hfg Latent heat of vaporization of water (J/kg) C* CpAir Specific heat of air (J/kg C) C* CpVap Specific heat of water vapor (J/kg C) C* CpWat Specific heat of water (J/kg C) INTEGER Patm,CpAir,CpWat,CpLiq,CpVap,DViscAir, & DViscLiq,KAir,KLiq,RhoLiq,Hfg,RAir, & TKelMult,TAbsAdd,PaMult,PAbsAdd REAL Prop(16) PARAMETER (Patm = 1) PARAMETER (CpAir = 2) PARAMETER (CpWat = 3) PARAMETER (CpVap = 4) PARAMETER (CpLiq = 5) PARAMETER (DViscAir = 6) PARAMETER (DViscLiq = 7) PARAMETER (KAir = 8) PARAMETER (KLiq = 9) PARAMETER (RhoLiq = 10) PARAMETER (Hfg = 11) PARAMETER (RAir = 12) PARAMETER (TKelMult = 13) PARAMETER (TAbsAdd = 14) PARAMETER (PaMult = 15) PARAMETER (PAbsAdd = 16) REAL newW DATA itmax/20/ C1*** Initial temperature guess tBoil = SATTEMP (Prop,Prop(Patm)) WetBulb = MAX( MIN(WetBulb,TDB,(tBoil-0.1)), 0.) C1*** Begin iteration loop DO 100 iter = 1,itmax IF (WetBulb .GE. (tBoil-0.09) ) WETBULB = tBoil-0.1 C1*** Determine the saturation pressure for wet bulb temperature psatStar = SATPRESS (Prop,WetBulb) C1*** Determine humidity ratio for given saturation pressure wStar = HUMRATIO (Prop(Patm),psatStar) C1*** Calculate new humidity ratio and determine difference from known C1*** humidity ratio newW = ((Prop(Hfg)-(Prop(CpWat)-Prop(CpVap))*WetBulb)*wStar- & Prop(CpAir)*(TDB-WetBulb))/(Prop(Hfg)+Prop(CpVap)*TDB & -Prop(CpWat)*WetBulb) C1*** Check error, if not satisfied, calculate new guess and iterate error = W-newW WetBulb = XITERATE(WetBulb,error,X1,F1,X2,F2,iter,icvg) C1*** If converged, leave iteration loop. IF (icvg .EQ. 1) GO TO 900 C1*** Wet bulb temperature not converged, repeat calculation with new C1*** estimate of wet bulb temperature. 100 CONTINUE C1*** Wet bulb temperature has not converged after maximum specified C1*** iterations. Print error message, set return error flag, and RETURN WRITE(LUW,1009) itmax 1009 FORMAT(/1X,'*** ERROR IN FUNCTION WetBulb ***'/ & 1X,' Wet bulb temperature has not ' & 'converged after ',I2,' iterations'/) 900 IF (WetBulb .GT. TDB) WetBulb = TDB 999 RETURN END