! This component has been assigned Type Number 209. If that number conflicts with ! another user Type number, you will need to change it and recompile the appropriate ! dll. SUBROUTINE TYPE 209 (time,xin,out,t,dtdt,par,info,icntrl,*) !DEC$ATTRIBUTES DLLEXPORT :: TYPE209 *------------------------------------------------------------------------- * This subroutine calculates the max.effectiveness of an EX and the * according outlet states 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 209 VARIABLES real*8 NTU ! NTU between air and matrix real*8 Tsi,Tso,Tei,Teo ! supply/exhaust, inlet/outlet temp. real*8 Tprime ! saturation temp. at w=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 di,disens ! enth.diff.betw.supply in-and outlet real*8 Et,Ei,Ew ! temp.,enth.and hum.effectiveness real*8 Qrec,Qrecsens ! power reduction in heating load real*8 mfsup ! mass flow rate of supply air stream real*8 at,at1,at2,at3 ! parameters for effect. curve fit real*8 bt,bt1,bt2,bt3 ! parameters for effect. curve fit real*8 ai,ai1,ai2,ai3,ai4,ai5 ! parameters for effect. curve fit real*8 bi,bi1,bi2,bi3 ! parameters for effect. curve fit real*8 ci,ci1,ci2 ! parameters for effect. curve fit real*8 p,psat ! total 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.calc. real*8 dB,dC ! function of temp.in enth.equ. real*8 term1,term2 ! terms in enth.equ. real*8 ivsi,ivso,ivei,iveo,idair ! enthalpies of vapor and dry air real*8 cpair ! specific heat of air real*8 Gamma ! combined capacitance rate ratio real*8 phiso ! rel.hum.of supply outlet real*8 daytime real*8 control ! control variables for on/off switch real*8 hr ! integrates hours of operation ! 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) goto1 np=4 ! # of parameter info(6)=12 ! # of outputs info(9)=1 ! call type 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) ! [C] Tei=par(1) ! [C] wsi=xin(2) ! [kg/kg] wei=par(2) ! [kg/kg] mfsup=par(3) ! [kg/s] NTU=par(4) ! between air and matrix (not NTUo !!) p=101.3 ! [kPa] cpair=1.004 ! [kJ/kg K] R=0.461520 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 50 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,Ei *---------------------------------------------------- 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 ai4=3.381e-3-9.679e-4*Tsi ai5=3.381e-3-4.127e-5*Tsi if (Tsi.le.0) then ai1=ai4 else ai1=ai5 endif ai2=5.088e-4+4.89e-6*Tsi ai3=-5.298e-6-7.652e-7*Tsi ai=ai1+ai2*NTU+ai3*NTU**2 bi1=6.237e-3+8.827e-3*Tsi-6.042e-4*Tsi**2 bi2=-0.02123+1.323e-4*Tsi bi3=4.908e-4+6.46e-6*Tsi bi=bi1+bi2*NTU+bi3*NTU**2 ci1=-0.4087+0.00253*Tsi+3.34e-4*Tsi**2 ci2=-1.449+0.02337*Tsi-5.578e-4*Tsi**2 ci=ci1+ci2/NTU**0.8 *--------------------------------------------------- * 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 *------------------------------------------------------------------ * Check for Excess Water *------------------------------------------------------------------ wsat=0.622*psat/(p-psat) Tprime=Tei wprime=wei 30 do while (Tprime.gt.Tsi.and.wsat.gt.wprime) Tprime=Tprime-0.1 wprime=wprime-0.1*(wei-wsi)/(Tei-Tsi) 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 30 enddo *------------------------------------------------------------ * Check Intersection and Calc. Et,Ei accordingly *------------------------------------------------------------ 40 if (Tprime.le.Tsi) then * **** no intersec.,thus,max.effect.**** Et=NTU/(NTU+2) Ei=Et Ew=Et Tso=Tsi+Et*(Tei-Tsi) Teo=Tei+Et*(Tsi-Tei) iso=isi+Ei*(iei-isi) ieo=iei+Ei*(isi-iei) wso=wsi+Ew*(wei-wsi) weo=wei+Ew*(wsi-wei) di=iso-isi disens=1.01*(Tso-Tsi) Gamma=5 else * **** inters.,thus,calc.effect.with curvefit**** Gamma=0 ! set Gamma=0 and outlet=inlet Et=0 Ei=0 Ew=0 Tso=Tsi Teo=Tei wso=wsi weo=wei iso=isi ieo=iei * ****Calc. wsat for T=Tei=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) * ****Increase Gamma until Sat.**** 45 do while (weo.lt.wsat.and.Gamma.lt.5) Gamma=Gamma+0.01 Et=NTU/(NTU+2)*(1-exp(at*Gamma**2+bt*Gamma)) Ei=NTU/(NTU+2)*(1-exp(ai*Gamma**3+bi*Gamma**2+ci*Gamma)) Tso=Tsi+Et*(Tei-Tsi) ! Calc.new Outlets Teo=Tei+Et*(Tsi-Tei) iso=isi+Ei*(iei-isi) ieo=iei+Ei*(isi-iei) * ****Calc.new wso**** Tkel=Tso+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 ivso=term1+term2 idair=cpair*Tso wso=(iso-idair)/ivso * ****Calc.new weo**** 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) 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 idair=cpair*Teo weo=(ieo-idair)/iveo di=iso-isi disens=1.01*(Tso-Tsi) goto 45 enddo * ****Decrease Gamma to Get out of Saturation**** if (Gamma.lt.5) then Gamma=Gamma-0.01 Et=NTU/(NTU+2)*(1-exp(at*Gamma**2+bt*Gamma)) Ei=NTU/(NTU+2)*(1-exp(ai*Gamma**3+bi*Gamma**2+ci*Gamma)) Tso=Tsi+Et*(Tei-Tsi) Teo=Tei+Et*(Tsi-Tei) iso=isi+Ei*(iei-isi) ieo=iei+Ei*(isi-iei) * ****Calc. new wso**** Tkel=Tso+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) 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 ivso=term1+term2 idair=cpair*Tso wso=(iso-idair)/ivso if (wso.gt.wsat) then wso=wsat endif * ****Calc. new weo**** 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 idair=cpair*Teo weo=(ieo-idair)/iveo di=iso-isi disens=1.01*(Tso-Tsi) endif * ****Hunidity Effectiveness**** Ew=(wso-wsi)/(wei-wsi) endif *----------------------------------------- * Power Reduction In Heating Load *----------------------------------------- 50 Qrec=di*mfsup Qrecsens=disens*mfsup *---------------------------------------------- * Outputs *---------------------------------------------- 60 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