SUBROUTINE TYPE97 (TIME,XIN,OUT,T,DTDT,PAR,INFO,ICNTRL,*) C************************************************************************ C* Copyright ASHRAE A Toolkit for Primary HVAC System Energy C* Calculation C*********************************************************************** C* SUBROUTINE: TYPE97 (BOILERCT) C* C* LANGUAGE: FORTRAN 77 C* C* PURPOSE: TYPE97 deals with the numerical simula- C* tion of a boiler submitted to a certain C* heat demand. Three types of combustion C* control systems are considered: ON-OFF, C* low-high-low-OFF and modulating. The aim is C* to determine the boiler operating mode in C* order to reach a given set point C* temperature. C*********************************************************************** C* INPUT VARIABLES: C* Ifuel Selection of the fuel (-) C* If Ifuel C* =1: Light fuel oil (liquid fuel) C* =2: Heavy fuel oil (liquid fuel) C* =3: Domestic gas oil (liquid fuel) C* =4: Methane (gaseous fuel) C* xin(1) (-) C* Type If Type (-) C* =1: boiler with one burner level C* =2: boiler with two burner levels C* =3: boiler with a modulating burner C* xin(2) (-) C* Choice If Choice (-) C* =1: the fuel/air ratio is known C* =2: the CO2 concentration in dry flue gas C* is known C* =3: the O2 concentration in dry flue gas C* is known C* xin(3) (-) C* ValMin This value is equal to the fuel/air ratio, the (-) C* CO2 concentration or the O2 concentration according C* to the value of Choice (minimum rate) C* !!ValMin and ValFL are the same if Type=1!! C* xin(4) (-) C* ValFL Identical to Val2 but for the maximum rate (-) C* xin(5) (-) C* MfrFuelMin Fuel mass flow rate (minimum rate) (kg/s) C* xin(6) (kg/hr) C* MfrFuelFL Fuel mass flow rate (maximum rate) (kg/s) C* !!MfrFuelMin and MfrFuelFL are the same if Type=1!! C* xin(7) (kg/hr) C* Tfuel Fuel temperature (K) C* xin(8) (øC) C* Tair Air temperature (K) C* xin(9) (øC) C* Tenv Environmental temperature (K) C* xin(10) (øC) C* MfrW Water mass flow rate (kg/s) C* xin(11) (kg/hr) C* Twsu Supply water temperature (K) C* xin(12) (øC) C* Tset Set point temperature (K) C* xin(13) (øC) C* TimeSim Interval of time during which the fuel (s) C* consumption is calculated C* xin(14) (hr) C* C* OUTPUT VARIABLES C* Pos The value of Pos indicates the boiler operating (-) C* mode in order to reach the set point temperature C* Pos=1: Full load (maximum rate) C* =2: Cycling Max/Min if Type=2 C* Modulating regime if Type=3 C* =3: Cycling ON/OFF C* =4: OFF C* out(1) (-) C* Teta The time period during which the boiler is (-) C* operating at the upper level C* out(2) (-) C* Twex Mean exhaust water temperature (K) C* out(3) (øC) C* TwexSS If Pos=1 and Type=2 or 3 or if Pos=2: (K) C* TwexSS is equal to the exhaust water temperature C* when the boiler is operating in full load regime C* If Pos=1 and Type=1 or if Pos=3 and Type=1: C* TwexSS is equal to the exhaust water temperature C* when the boiler is operating in ON regime C* If Pos=3 and Type=2 or 3: C* TwexSS is equal to the exhaust water temperature C* when the boiler is operating at the minimum firing C* rate C* If Pos=4: C* TwexSS is equal to the exhaust water temperature C* when the boiler is continously in OFF regime C* out(4) (øC) C* MfrFuel If Type=2 and Pos=1 or 2 or if Type=3 and Pos=1:(kg/s) C* MfrFuel is equal to MfrFuelFL C* If Type=1 and Pos=1 or 3 or if Type=2 and Pos=3 C* or if Type=3 and Pos=3: C* MfrFuel is equal to MfrFuelMin C* If Type=1 and Pos=4 or if Type=2 and Pos=4 C* or if Type=3 and Pos=4: C* MfrFuel is equal to zero C* If Type=3 and Pos=2: C* MfrFuel is equal to the fuel mass flow rate associated C* with the given set point temperature C* out(5) (kg/hr) C* FuelCons Fuel consumed during the specified time interval (kg) C* out(6) (kg) C* QuseMean Mean value of the useful power (W) C* out(7) (kJ/hr) C* QgwMean Mean value of the gas-water heat transfer (W) C* out(8) (kJ/hr) C* Effic Boiler efficiency (-) C* out(9) (-) C* ErrDetec This variable is equal to 1 if the ratio of the (-) C* water capacity flow rate to the flue gas capacity C* flow rate is too small(<1).In that case the routine C* stops running.Otherwise this variable is equal to 0 C* out(10) (-) C* C* PARAMETERS C* AUwenv Water-environment heat transfer coefficient (W/K) C* par(1) (kJ/øC/hr) C* AUgwFL Flue gas-water heat transfer coefficient (W/K) C* when the boiler is operating in full load regime C* par(2) (kJ/øC/hr) C* MfrGasAsFL Flue gas mass flow rate associated with the (kg/s) C* identified value of the heat transfer C* coefficient AUgwFL C* par(3) (kg/hr) C* AUgwMin Flue gas-water heat transfer coefficient (W/K) C* when the boiler is operating at the minimum rate C* par(4) (kJ/øC/hr) C* MfrGasAsMin Flue gas mass flow rate associated with the (kg/s) C* identified value of the heat transfer C* coefficient AUgwMin C* !! AUgwFL and AUgwMin are the same if Type=1 !! C* !! MfrGasAsFL and MfrGasAsMin are the same if Type=1 !! C* !! If Type=3, only the values of AUgwFL and MfrGasAsFL are C* necessary. The values given to AUgwMin and MfrGasAsMin will be C* ignored !! C* par(5) (kg/hr) C* C* WATER PROPERTIES C* CpWat Specific heat of liquid water (J/kg/K) C* C* FUEL PROPERTIES C* Cweight Weight of carbon in 1kg of fuel (kg) C* FLHV Fuel lower heating value (J/kg) C* Tr Reference temperature at which the FLHV is C* evaluated (K) C* Cfuel Fuel specific heat (J/kg/K) C*********************************************************************** C MAJOR RESTRICTIONS: The water-environment is assumed to remain C constant whatever the regime may be C whereas the gas-water heat transfer C coefficient is function of the flue gas C mass flow rate. C In the cyclic mode, it is assumed that the C boiler operation can be represented by C a simple linear combination of two C steady-state regimes. C C DEVELOPER: Jean Lebrun C Jean-Pascal Bourdouxhe C Marc Grodent C University of LiŠge, Belgium C C DATE: March 1, 1995 C C SUBROUTINES CALLED: TYPE98 C FUEL C TYPE99 C ENTHALP C LINKCK C*********************************************************************** C INTERNAL VARIABLES C TwexON Exhaust water temperature when the boiler is (K) C continuously operating in ON regime (Type=1) C TwexOFF Exhaust water temperature when the boiler is (K) C continuously in OFF regime C QgwON Gas-water heat transfer when the boiler is (W) C continuously operating in ON regime (Type=1) C QuseON Useful power when the boiler is continuously (W) C operating in ON regime (Type=1) C TwexFL Exhaust water temperature when the boiler is (K) C continuously operating in full load (Type=2 or 3) C TwexMin Exhaust water temperature when the boiler is (K) C continuously operating at the minimum rate C (Type=2 or 3) C QgwFL Gas-water heat transfer when the boiler is (W) C continuously operating in full load (Type=2 or 3) C QuseFL Useful power when the boiler is continuously (W) C operating in full load (Type=2 or 3) C EffFL Efficiency when the boiler is continuously (-) C operating in full load (Type=2 or 3) C QgwMin Gas-water heat transfer when the boiler is (W) C continuously operating at the minimum rate C (Type=2 or 3) C QuseMin Useful power when the boiler is continuously (W) C operating at the minimum rate (Type=2 or 3) C Tgex Gas temperature at the exhaust of the gas-water (K) C heat exchanger C Tadiab Adiabatic temperature of the combustion products (K) C Fratio Fuel/air ratio (-) C CPgas Specific heat of the combustion products (J/kg/K) C (mean value) C hgsu Gas enthalpy at the supply of the gas-water (J/kg gas) C heat exchanger C hgex Gas enthalpy at the exhaust of the gas-water (J/kg gas) C heat exchanger C Twexs Water temperature at the exhaust of the gas-water (K) C heat exchanger C MfrGas Flue gas mass flow rate (kg/s) C Val This value is equal to the fuel/air ratio, (-) C the CO2 concentration or the O2 concentration C according to the value of Choice C Toler Relative error tolerance (-) C Crgas Capacity flow rate of the combustion products (W/K) C Crw Water capacity flow rate (W/K) C Effgw Effectiveness of the gas-water heat exchanger (-) C Fct Value of the function to be nullified (K) C Dfct Value of the first derivative (-) C ErrRel Relative error (-) C I,J Loop counters (-) C ParAU Storage variable (W/K) C parMfr Storage variable (kg/s) C MfrFuelp Storage variable (kg/s) C C var,Sum1,Sum2,Jm1,Dhgex,DCPgas,Dcrgas,Deffgw and Tgexp are C variables used in the Newton-Raphson method. C*********************************************************************** INTEGER*4 INFO,INFO99,INFO98 DOUBLE PRECISION XIN,OUT,XIN99,OUT99,XIN98,OUT98 REAL Kmolp(5) REAL MfrW,MfrFuelMin,MfrFuelFL,MfrFuel,Ifuel,MfrGas,MfrFuelp, & MfrGasAsFL,MfrGasAsMin DIMENSION PAR(5),XIN(14),OUT(10),INFO(15), & XIN99(5),OUT99(7),INFO99(15), & PAR98(3),XIN98(9),OUT98(8),INFO98(15) COMMON /LUNITS/ LUR,LUW,IFORM,LUK COMMON /SIM/ TIME0,TFINAL,DELT,IWARN COMMON /STORE/ NSTORE,IAV,S(5000) COMMON /CONFIG/ TRNEDT,PERCOM,HEADER,PRTLAB,LNKCHK,PRUNIT,IOCHEK, & PRWARN COMMON/COMCP/PFCP(5,10) INFO(6)=10 INFO99(6)=7 INFO98(6)=8 DATA Toler,CpWat/1E-05,4187/ C*** INPUTS 14 (converted in SI units) C************* Ifuel=SNGL(xin(1)) Type=SNGL(xin(2)) Choice=SNGL(xin(3)) ValMin=SNGL(xin(4)) ValFL=SNGL(xin(5)) MfrFuelMin=SNGL(xin(6)/3600.) MfrFuelFL=SNGL(xin(7)/3600.) Tfuel=SNGL(xin(8)+273.15) Tair=SNGL(xin(9)+273.15) Tenv=SNGL(xin(10)+273.15) Mfrw=SNGL(xin(11)/3600.) Twsu=SNGL(xin(12)+273.15) Tset=SNGL(xin(13)+273.15) TimeSim=SNGL(xin(14)*3600.) C*** PARAMETERS 5 (converted in SI units) C**************** AUwenv=par(1)/3.6 AUgwFL=par(2)/3.6 MfrGasAsFL=par(3)/3600 AUgwMin=par(4)/3.6 MfrGasAsMin=par(5)/3600 CALL FUEL (Ifuel,Cweight,FLHV,Tr,Cfuel,*1) CALL LINKCK('TYPE97','FUEL',1,99) 1 CONTINUE IF (Type.EQ.1) THEN C1*** Calculate the exhaust water temperature when the boiler is continuously C1*** running in ON regime MfrFuel=MfrFuelFL par98(1)=AUwenv*3.6 par98(2)=AUgwFL*3.6 par98(3)=MfrGasAsFL*3600. xin98(1)=DBLE(Ifuel) xin98(2)=DBLE(Choice) xin98(3)=DBLE(ValFL) xin98(4)=DBLE(MfrFuel*3600.) xin98(5)=DBLE(Tfuel-273.15) xin98(6)=DBLE(Tair-273.15) xin98(7)=DBLE(Tenv-273.15) xin98(8)=DBLE(MfrW*3600.) xin98(9)=DBLE(Twsu-273.15) CALL TYPE98 (TIME,XIN98,OUT98,T,DTDT,PAR98,INFO98,ICNTRL,*2) CALL LINKCK('TYPE97','TYPE98 ',1,99) 2 CONTINUE CPgas=SNGL(out98(1)) TwexON=SNGL(out98(2)+273.15) Tgex=SNGL(out98(3)+273.15) QgwON=SNGL(out98(4)/3.6) Qwenv=SNGL(out98(5)/3.6) QuseON=SNGL(out98(6)/3.6) EffON=SNGL(out98(7)) ErrDetec=SNGL(out98(8)) IF (ErrDetec.EQ.1) GOTO 10 C1*** Calculate the exhaust water temperature when the boiler is continuously C1*** in OFF regime TwexOFF=Tenv+(Twsu-Tenv)*EXP(-AUwenv/(CpWat*MfrW)) C1*** Calculate the output variables according to the set point temperature IF (Tset.GE.TwexON) THEN C1*** The boiler must work in full load all the time Pos=1 Twex=TwexON TwexSS=TwexON Teta=1 C1*** Calculate the fuel consumption FuelCons=MfrFuel*TimeSim C1*** Calculate the mean useful power QuseMean=QuseON C1*** Calculate the mean gas-water heat transfer QgwMean=QgwON C1*** Calculate the boiler efficiency Effic=QuseMean/(MfrFuel*FLHV) ENDIF IF ((Tset.LT.TwexON).AND.(Tset.GT.TwexOFF)) THEN C1*** The boiler is cycling between ON and OFF regimes Pos=3 Twex=Tset TwexSS=TwexON C1*** Calculate the time period during which the boiler is working C1*** in ON regime Teta=(Tset-TwexOFF)/(TwexON-TwexOFF) FuelCons=Teta*MfrFuel*TimeSim QuseMean=MfrW*CpWat*(Tset-Twsu) QgwMean=Teta*QgwON C1*** Calculate the boiler efficiency IF (Tset.GE.Twsu) THEN Effic=QuseMean/(Teta*MfrFuel*FLHV) ELSE Effic=0 ENDIF ENDIF IF (Tset.LE.TwexOFF) THEN C1*** The boiler must stay on OFF position all the time Pos=4 Twex=TwexOFF TwexSS=TwexOFF MfrFuel=0 Teta=0 FuelCons=0 QuseMean=MfrW*CpWat*(TwexOFF-Twsu) QgwMean=0 C1*** Calculate the boiler efficiency Effic=0 ENDIF 10 CONTINUE ENDIF IF (Type.EQ.2) THEN C1*** Calculate the exhaust water temperature when the boiler is C1*** continuously supplied at the minimum burner rate par98(1)=AUwenv*3.6 par98(2)=AUgwMin*3.6 par98(3)=MfrGasAsMin*3600. xin98(1)=DBLE(Ifuel) xin98(2)=DBLE(Choice) xin98(3)=DBLE(ValMin) xin98(4)=DBLE(MfrFuelMin*3600.) xin98(5)=DBLE(Tfuel-273.15) xin98(6)=DBLE(Tair-273.15) xin98(7)=DBLE(Tenv-273.15) xin98(8)=DBLE(MfrW*3600.) xin98(9)=DBLE(Twsu-273.15) CALL TYPE98 (TIME,XIN98,OUT98,T,DTDT,PAR98,INFO98,ICNTRL,*11) CALL LINKCK('TYPE97','TYPE98 ',1,99) 11 CONTINUE CPgasMin=SNGL(out98(1)) TwexMin=SNGL(out98(2)+273.15) TgexMin=SNGL(out98(3)+273.15) QgwMin=SNGL(out98(4)/3.6) QwenvMin=SNGL(out98(5)/3.6) QuseMin=SNGL(out98(6)/3.6) EffMin=SNGL(out98(7)) ErrDetec=SNGL(out98(8)) IF (ErrDetec.EQ.1) GOTO 100 C1*** Calculate the exhaust water temperature when the boiler is C1*** continuously supplied at the maximum burner rate par98(1)=AUwenv*3.6 par98(2)=AUgwFL*3.6 par98(3)=MfrGasAsFL*3600. xin98(1)=DBLE(Ifuel) xin98(2)=DBLE(Choice) xin98(3)=DBLE(ValFL) xin98(4)=DBLE(MfrFuelFL*3600.) xin98(5)=DBLE(Tfuel-273.15) xin98(6)=DBLE(Tair-273.15) xin98(7)=DBLE(Tenv-273.15) xin98(8)=DBLE(MfrW*3600.) xin98(9)=DBLE(Twsu-273.15) CALL TYPE98 (TIME,XIN98,OUT98,T,DTDT,PAR98,INFO98,ICNTRL,*15) CALL LINKCK('TYPE97','TYPE98 ',1,99) 15 CONTINUE CPgasFL=SNGL(out98(1)) TwexFL=SNGL(out98(2)+273.15) TgexFL=SNGL(out98(3)+273.15) QgwFL=SNGL(out98(4)/3.6) QwenvFL=SNGL(out98(5)/3.6) QuseFL=SNGL(out98(6)/3.6) EffFL=SNGL(out98(7)) ErrDetec=SNGL(out98(8)) IF (ErrDetec.EQ.1) GOTO 100 C1*** Calculate the exhaust water temperature when the boiler C1*** is in OFF regime TwexOFF=Tenv+(Twsu-Tenv)*EXP(-AUwenv/(MfrW*CpWat)) C1*** Calculate the output values according to the set point temperature IF (Tset.GE.TwexFL) THEN C1*** The boiler must work at the maximum rate all the time Pos=1 Twex=TwexFL TwexSS=TwexFL MfrFuel=MfrFuelFL Teta=1 C1*** Calculate the fuel consumption FuelCons=MfrFuelFL*TimeSim C1*** Calculate the mean useful power QuseMean=QuseFL C1*** Calculate the mean gas-water heat transfer QgwMean=QgwFL C1*** Calculate the boiler efficiency Effic=EffFL ENDIF IF ((Tset.GE.TwexMin).AND.(Tset.LT.TwexFL)) THEN C1*** The boiler is cycling between the two fuel mass flow rates Pos=2 Twex=Tset TwexSS=TwexFL MfrFuel=MfrFuelFL C1*** Calculate the time period during which the boiler must work C1*** at the higher level Teta=(Tset-TwexMin)/(TwexFL-TwexMin) FuelCons=(Teta*MfrFuelFL+(1-Teta)*MfrFuelMin)*TimeSim QuseMean=MfrW*CpWat*(Tset-Twsu) QgwMean=Teta*QgwFL+(1-Teta)*QgwMin Effic=QuseMean/(FLHV*(Teta*MfrFuelFL+(1-Teta)*MfrFuelMin)) ENDIF IF ((Tset.GT.TwexOFF).AND.(Tset.LT.TwexMin)) THEN C1*** The boiler is cycling between the lower level and OFF Pos=3 Twex=Tset TwexSS=TwexMin MfrFuel=MfrFuelMin C1*** Calculate the time during which the boiler must work C1*** at the lower level Teta=(Tset-TwexOFF)/(TwexMin-TwexOFF) FuelCons=Teta*MfrFuelMin*TimeSim QuseMean=MfrW*CpWat*(Tset-Twsu) QgwMean=Teta*QgwMin C1*** Calculate the boiler efficiency IF (Tset.GE.Twsu) THEN Effic=QuseMean/(FLHV*Teta*MfrFuelMin) ELSE Effic=0 ENDIF ENDIF IF (Tset.LE.TwexOFF) THEN C1*** The boiler must stay on OFF position all the time Pos=4 Twex=TwexOFF TwexSS=TwexOFF MfrFuel=0 Teta=0 FuelCons=0 QuseMean=MfrW*CpWat*(TwexOFF-Twsu) QgwMean=0 C1*** Calculate the boiler efficiency Effic=0 ENDIF 20 CONTINUE ENDIF IF (Type.EQ.3) THEN C1*** Calculate the exhaust water temperature if the boiler C1*** works continuously with the smallest fuel mass flow rate par98(1)=AUwenv*3.6 par98(2)=AUgwMin*3.6 par98(3)=MfrGasAsMin*3600. xin98(1)=DBLE(Ifuel) xin98(2)=DBLE(Choice) xin98(3)=DBLE(ValMin) xin98(4)=DBLE(MfrFuelMin*3600.) xin98(5)=DBLE(Tfuel-273.15) xin98(6)=DBLE(Tair-273.15) xin98(7)=DBLE(Tenv-273.15) xin98(8)=DBLE(MfrW*3600.) xin98(9)=DBLE(Twsu-273.15) CALL TYPE98 (TIME,XIN98,OUT98,T,DTDT,PAR98,INFO98,ICNTRL,*22) CALL LINKCK('TYPE97','TYPE98 ',1,99) 22 CONTINUE CPgas=SNGL(out98(1)) TwexMin=SNGL(out98(2)+273.15) TgexMin=SNGL(out98(3)+273.15) QgwMin=SNGL(out98(4)/3.6) QwenvMin=SNGL(out98(5)/3.6) QuseMin=SNGL(out98(6)/3.6) EffMin=SNGL(out98(7)) ErrDetec=SNGL(out98(8)) IF (ErrDetec.EQ.1) GO TO 100 C1*** Compare this temperature with the set point temperature C1*** in order to find the regime that the boiler must use IF (TwexMin.GT.Tset) THEN MfrFuel=MfrFuelMin C1*** Calculate the exhaust water temperature when the boiler C1*** is continuously in OFF regime TwexOFF=Tenv+(Twsu-Tenv)*EXP(-AUwenv/(CpWat*MfrW)) IF (Tset.GT.TwexOFF) THEN C1*** The boiler is cycling between ON-OFF regime Pos=3 Twex=Tset TwexSS=TwexMin C1*** Calculate the time period during which the boiler C1*** is working in ON regime Teta=(Tset-TwexOFF)/(TwexMin-TwexOFF) C1*** Calculate the fuel consumption,the mean useful power and C1*** the mean gas-water heat transfer FuelCons=Teta*MfrFuel*TimeSim QuseMean=MfrW*CpWat*(Tset-Twsu) QgwMean=Teta*QgwMin C1*** Calculate the boiler efficiency IF (Tset.GE.Twsu) THEN Effic=QuseMean/(Teta*MfrFuel*FLHV) ELSE Effic=0 ENDIF ELSE C1*** The boiler must stay on OFF position all the time Pos=4 Twex=TwexOFF TwexSS=TwexOFF Teta=0 MfrFuel=0 C1*** Calculate the fuel consumption,the mean useful power and C1*** the mean gas-water heat transfer FuelCons=0 QuseMean=MfrW*CpWat*(TwexOFF-Twsu) QgwMean=0 C1*** Calculate the boiler efficiency Effic=0 ENDIF ELSE C1*** Calculate the exhaust water temperature when the boiler C1*** works continuously in full load par98(1)=AUwenv*3.6 par98(2)=AUgwFL*3.6 par98(3)=MfrGasAsFL*3600. xin98(1)=DBLE(Ifuel) xin98(2)=DBLE(Choice) xin98(3)=DBLE(ValFL) xin98(4)=DBLE(MfrFuelFL*3600.) xin98(5)=DBLE(Tfuel-273.15) xin98(6)=DBLE(Tair-273.15) xin98(7)=DBLE(Tenv-273.15) xin98(8)=DBLE(MfrW*3600.) xin98(9)=DBLE(Twsu-273.15) CALL TYPE98 (TIME,XIN98,OUT98,T,DTDT,PAR98,INFO98,ICNTRL,*30) CALL LINKCK('TYPE97','TYPE98 ',1,99) 30 CONTINUE CPgas=SNGL(out98(1)) TwexFL=SNGL(out98(2)+273.15) TgexFL=SNGL(out98(3)+273.15) QgwFL=SNGL(out98(4)/3.6) QwenvFL=SNGL(out98(5)/3.6) QuseFL=SNGL(out98(6)/3.6) EffFL=SNGL(out98(7)) ErrDetec=SNGL(out98(8)) IF (ErrDetec.EQ.1) GO TO 100 IF (Tset.GE.TwexFL) THEN C1*** The boiler must work in full load all the time Pos=1 Twex=TwexFL TwexSS=TwexFL Teta=1 MfrFuel=MfrFuelFL C1*** Calculate the fuel consumption,the mean useful power and C1*** the mean gas-water heat transfer FuelCons=MfrFuel*TimeSim QuseMean=QuseFL QgwMean=QgwFL C1*** Calculate the boiler efficiency Effic=QuseMean/(MfrFuel*FLHV) ELSE C1*** The boiler is operating in modulating regime C1*** The boiler must work continuously with an intermediate C1*** fuel mass flow rate Pos=2 Twex=Tset TwexSS=TwexFL Teta=1 C1*** Calculate the supply water temperature of the C1*** water-environment heat exchanger Twexs=Tenv+(Tset-Tenv)*EXP(AUwenv/(CpWat*MfrW)) C1*** Calculate the gas-water heat transfer QgwMean=MfrW*CpWat*(Twexs-Twsu) C1*** Calculation of the fuel mass flow rate (iterative scheme) C2*** First guess of the fuel mass flow rate MfrFuel=(MfrFuelMin+MfrFuelFL)/2 40 Val=ValMin+(ValFL-ValMin)*(MfrFuel-MfrFuelMin)/(MfrFuelFL- & MfrFuelMin) C1*** Calculate the adiabatic temperature,the fuel/air ratio as C1*** well as the enthalpy (expressed in J/kg fuel) and the C1*** composition of the combustion products xin99(1)=DBLE(Ifuel) xin99(2)=DBLE(Choice) xin99(3)=DBLE(Val) xin99(4)=DBLE(Tair-273.15) xin99(5)=DBLE(Tfuel-273.15) CALL TYPE99 (TIME,XIN99,OUT99,T,DTDT,PAR99,INFO99,ICNTRL,*45) CALL LINKCK('TYPE97','TYPE99 ',1,99) 45 CONTINUE Fratio=SNGL(out99(1)) Tadiab=SNGL(out99(2)+273.15) Kmolp(2)=SNGL(out99(3)) Kmolp(3)=SNGL(out99(4)) Kmolp(4)=SNGL(out99(5)) Kmolp(5)=SNGL(out99(6)) hgsu1=SNGL(out99(7)) C2*** The gas enthalpy at the supply of the gas-water heat C2*** exchanger is expressed in J/ kg gas hgsu=hgsu1/(1+1/Fratio) MfrGas=(1+1/Fratio)*MfrFuel C2*** Calculate the gas-water heat transfer coefficient AUgwMod=AUgwFL*(MfrGas/MfrGasAsFL)**0.65 C1*** Calculate the exhaust gas temperature (Newton-Raphson method) C2*** First guess of the exhaust gas temperature Tgex=500 C1*** Calculate the exhaust gas enthalpy (expressed in J/kg fuel) 50 hgex1=0 DO 60 I=2,5 CALL ENTHALP (Tgex,I,hpi,*55) CALL LINKCK('TYPE97','ENTHALP',1,99) 55 CONTINUE hgex1=hgex1+Kmolp(I)*hpi 60 CONTINUE C2*** The exhaust gas enthalpy is expressed in J/kg gas hgex=hgex1/(1+1/Fratio) C1*** Calculate the gas mean specific heat CPgas=(hgsu-hgex)/(Tadiab-Tgex) C1*** Calculate a new estimated value of the exhaust gas temperature C1*** by using the Newton-Raphson method C2*** Calculate the value of the function to be nullified Crgas=MfrGas*CPgas Crw=MfrW*CpWat C1*** Determine the value of ErrDetec IF (Crgas.GT.Crw) THEN ErrDetec=1 GOTO 100 ELSE ErrDetec=0 ENDIF var=EXP(-AUgwMod*(1/Crgas-1/Crw)) Effgw=(1-var)/(1-Crgas*var/Crw) Fct=Effgw*(Tadiab-Twsu)-Tadiab+Tgex C2*** Calculate the value of the first derivative Sum1=0 DO 70 I=2,5 Sum2=0 DO 80 J=1,10 Jm1=J-1 Sum2=Sum2+PFCP(I,J)*Tgex**Jm1 80 CONTINUE Sum1=Sum1+Sum2*Kmolp(I) 70 CONTINUE Dhgex=Sum1/(1+1/Fratio) DCPgas=(hgsu-hgex-Dhgex*(Tadiab-Tgex))/(Tadiab-Tgex)**2 DCrgas=MfrGas*DCPgas DEffgw=(AUgwMod*DCrgas*var*(1/Crw-1/Crgas)/Crgas+DCrgas*var* & (1-var)/Crw)/(1-(Crgas/Crw)*var)**2 Dfct=(Tadiab-Twsu)*DEffgw+1 Tgexp=Tgex C2*** The new estimated value is calculated Tgex=Tgex-Fct/Dfct ErrRel=ABS((Tgex-Tgexp)/Tgexp) C2*** If converged, leave loop IF (ErrRel.GT.Toler) GO TO 50 Tgex=Tgexp C1*** Recalculate the fuel mass flow rate MfrFuelp=MfrFuel MfrFuel=QgwMean/(CPgas*(Tadiab-Tgex)*(1+1/Fratio)) ErrRel=ABS((MfrFuel-MfrFuelp)/MfrFuelp) C2*** If converged, leave loop IF (ErrRel.GT.Toler) GO TO 40 C1*** Calculate the fuel consumption,the mean useful power and C1*** the mean gas-water heat transfer FuelCons=MfrFuel*TimeSim QuseMean=MfrW*CpWat*(Tset-Twsu) C1*** Calculate the boiler efficiency Effic=QuseMean/(MfrFuel*FLHV) ENDIF ENDIF ENDIF 100 CONTINUE C*** OUTPUTS 10 (converted in TRNSYS units) C************** out(1)=DBLE(Pos) out(2)=DBLE(Teta) out(3)=DBLE(Twex-273.15) out(4)=DBLE(TwexSS-273.15) out(5)=DBLE(MfrFuel*3600.) out(6)=DBLE(FuelCons) out(7)=DBLE(QuseMean*3.6) out(8)=DBLE(QgwMean*3.6) out(9)=DBLE(Effic) out(10)=DBLE(ErrDetec) RETURN 1 END SUBROUTINE LINKCK(ENAME1,ENAME2,ILINK,LNKTYP) C*************************************************************************** C THIS SUBROUTINE WAS WRITTEN FOR TRNSYS 14.0 LINK CHECKING - THIS ROUTINE C IS CALLED BY OTHER SUBROUTINES WHEN AN UNLINKED SUBROUTINE HAS BEEN C FOUND. LINKCK IS NEEDED IN ORDER TO AVOID PUTTING COMMON BLOCKS LUNITS C AND CONFIG IN THE TRNSYS TYPES - JWT -- 3/93 C*************************************************************************** COMMON /LUNITS/ LUR,LUW,IFORM,LUK COMMON /CONFIG/ TRNEDT,PERCOM,HEADER,PRTLAB,LNKCHK,PRUNIT,IOCHEK, 1 PRWARN COMMON /SIM/TIME0,TFINAL,DELT,IWARN CHARACTER*1 TRNEDT,PERCOM,HEADER,PRTLAB,LNKCHK,PRUNIT,IOCHEK, 1 PRWARN CHARACTER*6 ENAME1,ENAME2 INTEGER ILINK,LNKTYP C ILINK = 1 --> GENERATE AN ERROR MESSAGE AND STOP TRNSYS C ILINK = 2 --> GENERATE A WARNING BUT DON'T STOP TRNSYS C ILINK = 3 --> TRNSYS HAS FOUND AN UNLINKED TYPE - GENERATE AN ERROR AND C STOP THE PROGRAM C ILINK = 4 --> WARN THE USER THAT A ROUTINE REQUIRES AN EXTERNAL FUNCTION C ENAME1 --> CALLING PROGRAM THAT NEEDED THE UNLINKED FILE C ENAME2 --> FILE THAT WAS NOT FOUND BY ENAME1 SUBROUTINE C LNKTYP --> TYPE NUMBER THAT IS UNLINKED IF((LNKCHK.EQ.'Y').OR.(LNKCHK.EQ.'y')) THEN IF(ILINK.EQ.1) THEN WRITE(LUW,20) 104,ENAME1,ENAME2 WRITE(LUW,15) CALL MYSTOP(104) ELSE IF(ILINK.EQ.2) THEN WRITE(LUW,20) 104,ENAME1,ENAME2 IWARN=IWARN+1 ELSE IF(ILINK.EQ.3) THEN WRITE(LUW,25) 105,LNKTYP,LNKTYP WRITE(LUW,15) CALL MYSTOP(105) ELSE IF(ILINK.EQ.4) THEN WRITE(LUW,35) LNKTYP,ENAME1,ENAME2 IWARN=IWARN+1 ELSE IF(ILINK.EQ.5) THEN WRITE(LUW,40) 105,LNKTYP,LNKTYP WRITE(LUW,15) CALL MYSTOP(105) ELSE WRITE(LUW,30) ENAME1 IWARN=IWARN+1 ENDIF ENDIF 15 FORMAT(//2X,47H*** SIMULATION TERMINATED WITH ERROR STATUS ***/) 20 FORMAT(//,1X,'***** ERROR *****',8X,'TRNSYS ERROR # ',I3,/1X,A6, 1' REQUIRES THE FILE "',A6,'" WHICH WAS CALLED BUT NOT LINKED.',/1X 1,'PLEASE LINK IN THE REQUIRED FILE AND RERUN THE SIMULATION.') 25 FORMAT(//,1X,'***** ERROR *****',8X,'TRNSYS ERROR # ',I3,/1X, 1'TYPE ',I3,' WAS CALLED IN THE TRNSYS INPUT FILE BUT NOT LINKED.', 1/1X,'LINK TYPE ',I3,' BEFORE RUNNING THIS SIMULATION.') 30 FORMAT(/1X,'*****WARNING*****',/1X,'THE LINKCK SUBROUTINE WAS CALL 1ED WITH AN INVALID OPERAND.',/1X,'THE PROGRAM WHICH CALLED LINKCK 1WITH THE IMPROPER OPERAND WAS ',A6,'.',/1X,'PLEASE MAKE SURE THAT 1THE CALLING PROGRAM IS FIXED OR UNLINKED SUBROUTINES MAY ',/1X,'GO 1 UNNOTICED.') 35 FORMAT(/1X,'*****WARNING*****',/1X,'UNIT ',I2,' ',A6,' REQUIRES TH 1E SUBROUTINE ',A6,/1X,'MAKE SURE THAT THIS SUBROUTINE IS LINKED IN 1 TO AVOID PROBLEMS. IT MAY ALREADY BE LINKED IN.',/) 40 FORMAT(//,1X,'***** ERROR *****',8X,'TRNSYS ERROR # ',I3,/1X, 1'TYPE',I3,' WAS CALLED IN THE TRNSYS INPUT FILE BUT NOT LINKED.', 1/1X,'A DUMMY TYPE SUBROUTINE WAS CALLED IN ITS PLACE. PLEASE LINK' 1,/1X,'TYPE',I3,' BEFORE RUNNING THIS SIMULATION OR TURN OFF THE CH 1ECK'/1X,'FOR UNLINKED SUBROUTINES OPTION IN THE CONFIGURATION FILE 1.') RETURN END SUBROUTINE ENTHALP (Temp,I,Enthalpy,*) C************************************************************************ C* Copyright ASHRAE A Toolkit for Primary HVAC System Energy C* Calculation C*********************************************************************** C* SUBROUTINE: ENTHALP C* C* LANGUAGE: FORTRAN 77 C* C* PURPOSE: Calculate the enthalpy (J/kmol) of each C* species (H2,O2,N2,CO2,H2O) at a given C* temperature C*********************************************************************** C* INPUT VARIABLES C* Temp Temperature at which enthalpy must be calculated (K) C* I Selection of the species to be considered (-) C* I=1: H2 C* I=2: O2 C* I=3: N2 C* I=4: CO2 C* I=5: H2O C* C* OUTPUT VARIABLES C* Enthalpy Enthalpy of the species (J/kmol) C*********************************************************************** C DEVELOPER: Philippe Ngendakumana C Marc Grodent C University of LiŠge, Belgium C C DATE: March 1, 1995 C C REFERENCE: A. Brohmer and P. Kreuter C FEV Motorentechnik GmbH & Co KG C Aachen, Germany C*********************************************************************** C INTERNAL VARIABLES C PFCP Array containing the coefficients used (J/kmol/K) C in the polynomial expressions C Tref Array containing the temperatures at which (K) C the reference enthalpies are calculated C href Array containing the reference enthalpies (J/kmol) C h Enthalpy of species I (J/kmol) C J Loop counter C*********************************************************************** COMMON/COMCP/PFCP(5,10) COMMON/THREF/Tref(5),href(5) h=href(I) Enthalpy=0 DO 10 J=1,10 h=h+((PFCP(I,J)*Temp**J)-(PFCP(I,J)*Tref(I)**J))/J 10 CONTINUE Enthalpy=h RETURN 1 END BLOCK DATA COMMON/COMCP/PFCP(5,10) COMMON/THREF/Tref(5),href(5) C1*** Coefficients are given for H2 DATA PFCP(1,1),PFCP(1,2),PFCP(1,3), $PFCP(1,4),PFCP(1,5),PFCP(1,6),PFCP(1,7), $PFCP(1,8),PFCP(1,9),PFCP(1,10)/ $ 2.12183E+04, 4.90483E+01,-1.18908E-01, 1.50167E-04, $-1.07285E-07, 4.66644E-11,-1.26418E-14, 2.08562E-18, $-1.91864E-22, 7.54661E-27/ C1*** Coefficients are given for O2 DATA PFCP(2,1),PFCP(2,2),PFCP(2,3), $PFCP(2,4),PFCP(2,5),PFCP(2,6),PFCP(2,7), $PFCP(2,8),PFCP(2,9),PFCP(2,10)/ $ 3.12398E+04,-2.51025E+01, 9.50643E-02,-1.29283E-04, $ 9.56020E-08,-4.25012E-11, 1.16866E-14,-1.94778E-18, $ 1.80410E-22,-7.12717E-27/ C1*** Coefficients are given for N2 DATA PFCP(3,1),PFCP(3,2),PFCP(3,3), $PFCP(3,4),PFCP(3,5),PFCP(3,6),PFCP(3,7), $PFCP(3,8),PFCP(3,9),PFCP(3,10)/ $ 3.10052E+04,-1.65866E+01, 4.37297E-02,-4.10720E-05, $ 2.08732E-08,-6.27548E-12, 1.11654E-15,-1.08777E-19, $ 4.47487E-24, 0.E0 / C1*** Coefficients are given for CO2 DATA PFCP(4,1),PFCP(4,2),PFCP(4,3), $PFCP(4,4),PFCP(4,5),PFCP(4,6),PFCP(4,7), $PFCP(4,8),PFCP(4,9),PFCP(4,10)/ $ 1.89318E+04, 8.20742E+01,-8.47204E-02, 5.92177E-05, $-2.92546E-08, 1.01523E-11,-2.39525E-15, 3.62658E-19, $-3.15882E-23, 1.19863E-27/ C1*** Coefficients are given for H2O DATA PFCP(5,1),PFCP(5,2),PFCP(5,3), $PFCP(5,4),PFCP(5,5),PFCP(5,6),PFCP(5,7), $PFCP(5,8),PFCP(5,9),PFCP(5,10)/ $ 3.42084E+04,-1.04650E+01, 3.61342E-02,-2.73709E-05, $ 1.12406E-08,-2.93883E-12, 5.25323E-16,-6.54907E-20, $ 5.27765E-24,-2.04468E-28/ C1*** Reference values are given for H2 DATA Tref(1),href(1)/2.E3,6.144129E7/ C1*** Reference values are given for O2 DATA Tref(2),Href(2)/2.E3,6.7926643E7/ C1*** Reference values are given for N2 DATA Tref(3),Href(3)/2.E3,6.485353E7/ C1*** Reference values are given for CO2 DATA Tref(4),Href(4)/2.E3,-2.9253172E8/ C1*** Reference values are given for H2O DATA Tref(5),Href(5)/2.E3,-1.5643141E8/ END SUBROUTINE FUEL (Ifuel,Cweight,FLHV,Tr,Cfuel,*) C************************************************************************ C* Copyright ASHRAE A Toolkit for Primary HVAC System Energy C* Calculation C*********************************************************************** C* SUBROUTINE: FUEL C* C* LANGUAGE: FORTRAN 77 C* C* PURPOSE: Selection of the properties of a given fuel C*********************************************************************** C* INPUT VARIABLE: C* Ifuel Selection of the fuel (-) C* If Ifuel C* =1: Light fuel oil (liquid fuel) C* =2: Heavy fuel oil (liquid fuel) C* =3: Domestic gas oil (liquid fuel) C* =4: Methane (gaseous fuel) C*********************************************************************** C* OUTPUT VARIABLES: C* Cweight Weight of carbon in 1kg of fuel (kg) C* FLHV The fuel lower heating value (J/kg) C* Tr Reference temperature at which the FLHV is (K) C* evaluated C* Cfuel Fuel specific heat (J/kg/K) C*********************************************************************** C DEVELOPER: Jean-Pascal Bourdouxhe C Marc Grodent C University of LiŠge, Belgium C C DATE: March 1, 1995 C*********************************************************************** REAL Ifuel IF (Ifuel.EQ.1) THEN Cweight=0.88 FLHV=40910E3 Tr=298.15 Cfuel=1840 ENDIF IF (Ifuel.EQ.2) THEN Cweight=0.89 FLHV=40430E3 Tr=298.15 Cfuel=1840 ENDIF IF (Ifuel.EQ.3) THEN Cweight=0.86 FLHV=42770E3 Tr=298.15 Cfuel=1880 ENDIF IF (Ifuel.EQ.4) THEN Cweight=0.75 FLHV=49997E3 Tr=289.15 Cfuel=2183 ENDIF RETURN 1 END SUBROUTINE TYPE99 (TIME,XIN,OUT,T,DTDT,PAR,INFO,ICNTRL,*) C************************************************************************ C* Copyright ASHRAE A Toolkit for Primary HVAC System Energy C* Calculation C*********************************************************************** C* SUBROUTINE: TYPE99 (COMBCH) C* C* LANGUAGE: FORTRAN 77 C* C* PURPOSE: The purpose is to allow a very simplified C* study of the combustion process that takes C* place inside the combustion chamber. C*********************************************************************** C* INPUT VARIABLES C* Ifuel Selection of the fuel (-) C* If Ifuel C* =1: Light fuel oil (liquid fuel) C* =2: Heavy fuel oil (liquid fuel) C* =3: Domestic gas oil (liquid fuel) C* =4: Methane (gaseous fuel) C* xin(1) (-) C* C* Choice If Choice (-) C* =1: the fuel/air ratio is known C* =2: the CO2 concentration in dry flue gas C* is known C* =3: the O2 concentration in dry flue gas C* is known C* xin(2) (-) C* C* Val This value is equal to the fuel/air ratio f , (-) C* the CO2 concentration or the O2 concentration C* according to the value of Choice C* xin(3) (-) C* C* Tair Air temperature (K) C* xin(4) (øC) C* C* Tfuel Fuel temperature (K) C* xin(5) (øC) C* C* C* OUTPUT VARIABLES C* Fratio Actual fuel/air ratio (-) C* out(1) (-) C* C* Tadiab Adiabatic temperature of the combustion products (K) C* out(2) (øC) C* C* Kmolp(2) Number of kmol of O2 (kmol O2/kg fuel) C* in the combustion products per kg of fuel C* out(3) (kmol O2/kg fuel) C* C* Kmolp(3) Number of kmol of N2 (kmol N2/kg fuel) C* in the combustion products per kg of fuel C* out(4) (kmol N2/kg fuel) C* C* Kmolp(4) Number of kmol of CO2 (kmol CO2/kg fuel) C* in the combustion products per kg of fuel C* out(5) (kmol CO2/kg fuel) C* C* Kmolp(5) Number of kmol of HO2 (kmol HO2/kg fuel) C* in the combustion products per kg of fuel C* out(6) (kmol HO2/kg fuel) C* C* hprod Enthalpy of the combustion products (J/kg fuel) C* out(7) (J/kg fuel) C* C* C* FUEL PROPERTIES C* Cweight Weight of carbon in 1kg of fuel (kg) C* FLHV Fuel lower heating value (J/kg) C* Tr Reference temperature at which the FLHV is C* evaluated (K) C* Cfuel Fuel specific heat (J/kg/K) C*********************************************************************** C MAJOR RESTRICTIONS: The combustion process is assumed to be C adiabatic. The combustion reaction is C assumed to be complete and dissociation is C not taken into account. C C DEVELOPER: Philippe Ngendakumana C Marc Grodent C Jean-Pascal Bourdouxhe C University of LiŠge, Belgium C C DATE: March 1, 1995 C C SUBROUTINE CALLED: ENTHALP C FUEL C LINKCK C*********************************************************************** C INTERNAL VARIABLES C Excess Excess of air (-) C Hweight Weight of hydrogen in 1 kg of fuel (kg) C ParC Number of carbon atoms in equivalent hydrocarbon (-) C fuel C ParH Number of hydrogen atoms in equivalent (-) C hydrocarbon fuel C xCO2 CO2 concentration in dry flue gas (-) C xO2 O2 concentration in dry flue gas (-) C O2st Number of kmol of oxygen reacting with 1 kmol (kmol) C of fuel in a stoichiometric combustion process C Fratiost Stoichiometric fuel/air ratio (-) C Qa Heat transfer in the air preheater (W) C Qf Heat transfer in the fuel preheater (W) C Qr Heat transfer in the isothermal reactor (W) C Qg Heat transfer in the postheater (W) C MW Array containing the molecular weights (kg/kmol) C of the species (H2,O2,N2,CO2,H2O) C ZC Atomic number of carbon (-) C ParAir Number of kmol of nitrogen per kmol of oxygen (-) C (air composition) C hO2 Enthalpy of oxygen per kmol of oxygen (J/kmol) C hrO2 Enthalpy of oxygen per kmol of oxygen (J/kmol) C at the temperature Tr C hN2 Enthalpy of nitrogen per kmol of nitrogen (J/kmol) C hrN2 Enthalpy of nitrogen per kmol of nitrogen (J/kmol) C at the temperature Tr C hKP Enthalpy of species KP per kmol of (J/kmol) C species KP C hrKP Enthalpy of species KP per kmol of (J/kmol) C species KP at the temperature Tr C Toler Relative error tolerance (-) C ErrRel Relative error (-) C KP Loop counter C IO Integer replacing input Choice in the routine C Fct Value of the function to be nullified (J/kg fuel) C C Tmin,Tmax,Qg1,Fct1,Qg2,Fct2,Fcti,Fctip1,Ti,Tip1,Tp and C T are variables used in the chord method C*********************************************************************** INTEGER*4 INFO DOUBLE PRECISION XIN,OUT REAL Kmolp(5),MW(5),Ifuel DIMENSION XIN(5),OUT(7),INFO(15) COMMON /LUNITS/ LUR,LUW,IFORM,LUK COMMON /SIM/ TIME0,TFINAL,DELT,IWARN COMMON /STORE/ NSTORE,IAV,S(5000) COMMON /CONFIG/ TRNEDT,PERCOM,HEADER,PRTLAB,LNKCHK,PRUNIT,IOCHEK, & PRWARN INFO(6)=7 DATA Toler/1E-5/ DATA MW/2,32,28,44,18/ DATA ZC/12/ C*** INPUTS 5 (converted in SI units) C************ Ifuel=SNGL(xin(1)) Choice=SNGL(xin(2)) Val=SNGL(xin(3)) Tair=SNGL(xin(4)+273.15) Tfuel=SNGL(xin(5)+273.15) CALL FUEL (Ifuel,Cweight,FLHV,Tr,Cfuel,*1) CALL LINKCK('TYPE99','FUEL',1,99) 1 CONTINUE IO=INT(Choice) C2*** Selection of the information available GO TO (10,20,30),IO C2*** The fuel/air ratio is known 10 Fratio=Val GO TO 40 C2*** The CO2 concentration in dry flue gas is known 20 xCO2=Val GO TO 40 C2*** The O2 concentration in dry flue gas is known 30 xO2=Val C2*** The only fuel constituents are carbon and hydrogen 40 Hweight=1-Cweight C2*** Calculate the number of carbon atoms in C2*** equivalent hydrocarbon fuel ParC=Cweight/ZC C2*** Calculate the number of hydrogen atoms in C2*** equivalent hydrocarbon fuel ParH=Hweight C2*** Calculate the number of kmol of nitrogen per kmol of oxygen C2*** (air composition) ParAir=0.79/0.21 C2*** Calculate the number of kmol of oxygen reacting with 1 kmol C2*** of fuel in a stoichiometric combustion process O2st=ParC+ParH/4 C2*** Calculate the stoichiometric fuel/air ratio Fratiost=1/(O2st*(MW(2)+ParAir*MW(3))) C2*** Different cases according to the information available GO TO (50,60,70),IO C2*** Calculate the excess of air 50 Excess=(Fratiost/Fratio)-1 GO TO 80 60 Excess=(ParC-xCO2*(ParC+O2st*ParAir))/(xCO2*O2st*(1+ParAir)) C1*** Calculate the actual fuel/air ratio Fratio=Fratiost/(1+Excess) GO TO 80 70 Excess=-xO2*(ParC+O2st*ParAir)/(O2st*(xO2*(1+ParAir)-1)) Fratio=Fratiost/(1+Excess) C1*** Calculate the composition of the combustion products 80 Kmolp(2)=O2st*Excess Kmolp(3)=O2st*(1+Excess)*ParAir Kmolp(4)=ParC Kmolp(5)=ParH/2 C1*** Calculate the heat transfer in the fuel preheater Qf=Cfuel*(Tr-Tfuel) C1*** Calculate the heat transfer in the air preheater CALL ENTHALP(Tair,2,hO2,*81) CALL LINKCK('TYPE99','ENTHALP',1,99) 81 CONTINUE CALL ENTHALP(Tair,3,hN2,*82) 82 CALL ENTHALP(Tr,2,hrO2,*83) 83 CALL ENTHALP(Tr,3,hrN2,*84) 84 Qa=O2st*(1+Excess)*((hrO2-hO2)+ParAir*(hrN2-hN2)) C1*** Calculate the heat transfer in the isothermal reactor Qr=FLHV C1*** Calculate the adiabatic temperature by means of the chord method Tmin=700 C2*** For a given temperature calculate the heat transfer C2*** in the postheater Qg1=0 DO 90 KP=2,5 CALL ENTHALP(Tmin,KP,hKP,*85) 85 CALL ENTHALP(Tr,KP,hrKP,*86) 86 Qg1=Qg1+(hKP-hrKP)*Kmolp(KP) 90 CONTINUE C2*** Calculate the corresponding value of the function to be nullified Fct1=(Qr-Qa-Qf)-Qg1 C2*** Same processes for another given temperature Tmax=3000 Qg2=0 DO 100 KP=2,5 CALL ENTHALP(Tmax,KP,hKP,*91) 91 CALL ENTHALP(Tr,KP,hrKP,*92) 92 Qg2=Qg2+(hKP-hrKP)*Kmolp(KP) 100 CONTINUE Fct2=(Qr-Qa-Qf)-Qg2 Fcti=Fct1 Fctip1=Fct2 Ti=Tmin Tip1=Tmax Tp=Tmax C2*** New estimation of the adiabatic temperature 110 T=Ti+Fcti*(Ti-Tip1)/(Fctip1-Fcti) Qg=0 DO 120 KP=2,5 CALL ENTHALP(T,KP,hKP,*111) 111 CALL ENTHALP(Tr,KP,hrKP,*112) 112 Qg=Qg+(hKP-hrKP)*Kmolp(KP) 120 CONTINUE Fct=(Qr-Qa-Qf)-Qg ErrRel=ABS((T-Tp)/Tp) C2*** If converged, leave loop IF (ErrRel.GT.Toler) THEN Fcti=Fctip1 Fctip1=Fct Ti=Tip1 Tip1=T Tp=T GO TO 110 ENDIF Tadiab=T C1*** Calculate the enthalpy of the combustion products C1*** at the adiabatic temperature hprod=0 DO 130 KP=2,5 CALL ENTHALP(Tadiab,KP,hKP,*125) 125 hprod=hprod+Kmolp(KP)*hKP 130 CONTINUE C*** OUTPUTS 7 (converted in TRNSYS units) C************* out(1)=DBLE(Fratio) out(2)=DBLE(Tadiab-273.15) out(3)=DBLE(Kmolp(2)) out(4)=DBLE(Kmolp(3)) out(5)=DBLE(Kmolp(4)) out(6)=DBLE(Kmolp(5)) out(7)=DBLE(hprod) RETURN 1 END SUBROUTINE TYPE98 (TIME,XIN,OUT,T,DTDT,PAR,INFO,ICNTRL,*) C************************************************************************ C* Copyright ASHRAE A Toolkit for Primary HVAC System Energy C* Calculation C*********************************************************************** C* SUBROUTINE: TYPE98 (BOILERSS) C* C* LANGUAGE: FORTRAN 77 C* C* PURPOSE: Calculates the exhaust water temperature C* (i.e. the useful power) when the boiler C* is running in steady-state regime. C*********************************************************************** C* INPUT VARIABLES: C* Ifuel Selection of the fuel (-) C* If Ifuel C* =1: Light fuel oil (liquid fuel) C* =2: Heavy fuel oil (liquid fuel) C* =3: Domestic gas oil (liquid fuel) C* =4: Methane (gaseous fuel) C* xin(1) (-) C* Choice If Choice (-) C* =1: the fuel/air ratio is known C* =2: the CO2 concentration in dry flue gas C* is known C* =3: the O2 concentration in dry flue gas C* is known C* xin(2) (-) C* Val This value is equal to the fuel/air ratio, the (-) C* CO2 concentration or the O2 concentration according C* to the value of Choice C* xin(3) (-) C* MfrFuel Fuel mass flow rate (kg/s) C* xin(4) (kg/hr) C* Tfuel Fuel temperature (K) C* xin(5) (øC) C* Tair Air temperature (K) C* xin(6) (øC) C* Tenv Environmental temperature (K) C* xin(7) (øC) C* MfrW Water mass flow rate (kg/s) C* xin(8) (kg/hr) C* Twsu Supply water temperature (K) C* xin(9) (øC) C* C* OUTPUT VARIABLES C* CPgas Mean specific heat of the combustion (J/kg/K) C* products C* out(1) (J/kg/øC) C* Twex Exhaust water temperature (K) C* out(2) (øC) C* Tgex Gas temperature at the exhaust of the (K) C* gas-water heat exchanger C* out(3) (øC) C* Qgw Gas-water heat transfer (W) C* out(4) (kJ/hr) C* Qwenv Water-environment heat transfer (W) C* out(5) (kJ/hr) C* Quse Useful power (W) C* out(6) (kJ/hr) C* Effic Boiler efficiency (-) C* out(7) (-) C* ErrDetec This variable is equal to 1 if the ratio of (-) C* water capacity flow rate to the flue gas capacity C* flow rate is too small(<1).In that case the routine C* stops running.Otherwise this variable is equal to 0 C* out(8) (-) C* C* PARAMETERS C* AUwenv Water-environment heat transfer coefficient (W/K) C* par(1) (kJ/øC/hr) C* AUgw Gas-water heat transfer coefficient (W/K) C* par(2) (kJ/øC/hr) C* MfrGasAss Flue gas mass flow rate associated with the (kg/s) C* identified value of the gas-water heat transfer C* coefficient C* par(3) (kg/hr) C* C* WATER PROPERTIES C* CpWat Specific heat of liquid water (J/kg/K) C* C* FUEL PROPERTIES C* Cweight Weight of carbon in 1kg of fuel (kg) C* FLHV Fuel lower heating value (J/kg) C* Tr Reference temperature at which the FLHV is C* evaluated (K) C* Cfuel Fuel specific heat (J/kg/K) C*********************************************************************** C MAJOR RESTRICTIONS: It is assumed that the water-environment C heat transfer coefficient is constant C whereas the gas-water heat transfer C coefficient is function of the flue gas C mass flow rate. C C DEVELOPER: Jean Lebrun C Marc Grodent C University of LiŠge, Belgium C C DATE: March 1, 1995 C C SUBROUTINES CALLED: TYPE99 C ENTHALP C FUEL C LINKCK C*********************************************************************** C INTERNAL VARIABLES C AUgwCalc Value of the gas-water heat transfer (W/K) C coefficient associated with the calculated value of C the flue gas mass flow rate C Toler Relative error tolerance (-) C Crgas Capacity flow rate of the combustion products (W/K) C Crw Water capacity flow rate (W/K) C Effgw Effectiveness of the gas-water heat exchanger (-) C (counter flow type) C Fct Value of the function to be nullified (K) C Dfct Value of the first derivative (-) C ErrRel Relative error (-) C hgsu Gas enthalpy at the supply of the (J/kg gas) C gas-water heat exchanger C hgex Gas enthalpy at the exhaust of the (J/kg gas) C gas-water heat exchanger C MfrGas Calculated value of the flue gas mass flow (kg/s) C rate C Tadiab Adiabatic temperature of the combustion products (K) C Twexs Water temperature at the exhaust of the gas-water (K) C heat exchanger C I,J Loop counters (-) C C par,Sum1,Sum2,Jm1,Dhgex,DCPgas,Dcrgas,DEffgw and Tgexp are C variables used in the Newton-Raphson method. C*********************************************************************** INTEGER*4 INFO,INFO99 DOUBLE PRECISION XIN,OUT,XIN99,OUT99 REAL Kmolp(5) REAL MfrW,MfrFuel,MfrGas,Ifuel,MfrGasAss DIMENSION PAR(3),XIN(9),OUT(8),INFO(15), & XIN99(5),OUT99(7),INFO99(15) COMMON /LUNITS/ LUR,LUW,IFORM,LUK COMMON /SIM/ TIME0,TFINAL,DELT,IWARN COMMON /STORE/ NSTORE,IAV,S(5000) COMMON /CONFIG/ TRNEDT,PERCOM,HEADER,PRTLAB,LNKCHK,PRUNIT,IOCHEK, & PRWARN COMMON/COMCP/PFCP(5,10) INFO(6)=8 INFO99(6)=7 DATA Toler,CpWat/1E-05,4187/ C*** INPUTS 9 (converted in SI units) C************ Ifuel=SNGL(xin(1)) Choice=SNGL(xin(2)) Val=SNGL(xin(3)) MfrFuel=SNGL(xin(4)/3600.) Tfuel=SNGL(xin(5)+273.15) Tair=SNGL(xin(6)+273.15) Tenv=SNGL(xin(7)+273.15) Mfrw=SNGL(xin(8)/3600.) Twsu=SNGL(xin(9)+273.15) C*** PARAMETERS 3 (converted in SI units) C**************** AUwenv=par(1)/3.6 AUgw=par(2)/3.6 MfrGasAss=par(3)/3600 C1*** Calculate the adiabatic temperature, the fuel/air ratio as well as C1*** the enthalpy (expressed in J/kg fuel) and composition of the C1*** combustion products CALL FUEL (Ifuel,Cweight,FLHV,Tr,Cfuel,*1) CALL LINKCK('TYPE98','FUEL',1,99) 1 CONTINUE xin99(1)=DBLE(Ifuel) xin99(2)=DBLE(Choice) xin99(3)=DBLE(Val) xin99(4)=DBLE(Tair-273.15) xin99(5)=DBLE(Tfuel-273.15) CALL TYPE99 (TIME,XIN99,OUT99,T,DTDT,PAR99,INFO99,ICNTRL,*2) CALL LINKCK('TYPE98','TYPE99 ',1,99) 2 CONTINUE Fratio=SNGL(out99(1)) Tadiab=SNGL(out99(2)+273.15) Kmolp(2)=SNGL(out99(3)) Kmolp(3)=SNGL(out99(4)) Kmolp(4)=SNGL(out99(5)) Kmolp(5)=SNGL(out99(6)) hgsu1=SNGL(out99(7)) C2*** The gas enthalpy at the supply of the gas-water heat exchanger C2*** is expressed in J/kg gas hgsu=hgsu1/(1+1/Fratio) C1*** Calculate the gas mass flow rate MfrGas=(1+1/Fratio)*MfrFuel C1*** Calculate the value of the gas-water heat transfer coefficient C1*** associated with the value of the flue gas mass flow rate AUgwCalc=AUgw*(MfrGas/MfrGasAss)**0.65 C2*** First guess of the exhaust gas temperature Tgex=500 C1*** Calculate the exhaust gas enthalpy (expressed in J/kg fuel) 10 hgex1=0 DO 20 I=2,5 CALL ENTHALP (Tgex,I,hpi,*11) CALL LINKCK('TYPE98','ENTHALP',1,99) 11 CONTINUE hgex1=hgex1+Kmolp(I)*hpi 20 CONTINUE C2*** The exhaust gas enthalpy is expressed in J/kg gas hgex=hgex1/(1+1/Fratio) C1*** Calculate the gas mean specific heat CPgas=(hgsu-hgex)/(Tadiab-Tgex) C1*** Calculate a new estimated value of the exhaust gas temperature C1*** by using the Newton-Raphson method C2*** Calculate the value of the function to be nullified Crgas=MfrGas*CPgas Crw=MfrW*CpWat C1*** Determine the value of ErrDetec IF (Crgas.GT.Crw) THEN ErrDetec=1 GOTO 50 ELSE ErrDetec=0 ENDIF par1=EXP(-AUgwCalc*(1/Crgas-1/Crw)) Effgw=(1-par1)/(1-Crgas*par1/Crw) Fct=Effgw*(Tadiab-Twsu)-Tadiab+Tgex C2*** Calculate the value of the first derivative Sum1=0 DO 30 I=2,5 Sum2=0 DO 40 J=1,10 Jm1=J-1 Sum2=Sum2+PFCP(I,J)*Tgex**Jm1 40 CONTINUE Sum1=Sum1+Sum2*Kmolp(I) 30 CONTINUE Dhgex=Sum1/(1+1/Fratio) DCPgas=(hgsu-hgex-Dhgex*(Tadiab-Tgex))/(Tadiab-Tgex)**2 DCrgas=MfrGas*DCPgas DEffgw=(AUgwCalc*DCrgas*par1*(1/Crw-1/Crgas)/Crgas+DCrgas*par1* & (1-par1)/Crw)/(1-(Crgas/Crw)*par1)**2 Dfct=(Tadiab-Twsu)*DEffgw+1 Tgexp=Tgex C2*** The new estimated value is calculated Tgex=Tgex-Fct/Dfct ErrRel=ABS((Tgex-Tgexp)/Tgexp) C2*** If converged, leave loop IF (ErrRel.GT.Toler) GO TO 10 Tgex=Tgexp C1*** Calculate the gas-water heat transfer Qgw=MfrGas*(hgsu-hgex) C1*** Calculate the exhaust water temperature Twexs=Twsu+Qgw/(MfrW*CpWat) Twex=Tenv+(Twexs-Tenv)/EXP(AUwenv/(MfrW*CpWat)) C1*** Calculate the water-environment heat transfer Qwenv=MfrW*CpWat*(Twexs-Twex) C1*** Calculate the useful power Quse=MfrW*CpWat*(Twex-Twsu) C1*** Calculate the boiler efficiency Effic=Quse/(MfrFuel*FLHV) 50 CONTINUE C*** OUTPUTS 8 (converted in TRNSYS units) C************* out(1)=DBLE(CPgas) out(2)=DBLE(Twex-273.15) out(3)=DBLE(Tgex-273.15) out(4)=DBLE(Qgw*3.6) out(5)=DBLE(Qwenv*3.6) out(6)=DBLE(Quse*3.6) out(7)=DBLE(Effic) out(8)=DBLE(ErrDetec) RETURN 1 END