SUBROUTINE TYPE59(TIME,XIN,OUT,T,DTDT,PAR,INFO,ICNTRL,*) C*********************************************************************** C* Copyright ASHRAE. Toolkit for HVAC System Energy Calculations C*********************************************************************** C* SUBROUTINE: FANDET C* C* LANGUAGE: FORTRAN 77 C* C* PURPOSE: Calculate the performance of a fan given C* the entering fluid conditions and mass C* flow rate. Results include leaving fluid C* pressure, temperature, and humidity and C* the fan energy consumption. Calculations C* are based on regression fits to fan head C* and efficiency versus dimensionless flow. C* Uses fan laws as necessary. C*********************************************************************** C* INPUT VARIABLES DESCRIPTION(UNITS) SAMPLE VALUES C* XIN(1) M Dry air mass flow rate(kg/s) 5.0 C* XIN(2) PEnt Entering pressure(Pa) 0.0 C* XIN(3) TEnt Entering temperature(C) 25.0 C* XIN(4) WEnt Entering humidity ratio(-) .01 C* XIN(5) Speed Rotation speed(Hz) 15.0 C* C* Note: If M<0, TEnt and WEnt are assumed to be fan outlet air C* conditions, TLvg and WLvg are calculated inlet conditions C* C* OUTPUT VARIABLES C* OUT(1) PLvg Leaving pressure(Pa) 617.830 C* OUT(2) TLvg Leaving temperature(C) 26.5646 C* OUT(3) WLvg Leaving humidity ratio(-) .01 C* OUT(4) Power Power consumption(W) 9424.73 C* OUT(5) ErrStat Error flag, 0=ok, 1=error 0.0 C* C* PARAMETERS C* PAR(1) DiamWheel Diameter of impeller(m) .76 C* PAR(2) EffMot Motor drive efficiency(-) .85 C* PAR(3) MotorLoss Fraction of motor loss to fluid stream(-) 0.0 C* Coef(i)Head Array of coefficients for head vs flow curve C* head=coef0+coef1*flow+coef2*flow**2+coef3*flow**3+coef4*flow**4 C* PAR(4) COEF(0)HEAD 3.64 C* PAR(5) COEF(1)HEAD .801 C* PAR(6) COEF(2)HEAD -.19 C* PAR(7) COEF(3)HEAD -.00445 C* PAR(8) COEF(4)HEAD 0.0 C* C* Coef(i)Eff Array of coefficients for efficiency curve C* eff=coef0+coef1*flow+coef2*flow**2+coef3*flow**3+coef4*flow**4 C* PAR(9) COEF(0)EFF 0.0 C* PAR(10) COEF(1)EFF .564 C* PAR(11) COEF(2)EFF -.0862 C* PAR(12) COEF(3)EFF 0.0 C* PAR(13) COEF(4)EFF 0.0 C* C* PROPERTIES C* CpAir Specific heat of dry air (J/kg C) C* CpVap Specific heat of water vapor (J/kg C) C*********************************************************************** C MAJOR RESTRICTIONS: Assumes fan obeys fan laws C C DEVELOPER: Michael J. Brandemuehl, PhD, PE C University of Colorado at Boulder C C DATE: January 1, 1992 C C INCLUDE FILES: fanpmp.inc C prop.inc C SUBROUTINES CALLED: None C FUNCTIONS CALLED: RHODRY C ENTHALPY C DRYBULB C C REVISION HISTORY: None C C REFERENCE: Clark, D.R. 1985. HVACSIM+ building C systems and equipment simulation program: C Reference Manual. NBSIR 84-2996, National C Institute of Standards and Technology, C Washingtion, D.C. C*********************************************************************** C INTERNAL VARIABLES: C flow Dimensionless flow coefficient (-) C head Dimensionless pressure head coefficient (-) C eff Fan efficiency (-) C hEnt Entering air enthalpy (J/kg) C rho Entering moist air density (kg/m3) C powShaft Shaft power (W) C qLoss Heat transfer to fluid stream (W) C small Small number used in place of zero C*********************************************************************** DOUBLE PRECISION XIN, OUT INTEGER ErrStat, INFO, IOPT, NI, NP, ND REAL M, PAR DIMENSION XIN(5),OUT(5),PAR(13), INFO(15) CHARACTER*3 YCHECK(5), OCHECK(5) DATA small/1.E-9/ DATA PATM/101325.0/,CPAIR/1006.0/,CPVAP/1805.0/,HFG/2501000.0/, &RAIR/287.055/,TABSADD/273.15/ DATA YCHECK/'MF2','PR3','TE1','DM1','NAV'/ DATA OCHECK/'PR3','TE1','DM1','PW2','DM1'/ ErrStat = 0 IOPT = -1 NI = 5 !NUMBER OF CORRECT INPUTS NP = 13 !NUMBER OF CORRECT PARAMETERS ND = 0 !NUMBER OF CORRECT DERIVATIVES M = XIN(1) PENT = XIN(2) TENT = XIN(3) WENT = XIN(4) SPEED = XIN(5) DIAMWHEEL = PAR(1) EFFMOT = PAR(2) MOTORLOSS = PAR(3) COEF0HEAD = PAR(4) COEF1HEAD = PAR(5) COEF2HEAD = PAR(6) COEF3HEAD = PAR(7) COEF4HEAD = PAR(8) COEF0EFF = PAR(9) COEF1EFF = PAR(10) COEF2EFF = PAR(11) COEF3EFF = PAR(12) COEF4EFF = PAR(13) IF (INFO(7).EQ.-1) THEN CALL TYPECK(IOPT,INFO,NI,NP,ND) C CHECKS TO SEE IF THE USER'S INPUT MATCHES THE CORRECT NUMBER CALL RCHECK(INFO,YCHECK,OCHECK) C CHECKS TO SEE IF THE INPUT AND OUTPUT UNITS MATCH ENDIF C1*** Calculate entering moist air properties hEnt = ENTHALPY(CPAIR,CPVAP,HFG,TEnt,WEnt) rho = RHODRY(PATM,RAIR,TABSADD,TEnt,WEnt) C1*** Calculate the dimensionless flow coefficient flow = ABS(M)/MAX(rho*Speed*DiamWheel**3, small) C1*** Calculate the dimensionless head coefficient and efficiency head = Coef0Head+flow*(Coef1Head & +flow*(Coef2Head & +flow*(Coef3Head & +flow* Coef4Head))) eff = Coef0Eff+flow*(Coef1Eff & +flow*(Coef2Eff & +flow*(Coef3Eff & +flow* Coef4Eff))) C1*** Calculate the power consumption powShaft = ABS(M)*head*Speed**2*DiamWheel**2/MAX(eff,small) Power = powShaft/EffMot C1*** Calculate the leaving air conditions C2*** If flow is zero, ABS(M) < small, the value of M is replaces with C2*** small of the same sign as M in calculating hLvg deltaP = head*rho*Speed**2*DiamWheel**2 PLvg = PEnt + SIGN(MAX(deltaP,small),M) qLoss = powShaft + (Power-powShaft)*MotorLoss hLvg = hEnt + qLoss/SIGN(MAX(ABS(M),small),M) WLvg = WEnt TLvg = DRYBULB(CPAIR,CPVAP,HFG,hLvg,WLvg) OUT(1) = PLVG OUT(2) = TLVG OUT(3) = WLVG OUT(4) = POWER OUT(5) = ERRSTAT RETURN 1 END REAL FUNCTION DRYBULB (CPAIR,CPVAP,HFG,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*********************************************************************** 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-Hfg*W)/(CpAir+CpVap*W) RETURN END REAL FUNCTION ENTHALPY (CPAIR,CPVAP,HFG,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*********************************************************************** C1*** Calculate the enthalpy as a function of dry bulb temperature and C1*** humidity ratio. hDryAir = CpAir*TDB hSatVap = Hfg + CpVap*TDB Enthalpy = hDryAir + W*hSatVap RETURN END REAL FUNCTION RHODRY (PATM,RAIR,TABSADD,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*********************************************************************** C1*** Calculate the dry air density from perfect gas laws. pAir = 0.62198*Patm/(0.62198+W) RhoDry = pAir/RAir/(TDB+TAbsAdd) RETURN END