! This component has been assigned Type Number 208. If that number conflicts with ! another user Type number, you will need to change it and recompile the appropriate ! dll. SUBROUTINE TYPE 208 (time,xin,out,t,dtdt,par,info,icntrl,*) !DEC$ATTRIBUTES DLLEXPORT :: TYPE208 *------------------------------------------------------------------ * This subroutine calculates the maximum effectiveness of a HX with * the constraint that no excess water accumulates on the matrix *------------------------------------------------------------------ implicit none * TRNSYS VARIABLES integer*4 info(15) integer icount,ni,nd,np,icntrl(2) character*3 ycheck(2),ocheck(12) real*8 xin(2),out(12) real*4 t,dtdt,par(4),time * TYPE 208 VARIABLES real*8 NTU ! NTU between air and matrix real*8 Tsi,Tso,Tei,Teo ! supply/exhaust, inlet/outlet temp. real*8 Tprime,Teisat ! sat.temp. and sat.temp.+3 at wei real*8 wsi,wso,wei,weo ! supply/exhaust, inlet/outlet humrat. real*8 wsat,wprime ! humrat. to check intersec. with sat. real*8 deltaTpr,deltawpr ! temp.and humrat.diff.betw. 1 and 3' real*8 isi,iso,iei,ieo ! supply/exhaust, inlet/outlet enth. real*8 Et,Ew,Ei ! temp.,hum.and enth. effectiveness real*8 Qrec,Qrecsens ! reduction in heating power real*8 mfsup ! mass flow rate of supply air stream real*8 at,at1,at2,at3 ! parameters in temp. effect. equation real*8 bt,bt1,bt2,bt3 ! parameters in temp. effect. equation real*8 p,psat ! absolut and sat. pressure real*8 C1,C2,C3,C4,C5,C6,C7 ! constants for sat. pressure real*8 C8,C9,C10,C11,C12,C13 ! constants for sat. pressure real*8 Tkel ! temperature in Kelvin real*8 R ! gas constant real*8 A0,A1,A2,A3,A4,A5 ! constants for enth. equation real*8 dB,dC ! functions of temp. in enth. equ. real*8 term1,term2 ! terms in enth. equ. real*8 ivsi,ivso,ivei,iveo,idair! enthlpies of vapor and dry air real*8 di,disens ! enth. difference between in and outlet real*8 cpair ! specific heat of dry air real*8 Gamma,f1gamma,f2gamma ! rotation speed and var.to calc.it real*8 phiso ! rel.hum.os supply outlet real*8 daytime real*8 control,hr ! on/off switch ! Set the version information for TRNSYS IF (INFO(7).EQ.-2) THEN INFO(12) = 15 RETURN 1 ENDIF *----------------------------------------------- * First Call, Info Array.... *----------------------------------------------- if (info(7).ge.0) goto 1 np=4 ! # of parameters info(6)=12 ! # of outputs info(9)=1 ! call type71 every timestep ni=2 ! # of inputs nd=0 ! # of derivatives call typeck(1,info,ni,np,nd) *----------------------------------------------- * Set Variable Types *----------------------------------------------- data ycheck/'TE1','DM1'/ data ocheck/'TE1','DM1','TE1','DM1','SE1','PW3','DM1', @ 'DM1','DM1','DM1','PW3','DM1'/ call rcheck(info,ycheck,ocheck) return 1 *------------------------------------------------------------ * Input of the Two Inlet States *------------------------------------------------------------ 1 Tsi=xin(1) ! in [C] Tei=par(1) ! in [C] wsi=xin(2) ! in [kg/kg] wei=par(2) ! in [kg/kg] mfsup=par(3) ! in [kg/s] NTU=par(4) ! air to matrix (not overall!) p=101.3 ! in [kPa] R=0.461520 ! in [kJ/kgK] cpair=1.004 ! in [kJ/kgK] hr=1 *----------------------------------------------------------- * Control Vars. Operation Between 6 AM and 9 PM, Tamb < 18 C * ---------------------------------------------------------- daytime=mod(time,24.) if (6.lt.daytime.and.daytime.le.21.and.Tsi.lt.18) then control=1 else control=0 endif if (control.eq.0) then di=0 disens=0 Tso=Tsi wso=wsi Gamma=0 Teo=Tei weo=wei Et=0 Ew=0 Ei=0 hr=0 goto 70 endif *------------------------------------------------------------- * Constants *------------------------------------------------------------- C1=-5.6745359e3 C2=-5.1523057e-1 C3=-9.677843e-3 C4=6.2215701e-7 C5=2.0747825e-9 C6=-9.4842024e-13 C7=4.1635019 C8=-5.8002206e3 C9=-5.5162560 C10=-4.8640239e-2 C11=4.1764768e-5 C12=-1.4452093e-8 C13=6.5459673 A0=0.199798e4 A1=0.18035706e1 A2=0.36400463e-3 A3=-0.14677622e-5 A4=0.28726608e-8 A5=-0.17508262e-11 *---------------------------------------------------- * Calculate Parameters Needed for Evaluation of Et *---------------------------------------------------- 10 at1=0.02259-1.376e-3*Tsi-6.91e-6*Tsi**2 at2=0.09084-3.263e-4*tsi+7.4e-6*Tsi**2 at3=0.7388-0.01994*Tsi+3.829e-4*Tsi**2 at=at1+at2/NTU**at3 bt1=-1.007+0.0093*Tsi+2.778e-4*Tsi**2 bt2=-1.533+0.02287*Tsi-2.356e-4*Tsi**2 bt3=1.111-2.667e-3*Tsi+1.378e-4*Tsi**2 bt=bt1+bt2/NTU**bt3 *--------------------------------------------------- * Calculation of Enthalpies for Both Inlets *--------------------------------------------------- * ****Enthalpy of Supply Inlet**** 20 Tkel=Tsi+273.15 if (Tkel.ge.273.15) then psat=exp(C8/Tkel+C9+C10*Tkel+C11*Tkel**2+C12*Tkel**3 @ +C13*dlog(Tkel)) else psat=exp(C1/Tkel+C2+C3*Tkel+C4*Tkel**2+C5*Tkel**3+C6*Tkel**4 @ +C7*dlog(Tkel)) endif dB=255.2597394e-8*exp(1734.29/Tkel)/Tkel**2 dC=0.104e-14-0.335297e-17*exp(3645.09/Tkel) term1=A0+A1*Tkel+A2*Tkel**2+A3*Tkel**3+A4*Tkel**4+A5*Tkel**5 term2=-R*Tkel**2*dB*1000*psat+0.5*dC*(1000*psat)**2 ivsi=term1+term2 isi=cpair*Tsi+wsi*ivsi * ****Enthalpy of Exhaust Inlet**** Tkel=Tei+273.15 if (Tkel.ge.273.15) then psat=exp(C8/Tkel+C9+C10*Tkel+C11*Tkel**2+C12*Tkel**3 @ +C13*dlog(Tkel)) else psat=exp(C1/Tkel+C2+C3*Tkel+C4*Tkel**2+C5*Tkel**3+C6*Tkel**4 @ +C7*dlog(Tkel)) endif dB=255.2597394e-8*exp(1734.29/Tkel)/Tkel**2 dC=0.104e-14-0.335297e-17*exp(3645.09/Tkel) term1=A0+A1*Tkel+A2*Tkel**2+A3*Tkel**3+A4*Tkel**4+A5*Tkel**5 term2=-R*Tkel**2*dB*1000*psat+0.5*dC*(1000*psat)**2 ivei=term1+term2 iei=cpair*Tei+wei*ivei *----------------------------------------------------------- * Calc.Sat.Temp. and Tprime at w=wei, calc.deltaTpr,deltawpr *----------------------------------------------------------- 30 wprime=wei psat=p/(0.622/wei+1) Teisat=4064.75/(19.016-dlog(10*psat))-236.25 Tprime=Teisat+4 ! definition by Holmberg deltaTpr=Tprime-Tsi deltawpr=wprime-wsi * ****Calculate wsat for initial Tprime**** Tkel=Tprime+273.15 if (Tkel.ge.273.15) then psat=exp(C8/Tkel+C9+C10*Tkel+C11*Tkel**2+C12*Tkel**3 @ +C13*dlog(Tkel)) else psat=exp(C1/Tkel+C2+C3*Tkel+C4*Tkel**2+C5*Tkel**3+C6*Tkel**4 @ +C7*dlog(Tkel)) endif wsat=0.622*psat/(p-psat) *------------------------------------------------------------------ * Check for Excess Water *------------------------------------------------------------------ 40 do while (Tprime.gt.Tsi.and.wsat.gt.wprime) Tprime=Tprime-0.1 wprime=wprime-0.1*deltawpr/deltaTpr * ****Calc. New wsat**** Tkel=Tprime+273.15 if (Tkel.ge.273.15) then psat=exp(C8/Tkel+C9+C10*Tkel+C11*Tkel**2+C12*Tkel**3 @ +C13*dlog(Tkel)) else psat=exp(C1/Tkel+C2+C3*Tkel+C4*Tkel**2+C5*Tkel**3+C6*Tkel**4 @ +C7*dlog(Tkel)) endif wsat=0.622*psat/(p-psat) goto 40 enddo *-------------------------------------------------------------------- * Calculate Max. Effectiveness Without Freezing *-------------------------------------------------------------------- 50 if (Tprime.le.Tsi) then * ****No Excess Water, thus, Max. Speed**** Et=NTU/(NTU+2) Teo=Tei+Et*(Tsi-Tei) weo=wei * ****Calc. wsat=wsat(Teo)**** Tkel=Teo+273.15 if (Tkel.ge.273.15) then psat=exp(C8/Tkel+C9+C10*Tkel+C11*Tkel**2+C12*Tkel**3 @ +C13*dlog(Tkel)) else psat=exp(C1/Tkel+C2+C3*Tkel+C4*Tkel**2+C5*Tkel**3+C6*Tkel**4 @ +C7*dlog(Tkel)) endif wsat=0.622*psat/(p-psat) * ****outlet state follows Saturation line**** if (wsat.lt.weo) then weo=wsat endif else * ****Risk of Excess Water => stop at Saturation**** Et=NTU/(NTU+2) Teo=Tei+Et*(Tsi-Tei) weo=wei * ****Calc. wsat for Max. Effect.**** Tkel=Teo+273.15 if (Tkel.ge.273.15) then psat=exp(C8/Tkel+C9+C10*Tkel+C11*Tkel**2+C12*Tkel**3 @ +C13*dlog(Tkel)) else psat=exp(C1/Tkel+C2+C3*Tkel+C4*Tkel**2+C5*Tkel**3+C6*Tkel**4 @ +C7*dlog(Tkel)) endif wsat=0.622*psat/(p-psat) * ****outlet state must stop at saturation line**** if (weo.gt.wsat) then Teo=Teisat weo=wei endif endif *------------------------------------------------------------- * Calculation of the Remaining Outlet Properties *------------------------------------------------------------- * ****Exhaust Outlet Enthalpy**** 60 Tkel=Teo+273.15 if (Tkel.ge.273.15) then psat=exp(C8/Tkel+C9+C10*Tkel+C11*Tkel**2+C12*Tkel**3 @ +C13*dlog(Tkel)) else psat=exp(C1/Tkel+C2+C3*Tkel+C4*Tkel**2+C5*Tkel**3+C6*Tkel**4 @ +C7*dlog(Tkel)) endif dB=255.2597394e-8*exp(1734.29/Tkel)/Tkel**2 dC=0.104e-14-0.335297e-17*exp(3645.09/Tkel) term1=A0+A1*Tkel+A2*Tkel**2+A3*Tkel**3+A4*Tkel**4+A5*Tkel**5 term2=-R*Tkel**2*dB*1000*psat+0.5*dC*(1000*psat)**2 iveo=term1+term2 ieo=cpair*Teo+weo*iveo * ****Supply Outlet Properties**** Tso=Tsi+Tei-Teo wso=wsi+wei-weo iso=isi+iei-ieo * ****Enthalpy Transfer**** di=iso-isi disens=1.01*(Tso-Tsi) *-------------------------------- * Effectivenesses *-------------------------------- Et=(Tso-Tsi)/(Tei-Tsi) Ew=(wso-wsi)/(wei-wsi) Ei=(iso-isi)/(iei-isi) *---------------------------------------------- * Calculation of Rotation Speed *---------------------------------------------- 65 if (Et.lt.NTU/(NTU+2)) then f1gamma=dlog(1-Et*(NTU+2)/NTU) f2gamma=bt**2/(4*at**2)+f1gamma/at if (f2gamma.le.0) then f2gamma=0 endif Gamma=-bt/(2*at)-(f2gamma)**0.5 if (Gamma.gt.5) then Gamma=5 endif else Gamma=5 endif *------------------------------------------------------------- * Recovered Power *------------------------------------------------------------- 70 Qrec=di*mfsup Qrecsens=disens*mfsup *----------------------------------------------------- * Outputs *----------------------------------------------------- out(1)=Tso out(2)=wso out(3)=Teo out(4)=weo out(5)=di out(6)=Qrec out(7)=Et out(8)=Ew out(9)=Ei out(10)=Gamma out(11)=Qrecsens out(12)=hr Return 1 End