SUBROUTINE TYPE87 (TIME,XIN,OUT,T,DTDT,PAR,INFO,ICNTRL,*) C************************************************************************ C* Copyright ASHRAE A Toolkit for Primary HVAC System Energy C* Calculation C*********************************************************************** C* SUBROUTINE: TYPE87 (PCHILPL) C* C* LANGUAGE: FORTRAN 77 C* C* PURPOSE: Deals with the part-load operation of a C* reciprocating chiller.The purpose is to C* determine how the chiller should be used C* in order to reach a given set point C* temperature at the evaporator exhaust. C* The pressure drop at the exhaust of the C* compressor cylinders is taken into account. C*********************************************************************** C* INPUT VARIABLES C* Ifluid Selection of the refrigerant (-) C* If Ifluid C* =1: Refrigerant 12 C* =2: Refrigerant 134a C* =3: Refrigerant 114 C* =4: Refrigerant 22 C* =5: Refrigerant 502 C* =6: Refrigerant 717 (Ammonia) C* xin(1) (-) C* Mfrwev Water mass flow rate in the evaporator (kg/s) C* xin(2) (kg/hr) C* Mfrwcd Water mass flow rate in the condenser (kg/s) C* xin(3) (kg/hr) C* Twsuev Evaporator supply water temperature (K) C* xin(4) (øC) C* Twsucd Condenser supply water temperature (K) C* xin(5) (øC) C* Tset Set point temperature at the evaporator exhaust (K) C* xin(6) (øC) C* PevG Guess of the cooling capacity (W) C* xin(7) (kJ/hr) C* PcdG Guess of the heat rejected in the condenser (W) C* xin(8) (kJ/hr) C* NcMax Maximum number of loaded cylinders (-) C* xin(9) (-) C* NcMin Minimum number of loaded cylinders (-) C* xin(10) (-) C* dNc Decrement for part-load operation (-) C* (NcMax=NcMin+I*dNc where I is an integer) C* xin(11) (-) C* NcFL Number of cylinders used in full load regime (-) C* xin(12) (-) C* C* OUTPUT VARIABLES C* Pos The value of Pos indicates the chiller operating (-) C* mode in order to reach the set point temperature C* Pos=1: Maximum C* =2: Cycling mode C* =3: ON/OFF C* =4: OFF C* out(1) (-) C* Teta The time period during which the chiller is (-) C* working with the upper number of loaded cylinders C* out(2) (-) C* NcUp Upper number of loaded cylinders (-) C* out(3) (-) C* NcLow Lower number of loaded cylinders (-) C* out(4) (-) C* TwexevMin Evaporator exhaust water temperature when the (K) C* chiller is working continuously with the upper C* number of loaded cylinders C* out(5) (øC) C* TwexcdMax Condenser exhaust water temperature when the (K) C* chiller is working continuously with the upper C* number of loaded cylinders C* out(6) (øC) C* TwexevMean Mean evaporator exhaust water temperature (K) C* out(7) (øC) C* TwexcdMean Mean condenser exhaust water temperature (K) C* out(8) (øC) C* PevMean Mean value of the cooling capacity (W) C* out(9) (kJ/hr) C* Wmean Mean value of the power consumed by the (W) C* compressor C* out(10) (kJ/hr) C* PcdMean Mean value of the heat rejected in the condenser (W) C* out(11) (kJ/hr) C* COPmean Mean value of the coefficient of performance (-) C* out(12) (-) C* C* PARAMETERS C* AUev Evaporator heat transfer coefficient (W/K) C* par(1) (kJ/hr/øC) C* AUcd Condenser heat transfer coefficient (W/K) C* par(2) (kJ/hr/øC) C* Losses Constant part of the electromechanical losses (W) C* par(3) (kJ/hr) C* Alpha Loss factor allowing to define another (-) C* electromechanical loss which is assumed to be C* proportional to the internal power C* par(4) (-) C* Aex Equivalent nozzle throat area of a cylinder (m**2) C* par(5) (m**2) C* Cf Clearance factor of the compressor (-) C* par(6) (-) C* VsFL Geometric displacement of the compressor (m**3/s) C* in full load regime C* par(7) (m**3/hr) C* Wpumping Internal power of the compressor when all the (W) C* cylinders are unloaded C* par(8) (kJ/hr) C*********************************************************************** C MAJOR RESTRICTIONS: The surrounding heat exchanges are C neglected. C The compression is assumed to be isentropic. C Perfect gas properties are used. C The chiller is assumed to work with only C one compressor. 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 SUBROUTINE CALLED: TYPE88 (PSIMPL) C LINKCK C*********************************************************************** C INTERNAL VARIABLES: C Nc Number of loaded cylinders considered (-) C Twexevp,Twexcdp,Pevp,Pcdp,Wp are storage variables C*********************************************************************** INTEGER*4 INFO,INFO88 DOUBLE PRECISION XIN,OUT,XIN88,OUT88 REAL Mfrwev,Mfrwcd,NcMax,NcMin,NcUp,NcLow,Nc,MfrRef, & Ifluid,NcFL,Losses DIMENSION PAR(8),XIN(12),OUT(12),INFO(15), & PAR88(8),XIN88(10),OUT88(7),INFO88(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)=12 INFO88(6)=7 C*** INPUTS 12 (converted in SI units) C************* Ifluid=SNGL(xin(1)) Mfrwev=SNGL(xin(2)/3600.) Mfrwcd=SNGL(xin(3)/3600.) Twsuev=SNGL(xin(4)+273.15) Twsucd=SNGL(xin(5)+273.15) Tset=SNGL(xin(6)+273.15) PevG=SNGL(xin(7)/3.6) PcdG=SNGL(xin(8)/3.6) NcMax=SNGL(xin(9)) NcMin=SNGL(xin(10)) dNc=SNGL(xin(11)) NcFL=SNGL(xin(12)) C*** PARAMETERS 8 (converted in SI units) C**************** AUev=par(1)/3.6 AUcd=par(2)/3.6 Losses=par(3)/3.6 Alpha=par(4) Aex=par(5) Cf=par(6) VsFL=par(7)/3600. Wpumping=par(8)/3.6 C1*** Compare the given set point temperature with the evaporator C1*** supply water temperature IF (Tset.GE.Twsuev) THEN C1*** Regime OFF all the time Pos=4 Teta=0 NcUp=0 NcLow=0 TwexevMin=Twsuev TwexcdMax=Twsucd TwexevMean=Twsuev TwexcdMean=Twsucd PevMean=0 Wmean=0 PcdMean=0 COPmean=0 ELSE C1*** Compare the set point temperature with the evaporator exhaust C1*** water temperature when the chiller is working with the C1*** maximum number of cylinders par88(1)=AUev*3.6 par88(2)=AUcd*3.6 par88(3)=Losses*3.6 par88(4)=Alpha par88(5)=Aex par88(6)=Cf par88(7)=VsFL*3600 par88(8)=Wpumping*3.6 xin88(1)=DBLE(Ifluid) xin88(2)=DBLE(Mfrwev*3600.) xin88(3)=DBLE(Mfrwcd*3600.) xin88(4)=1.0 xin88(5)=DBLE(Twsuev-273.15) xin88(6)=DBLE(Twsucd-273.15) xin88(7)=DBLE(PevG*3.6) xin88(8)=DBLE(PcdG*3.6) xin88(9)=DBLE(NcMax) xin88(10)=DBLE(NcFL) CALL TYPE88 (TIME,XIN88,OUT88,T,DTDT,PAR88,INFO88,ICNTRL,*2) CALL LINKCK('TYPE87','TYPE88 ',1,99) 2 CONTINUE MfrRef=SNGL(out88(1)/3600) Pev=SNGL(out88(2)/3.6) W=SNGL(out88(3)/3.6) Pcd=SNGL(out88(4)/3.6) COP=SNGL(out88(5)) Twexev=SNGL(out88(6)+273.15) Twexcd=SNGL(out88(7)+273.15) IF (Twexev.GE.Tset) THEN C1*** Regime ON all the time with the maximum number of cylinders Pos=1 Teta=1 NcUp=NcMax NcLow=NcMax TwexevMin=Twexev TwexcdMax=Twexcd TwexevMean=Twexev TwexcdMean=Twexcd PevMean=Pev Wmean=W PcdMean=Pcd COPmean=COP ELSE C1*** Part-load regime Nc=NcMax 10 Twexevp=Twexev Twexcdp=Twexcd Pevp=Pev Wp=W Pcdp=Pcd Nc=Nc-dNc par88(1)=AUev*3.6 par88(2)=AUcd*3.6 par88(3)=Losses*3.6 par88(4)=Alpha par88(5)=Aex par88(6)=Cf par88(7)=VsFL*3600 par88(8)=Wpumping*3.6 xin88(1)=DBLE(Ifluid) xin88(2)=DBLE(Mfrwev*3600.) xin88(3)=DBLE(Mfrwcd*3600.) xin88(4)=1.0 xin88(5)=DBLE(Twsuev-273.15) xin88(6)=DBLE(Twsucd-273.15) xin88(7)=DBLE(PevG*3.6) xin88(8)=DBLE(PcdG*3.6) xin88(9)=DBLE(Nc) xin88(10)=DBLE(NcFL) CALL TYPE88 (TIME,XIN88,OUT88,T,DTDT,PAR88,INFO88,ICNTRL,*12) CALL LINKCK('TYPE87','TYPE88 ',1,99) 12 CONTINUE MfrRef=SNGL(out88(1)/3600) Pev=SNGL(out88(2)/3.6) W=SNGL(out88(3)/3.6) Pcd=SNGL(out88(4)/3.6) COP=SNGL(out88(5)) Twexev=SNGL(out88(6)+273.15) Twexcd=SNGL(out88(7)+273.15) IF (Twexev.GE.Tset) THEN C1*** Cycles between Nc and (Nc+dNc) Pos=2 Teta=(Tset-Twexev)/(Twexevp-Twexev) NcUp=Nc+dNc NcLow=Nc TwexevMin=Twexevp TwexcdMax=Twexcdp TwexevMean=Tset TwexcdMean=Twexcd+Teta*(Twexcdp-Twexcd) PevMean=Pev+Teta*(Pevp-Pev) Wmean=W+Teta*(Wp-W) PcdMean=Pcd+Teta*(Pcdp-Pcd) COPmean=PevMean/Wmean ELSE IF (Nc.EQ.NcMin) THEN C1*** Regime ON-OFF Pos=3 Teta=(Tset-Twsuev)/(Twexev-Twsuev) NcUp=NcMin NcLow=0 TwexevMin=Twexev TwexcdMax=Twexcd TwexevMean=Tset TwexcdMean=Twsucd+Teta*(Twexcd-Twsucd) PevMean=Teta*Pev Wmean=Teta*W PcdMean=Teta*Pcd COPmean=COP ELSE C2*** Reduced the number of loaded cylinders GOTO 10 ENDIF ENDIF ENDIF ENDIF C*** OUTPUTS 12 (converted in TRNSYS units) C************** out(1)=DBLE(Pos) out(2)=DBLE(Teta) out(3)=DBLE(NcUp) out(4)=DBLE(NcLow) out(5)=DBLE(TwexevMin-273.15) out(6)=DBLE(TwexcdMax-273.15) out(7)=DBLE(TwexevMean-273.15) out(8)=DBLE(TwexcdMean-273.15) out(9)=DBLE(PevMean*3.6) out(10)=DBLE(Wmean*3.6) out(11)=DBLE(PcdMean*3.6) out(12)=DBLE(COPmean) 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 TYPE88 (TIME,XIN,OUT,T,DTDT,PAR,INFO,ICNTRL,*) C************************************************************************ C* Copyright ASHRAE A Toolkit for Primary HVAC System Energy C* Calculation C*********************************************************************** C* SUBROUTINE: TYPEP88 (PSIMPL) C* C* LANGUAGE: FORTRAN 77 C* C* PURPOSE: Numerical simulation of a chiller in C* part-load regime. The routine C* mainly calculates the cooling C* capacity and the compressor consumption C* for specified working conditions. C* The pressure drop at the exhaust of the C* compressor cylinders is taken into account. C*********************************************************************** C* INPUT VARIABLES C* Ifluid Selection of the refrigerant (-) C* If Ifluid C* =1: Refrigerant 12 C* =2: Refrigerant 134a C* =3: Refrigerant 114 C* =4: Refrigerant 22 C* =5: Refrigerant 502 C* =6: Refrigerant 717 (Ammonia) C* xin(1) (-) C* Mfrwev Water mass flow rate in the evaporator (kg/s) C* xin(2) (kg/hr) C* Mfrwcd Water mass flow rate in the condenser (kg/s) C* xin(3) (kg/hr) C* Choice If Choice (-) C* =1: the supply water temperature is known for both C* evaporator and condenser C* =2: the water temperature is known at the evaporator C* supply and at the condenser exhaust C* =3: the exhaust water temperature is known for both C* evaporator and condenser C* =4: the water temperature is known at the evaporator C* exhaust and at the condenser supply C* xin(4) (-) C* Twev1 This value is equal to the evaporator supply or (K) C* exhaust water temperature according to the value C* of Choice C* xin(5) (øC) C* Twcd1 This value is equal to the condenser supply or (K) C* exhaust water temperature according to the value C* of Choice C* xin(6) (øC) C* PevG Guess of the cooling capacity (W) C* xin(7) (kJ/hr) C* PcdG Guess of the heat rejected in the condenser (W) C* xin(8) (kJ/hr) C* Nc Number of loaded cylinders (-) C* xin(9) (-) C* NcFL Number of loaded cylinders in ful-load regime (-) C* xin(10) (-) C* C* OUTPUT VARIABLES C* MfrRef Refrigerant mass flow rate (kg/s) C* out(1) (kg/hr) C* Pev Cooling capacity (W) C* out(2) (kJ/hr) C* Pcomp Power consumed by the compressor (W) C* out(3) (kJ/hr) C* Pcd Heat rejected in the condenser (W) C* out(4) (kJ/hr) C* COP Coefficient of performance (-) C* out(5) (-) C* Twev2 This value is equal to the evaporator exhaust (K) C* or supply water temperature according to the value C* of Choice C* out(6) (øC) C* Twcd2 This value is equal to the condenser exhaust (K) C* or supply water temperature according to the value C* of Choice C* out(7) (øC) C* C* PARAMETERS C* AUev Evaporator heat transfer coefficient (W/K) C* par(1) (kJ/øC/hr) C* AUcd Condenser heat transfer coefficient (W/K) C* par(2) (kJ/øC/hr) C* Losses Constant part of the electromechanical losses (W) C* par(3) (kJ/hr) C* Alpha Loss factor allowing to define another (-) C* electromechanical loss which is assumed to be C* proportional to the internal power C* par(4) (-) C* Aex Equivalent nozzle throat area of a cylinder (m**2) C* par(5) (m**2) C* Cf Clearance factor of the compressor (-) C* par(6) (-) C* VsFL Geometric displacement of the compressor (m**3/s) C* in full-load regime C* par(7) (m**3/hr) C* Wpumping Internal power of the compressor when all the (W) C* cylinders are unloaded C* par(8) (kJ/hr) C* C* WATER PROPERTY C* CpWat Specific heat of liquid water (J/kg/K) C* C* REFRIGERANT PROPERTIES C* To Reference temperature (K) C* cpliq Mean specific heat in saturated liquid state (J/kg/K) C* hfo Enthalpy of the saturated liquid at the (J/kg) C* reference temperature C* cpvap Mean specific heat at constant pressure (J/kg/K) C* in superheated vapor state for saturation C* temperatures ranging from 253 K to 283 K C* cpvapcd Mean specific heat at constant pressure (J/kg/K) C* in superheated vapor state for saturation C* temperatures ranging from 303 K to 333 K C* hfgb Vaporization enthalpy at standard boiling (J/kg) C* point (101325 Pa) C* Tb Standard boiling temperature (K) C* Tc Critical temperature (K) C* b Coefficient used in the calculation of the (-) C* vaporization enthalpy C* r Gas constant (J/kg/K) C* Zeta Mean compressibility factor for saturation (-) C* temperatures ranging from 253 K to 283 K C* Zetacd Mean compressibility factor for saturation (-) C* temperatures ranging from 303 K to 333 K C* Gamma Mean isentropic coefficient (-) C* Acl First coefficient in the Clausius-Clapeyron (-) C* equation C* Bcl Second coefficient in the Clausius-Clapeyron (K) C* equation C*********************************************************************** C MAJOR RESTRICTIONS: The surrounding heat exchanges are C neglected. The refrigerant leaves the C evaporator and the condenser as saturated C vapor and saturated liquid respectively. C The compression is assumed to be isentropic. C Perfect gas properties are used. C The chiller is assumed to work with only C one compressor. 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 SUBROUTINE CALLED: PROPERTY C LINKCK C*********************************************************************** C INTERNAL VARIABLES: C Twsuev Evaporator supply water temperature (K) C Twexev Evaporator exhaust water temperature (K) C Twsucd Condenser supply water temperature (K) C Twexcd Condenser exhaust water temperature (K) C T1 Evaporating temperature (K) C T1p Temperature after the heating-up (K) C v1p Specific volume after the heating-up (m**3/kg) C p1 Evaporating pressure (Pa) C dhfg Vaporization enthalpy (J/kg) C h1 Enthalpy at the evaporator exhaust (J/kg) C T3 Condensing temperature (K) C h3 Enthalpy at the condenser exhaust (J/kg) C p3 Condensing pressure (Pa) C v2p Specific volume at point 2' (m**3/kg) C p2 Pressure at point 2 (Pa) C Effvol Volumetric effectiveness of the compressor (-) C Wis Isentropic compression power (W) C Effev Evaporator effectiveness (-) C Effcd Condenser effectiveness (-) C Vs Geometris displacement of the compressor (m**3/s) C for specified working conditions C dpex Pressure drop at the compressor exhaust (Pa) C TolRel Relative error tolerance (-) C ErrRel Relative error (-) C C Pevp,Pcdp,T1pp and dpexp are variables used in the iterative C scheme. C*********************************************************************** INTEGER*4 INFO DOUBLE PRECISION XIN,OUT REAL Mfrwev,Mfrwcd,MfrRef,Nc,NcFL,Ifluid,Losses DIMENSION PAR(8),XIN(10),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 TolRel,CpWat/1E-05,4187/ C*** INPUTS 10 (converted in SI units) C************* Ifluid=SNGL(xin(1)) Mfrwev=SNGL(xin(2)/3600.) Mfrwcd=SNGL(xin(3)/3600.) Choice=SNGL(xin(4)) Twev1=SNGL(xin(5)+273.15) Twcd1=SNGL(xin(6)+273.15) PevG=SNGL(xin(7)/3.6) PcdG=SNGL(xin(8)/3.6) Nc=SNGL(xin(9)) NcFL=SNGL(xin(10)) C*** PARAMETERS 8 (converted in SI units) C**************** AUev=par(1)/3.6 AUcd=par(2)/3.6 Losses=par(3)/3.6 Alpha=par(4) Aex=par(5) Cf=par(6) VsFL=par(7)/3600. Wpumping=par(8)/3.6 C2*** Selection of the refrigerant CALL PROPERTY (Ifluid,To,cpliq,hfo,cpvap,cpvapcd,hfgb,Tb,Tc, & b,r,Zeta,Zetacd,Gamma,Acl,Bcl,*1) CALL LINKCK('TYPE88','PROPERTY',1,99) 1 CONTINUE Pev=PevG Pcd=PcdG Gm1G=(Gamma-1)/Gamma NChoice=INT(Choice) GOTO (10,20,30,40),NChoice C2*** The supply water temperature is known for both evaporator C2*** and condenser 10 Twsuev=Twev1 Twsucd=Twcd1 GOTO 50 C2*** The water temperature is known at the evaporator supply and C2*** at the condenser exhaust 20 Twsuev=Twev1 Twexcd=Twcd1 GOTO 50 C2*** The exhaust water temperature is known for both C2*** evaporator and condenser 30 Twexev=Twev1 Twexcd=Twcd1 GOTO 50 C2*** The water temperature is known at the evaporator exhaust and C2*** at the condenser supply 40 Twexev=Twev1 Twsucd=Twcd1 50 CONTINUE C1*** Calculate the evaporator and condenser effectivenesses Effev=1-EXP(-AUev/(CpWat*Mfrwev)) Effcd=1-EXP(-AUcd/(CpWat*Mfrwcd)) C1*** Calculate the geometric displacement of the compressor Vs=Nc/NcFL*VsFL C1*** Beginning of the first loop 60 CONTINUE C1*** Calculate the evaporating temperature according to the C1*** information available IF ((NChoice.EQ.1).OR.(NChoice.EQ.2)) THEN T1=Twsuev-Pev/(Effev*CpWat*Mfrwev) ELSE T1=Twexev+(Pev/(CpWat*Mfrwev))*(1-1/Effev) ENDIF C1*** Calculate the evaporating pressure p1=1000*EXP(Acl+Bcl/T1) C1*** Calculate the enthalpy at the evaporator exhaust dhfg=hfgb*((Tc-T1)/(Tc-Tb))**b h1=hfo+cpliq*(T1-To)+dhfg C1*** Beginning of the second loop 70 CONTINUE C1*** Calculate the condensing temperature according to the information C1*** available IF ((NChoice.EQ.1).OR.(NChoice.EQ.4)) THEN T3=Twsucd+Pcd/(Effcd*CpWat*Mfrwcd) ELSE T3=Twexcd+(Pcd/(CpWat*Mfrwcd))*(1/Effcd-1) ENDIF C1*** Calculate the condensing pressure p3=1000*EXP(Acl+Bcl/T3) C2*** Calculate the enthalpy at the condenser exhaust h3=hfo+cpliq*(T3-To) C1*** Beginning of the third loop C2*** First guess of the temperature after the heating-up T1p=T1 C2*** Calculate the specific volumes after the heating-up and at point 2' 80 v1p=Zeta*r*T1p/p1 v2p=Zeta*r*T1p/p3*(p3/p1)**Gm1G C2*** First guess of the pressure drop dpex=1.0 85 p2=p3+dpex C2*** Calculate the volumetric efficiency of the compressor Effvol=1+Cf-Cf*(p2/p1)**(1/Gamma) C1*** Calculate the refrigerant mass flow rate MfrRef=Effvol*Vs/v1p dpexp=dpex C2*** Recalculate the pressure drop dpex=MfrRef**2*v2p/(2*(Nc*Aex)**2) ErrRel=ABS((dpex-dpexp)/dpexp) C2*** If converged, leave loop IF (ErrRel.GT.TolRel) GOTO 85 C2*** Calculate the isentropic compression power Wis=MfrRef*Zeta*r*T1p*((p2/p1)**Gm1G-1)/Gm1G T1pp=T1p C1*** Recalculate the temperature after the heating-up T1p=T1+(Losses+Alpha*Wis+(1+Alpha)*(1-Nc/NcFL)* & Wpumping)/(MfrRef*cpvap) ErrRel=ABS((T1p-T1pp)/T1pp) C2*** If converged, leave the third loop IF (ErrRel.GT.TolRel) GOTO 80 C1*** Calculate the power consumed by the compressor Pcomp=Losses+(1+Alpha)*(Wis+(1-Nc/NcFL)*Wpumping) Pcdp=Pcd C1*** Calculate the heat rejected in the condenser Pcd=Pev+Pcomp ErrRel=ABS((Pcd-Pcdp)/Pcdp) C2*** If converged, leave the second loop IF (ErrRel.GT.TolRel) GOTO 70 C1*** Calculate the cooling capacity Pcd=Pcdp Pevp=Pev Pev=MfrRef*(h1-h3) ErrRel=ABS((Pev-Pevp)/Pevp) C2*** If converged, leave the first loop IF (ErrRel.GT.TolRel) GOTO 60 Pev=Pevp C1*** Calculate the coefficient of performance COP=Pev/Pcomp GOTO (90,100,110,120),NChoice C1*** Calculate the evaporator and condenser exhaust water temperatures 90 Twev2=Twsuev-Pev/(CpWat*Mfrwev) Twcd2=Twsucd+Pcd/(CpWat*Mfrwcd) GOTO 130 C1*** Calculate the evaporator exhaust water temperature and the condenser C1*** supply water temperature 100 Twev2=Twsuev-Pev/(CpWat*Mfrwev) Twcd2=Twexcd-Pcd/(CpWat*Mfrwcd) GOTO 130 C1*** Calculate the evaporator and condenser supply water temperatures 110 Twev2=Twexev+Pev/(CpWat*Mfrwev) Twcd2=Twexcd-Pcd/(CpWat*Mfrwcd) GOTO 130 C1*** Calculate the evaporator supply water temperature and the condenser C1*** exhaust water temperature 120 Twev2=Twexev+Pev/(CpWat*Mfrwev) Twcd2=Twsucd+Pcd/(CpWat*Mfrwcd) 130 CONTINUE C*** OUTPUTS 7 (converted in TRNSYS units) C************* out(1)=DBLE(MfrRef*3600.) out(2)=DBLE(Pev*3.6) out(3)=DBLE(Pcomp*3.6) out(4)=DBLE(Pcd*3.6) out(5)=DBLE(COP) out(6)=DBLE(Twev2-273.15) out(7)=DBLE(Twcd2-273.15) RETURN 1 END & b,r,Zeta,Zetacd,Gamma,Acl,Bcl,*) C************************************************************************ C* Copyright ASHRAE A Toolkit for Primary HVAC System Energy C* Calculation C*********************************************************************** C* SUBROUTINE: PROPERTY C* C* LANGUAGE: FORTRAN 77 C* C* PURPOSE: Selection of the thermodynamic properties C* of a given refrigerant. C*********************************************************************** C* INPUT VARIABLES: C* Ifluid Selection of the refrigerant (-) C* If Ifluid C* =1: Refrigerant 12 C* =2: Refrigerant 134a C* =3: Refrigerant 114 C* =4: Refrigerant 22 C* =5: Refrigerant 502 C* =6: Refrigerant 717 (Ammonia) C*********************************************************************** C* OUTPUT VARIABLES: C* To Reference temperature (K) C* cpliq Mean specific heat in saturated liquid state (J/kg/K) C* hfo Enthalpy of the saturated liquid at the (J/kg) C* reference temperature C* cpvap Mean specific heat at constant pressure (J/kg/K) C* in superheated vapor state for saturation C* temperatures ranging from 253 K to 283 K C* cpvapcd Mean specific heat at constant pressure (J/kg/K) C* in superheated vapor state for saturation C* temperatures ranging from 303 K to 333 K C* hfgb Vaporization enthalpy at standard boiling (J/kg) C* point (101325 Pa) C* Tb Standard boiling temperature (K) C* Tc Critical temperature (K) C* b Coefficient used in the calculation of the (-) C* vaporization enthalpy C* r Gas constant (J/kg/K) C* Zeta Mean compressibility factor for saturation (-) C* temperatures ranging from 253 K to 283 K C* Zetacd Mean compressibility factor for saturation (-) C* temperatures ranging from 303 K to 333 K C* Gamma Mean isentropic coefficient (-) C* Acl First coefficient in the Clausius-Clapeyron (-) C* equation C* Bcl Second coefficient in the Clausius-Clapeyron (K) C* equation C*********************************************************************** C MAJOR RESTRICTION: Perfect gas approximation is used C C DEVELOPER: Claudio Saavedra C University of Concepcion, Chile C Marc Grodent, Jean-Pascal Bourdouxhe C University of LiŠge, Belgium C C DATE: March 1, 1995 C*********************************************************************** REAL Ifluid To=233.15 IF (Ifluid.EQ.1) THEN cpliq=917 hfo=0 cpvap=641.6 cpvapcd=779 hfgb=165300 Tb=243.4 Tc=385.2 b=0.37 r=68.7539 Zeta=0.9403 Zetacd=0.8670 Gamma=1.086 Acl=14.669 Bcl=-2443.13 ENDIF IF (Ifluid.EQ.2) THEN cpliq=1265 hfo=0 cpvap=892.5 cpvapcd=1144 hfgb=215100 Tb=246.9 Tc=374.3 b=0.376 r=81.4899 Zeta=0.9411 Zetacd=0.8610 Gamma=1.072 Acl=15.489 Bcl=-2681.99 ENDIF IF (Ifluid.EQ.3) THEN cpliq=925 hfo=0 cpvap=693.6 cpvapcd=784 hfgb=136100 Tb=276.9 Tc=418.9 b=0.359 r=48.6393 Zeta=0.9757 Zetacd=0.9260 Gamma=1.056 Acl=15.107 Bcl=-2908.73 ENDIF IF (Ifluid.EQ.4) THEN cpliq=1144 hfo=0 cpvap=710.4 cpvapcd=936 hfgb=233700 Tb=232.4 Tc=369.2 b=0.369 r=96.1426 Zeta=0.9300 Zetacd=0.8440 Gamma=1.114 Acl=15.070 Bcl=-2421.94 ENDIF IF (Ifluid.EQ.5) THEN cpliq=1090 hfo=0 cpvap=732 cpvapcd=965 hfgb=172500 Tb=227.8 Tc=355.4 b=0.374 r=74.4752 Zeta=0.9130 Zetacd=0.8150 Gamma=1.065 Acl=14.809 Bcl=-2312.21 ENDIF IF (Ifluid.EQ.6) THEN cpliq=4575 hfo=0 cpvap=2447.1 cpvapcd=3159 hfgb=1372900 Tb=239.8 Tc=405.6 b=0.396 r=488.2214 Zeta=0.9570 Zetacd=0.8960 Gamma=1.230 Acl=16.204 Bcl=-2772.39 ENDIF RETURN 1 END