SUBROUTINE TYPE71(TIME,XIN,OUT,T,DTDT,PAR,INFO,ICNTRL,*) C*********************************************************************** C* Copyright ASHRAE. Toolkit for HVAC System Energy Calculations C* Revised for TRNSYS by N.Blair and R.Schwarz 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 Sample Values C* XIN(1) MLiq Liquid mass flow rate (kg/s) 3.6 C* XIN(2) TLiqEnt Entering water temperature (C) 12.0 C* XIN(3) MAir Dry air mass flow rate (kg/s) 30.0 C* XIN(4) TAirEnt Entering air dry bulb temperature (C) 25.0 C* XIN(5) WAirEnt Entering air humidity ratio (-) 0.6 C* C* XIN(6) UA Overall heat transfer coefficient (W/C) 5753.64 C* XIN(7) 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* OUT(1) TLiqLvg Leaving water temperature (C) 15.99 C* OUT(2) TAirLvg Leaving air dry bulb temperature (C) 24.04 C* OUT(3) WAirLvg Leaving air humidity ratio (-) 60.00 C* OUT(4) Q Heat transfer rate (W) 60140.00 C* OUT(5) ErrStat Error status indicator, 0 = ok, 1 = error (-)0.0 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*********************************************************************** DOUBLE PRECISION XIN, OUT REAL CAPLIQ,CAPAIR DIMENSION XIN(7),OUT(5),INFO(15) INTEGER Errstat,INFO,IOPT,NI,NP,ND CHARACTER*3 YCHECK(7),OCHECK(5) DATA CPAIR/1006.0/,CPVAP/1805.0/,CPLIQ/4186.0/ DATA YCHECK/'MF2','TE1','MF2','TE1','DM1','NAV','DM1'/ DATA OCHECK/'TE1','TE1','DM1','PW2','DM1'/ Errstat = 0 IOPT =-1 NI = 7 !CORRECT NUMBER OF INPUTS NP = 0 !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) UA = XIN(6) CONFIGHX = XIN(7) IF (INFO(7).EQ.-1) THEN CALL TYPECK(IOPT,INFO,NI,NP,ND) C CHECKS TO SEE IF THE USER'S INFO MATCHES THE CORRECT NUMBER CALL RCHECK(INFO,YCHECK,OCHECK) C CHECKS TO SEE IF THE INPUT AND OUTPUT UNITS MATCH ENDIF C2*** Calculate air and water capacity rates capAir = MAir*(CpAir+WAirEnt*CpVap) capLiq = MLiq*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 OUT(1)=TLIQLVG OUT(2)=TAIRLVG OUT(3)=WAIRLVG OUT(4)=Q OUT(5)=ERRSTAT RETURN 1 END SUBROUTINE HEATEX (Cap1,In1,Cap2,In2,UA,ConfigHX,Out1,Out2) C*********************************************************************** C* Copyright ASHRAE. Toolkit for HVAC System Energy Calculations C*********************************************************************** C* SUBROUTINE: HEATEX C* C* LANGUAGE: FORTRAN 77 C* C* PURPOSE: Calculate the outlet states of a simple C* heat exchanger using the effectiveness-Ntu C* method of analysis. C*********************************************************************** C* INPUT VARIABLES C* Cap1 Capacity rate of stream 1 (W/C) C* In1 Inlet state of stream 1 (C) C* Cap2 Capacity rate of stream 2 (W/C) C* In2 Inlet state of stream 2 (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* Out1 Outlet state of stream 1 (C) C* Out2 Outlet state of stream 2 (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: Kays, W.M. and A.L. London. 1964. C Compact Heat Exchangers, 2nd Ed., McGraw- C Hill: New York. C*********************************************************************** C* INTERNAL VARIABLES: C* cMin Minimum capacity rate of the streams (W/C) C* cMax Maximum capacity rate of the streams (W/C) C* cRatio Ratio of minimum to maximum capacity rate C* ntu Number of transfer units (-) C* effectiveness Heat exchanger effectiveness (-) C* qMax Maximum heat transfer possible (W) C*********************************************************************** REAL ntu,qMax,In1,In2,large,CMIN,CMAX,CONFIGHX,EFFECTIVENESS, &E,CRATIO,ETA,OUT1,OUT2 DATA small/1.E-15/, large/1.E15/ C1*** Ntu and Cmin/Cmax (cRatio) calculations cMin = MIN(Cap1,Cap2) cMax = MAX(Cap1,Cap2) IF( cMax .EQ. 0.) THEN cRatio = 1. ELSE cRatio = cMin/cMax ENDIF IF( cMin .EQ. 0.) THEN ntu = large ELSE ntu = ua/cMin ENDIF C1*** Calculate effectiveness for special limiting cases mode = NINT(ConfigHX) IF(ntu .LE. 0) THEN effectiveness = 0. ELSE IF(cRatio .LT. small) THEN C2*** Cmin/Cmax = 0 and effectiveness is independent of configuration effectiveness = 1 - EXP(-ntu) C1*** Calculate effectiveness depending on heat exchanger configuration ELSE IF (mode .EQ. 1) THEN C2*** Counterflow IF (ABS(cRatio-1.) .LT. small) THEN effectiveness = ntu/(ntu+1.) ELSE e=EXP(-ntu*(1-cRatio)) effectiveness = (1-e)/(1-cRatio*e) ENDIF ELSE IF (mode .EQ. 2) THEN C2*** Parallel flow effectiveness = (1-EXP(-ntu*(1+cRatio)))/(1+cRatio) ELSE IF (mode .EQ. 3) THEN C2*** Cross flow, both streams unmixed eta = ntu**(-0.22) effectiveness = 1 - EXP((EXP(-ntu*cRatio*eta)-1)/(cRatio*eta)) ELSE IF (mode .EQ. 4) THEN C2*** Cross flow, both streams mixed effectiveness = ((1/(1-EXP(-ntu)))+ & (cRatio/(1-EXP(-ntu*cRatio)))-(1/(-ntu)))**(-1) ELSE C2*** One stream is mixed and one is unmixed. Determine whether the C2*** minimum or maximum capacity rate stream is mixed. IF ( (ABS(Cap1-cMin).LT.small .AND. mode.EQ.5) .OR. & (ABS(Cap2-cMin).LT.small .AND. mode.EQ.6) ) THEN C2*** Cross flow, stream with minimum capacity rate unmixed effectiveness = (1-EXP(-cRatio*(1-EXP(-ntu))))/cRatio ELSE C2*** Cross flow, stream with maximum capacity rate unmixed effectiveness = 1-EXP(-(1-EXP(-ntu*cRatio))/cRatio) ENDIF ENDIF C1*** Determine leaving conditions for the two streams qMax = MAX(cMin,small)*(In1-In2) Out1 = In1 - effectiveness*qMax/MAX(Cap1,small) Out2 = In2 + effectiveness*qMax/MAX(Cap2,small) RETURN END